summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/luatexdir/luatex.web
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/luatexdir/luatex.web')
-rw-r--r--Build/source/texk/web2c/luatexdir/luatex.web31941
1 files changed, 0 insertions, 31941 deletions
diff --git a/Build/source/texk/web2c/luatexdir/luatex.web b/Build/source/texk/web2c/luatexdir/luatex.web
deleted file mode 100644
index 2a2589f7d07..00000000000
--- a/Build/source/texk/web2c/luatexdir/luatex.web
+++ /dev/null
@@ -1,31941 +0,0 @@
-% luatex.web
-%
-% Copyright 2006-2009 Taco Hoekwater <taco@@luatex.org>
-% Copyright 2006-2009 Hartmut Henkel <hartmut@@luatex.org>
-%
-% This file is part of LuaTeX.
-%
-% LuaTeX is free software; you can redistribute it and/or modify it under
-% the terms of the GNU General Public License as published by the Free
-% Software Foundation; either version 2 of the License, or (at your
-% option) any later version.
-%
-% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
-% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
-% License for more details.
-%
-% You should have received a copy of the GNU General Public License along
-% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
-%
-% $Id$
-
-% pdfTeX is copyright (C) 1996-2006 Han The Thanh, <thanh@@pdftex.org>.
-% e-TeX is copyright (C) 1994,98 by Peter Breitenlohner.
-
-% This program is directly derived from Donald E. Knuth's TeX;
-% the change history which follows and the reward offered for finders of
-% bugs refer specifically to TeX; they should not be taken as referring
-% to e-TeX, although the change history is relevant in that it
-% demonstrates the evolutionary path followed. This program is not TeX;
-% that name is reserved strictly for the program which is the creation
-% and sole responsibility of Professor Knuth.
-
-% Version 0 was released in September 1982 after it passed a variety of tests.
-% Version 1 was released in November 1983 after thorough testing.
-% Version 1.1 fixed ``disappearing font identifiers'' et alia (July 1984).
-% Version 1.2 allowed `0' in response to an error, et alia (October 1984).
-% Version 1.3 made memory allocation more flexible and local (November 1984).
-% Version 1.4 fixed accents right after line breaks, et alia (April 1985).
-% Version 1.5 fixed \the\toks after other expansion in \edefs (August 1985).
-% Version 2.0 (almost identical to 1.5) corresponds to "Volume B" (April 1986).
-% Version 2.1 corrected anomalies in discretionary breaks (January 1987).
-% Version 2.2 corrected "(Please type...)" with null \endlinechar (April 1987).
-% Version 2.3 avoided incomplete page in premature termination (August 1987).
-% Version 2.4 fixed \noaligned rules in indented displays (August 1987).
-% Version 2.5 saved cur_order when expanding tokens (September 1987).
-% Version 2.6 added 10sp slop when shipping leaders (November 1987).
-% Version 2.7 improved rounding of negative-width characters (November 1987).
-% Version 2.8 fixed weird bug if no \patterns are used (December 1987).
-% Version 2.9 made \csname\endcsname's "relax" local (December 1987).
-% Version 2.91 fixed \outer\def\a0{}\a\a bug (April 1988).
-% Version 2.92 fixed \patterns, also file names with complex macros (May 1988).
-% Version 2.93 fixed negative halving in allocator when mem_min<0 (June 1988).
-% Version 2.94 kept open_log_file from calling fatal_error (November 1988).
-% Version 2.95 solved that problem a better way (December 1988).
-% Version 2.96 corrected bug in "Infinite shrinkage" recovery (January 1989).
-% Version 2.97 corrected blunder in creating 2.95 (February 1989).
-% Version 2.98 omitted save_for_after at outer level (March 1989).
-% Version 2.99 caught $$\begingroup\halign..$$ (June 1989).
-% Version 2.991 caught .5\ifdim.6... (June 1989).
-% Version 2.992 introduced major changes for 8-bit extensions (September 1989).
-% Version 2.993 fixed a save_stack synchronization bug et alia (December 1989).
-% Version 3.0 fixed unusual displays; was more \output robust (March 1990).
-% Version 3.1 fixed nullfont, disabled \write{\the\prevgraf} (September 1990).
-% Version 3.14 fixed unprintable font names and corrected typos (March 1991).
-% Version 3.141 more of same; reconstituted ligatures better (March 1992).
-% Version 3.1415 preserved nonexplicit kerns, tidied up (February 1993).
-% Version 3.14159 allowed fontmemsize to change; bulletproofing (March 1995).
-% Version 3.141592 fixed \xleaders, glueset, weird alignments (December 2002).
-% Version 3.1415926 was a general cleanup with minor fixes (February 2008).
-
-
-% Although considerable effort has been expended to make the LuaTeX program
-% correct and reliable, no warranty is implied; the authors disclaim any
-% obligation or liability for damages, including but not limited to
-% special, indirect, or consequential damages arising out of or in
-% connection with the use or performance of this software. This work has
-% been a ``labor of love'' and the authors hope that users enjoy it.
-
-% Here is TeX material that gets inserted after \input webmac
-\def\hang{\hangindent 3em\noindent\ignorespaces}
-\def\hangg#1 {\hang\hbox{#1 }}
-\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
-\font\ninerm=cmr9
-\let\mc=\ninerm % medium caps for names like SAIL
-\def\PASCAL{Pascal}
-\def\pdfTeX{pdf\TeX}
-\def\pdfeTeX{pdf\eTeX}
-\def\PDF{PDF}
-\def\Aleph{Aleph}
-\def\eTeX{e\TeX}
-\def\LuaTeX{Lua\TeX}
-\def\THANH{H\`an Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh}
-\def\ph{\hbox{Pascal-H}}
-\def\pct!{{\char`\%}} % percent sign in ordinary text
-\def\grp{\.{\char'173...\char'175}}
-\font\logo=logo10 % font used for the METAFONT logo
-\def\MF{{\logo META}\-{\logo FONT}}
-\def\<#1>{$\langle#1\rangle$}
-\def\section{\mathhexbox278}
-
-\def\(#1){} % this is used to make section names sort themselves better
-\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
-
-\outer\def\N#1. \[#2]#3.{\MN#1.\vfil\eject % begin starred section
- \def\rhead{PART #2:\uppercase{#3}} % define running headline
- \message{*\modno} % progress report
- \edef\next{\write\cont{\Z{\?#2]#3}{\modno}{\the\pageno}}}\next
- \ifon\startsection{\bf\ignorespaces#3.\quad}\ignorespaces}
-\let\?=\relax % we want to be able to \write a \?
-
-\def\title{LuaTeX}
-\let\maybe=\iffalse % print only changed modules
-\def\topofcontents{\hsize 5.5in
- \vglue 0pt plus 1fil minus 1.5in
- \def\?##1]{\hbox to 1in{\hfil##1.\ }}
- }
-\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
-\pageno=3
-\def\glob{13} % this should be the section number of "<Global...>"
-\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
-
-@* \[1] Introduction.
-
-This is LuaTeX, a continuation of $\pdfTeX$ and $\Aleph$. LuaTeX is a
-document compiler intended to simplify high-quality typesetting for
-many of the world's languages. It is an extension of D. E. Knuth's
-\TeX, which was designed essentially for the typesetting of languages
-using the Latin alphabet.
-
-The $\Aleph$ subsystem loosens many of the restrictions imposed by~\TeX:
-register numbers are no longer limited to 8~bits; fonts may have more
-than 256~characters; more than 256~fonts may be used; etc.
-
-The \PASCAL\ program that follows is the definition of \TeX82, a standard
-@:PASCAL}{\PASCAL@>
-@!@:TeX82}{\TeX82@>
-version of \TeX\ that is designed to be highly portable so that
-identical output will be obtainable on a great variety of computers.
-
-The main purpose of the following program is to explain the algorithms of \TeX\
-as clearly as possible. As a result, the program will not necessarily be very
-efficient when a particular \PASCAL\ compiler has translated it into a
-particular machine language. However, the program has been written so that it
-can be tuned to run efficiently in a wide variety of operating environments
-by making comparatively few changes. Such flexibility is possible because
-the documentation that follows is written in the \.{WEB} language, which is
-at a higher level than \PASCAL; the preprocessing step that converts \.{WEB}
-to \PASCAL\ is able to introduce most of the necessary refinements.
-Semi-automatic translation to other languages is also feasible, because the
-program below does not make extensive use of features that are peculiar to
-\PASCAL.
-
-A large piece of software like \TeX\ has inherent complexity that cannot
-be reduced below a certain level of difficulty, although each individual
-part is fairly simple by itself. The \.{WEB} language is intended to make
-the algorithms as readable as possible, by reflecting the way the
-individual program pieces fit together and by providing the
-cross-references that connect different parts. Detailed comments about
-what is going on, and about why things were done in certain ways, have
-been liberally sprinkled throughout the program. These comments explain
-features of the implementation, but they rarely attempt to explain the
-\TeX\ language itself, since the reader is supposed to be familiar with
-{\sl The \TeX book}.
-@.WEB@>
-@:TeXbook}{\sl The \TeX book@>
-
-@ The present implementation has a long ancestry, beginning in the summer
-of~1977, when Michael~F. Plass and Frank~M. Liang designed and coded
-a prototype
-@^Plass, Michael Frederick@>
-@^Liang, Franklin Mark@>
-@^Knuth, Donald Ervin@>
-based on some specifications that the author had made in May of that year.
-This original proto\TeX\ included macro definitions and elementary
-manipulations on boxes and glue, but it did not have line-breaking,
-page-breaking, mathematical formulas, alignment routines, error recovery,
-or the present semantic nest; furthermore,
-it used character lists instead of token lists, so that a control sequence
-like \.{\\halign} was represented by a list of seven characters. A
-complete version of \TeX\ was designed and coded by the author in late
-1977 and early 1978; that program, like its prototype, was written in the
-{\mc SAIL} language, for which an excellent debugging system was
-available. Preliminary plans to convert the {\mc SAIL} code into a form
-somewhat like the present ``web'' were developed by Luis Trabb~Pardo and
-@^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 `\eTeX' and not
-`\TeX'; the official name `\TeX' by itself is reserved
-for software systems that are fully compatible with each other.
-A special test suite called the ``\.{TRIP} test'' is available for
-helping to determine whether a particular implementation deserves to be
-known as `\TeX' [cf.~Stanford Computer Science report CS1027,
-November 1984].
-
-A similar test suite called the ``\.{e-TRIP} test'' is available for
-helping to determine whether a particular implementation deserves to be
-known as `\eTeX'.
-
-@d eTeX_version_string=="2.2" {current \eTeX\ version}
-@d Omega_version_string=="1.15" { \.{\\OmegaVersion} }
-@d Aleph_version_string=="0.0" { \.{\\AlephVersion} }
-@d eTeX_version=2 { \.{\\eTeXversion} }
-@d Omega_version=1 { \.{\\Omegaversion} }
-@d Aleph_version=0 { \.{\\Alephversion} }
-@d eTeX_minor_version=1 { \.{\\eTeXminorversion} }
-@d Omega_minor_version=15 { \.{\\Omegaminorversion} }
-@d Aleph_minor_version=0 { \.{\\Alephminorversion} }
-@d eTeX_revision==".2" { \.{\\eTeXrevision} }
-@d Omega_revision==".15" { \.{\\Omegarevision} }
-@d Aleph_revision==".0" { \.{\\Alephrevision} }
-@#
-@d pdftex_version==200 { \.{\\pdftexversion} }
-@d pdftex_revision=="0" { \.{\\pdftexrevision} }
-@d pdftex_version_string=='-2.00.0' {current \pdfTeX\ version}
-@#
-@d luatex_version==40 { \.{\\luatexversion} }
-@d luatex_revision=="6" { \.{\\luatexrevision} }
-@d luatex_version_string=='beta-0.40.6' {current \LuaTeX\ version}
-@d luatex_date_info==-extra_version_info { the compile date is negated }
-@d luatex_svnversion=='$Id$'
- {for long --version information, as proposed by Peter M\"unster}
-@#
-@d LuaTeX_banner=='This is LuaTeX, Version ',luatex_version_string,extra_version_info
- {printed when \LuaTeX\ starts}
-@#
-@d banner==LuaTeX_banner
-@#
-@d TEX==ETEX {change program name into |ETEX|}
-
-@ Different \PASCAL s have slightly different conventions, and the present
-@!@:PASCAL H}{\ph@>
-program expresses \TeX\ in terms of the \PASCAL\ that was
-available to the author in 1982. Constructions that apply to
-this particular compiler, which we shall call \ph, should help the
-reader see how to make an appropriate interface for other systems
-if necessary. (\ph\ is Charles Hedrick's modification of a compiler
-@^Hedrick, Charles Locke@>
-for the DECsystem-10 that was originally developed at the University of
-Hamburg; cf.\ {\sl SOFTWARE---Practice \AM\ Experience \bf6} (1976),
-29--42. The \TeX\ program below is intended to be adaptable, without
-extensive changes, to most other versions of \PASCAL, so it does not fully
-use the admirable features of \ph. Indeed, a conscious effort has been
-made here to avoid using several idiosyncratic features of standard
-\PASCAL\ itself, so that most of the code can be translated mechanically
-into other high-level languages. For example, the `\&{with}' and `\\{new}'
-features are not used, nor are pointer types, set types, or enumerated
-scalar types; there are no `\&{var}' parameters, except in the case of files
---- \eTeX, however, does use `\&{var}' parameters for the |reverse| function;
-there are no tag fields on variant records; there are no assignments
-|real:=integer|; no procedures are declared local to other procedures.)
-
-The portions of this program that involve system-dependent code, where
-changes might be necessary because of differences between \PASCAL\ compilers
-and/or differences between
-operating systems, can be identified by looking at the sections whose
-numbers are listed under `system dependencies' in the index. Furthermore,
-the index entries for `dirty \PASCAL' list all places where the restrictions
-of \PASCAL\ have not been followed perfectly, for one reason or another.
-@!@^system dependencies@>
-@!@^dirty \PASCAL@>
-
-Incidentally, \PASCAL's standard |round| function can be problematical,
-because it disagrees with the IEEE floating-point standard.
-Many implementors have
-therefore chosen to substitute their own home-grown rounding procedure.
-
-@ The program begins with a normal \PASCAL\ program heading, whose
-components will be filled in later, using the conventions of \.{WEB}.
-@.WEB@>
-For example, the portion of the program called `\X\glob:Global
-variables\X' below will be replaced by a sequence of variable declarations
-that starts in $\section\glob$ of this documentation. In this way, we are able
-to define each individual global variable when we are prepared to
-understand what it means; we do not have to define all of the globals at
-once. Cross references in $\section\glob$, where it says ``See also
-sections \gglob, \dots,'' also make it possible to look at the set of
-all global variables, if desired. Similar remarks apply to the other
-portions of the program heading.
-
-Actually the heading shown here is not quite normal: The |program| line
-does not mention any |output| file, because \ph\ would ask the \TeX\ user
-to specify a file name if |output| were specified here.
-@: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@>@/
-
-@ Here is a workaround for the unfortunate limitation of WEB2C that
-doesn't know how to deal with symbolic case labels.
-
-@d hlist_node_case==0
-@d vlist_node_case==1
-@d rule_node_case==2
-@d ins_node_case==3
-@d mark_node_case==4
-@d adjust_node_case==5
-@d disc_node_case==7
-@d whatsit_node_case==8
-@d math_node_case==9
-@d glue_node_case==10
-@d kern_node_case==11
-@d penalty_node_case==12
-@d unset_node_case==13
-@d margin_kern_node_case==36
-
-@<Initialize whatever \TeX\ might access@>=
-pdfassert(hlist_node_case=hlist_node);
-pdfassert(vlist_node_case=vlist_node);
-pdfassert(rule_node_case=rule_node);
-pdfassert(ins_node_case=ins_node);
-pdfassert(mark_node_case=mark_node);
-pdfassert(adjust_node_case=adjust_node);
-pdfassert(disc_node_case=disc_node);
-pdfassert(whatsit_node_case=whatsit_node);
-pdfassert(math_node_case=math_node);
-pdfassert(glue_node_case=glue_node);
-pdfassert(kern_node_case=kern_node);
-pdfassert(penalty_node_case=penalty_node);
-pdfassert(unset_node_case=unset_node);
-pdfassert(margin_kern_node_case=margin_kern_node);
-
-
-
-
-
-@ The overall \TeX\ program begins with the heading just shown, after which
-comes a bunch of procedure declarations and function declarations.
-Finally we will get to the main program, which begins with the
-comment `|start_here|'. If you want to skip down to the
-main program now, you can look up `|start_here|' in the index.
-But the author suggests that the best way to understand this program
-is to follow pretty much the order of \TeX's components as they appear in the
-\.{WEB} description you are now reading, since the present ordering is
-intended to combine the advantages of the ``bottom up'' and ``top down''
-approaches to the problem of understanding a somewhat complicated system.
-
-@ Three labels must be declared in the main program, so we give them
-symbolic names.
-
-@d start_of_TEX=1 {go here when \TeX's variables are initialized}
-@d end_of_TEX=9998 {go here to close files and terminate gracefully}
-@d final_end=9999 {this label marks the ending of the program}
-
-@<Labels in the out...@>=
-start_of_TEX@t\hskip-2pt@>, end_of_TEX@t\hskip-2pt@>,@,final_end;
- {key control points}
-
-@ Some of the code below is intended to be used only when diagnosing the
-strange behavior that sometimes occurs when \TeX\ is being installed or
-when system wizards are fooling around with \TeX\ without quite knowing
-what they are doing. Such code will not normally be compiled; it is
-delimited by the codewords `$|debug|\ldots|gubed|$', with apologies
-to people who wish to preserve the purity of English.
-
-Similarly, there is some conditional code delimited by
-`$|stat|\ldots|tats|$' that is intended for use when statistics are to be
-kept about \TeX's memory usage. The |stat| $\ldots$ |tats| code also
-implements diagnostic information for \.{\\tracingparagraphs} and
-\.{\\tracingpages}.
-@^debugging@>
-
-@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
-@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
-@f debug==begin
-@f gubed==end
-@#
-@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
- usage statistics}
-@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
- usage statistics}
-@f stat==begin
-@f tats==end
-
-@ This program has two important variations: (1) There is a long and slow
-version called \.{INITEX}, which does the extra calculations needed to
-@.INITEX@>
-initialize \TeX's internal tables; and (2)~there is a shorter and faster
-production version, which cuts the initialization to a bare minimum.
-Parts of the program that are needed in (1) but not in (2) are delimited by
-the codewords `$|init|\ldots|tini|$'.
-
-@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
-@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
-@f init==begin
-@f tini==end
-
-@<Initialize whatever...@>=
-@<Set initial values of key variables@>@/
-@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini
-
-@ If the first character of a \PASCAL\ comment is a dollar sign,
-\ph\ treats the comment as a list of ``compiler directives'' that will
-affect the translation of this program into machine language. The
-directives shown below specify full checking and inclusion of the \PASCAL\
-debugger when \TeX\ is being debugged, but they cause range checking and other
-redundant code to be eliminated when the production system is being generated.
-Arithmetic overflow will be detected in all cases.
-@: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...@>=
-@!buf_size=500; {maximum number of characters simultaneously present in
- current lines of open files and in control sequences between
- \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
-@!error_line=72; {width of context lines on terminal error messages}
-@!half_error_line=42; {width of first lines of contexts in terminal
- error messages; should be between 30 and |error_line-15|}
-@!max_print_line=79; {width of longest text lines output; should be at least 60}
-@!stack_size=200; {maximum number of simultaneous input sources}
-@!max_in_open=6; {maximum number of input files and error insertions that
- can be going on simultaneously}
-@!param_size=60; {maximum number of simultaneous macro parameters}
-@!nest_size=40; {maximum number of semantic levels simultaneously active}
-@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
-@!string_vacancies=8000; {the minimum number of characters that should be
- available for the user's control sequences and font names,
- after \TeX's own error messages are stored}
-@!pool_size=32000; {maximum number of characters in strings, including all
- error messages and help texts, and the names of all fonts and
- control sequences; must exceed |string_vacancies| by the total
- length of \TeX's own strings, which is currently about 23000}
-@!save_size=600; {space for saving values outside of current group; must be
- at most |max_halfword|}
-@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
-@!expand_depth=10000; {limits recursive calls of the |expand| procedure}
-@!file_name_size=40; {file names shouldn't be longer than this}
-@!pool_name='TeXformats:TEX.POOL ';
- {string of length |file_name_size|; tells where the string pool appears}
-@.TeXformats@>
-@!active_mem_size=50000; {number of words of |active_info| for active ocps}
-@!ocp_maxint=@"10000000;
-
-
-@ Like the preceding parameters, the following quantities can be changed
-at compile time to extend or reduce \TeX's capacity. But if they are changed,
-it is necessary to rerun the initialization program \.{INITEX}
-@.INITEX@>
-to generate new tables for the production \TeX\ program.
-One can't simply make helter-skelter changes to the following constants,
-since certain rather complex initialization
-numbers are computed from them. They are defined here using
-\.{WEB} macros, instead of being put into \PASCAL's |const| list, in order to
-emphasize this distinction.
-
-@d font_base=0 {smallest internal font number; must not be less
- than |min_quarterword|}
-@d hash_size=65536 {maximum number of control sequences; it should be at most
- about |(fix_mem_max-fix_mem_min)/10|}
-@d ocp_base=0 {smallest internal ocp number; must not be less
- than |min_quarterword|}
-@d ocp_biggest=32767 {the real biggest ocp}
-@d number_ocps=ocp_biggest-ocp_base+1
-@d ocp_list_base=0 {smallest internal ocp list number; must not be less
- than |min_quarterword|}
-@d ocp_list_biggest=32727 {the real biggest ocp list}
-@d number_ocp_lists=ocp_list_biggest-ocp_list_base+1
-@d max_active_ocp_lists=32768
-@d biggest_reg=65535 {the largest allowed register number; must be |<=max_quarterword|}
-@d number_regs=65536 {|biggest_reg+1|}
-@d number_attrs=65536 {total numbeer of attributes}
-@d biggest_mark=65535 {the largest allowed marks class; must be |<=max_quarterword|}
-@d number_marks=65536 {|biggest_mark+1|}
-{using |2^20+2^16| characters instead of |2^21| saves 286MB on the virtual memory size
- of the running executable}
-@d biggest_char=1114111 {2097151} {the largest allowed character number; must be |<=max_halfword|}
-@d too_big_char=1114112 {2097152} {|biggest_char+1|}
-@d special_char=1114113 {2097153} {|biggest_char+2|}
-@d number_chars=1114112 {2097152} {|biggest_char+1|}
-@d string_offset=2097152
-@d font_biggest=5535 {the real biggest font}
-@d number_fonts=font_biggest-font_base+1
-@d biggest_lang=32767
-@d too_big_lang=32768
-@d text_size=0 {size code for the largest size in a family}
-@d script_size=1 {size code for the medium size in a family}
-@d script_script_size=2 {size code for the smallest size in a family}
-
-
-@ In case somebody has inadvertently made bad settings of the ``constants,''
-\TeX\ checks them using a global variable called |bad|.
-
-This is the first of many sections of \TeX\ where global variables are
-defined.
-
-@<Glob...@>=
-@!bad:integer; {is some ``constant'' wrong?}
-@!luainit:boolean; {are we using lua for initializations }
-@!tracefilenames:boolean; { print file open-close info? }
-
-@ Later on we will say `\ignorespaces|if X>=max_halfword then bad:=14|',
-or something similar. (We can't do that until |max_halfword| has been defined.)
-
-@<Check the ``constant'' values for consistency@>=
-bad:=0;
-if not luainit then tracefilenames:=true;
-if (half_error_line<30)or(half_error_line>error_line-15) then bad:=1;
-if max_print_line<60 then bad:=2;
-if dvi_buf_size mod 8<>0 then bad:=3;
-if hash_prime>hash_size then bad:=5;
-if max_in_open>=128 then bad:=6;
-{ |if null_list<256 then bad:=7;| } {we will want |null_list>255|}
-
-@ Labels are given symbolic names by the following definitions, so that
-occasional |goto| statements will be meaningful. We insert the label
-`|exit|' just before the `\ignorespaces|end|\unskip' of a procedure in
-which we have used the `|return|' statement defined below; the label
-`|restart|' is occasionally used at the very beginning of a procedure; and
-the label `|reswitch|' is occasionally used just prior to a |case|
-statement in which some cases change the conditions and we wish to branch
-to the newly applicable case. Loops that are set up with the |loop|
-construction defined below are commonly exited by going to `|done|' or to
-`|found|' or to `|not_found|', and they are sometimes repeated by going to
-`|continue|'. If two or more parts of a subroutine start differently but
-end up the same, the shared code may be gathered together at
-`|common_ending|'.
-
-Incidentally, this program never declares a label that isn't actually used,
-because some fussy \PASCAL\ compilers will complain about redundant labels.
-
-@d exit=10 {go here to leave a procedure}
-@d restart=20 {go here to start a procedure again}
-@d reswitch=21 {go here to start a case statement again}
-@d continue=22 {go here to resume a loop}
-@d done=30 {go here to exit a loop}
-@d done1=31 {like |done|, when there is more than one loop}
-@d done2=32 {for exiting the second loop in a long block}
-@d done3=33 {for exiting the third loop in a very long block}
-@d done4=34 {for exiting the fourth loop in an extremely long block}
-@d done5=35 {for exiting the fifth loop in an immense block}
-@d done6=36 {for exiting the sixth loop in a block}
-@d found=40 {go here when you've found it}
-@d found1=41 {like |found|, when there's more than one per routine}
-@d found2=42 {like |found|, when there's more than two per routine}
-@d not_found=45 {go here when you've found nothing}
-@d not_found1=46 {like |not_found|, when there's more than one}
-@d not_found2=47 {like |not_found|, when there's more than two}
-@d not_found3=48 {like |not_found|, when there's more than three}
-@d not_found4=49 {like |not_found|, when there's more than four}
-@d common_ending=50 {go here when you want to merge with another branch}
-
-@ Here are some macros for common programming idioms.
-
-@d incr(#) == #:=#+1 {increase a variable by unity}
-@d decr(#) == #:=#-1 {decrease a variable by unity}
-@d negate(#) == #:=-# {change the sign of a variable}
-@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
-@f loop == xclause
- {\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'}
-@d do_nothing == pdfassert(1) {empty statement}
-@d return == goto exit {terminate a procedure call}
-@f return == nil
-@d empty=0 {symbolic name for a null constant}
-
-@* \[2] The character set.
-In order to make \TeX\ readily portable to a wide variety of
-computers, all of its input text is converted to an internal
-twenty-one-bit code that covers all of unicode, including ASCII, the
-``American Standard Code for Information Interchange.'' This
-conversion is done immediately when each character is read
-in. Conversely, characters are converted from ASCII to the user's
-external representation just before they are output to a text file.
-
-Such an internal code is relevant to users of \TeX\ primarily because it
-governs the positions of characters in the fonts. For example, the
-character `\.A' has ASCII code $65=@'101$, and when \TeX\ typesets
-this letter it specifies character number 65 in the current font.
-If that font actually has `\.A' in a different position, \TeX\ doesn't
-know what the real position is; the program that does the actual printing from
-\TeX's device-independent files is responsible for converting from ASCII to
-a particular font encoding.
-@^ASCII code@>
-
-\TeX's internal code also defines the value of constants
-that begin with a reverse apostrophe; and it provides an index to the
-\.{\\catcode}, \.{\\mathcode}, \.{\\uccode}, \.{\\lccode}, and \.{\\delcode}
-tables.
-
-@ Characters of text that have been converted to \TeX's internal form
-are said to be of type |ASCII_code|, which is a subrange of the integers.
-
-@<Types...@>=
-@!ASCII_code=0..biggest_char; {eight-bit numbers}
-@!BMP_code=0..65535; {sixteen-bit numbers}
-
-@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
-character sets were common, so it did not make provision for lowercase
-letters. Nowadays, of course, we need to deal with both capital and small
-letters in a convenient way, especially in a program for typesetting;
-so the present specification of \TeX\ has been written under the assumption
-that the \PASCAL\ compiler and run-time system permit the use of text files
-with more than 64 distinguishable characters. More precisely, we assume that
-the character set contains at least the letters and symbols associated
-with ASCII codes @'40 through @'176; all of these characters are now
-available on most computer terminals.
-
-Since we are dealing with more characters than were present in the first
-\PASCAL\ compilers, we have to decide what to call the associated data
-type. Some \PASCAL s use the original name |char| for the
-characters in text files, even though there now are more than 64 such
-characters, while other \PASCAL s consider |char| to be a 64-element
-subrange of a larger data type that has some other name.
-
-In order to accommodate this difference, we shall use the name |text_char|
-to stand for the data type of the characters that are converted to and
-from |ASCII_code| when they are input and output. We shall also assume
-that |text_char| consists of the elements |chr(first_text_char)| through
-|chr(last_text_char)|, inclusive. The following definitions should be
-adjusted if necessary.
-@^system dependencies@>
-
-@d text_char == char {the data type of characters in text files}
-@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
-@d last_text_char=255 {ordinal number of the largest element of |text_char|}
-
-@<Local variables for init...@>=
-@!i:integer;
-
-@ The \TeX\ processor converts between ASCII code and
-the user's external character set by means of arrays |xord| and |xchr|
-that are analogous to \PASCAL's |ord| and |chr| functions.
-
-@<Glob...@>=
-@!xchr: array [ASCII_code] of text_char;
- {specifies conversion of output characters}
-
-@ Since we are assuming that our \PASCAL\ system is able to read and
-write the visible characters of standard ASCII (although not
-necessarily using the ASCII codes to represent them), the following
-assignment statements initialize the standard part of the |xchr| array
-properly, without needing any system-dependent changes. On the other
-hand, it is possible to implement \TeX\ with less complete character
-sets, and in such cases it will be necessary to change something here.
-@^system dependencies@>
-
-@<Set init...@>=
-xchr[@'40]:=' ';
-xchr[@'41]:='!';
-xchr[@'42]:='"';
-xchr[@'43]:='#';
-xchr[@'44]:='$';
-xchr[@'45]:='%';
-xchr[@'46]:='&';
-xchr[@'47]:='''';@/
-xchr[@'50]:='(';
-xchr[@'51]:=')';
-xchr[@'52]:='*';
-xchr[@'53]:='+';
-xchr[@'54]:=',';
-xchr[@'55]:='-';
-xchr[@'56]:='.';
-xchr[@'57]:='/';@/
-xchr[@'60]:='0';
-xchr[@'61]:='1';
-xchr[@'62]:='2';
-xchr[@'63]:='3';
-xchr[@'64]:='4';
-xchr[@'65]:='5';
-xchr[@'66]:='6';
-xchr[@'67]:='7';@/
-xchr[@'70]:='8';
-xchr[@'71]:='9';
-xchr[@'72]:=':';
-xchr[@'73]:=';';
-xchr[@'74]:='<';
-xchr[@'75]:='=';
-xchr[@'76]:='>';
-xchr[@'77]:='?';@/
-xchr[@'100]:='@@';
-xchr[@'101]:='A';
-xchr[@'102]:='B';
-xchr[@'103]:='C';
-xchr[@'104]:='D';
-xchr[@'105]:='E';
-xchr[@'106]:='F';
-xchr[@'107]:='G';@/
-xchr[@'110]:='H';
-xchr[@'111]:='I';
-xchr[@'112]:='J';
-xchr[@'113]:='K';
-xchr[@'114]:='L';
-xchr[@'115]:='M';
-xchr[@'116]:='N';
-xchr[@'117]:='O';@/
-xchr[@'120]:='P';
-xchr[@'121]:='Q';
-xchr[@'122]:='R';
-xchr[@'123]:='S';
-xchr[@'124]:='T';
-xchr[@'125]:='U';
-xchr[@'126]:='V';
-xchr[@'127]:='W';@/
-xchr[@'130]:='X';
-xchr[@'131]:='Y';
-xchr[@'132]:='Z';
-xchr[@'133]:='[';
-xchr[@'134]:='\';
-xchr[@'135]:=']';
-xchr[@'136]:='^';
-xchr[@'137]:='_';@/
-xchr[@'140]:='`';
-xchr[@'141]:='a';
-xchr[@'142]:='b';
-xchr[@'143]:='c';
-xchr[@'144]:='d';
-xchr[@'145]:='e';
-xchr[@'146]:='f';
-xchr[@'147]:='g';@/
-xchr[@'150]:='h';
-xchr[@'151]:='i';
-xchr[@'152]:='j';
-xchr[@'153]:='k';
-xchr[@'154]:='l';
-xchr[@'155]:='m';
-xchr[@'156]:='n';
-xchr[@'157]:='o';@/
-xchr[@'160]:='p';
-xchr[@'161]:='q';
-xchr[@'162]:='r';
-xchr[@'163]:='s';
-xchr[@'164]:='t';
-xchr[@'165]:='u';
-xchr[@'166]:='v';
-xchr[@'167]:='w';@/
-xchr[@'170]:='x';
-xchr[@'171]:='y';
-xchr[@'172]:='z';
-xchr[@'173]:='{';
-xchr[@'174]:='|';
-xchr[@'175]:='}';
-xchr[@'176]:='~';@/
-
-@ Some of the ASCII codes without visible characters have been given symbolic
-names in this program because they are used with a special meaning.
-
-@d null_code=@'0 {ASCII code that might disappear}
-@d carriage_return=@'15 {ASCII code used at end of line}
-@d invalid_code=@'177 {ASCII code that many systems prohibit in text files}
-
-@ The ASCII code is ``standard'' only to a certain extent, since many
-computer installations have found it advantageous to have ready access
-to more than 94 printing characters. Appendix~C of {\sl The \TeX book\/}
-gives a complete specification of the intended correspondence between
-characters and \TeX's internal representation.
-@:TeXbook}{\sl The \TeX book@>
-
-If \TeX\ is being used
-on a garden-variety \PASCAL\ for which only standard ASCII
-codes will appear in the input and output files, it doesn't really matter
-what codes are specified in |xchr[0..@'37]|, but the safest policy is to
-blank everything out by using the code shown below.
-
-However, other settings of |xchr| will make \TeX\ more friendly on
-computers that have an extended character set, so that users can type things
-like `\.^^Z' instead of `\.{\\ne}'. People with extended character sets can
-assign codes arbitrarily, giving an |xchr| equivalent to whatever
-characters the users of \TeX\ are allowed to have in their input files.
-It is best to make the codes correspond to the intended interpretations as
-shown in Appendix~C whenever possible; but this is not necessary. For
-example, in countries with an alphabet of more than 26 letters, it is
-usually best to map the additional letters into codes less than~@'40.
-To get the most ``permissive'' character set, change |' '| on the
-right of these assignment statements to |chr(i)|.
-@^character set dependencies@>
-@^system dependencies@>
-
-@<Set init...@>=
-for i:=0 to biggest_char do xchr[i]:=i;
-
-@ The following system-independent code makes the |xord| array contain a
-suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
-where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
-|j| or more; hence, standard ASCII code numbers will be used instead of
-codes below @'40 in case there is a coincidence.
-
-@<Set init...@>=
-
-@* \[3] Input and output.
-The bane of portability is the fact that different operating systems treat
-input and output quite differently, perhaps because computer scientists
-have not given sufficient attention to this problem. People have felt somehow
-that input and output are not part of ``real'' programming. Well, it is true
-that some kinds of programming are more fun than others. With existing
-input/output conventions being so diverse and so messy, the only sources of
-joy in such parts of the code are the rare occasions when one can find a
-way to make the program a little less bad than it might have been. We have
-two choices, either to attack I/O now and get it over with, or to postpone
-I/O until near the end. Neither prospect is very attractive, so let's
-get it over with.
-
-The basic operations we need to do are (1)~inputting and outputting of
-text, to or from a file or the user's terminal; (2)~inputting and
-outputting of eight-bit bytes, to or from a file; (3)~instructing the
-operating system to initiate (``open'') or to terminate (``close'') input or
-output from a specified file; (4)~testing whether the end of an input
-file has been reached.
-
-\TeX\ needs to deal with two kinds of files.
-We shall use the term |alpha_file| for a file that contains textual data,
-and the term |byte_file| for a file that contains eight-bit binary information.
-These two types turn out to be the same on many computers, but
-sometimes there is a significant distinction, so we shall be careful to
-distinguish between them. Standard protocols for transferring
-such files from computer to computer, via high-speed networks, are
-now becoming available to more and more communities of users.
-
-The program actually makes use also of a third kind of file, called a
-|word_file|, when dumping and reloading base information for its own
-initialization. We shall define a word file later; but it will be possible
-for us to specify simple operations on word files before they are defined.
-
-@<Types...@>=
-@!eight_bits=0..65535; {unsigned one-byte quantity}
-@!real_eight_bits=0..255; {unsigned one-byte quantity}
-@!alpha_file=packed file of text_char; {files that contain textual data}
-@!byte_file=packed file of real_eight_bits; {files that contain binary data}
-
-@ Most of what we need to do with respect to input and output can be handled
-by the I/O facilities that are standard in \PASCAL, i.e., the routines
-called |get|, |put|, |eof|, and so on. But
-standard \PASCAL\ does not allow file variables to be associated with file
-names that are determined at run time, so it cannot be used to implement
-\TeX; some sort of extension to \PASCAL's ordinary |reset| and |rewrite|
-is crucial for our purposes. We shall assume that |nameoffile| is a variable
-of an appropriate type such that the \PASCAL\ run-time system being used to
-implement \TeX\ can open a file whose external name is specified by
-|nameoffile|.
-@^system dependencies@>
-
-@<Glob...@>=
-@!nameoffile:packed array[1..file_name_size] of char;@;@/
- {on some systems this may be a \&{record} variable}
-@!namelength:0..file_name_size;@/{this many characters are actually
- relevant in |nameoffile| (the rest are blank)}
-@!name_file_pointer:alpha_file;
-
-@ The \ph\ compiler with which the present version of \TeX\ was prepared has
-extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
-we can write
-$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
-|reset(f,@t\\{name}@>,'/O')|&for input;\cr
-|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
-The `\\{name}' parameter, which is of type `{\bf packed array
-$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of
-the external file that is being opened for input or output.
-Blank spaces that might appear in \\{name} are ignored.
-
-The `\.{/O}' parameter tells the operating system not to issue its own
-error messages if something goes wrong. If a file of the specified name
-cannot be found, or if such a file cannot be opened for some other reason
-(e.g., someone may already be trying to write the same file), we will have
-|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
-\TeX\ to undertake appropriate corrective action.
-@:PASCAL H}{\ph@>
-@^system dependencies@>
-
-\TeX's file-opening procedures return |false| if no file identified by
-|nameoffile| could be opened.
-
-@d reset_OK(#)==erstat(#)=0
-@d rewrite_OK(#)==erstat(#)=0
-
-@p function a_open_in(var f:alpha_file):boolean;
- {open a text file for input}
-begin reset(f,nameoffile,'/O'); a_open_in:=reset_OK(f);
-end;
-@#
-function a_open_out(var f:alpha_file):boolean;
- {open a text file for output}
-begin rewrite(f,nameoffile,'/O'); a_open_out:=rewrite_OK(f);
-end;
-@#
-function b_open_in(var f:byte_file):boolean;
- {open a binary file for input}
-begin reset(f,nameoffile,'/O'); b_open_in:=reset_OK(f);
-end;
-@#
-function b_open_out(var f:byte_file):boolean;
- {open a binary file for output}
-begin rewrite(f,nameoffile,'/O'); b_open_out:=rewrite_OK(f);
-end;
-@#
-function w_open_in(var f:word_file):boolean;
- {open a word file for input}
-begin reset(f,nameoffile,'/O'); w_open_in:=reset_OK(f);
-end;
-@#
-function w_open_out(var f:word_file):boolean;
- {open a word file for output}
-begin rewrite(f,nameoffile,'/O'); w_open_out:=rewrite_OK(f);
-end;
-
-@ When input files are opened via a callback, they will also be read using
-callbacks. for that purpose, the |open_read_file_callback| returns an
-integer to uniquely identify a callback table. This id replaces the file
-point |f| in this case, because the input does not have to be a file
-in the traditional sense.
-
-Signalling this fact is achieved by having two arrays of integers.
-
-@<Glob...@>=
-@!input_file_callback_id : ^integer;
-@!read_file_callback_id : array[0..16] of integer;
-
-@
-@p function lua_a_open_in(var f:alpha_file; n:quarterword):boolean;
-var k:integer; { a temporary value }
- fnam:str_number; { string returned by find callback }
- callback_id:integer;
- file_ok:boolean; { the status so far }
-begin
- file_ok:=true;
- if n=0 then begin
- texinputtype := 1; {Tell |open_input| we are \.{\\input}.}
- input_file_callback_id[index] := 0;
- end
- else begin
- texinputtype:=0;
- read_file_callback_id[n] := 0;
- end;
- callback_id:=callback_defined(find_read_file_callback);
- if callback_id>0 then begin
- fnam:=0;
- file_ok:=run_callback(callback_id,'dS->s',n,stringcast(nameoffile+1),addressof(fnam));
- if (file_ok)and(fnam<>0)and(length(fnam)>0) then begin
- @<Fixup |nameoffile| after callback@>;
- end
- else
- file_ok:=false; {file not found}
- end;
- if file_ok then begin
- callback_id:=callback_defined(open_read_file_callback);
- if callback_id>0 then begin
- k := run_and_save_callback(callback_id,'S->',stringcast(nameoffile+1));
- if k>0 then begin
- lua_a_open_in := true;
- if n=0 then
- input_file_callback_id[index] := k
- else
- read_file_callback_id[n] := k;
- end
- else
- file_ok:=false; {read failed}
- end
- else begin {no read callback}
- if kpse_in_name_ok(stringcast(nameoffile+1)) then begin
- lua_a_open_in := a_open_in(f,kpsetexformat);
- name_file_pointer := f;
- end
- else
- file_ok:=false; {open failed}
- end;
- end;
- if not file_ok then begin
- lua_a_open_in := false;
- name_file_pointer := 0;
- end;
-end;
-@#
-function lua_a_open_out(var f:alpha_file; n:quarterword):boolean;
-var test:boolean;
- k:integer;
- fnam:str_number;
- callback_id:integer;
-begin
- name_file_pointer := 0;
- callback_id:=callback_defined(find_write_file_callback);
- if callback_id>0 then begin
- fnam:=0;
- test:=run_callback(callback_id,'dS->s',n,stringcast(nameoffile+1),addressof(fnam));
- if (test)and(fnam<>0)and(length(fnam)>0) then begin
- @<Fixup |nameoffile| after callback@>;
- lua_a_open_out := do_a_open_out(f);
- name_file_pointer := f;
- end
- else
- lua_a_open_out := false;
- end
- else begin
- if kpse_out_name_ok(stringcast(nameoffile+1)) then begin
- lua_a_open_out := a_open_out(f);
- name_file_pointer := f;
- end
- else
- lua_a_open_out := false;
- end;
-end;
-function lua_b_open_out(var f:alpha_file):boolean;
-var test:boolean;
- k:integer;
- fnam:str_number;
- callback_id:integer;
-begin
- name_file_pointer := 0;
- callback_id:=callback_defined(find_output_file_callback);
- if callback_id>0 then begin
- fnam:=0;
- test:=run_callback(callback_id,'S->s',stringcast(nameoffile+1),addressof(fnam));
- if (test)and(fnam<>0)and(length(fnam)>0) then begin
- @<Fixup |nameoffile| after callback@>;
- lua_b_open_out := do_b_open_out(f);
- name_file_pointer := f;
- end
- else
- lua_b_open_out := false;
- end
- else begin
- if kpse_out_name_ok(stringcast(nameoffile+1)) then begin
- lua_b_open_out := b_open_out(f);
- name_file_pointer := f;
- end
- else
- lua_b_open_out := false;
- end;
-end;
-
-@
-@<Fixup |nameoffile| after callback@>=
-libcfree (nameoffile);
-nameoffile := xmallocarray (packed_ASCII_code, length(fnam)+2);
-for k:=str_start_macro(fnam) to str_start_macro(fnam+1)-1 do
- nameoffile[k-str_start_macro(fnam)+1] := str_pool[k];
-nameoffile[length(fnam)+1]:=0;
-namelength := length(fnam);
-flush_string
-
-@ Files can be closed with the \ph\ routine `|close(f)|', which
-@: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;
-
-
-@
-
-@p procedure lua_a_close_in(var f:alpha_file; n:quarterword); {close a text file}
-var ret:boolean;
- callback_id:integer;
-begin
-if n=0 then
- callback_id:=input_file_callback_id[index]
-else
- callback_id:=read_file_callback_id[n];
-if callback_id>0 then begin
- ret:=run_saved_callback(callback_id,'close','->');
- destroy_saved_callback(callback_id);
- if n=0 then
- input_file_callback_id[index] := 0
- else
- read_file_callback_id[n] := 0;
- end
-else
- a_close(f);
-end;
-@#
-procedure lua_a_close_out(var f:alpha_file); {close a text file}
-begin
- a_close(f);
-end;
-
-
-@ Binary input and output are done with \PASCAL's ordinary |get| and |put|
-procedures, so we don't have to make any other special arrangements for
-binary~I/O. Text output is also easy to do with standard \PASCAL\ routines.
-The treatment of text input is more difficult, however, because
-of the necessary translation to |ASCII_code| values.
-\TeX's conventions should be efficient, and they should
-blend nicely with the user's operating environment.
-
-@ Input from text files is read one line at a time, using a routine called
-|lua_input_ln|. This function is defined in terms of global variables called
-|buffer|, |first|, and |last| that will be described in detail later; for
-now, it suffices for us to know that |buffer| is an array of |ASCII_code|
-values, and that |first| and |last| are indices into this array
-representing the beginning and ending of a line of text.
-
-@<Glob...@>=
-@!buffer:array[0..buf_size] of packed_ASCII_code; {lines of characters being read}
-@!first:0..buf_size; {the first unused position in |buffer|}
-@!last:0..buf_size; {end of the line just input to |buffer|}
-@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
-
-@ The |lua_input_ln| function brings the next line of input from the specified
-file into available positions of the buffer array and returns the value
-|true|, unless the file has already been entirely read, in which case it
-returns |false| and sets |last:=first|. In general, the |ASCII_code|
-numbers that represent the next line of the file are input into
-|buffer[first]|, |buffer[first+1]|, \dots, |buffer[last-1]|; and the
-global variable |last| is set equal to |first| plus the length of the
-line. Trailing blanks are removed from the line; thus, either |last=first|
-(in which case the line was entirely blank) or |buffer[last-1]<>" "|.
-
-An overflow error is given, however, if the normal actions of |lua_input_ln|
-would make |last>=buf_size|; this is done so that other parts of \TeX\
-can safely look at the contents of |buffer[last+1]| without overstepping
-the bounds of the |buffer| array. Upon entry to |lua_input_ln|, the condition
-|first<buf_size| will always hold, so that there is always room for an
-``empty'' line.
-
-The variable |max_buf_stack|, which is used to keep track of how large
-the |buf_size| parameter must be to accommodate the present job, is
-also kept up to date by |lua_input_ln|.
-
-If the |bypass_eoln| parameter is |true|, |lua_input_ln| will do a |get|
-before looking at the first character of the line; this skips over
-an |eoln| that was in |f^|. The procedure does not do a |get| when it
-reaches the end of the line; therefore it can be used to acquire input
-from the user's terminal as well as from ordinary text files.
-
-Standard \PASCAL\ says that a file should have |eoln| immediately
-before |eof|, but \TeX\ needs only a weaker restriction: If |eof|
-occurs in the middle of a line, the system function |eoln| should return
-a |true| result (even though |f^| will be undefined).
-
-Since the inner loop of |lua_input_ln| is part of \TeX's ``inner loop''---each
-character of input comes in at this place---it is wise to reduce system
-overhead by making use of special routines that read in an entire array
-of characters at once, if such routines are available. The following
-code uses standard \PASCAL\ to illustrate what needs to be done, but
-finer tuning is often possible at well-developed \PASCAL\ sites.
-@^inner loop@>
-
-@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
- {inputs the next line or returns |false|}
-var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
-begin if bypass_eoln then if not eof(f) then get(f);
- {input the first character of the line into |f^|}
-last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
-if eof(f) then input_ln:=false
-else begin last_nonblank:=first;
- while not eoln(f) do
- begin if last>=max_buf_stack then
- begin max_buf_stack:=last+1;
- if max_buf_stack=buf_size then
- @<Report overflow of the input buffer, and abort@>;
- end;
- buffer[last]:=f^; get(f); incr(last);
- if buffer[last-1]<>" " then last_nonblank:=last;
- end;
- last:=last_nonblank; input_ln:=true;
- end;
-end;
-
-function lua_input_ln(var f:alpha_file;n:quarterword;@!bypass_eoln:boolean):boolean;
-var lua_result:boolean;
- last_ptr:integer;
- callback_id:integer;
- bypass_p:boolean;
-begin
-if n=0 then
- callback_id:=input_file_callback_id[index]
-else
- callback_id:=read_file_callback_id[n];
-if callback_id>0 then begin
- last:=first;
- last_ptr := first;
- lua_result := run_saved_callback(callback_id,'reader','->l', addressof(last_ptr));
- if (lua_result=true)and(last_ptr<>0) then begin
- last := last_ptr;
- if last>max_buf_stack then max_buf_stack:=last;
- lua_input_ln := true;
- @<Fix up the input buffer using callbacks@>;
- end
- else
- lua_input_ln := false;
- end
- else begin
- bypass_p := bypass_eoln; {this is for -Wextra}
- lua_result := input_ln(f,bypass_p);
- if lua_result=true then begin
- lua_input_ln := true;
- @<Fix up the input buffer using callbacks@>;
- end
- else
- lua_input_ln := false;
- end
-end;
-
-@
-@<Fix up the input buffer using callbacks@>=
-if last>=first then begin
- callback_id := callback_defined(process_input_buffer_callback);
- if callback_id>0 then begin
- last_ptr := first;
- lua_result := run_callback(callback_id, 'l->l', (last-first), addressof(last_ptr));
- if (lua_result=true)and(last_ptr<>0) then begin
- last := last_ptr;
- if last>max_buf_stack then max_buf_stack:=last;
- end;
- end;
- end
-
-
-
-@ The user's terminal acts essentially like other files of text, except
-that it is used both for input and for output. When the terminal is
-considered an input file, the file variable is called |term_in|, and when it
-is considered an output file the file variable is |term_out|.
-@^system dependencies@>
-
-@<Glob...@>=
-@!term_in:alpha_file; {the terminal as an input file}
-@!term_out:alpha_file; {the terminal as an output file}
-
-@ Here is how to open the terminal files
-in \ph. The `\.{/I}' switch suppresses the first |get|.
-@: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 writeln(term_out,'Buffer size exceeded!'); goto final_end;
-@.Buffer size exceeded@>
- end
-else
- check_buffer_overflow(buf_size+10) { need a little bit more}
-
-@ Different systems have different ways to get started. But regardless of
-what conventions are adopted, the routine that initializes the terminal
-should satisfy the following specifications:
-
-\yskip\textindent{1)}It should open file |term_in| for input from the
- terminal. (The file |term_out| will already be open for output to the
- terminal.)
-
-\textindent{2)}If the user has given a command line, this line should be
- considered the first line of terminal input. Otherwise the
- user should be prompted with `\.{**}', and the first line of input
- should be whatever is typed in response.
-
-\textindent{3)}The first line of input, which might or might not be a
- command line, should appear in locations |first| to |last-1| of the
- |buffer| array.
-
-\textindent{4)}The global variable |loc| should be set so that the
- character to be read next by \TeX\ is in |buffer[loc]|. This
- character should not be blank, and we should have |loc<last|.
-
-\yskip\noindent(It may be necessary to prompt the user several times
-before a non-blank line comes in. The prompt is `\.{**}' instead of the
-later `\.*' because the meaning is slightly different: `\.{\\input}' need
-not be typed immediately after~`\.{**}'.)
-
-@d loc==cur_input.loc_field {location of first unread character in |buffer|}
-
-@ The following program does the required initialization
-without retrieving a possible command line.
-It should be clear how to modify this routine to deal with command lines,
-if the system permits them.
-@^system dependencies@>
-
-@p function init_terminal:boolean; {gets the terminal input started}
-label exit;
-begin t_open_in;
-loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
-@.**@>
- if not input_ln(term_in,true)
-then {this shouldn't happen}
- begin writeln(term_out);
- write(term_out,'! End of file on the terminal... why?');
-@.End of file on the terminal@>
- init_terminal:=false; return;
- end;
- loc:=first;
- while (loc<last)and(buffer[loc]=" ") do incr(loc);
- if loc<last then
- begin init_terminal:=true;
- return; {return unless the line was all blank}
- end;
- writeln(term_out,'Please type the name of your input file.');
- end;
-exit:end;
-
-@* \[4] String handling.
-Control sequence names and diagnostic messages are variable-length strings
-of eight-bit characters. Since \PASCAL\ does not have a well-developed string
-mechanism, \TeX\ does all of its string processing by homegrown methods.
-
-Elaborate facilities for dynamic strings are not needed, so all of the
-necessary operations can be handled with a simple data structure.
-The array |str_pool| contains all of the (eight-bit) ASCII codes in all
-of the strings, and the array |str_start| contains indices of the starting
-points of each string. Strings are referred to by integer numbers, so that
-string number |s| comprises the characters |str_pool[j]| for
-|str_start_macro(s)<=j<str_start_macro(s+1)|. Additional integer variables
-|pool_ptr| and |str_ptr| indicate the number of entries used so far
-in |str_pool| and |str_start|, respectively; locations
-|str_pool[pool_ptr]| and |str_start_macro(str_ptr)| are
-ready for the next string to be allocated.
-
-String numbers 0 to |biggest_char| are reserved for strings that correspond to single
-UNICODE characters. This is in accordance with the conventions of \.{WEB},
-@.WEB@>
-which converts single-character strings into the ASCII code number of the
-single character involved, while it converts other strings into integers
-and builds a string pool file. Thus, when the string constant \.{"."} appears
-in the program below, \.{WEB} converts it into the integer 46, which is the
-ASCII code for a period, while \.{WEB} will convert a string like \.{"hello"}
-into some integer greater than~|biggest_char|.
-
-Some \PASCAL\ compilers won't pack integers into a single byte unless the
-integers lie in the range |-128..127|. To accommodate such systems
-we access the string pool only via macros that can easily be redefined.
-@^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[(#) - string_offset]
-
-@<Types...@>=
-@!pool_pointer = integer; {for variables that point into |str_pool|}
-@!str_number = integer; {for variables that point into |str_start|}
-@!packed_ASCII_code = 0..255; {elements of |str_pool| array}
-
-@ @<Glob...@>=
-@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
-@!str_start : array[str_number] of pool_pointer; {the starting pointers}
-@!pool_ptr : pool_pointer; {first unused position in |str_pool|}
-@!str_ptr : str_number; {number of the current string being created}
-@!init_pool_ptr : pool_pointer; {the starting value of |pool_ptr|}
-@!init_str_ptr : str_number; {the starting value of |str_ptr|}
-
-@ Several of the elementary string operations are performed using \.{WEB}
-macros instead of \PASCAL\ procedures, because many of the
-operations are done quite frequently and we want to avoid the
-overhead of procedure calls. For example, here is
-a simple macro that computes the length of a string.
-@.WEB@>
-
-@d length(#)==(str_start_macro(#+1)-str_start_macro(#)) {the number of characters
- in string number \#}
-
-@ The length of the current string is called |cur_length|:
-
-@d cur_length == (pool_ptr - str_start_macro(str_ptr))
-
-@ Strings are created by appending character codes to |str_pool|.
-The |append_char| macro, defined here, does not check to see if the
-value of |pool_ptr| has gotten too high; this test is supposed to be
-made before |append_char| is used. There is also a |flush_char|
-macro, which erases the last character appended.
-
-To test if there is room to append |l| more characters to |str_pool|,
-we shall write |str_room(l)|, which aborts \TeX\ and gives an
-apologetic error message if there isn't enough room.
-
-@d append_char(#) == {put |ASCII_code| \# at the end of |str_pool|}
-begin str_pool[pool_ptr]:=si(#); incr(pool_ptr);
-end
-@d flush_char == decr(pool_ptr) {forget the last character in the pool}
-@d str_room(#) == check_pool_overflow((pool_ptr+#)) {test or grow the pool}
-
-@p procedure string_room(t:integer);
-begin
- str_room(t);
-end;
-@#
-procedure append_pool_char(c:ASCII_code);
-begin
- append_char(c);
-end;
-
-
-@ Once a sequence of characters has been appended to |str_pool|, it
-officially becomes a string when the function |make_string| is called.
-This function returns the identification number of the new string as its
-value.
-
-@p function make_string : str_number; {current string enters the pool}
-begin if str_ptr=(max_strings+string_offset) then
- overflow("number of strings",max_strings-init_str_ptr);
-@:TeX capacity exceeded number of strings}{\quad number of strings@>
-incr(str_ptr); str_start_macro(str_ptr):=pool_ptr;
-make_string:=str_ptr-1;
-end;
-
-@ To destroy the most recently made string, we say |flush_string|.
-
-The helper routines reads one utf sequence from the pool resp. the
-buffer, and returns its character value.
-
-@d flush_string==begin decr(str_ptr); pool_ptr:=str_start_macro(str_ptr);
- end
-@d test_sequence_byte(#)==if (#<@"80) or (#>=@"C0) then begin
- print_err("Text line contains an invalid utf-8 sequence");
-@.Text line contains...@>
- help2("A funny symbol that I can't read has just been input.")@/
- ("Just continue, I'll change it to 0xFFFD.");@/
- deletions_allowed:=false; error; deletions_allowed:=true;
-{the assigment before return is needed because web2c generates incorrect code}
- a:=@"FFFD; buffer_to_unichar:=a; return; end
-
-
-@p function buffer_to_unichar(@!k:integer):integer;
-label exit;
-var a:@!integer; {a utf char}
-b:@!integer; { a utf nibble}
-begin
- b := buffer[k];
- if b<@"80 then
- a := b
- else if b>=@"F0 then begin
- a := (b-@"F0) * 64;
- b := buffer[k+1];
- test_sequence_byte(b);
- a := (a + (b-128)) * 64;
- b := buffer[k+2];
- test_sequence_byte(b);
- a := (a + (b-128)) * 64;
- b := buffer[k+3];
- test_sequence_byte(b);
- a := a + (b-128);
- end
- else if b>=@"E0 then begin
- a := (b-@"E0) * 64;
- b := buffer[k+1];
- test_sequence_byte(b);
- a := (a + (b-128)) * 64;
- b := buffer[k+2];
- test_sequence_byte(b);
- a := a + (b-128);
- end
- else if b>=@"C0 then begin
- a := (b-@"C0) * 64;
- b := buffer[k+1];
- test_sequence_byte(b);
- a := a + (b-128);
- end
- else begin { NI: this is an encoding error }
- print_err("Buffer contains an invalid utf-8 sequence");
-@.Text line contains...@>
- help2("A funny symbol somehow ended up in the input buffer.")@/
- ("Just continue, I'll change it to 0xFFFD.");@/
- deletions_allowed:=false; error; deletions_allowed:=true;
- a:=@"FFFD;
- end;
-exit:
- buffer_to_unichar := a;
-end ;
-
-
-
-@ The following subroutine compares string |s| with another string of the
-same length that appears in |buffer| starting at position |k|;
-the result is |true| if and only if the strings are equal.
-Empirical tests indicate that |str_eq_buf| is used in such a way that
-it tends to return |true| about 80 percent of the time.
-
-@p function str_eq_buf(@!s:str_number;@!k:integer):boolean;
- {test equality of strings}
-label not_found; {loop exit}
-var j: pool_pointer; {running index}
-a: ASCII_code; {a unicode character }
-@!result: boolean; {result of comparison}
-begin result:=false;
-if s<string_offset then begin
- a := buffer_to_unichar(k);
- if a<>s then goto not_found;
- end
-else begin
-j:=str_start_macro(s);
-while j<str_start_macro(s+1) do
- begin if so(str_pool[j])<>buffer[k] then
- begin goto not_found;
- end;
- incr(j); incr(k);
- end;
-end;
-result:=true;
-not_found: str_eq_buf:=result;
-end;
-
-@ Here is a similar routine, but it compares two strings in the string pool,
-and it does not assume that they have the same length.
-
-@p function str_eq_str(@!s,@!t:str_number):boolean;
- {test equality of strings}
-label found,not_found; {loop exit}
-var j,@!k: pool_pointer; {running indices}
-a: ASCII_code; {a utf char}
-@!result: boolean; {result of comparison}
-begin result:=false;
-a:= 0;
-if s<string_offset then begin
- if t>=string_offset then begin
- if s<=@"7F then
- if length(t)=1 then
- if str_pool[str_start_macro(t)]=s then
- goto found;
- a := pool_to_unichar(str_start_macro(t));
- if a<>s then goto not_found;
- end
- else
- if t<>s then goto not_found;
- end
-else if t<string_offset then begin
- if t<=@"7F then
- if length(s)=1 then
- if str_pool[str_start_macro(s)]=t then
- goto found;
- a := pool_to_unichar(str_start_macro(s));
- if a<>t then goto not_found;
- end
-else begin
- if length(s)<>length(t) then goto not_found;
- j:=str_start_macro(s); k:=str_start_macro(t);
- while j<str_start_macro(s+1) do
- begin if str_pool[j]<>str_pool[k] then goto not_found;
- incr(j); incr(k);
- end;
- end;
-found: result:=true;
-not_found: str_eq_str:=result;
-end;
-
-@ The initial values of |str_pool|, |str_start|, |pool_ptr|,
-and |str_ptr| are computed by the \.{INITEX} program, based in part
-on the information that \.{WEB} has output while processing \TeX.
-@.INITEX@>
-@^string pool@>
-
-The first |string_offset| strings are single-characters strings matching
-Unicode. There is no point in generating all of these. But |str_ptr| has
-initialized properly, otherwise |print_char| cannot see the difference
-between characters and strings.
-
-@p @!init function get_strings_started:boolean; {initializes the string pool,
- but returns |false| if something goes wrong}
-label done,exit;
-var @!g:str_number; {garbage}
-begin pool_ptr:=0; str_ptr:=string_offset; str_start[0]:=0;
-@<Read the other strings from the \.{TEX.POOL} file and return |true|,
- or give an error message and return |false|@>;
-exit:end;
-tini
-
-@ @d app_lc_hex(#)==l:=#;
- if l<10 then append_char(l+"0")@+else append_char(l-10+"a")
-
-@ The first 128 strings will contain 95 standard ASCII characters, and the
-other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
-unless a system-dependent change is made here. Installations that have
-an extended character set, where for example |xchr[@'32]=@t\.{\'^^Z\'}@>|,
-would like string @'32 to be the single character @'32 instead of the
-three characters @'136, @'136, @'132 (\.{\^\^Z}). On the other hand,
-even people with an extended character set will want to represent string
-@'15 by \.{\^\^M}, since @'15 is |carriage_return|; the idea is to
-produce visible strings instead of tabs or line-feeds or carriage-returns
-or bell-rings or characters that are treated anomalously in text files.
-
-Unprintable characters of codes 128--255 are, similarly, rendered
-\.{\^\^80}--\.{\^\^ff}.
-
-Unprintable characters of codes 256--|65535| are, similarly, rendered
-\.{\^\^\^\^0100}--\.{\^\^\^\^ffff}.
-
-The boolean expression defined here should be |true| unless \TeX\
-internal code number~|k| corresponds to a non-troublesome visible
-symbol in the local character set. An appropriate formula for the
-extended character set recommended in {\sl The \TeX book\/} would, for
-example, be `|k in [0,@'10..@'12,@'14,@'15,@'33,@'177..@'377]|'.
-If character |k| cannot be printed, and |k<@'200|, then character |k+@'100| or
-|k-@'100| must be printable; moreover, ASCII codes |[@'41..@'46,
-@'60..@'71, @'136, @'141..@'146, @'160..@'171]| must be printable.
-Thus, at least 81 printable characters are needed.
-@:TeXbook}{\sl The \TeX book@>
-@^character set dependencies@>
-@^system dependencies@>
-
-@ @<Read the other strings...@>=
- g := loadpoolstrings((pool_size-string_vacancies));
- if g=0 then begin
- wake_up_terminal; writeln(term_out,'! You have to increase POOLSIZE.');
- get_strings_started:=false;
- return;
- end;
- get_strings_started:=true;
-
-@* \[5] On-line and off-line printing.
-Messages that are sent to a user's terminal and to the transcript-log file
-are produced by several `|print|' procedures. These procedures will
-direct their output to a variety of places, based on the setting of
-the global variable |selector|, which has the following possible
-values:
-
-\yskip
-\hang |term_and_log|, the normal setting, prints on the terminal and on the
- transcript file.
-
-\hang |log_only|, prints only on the transcript file.
-
-\hang |term_only|, prints only on the terminal.
-
-\hang |no_print|, doesn't print at all. This is used only in rare cases
- before the transcript file is open.
-
-\hang |pseudo|, puts output into a cyclic buffer that is used
- by the |show_context| routine; when we get to that routine we shall discuss
- the reasoning behind this curious mode.
-
-\hang |new_string|, appends the output to the current string in the
- string pool.
-
-\hang 0 to 15, prints on one of the sixteen files for \.{\\write} output.
-
-\yskip
-\noindent The symbolic names `|term_and_log|', etc., have been assigned
-numeric codes that satisfy the convenient relations |no_print+1=term_only|,
-|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|.
-
-Three additional global variables, |tally| and |term_offset| and
-|file_offset|, record the number of characters that have been printed
-since they were most recently cleared to zero. We use |tally| to record
-the length of (possibly very long) stretches of printing; |term_offset|
-and |file_offset|, on the other hand, keep track of how many characters
-have appeared so far on the current line that has been output to the
-terminal or to the transcript file, respectively.
-
-@d no_print=16 {|selector| setting that makes data disappear}
-@d term_only=17 {printing is destined for the terminal only}
-@d log_only=18 {printing is destined for the transcript file only}
-@d term_and_log=19 {normal |selector| setting}
-@d pseudo=20 {special |selector| setting for |show_context|}
-@d new_string=21 {printing is deflected to the string pool}
-@d max_selector=21 {highest selector setting}
-
-@<Glob...@>=
-@!log_file : alpha_file; {transcript of \TeX\ session}
-@!term_out_mode:halfword;
-@!term_out_translation:halfword;
-@!selector : 0..max_selector; {where to print a message}
-@!dig : array[0..22] of 0..15; {digits in a number being output}
-@!tally : integer; {the number of characters recently printed}
-@!term_offset : 0..max_print_line;
- {the number of characters on the current terminal line}
-@!file_offset : 0..max_print_line;
- {the number of characters on the current file line}
-@!trick_buf:array[0..error_line] of packed_ASCII_code; {circular buffer for
- pseudoprinting}
-@!trick_count: integer; {threshold for pseudoprinting, explained later}
-@!first_count: integer; {another variable for pseudoprinting}
-@!inhibit_par_tokens:boolean; { for minor adjustments to |show_token_list| }
-
-@ @<Initialize the output routines@>=
-selector:=term_only; tally:=0; term_offset:=0; file_offset:=0;
-inhibit_par_tokens:=false;
-
-@ Macro abbreviations for output to the terminal and to the log file are
-defined here for convenience. Some systems need special conventions
-for terminal output, and it is possible to adhere to those conventions
-by changing |wterm|, |wterm_ln|, and |wterm_cr| in this section.
-@^system dependencies@>
-
-@d wterm(#)==write(term_out,#)
-@d wterm_ln(#)==writeln(term_out,#)
-@d wterm_cr==writeln(term_out)
-@d wlog(#)==write(log_file,#)
-@d wlog_ln(#)==writeln(log_file,#)
-@d wlog_cr==writeln(log_file)
-
-@ To end a line of text output, we call |print_ln|.
-
-@<Basic print...@>=
-procedure print_ln; {prints an end-of-line}
-begin case selector of
-term_and_log: begin wterm_cr; wlog_cr;
- term_offset:=0; file_offset:=0;
- end;
-log_only: begin wlog_cr; file_offset:=0;
- end;
-term_only: begin wterm_cr; term_offset:=0;
- end;
-no_print,pseudo,new_string: do_nothing;
-othercases writeln(write_file[selector])
-endcases;@/
-end; {|tally| is not affected}
-
-@ The |print_char| procedure sends one character to the desired destination,
-using the |xchr| array to map it into an external character compatible with
-|lua_input_ln|. All printing comes through |print_ln| or |print_char|.
-
-@d wterm_char(#)==begin if (#>=@"20)or(#=@"0A)or(#=@"0D)or(#=@"09) then wterm(xchr[#])
- else begin if term_offset+2>=max_print_line then begin
- wterm_cr; term_offset:=0;
- end;
- incr(term_offset); wterm('^'); incr(term_offset); wterm('^');
- wterm(xchr[#+64]);
- end; end
-@d fix_term_offset(#)==
- if ((#>=@"C0) and (#<=@"DF) and (term_offset+2>=max_print_line)) or
- ((#>=@"E0) and (#<=@"EF) and (term_offset+3>=max_print_line)) or
- ((#>=@"F0) and (term_offset+4>=max_print_line)) then begin
- wterm_cr; term_offset:=0;
- end
-@d fix_log_offset(#)==
- if ((#>=@"C0) and (#<=@"DF) and (file_offset+2>=max_print_line)) or
- ((#>=@"E0) and (#<=@"EF) and (file_offset+3>=max_print_line)) or
- ((#>=@"F0) and (file_offset+4>=max_print_line)) then begin
- wlog_cr; file_offset:=0;
- end
-
-@<Basic print...@>=
-procedure print_char(@!s:ASCII_code); {prints a single character}
-label exit;
-begin if @<Character |s| is the current new-line character@> then
- if selector<pseudo then
- begin print_ln; return;
- end;
-case selector of
-term_and_log: begin
- fix_term_offset(s); fix_log_offset(s);
- wterm_char(s); wlog(xchr[s]);
- incr(term_offset); incr(file_offset);
- if term_offset=max_print_line then
- begin wterm_cr; term_offset:=0;
- end;
- if file_offset=max_print_line then
- begin wlog_cr; file_offset:=0;
- end;
- end;
-log_only: begin
- fix_log_offset(s);
- wlog(xchr[s]); incr(file_offset);
- if file_offset=max_print_line then print_ln;
- end;
-term_only: begin
- fix_term_offset(s);
- wterm_char(s); incr(term_offset);
- if term_offset=max_print_line then print_ln;
- end;
-no_print: do_nothing;
-pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
-new_string: begin if pool_ptr<pool_size then append_char(s);
- end; {we drop characters if the string space is full}
-othercases write(write_file[selector],xchr[s])
-endcases;@/
-incr(tally);
-exit:end;
-
-@ An entire string is output by calling |print|. Note that if we are outputting
-the single standard ASCII character \.c, we could call |print("c")|, since
-|"c"=99| is the number of a single-character string, as explained above. But
-|print_char("c")| is quicker, so \TeX\ goes directly to the |print_char|
-routine when it knows that this is safe. (The present implementation
-assumes that it is always safe to print a visible ASCII character.)
-@^system dependencies@>
-
-The first 256 entries above the 17th unicode plane are used for a
-special trick: when \TeX\ has to print items in that range, it will
-instead print the character that results from substracting @"110000
-from that value. This allows byte-oriented output to things like
-\.{\\specials} and \.{\\pdfliterals}. Todo: Perhaps it would be useful
-to do the same substraction while typesetting.
-
-@d print_lc_hex(#)==l:=#;
- if l<10 then print_char(l+"0") else print_char(l-10+"a");
-
-@<Basic print...@>=
-function pool_to_unichar(@!t:pool_pointer):ASCII_code;
-var a,result:@!ASCII_code; {a utf char}
-b:@!quarterword; { a utf nibble}
-begin
- b := str_pool[t];
- if b<=@"7F then
- a := b
- else if b>=@"F0 then begin
- a := (b-@"F0) * 64;
- b := str_pool[t+1];
- a := (a + (b-128)) * 64;
- b := str_pool[t+2];
- a := (a + (b-128)) * 64;
- b := str_pool[t+3];
- a := a + (b-128);
- end
- else if b>=@"E0 then begin
- a := (b-@"E0) * 64;
- b := str_pool[t+1];
- a := (a + (b-128)) * 64;
- b := str_pool[t+2];
- a := a + (b-128);
- end
- else if b>=@"C0 then begin
- a := (b-@"C0) * 64;
- b := str_pool[t+1];
- a := a + (b-128);
- end
- else begin { NI: this is an encoding error }
- wlog_ln('! Pool contains an invalid utf-8 sequence');
- wterm_ln('! Pool contains an invalid utf-8 sequence');
-@.Text line contains...@>
- help2("A funny symbol somehow ended up in the string pool.")@/
- ("Just continue, I'll change it to 0xFFFD.");@/
- deletions_allowed:=false; error; deletions_allowed:=true;
- a:=@"FFFD;
- end;
-result := a;
-pool_to_unichar := result;
-end ;
-
-procedure print(@!s:integer); {prints string |s|}
-label exit;
-var j:pool_pointer; {current character code position}
-@!v:integer; { a unicode char }
-begin if s>=str_ptr then s:="???" {this can't happen}
-@.???@>
-else if s<string_offset then begin
- if s<0 then s:="???" {can't happen}
- else begin
- {TH not sure about this, disabled for now!}
- if (false)and(selector>pseudo) then
- begin print_char(s); return; {internal strings are not expanded}
- end;
- if (@<Character |s| is the current new-line character@>) then
- if selector<pseudo then
- begin print_ln; return;
- end;
- if s<=@"7F then
- print_char(s)
- else if s<=@"7FF then begin
- print_char(@"C0 + (s div @"40));
- print_char(@"80 + (s mod @"40));
- end
- else if s<=@"FFFF then begin
- print_char(@"E0 + (s div @"1000));
- print_char(@"80 + ((s mod @"1000) div @"40));
- print_char(@"80 + ((s mod @"1000) mod @"40));
- end
- else begin
- if s>=@"110000 then
- print_char(s-@"110000)
- else begin
- print_char(@"F0 + (s div @"40000));
- print_char(@"80 + ((s mod @"40000) div @"1000));
- print_char(@"80 + (((s mod @"40000) mod @"1000) div @"40));
- print_char(@"80 + (((s mod @"40000) mod @"1000) mod @"40));
- end;
- end;
- return;
- end;
- end;
-j:=str_start_macro(s);
-while j<str_start_macro(s+1) do
- begin { 0x110000 in utf=8: 0xF4 0x90 0x80 0x80 }
- if (str_pool[j]=@"F4)and(j<str_start_macro(s+4))and(str_pool[j+1]=@"90) then begin
- v := (((7*64+63)*64)+ (str_pool[j+2]-128))*64 +(str_pool[j+3]-128);
- print_char(v-@"110000); j := j+4;
- end
- else begin
- print_char(str_pool[j]); incr(j);
- end;
- end;
-exit:end;
-
-procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
-begin if ((term_offset>0)and(odd(selector)))or@|
- ((file_offset>0)and(selector>=log_only)) then print_ln;
-print(s);
-end;
-
-procedure print_nlp; {move to beginning of a line}
-begin if ((term_offset>0)and(odd(selector)))or@|
- ((file_offset>0)and(selector>=log_only)) then print_ln;
-end;
-
-@ |slow_print| is the same as |print| nowadays, but the name is kept for now.
-
-@<Basic print...@>=
-procedure slow_print(@!s:integer); {prints string |s|}
-begin print(s);
-end;
-
-@ Here is the very first thing that \TeX\ prints: a headline that identifies
-the version number and format package. The |term_offset| variable is temporarily
-incorrect, but the discrepancy is not serious since we assume that the banner
-and format identifier together will occupy at most |max_print_line|
-character positions.
-
-@<Initialize the output...@>=
-print_banner;
-
-@ The procedure |print_nl| is like |print|, but it makes sure that the
-string appears at the beginning of a new line. (moved)
-
-@<Basic print...@>=
-
-@ The procedure |print_esc| prints a string that is preceded by
-the user's escape character (which is usually a backslash).
-
-@<Basic print...@>=
-procedure print_esc(@!s:str_number); {prints escape character, then |s|}
-var c:integer; {the escape character code}
-begin @<Set variable |c| to the current escape character@>;
-if c>=0 then if c<string_offset then print(c);
-slow_print(s);
-end;
-
-@ An array of digits in the range |0..15| is printed by |print_the_digs|.
-
-@<Basic print...@>=
-procedure print_the_digs(@!k:eight_bits);
- {prints |dig[k-1]|$\,\ldots\,$|dig[0]|}
-begin while k>0 do
- begin decr(k);
- if dig[k]<10 then print_char("0"+dig[k])
- else print_char("A"-10+dig[k]);
- end;
-end;
-
-@ The following procedure, which prints out the decimal representation of a
-given integer |n|, has been written carefully so that it works properly
-if |n=0| or if |(-n)| would cause overflow. It does not apply |mod| or |div|
-to negative arguments, since such operations are not implemented consistently
-by all \PASCAL\ compilers.
-
-@<Basic print...@>=
-procedure print_int(@!n:longinteger); {prints an integer in decimal form}
-var k:0..23; {index to current digit; we assume that $|n|<10^{23}$}
-@!m:longinteger; {used to negate |n| in possibly dangerous cases}
-begin k:=0;
-if n<0 then
- begin print_char("-");
- if n>-100000000 then negate(n)
- else begin m:=-1-n; n:=m div 10; m:=(m mod 10)+1; k:=1;
- if m<10 then dig[0]:=m
- else begin dig[0]:=0; incr(n);
- end;
- end;
- end;
-repeat dig[k]:=n mod 10; n:=n div 10; incr(k);
-until n=0;
-print_the_digs(k);
-end;
-
-@ Here is a trivial procedure to print two digits; it is usually called with
-a parameter in the range |0<=n<=99|.
-
-@p procedure print_two(@!n:integer); {prints two least significant digits}
-begin n:=abs(n) mod 100; print_char("0"+(n div 10));
-print_char("0"+(n mod 10));
-end;
-
-@ Hexadecimal printing of nonnegative integers is accomplished by |print_hex|.
-
-@p procedure print_hex(@!n:integer);
- {prints a positive integer in hexadecimal form}
-var k:0..22; {index to current digit; we assume that $0\L n<16^{22}$}
-begin k:=0; print_char("""");
-repeat dig[k]:=n mod 16; n:=n div 16; incr(k);
-until n=0;
-print_the_digs(k);
-end;
-
-@ Old versions of \TeX\ needed a procedure called |print_ASCII| whose function
-is now subsumed by |print|. We retain the old name here as a possible aid to
-future software arch\ae ologists.
-
-@d print_ASCII == print
-@d print_font_name(#)==begin print(tex_font_name(#)); flush_string; end
-
-@ Roman numerals are produced by the |print_roman_int| routine. Readers
-who like puzzles might enjoy trying to figure out how this tricky code
-works; therefore no explanation will be given. Notice that 1990 yields
-\.{mcmxc}, not \.{mxm}.
-
-@p procedure print_roman_int(@!n:integer);
-label exit;
-var j,@!k: pool_pointer; {mysterious indices into |str_pool|}
-@!u,@!v: nonnegative_integer; {mysterious numbers}
-begin j:=str_start_macro("m2d5c2l5x2v5i"); v:=1000;
-loop@+ begin while n>=v do
- begin print_char(so(str_pool[j])); n:=n-v;
- end;
- if n<=0 then return; {nonpositive input produces no output}
- k:=j+2; u:=v div (so(str_pool[k-1])-"0");
- if str_pool[k-1]=si("2") then
- begin k:=k+2; u:=u div (so(str_pool[k-1])-"0");
- end;
- if n+u>=v then
- begin print_char(so(str_pool[k])); n:=n+u;
- end
- else begin j:=j+2; v:=v div (so(str_pool[j-1])-"0");
- end;
- end;
-exit:end;
-
-@ The |print| subroutine will not print a string that is still being
-created. The following procedure will.
-
-@p procedure print_current_string; {prints a yet-unmade string}
-var j:pool_pointer; {points to current character code}
-begin j:=str_start_macro(str_ptr);
-while j<pool_ptr do
- begin print_char(so(str_pool[j])); incr(j);
- end;
-end;
-
-@ Here is a procedure that asks the user to type a line of input,
-assuming that the |selector| setting is either |term_only| or |term_and_log|.
-The input is placed into locations |first| through |last-1| of the
-|buffer| array, and echoed on the transcript file if appropriate.
-
-This procedure is never called when |interaction<scroll_mode|.
-
-@<Basic print...@>=
-procedure prompt_input(s:str_number);
-begin wake_up_terminal; print(s); term_input;
-end;
-
-@
-@p procedure term_input; {gets a line from the terminal}
-var k:0..buf_size; {index into |buffer|}
-begin update_terminal; {now the user sees the prompt for sure}
-if not input_ln(term_in,true)
-then fatal_error("End of file on the terminal!");
-@.End of file on the terminal@>
-term_offset:=0; {the user's line ended with \<\rm return>}
-decr(selector); {prepare to echo the input}
-if last<>first then for k:=first to last-1 do print(buffer[k]);
-print_ln; incr(selector); {restore previous status}
-end;
-
-@* \[6] Reporting errors.
-When something anomalous is detected, \TeX\ typically does something like this:
-$$\vbox{\halign{#\hfil\cr
-|print_err("Something anomalous has been detected");|\cr
-|help3("This is the first line of my offer to help.")|\cr
-|("This is the second line. I'm trying to")|\cr
-|("explain the best way for you to proceed.");|\cr
-|error;|\cr}}$$
-A two-line help message would be given using |help2|, etc.; these informal
-helps should use simple vocabulary that complements the words used in the
-official error message that was printed. (Outside the U.S.A., the help
-messages should preferably be translated into the local vernacular. Each
-line of help is at most 60 characters long, in the present implementation,
-so that |max_print_line| will not be exceeded.)
-
-The |print_err| procedure supplies a `\.!' before the official message,
-and makes sure that the terminal is awake if a stop is going to occur.
-The |error| procedure supplies a `\..' after the official message, then it
-shows the location of the error; and if |interaction=error_stop_mode|,
-it also enters into a dialog with the user, during which time the help
-message may be printed.
-@^system dependencies@>
-
-@ The global variable |interaction| has four settings, representing increasing
-amounts of user interaction:
-
-@d batch_mode=0 {omits all stops and omits terminal output}
-@d nonstop_mode=1 {omits all stops}
-@d scroll_mode=2 {omits error stops}
-@d error_stop_mode=3 {stops at every opportunity to interact}
-@d print_err(#)==begin if interaction=error_stop_mode then wake_up_terminal;
- print_nl("! "); print(#);
- last_error:=#; end
-@d print_warn(#)==begin if interaction=error_stop_mode then wake_up_terminal;
- if prepend_nl then begin print_nl(""); print_ln end;
- print_nl(#);
- end
-
-@<Glob...@>=
-@!interaction:batch_mode..error_stop_mode; {current level of interaction}
-@!last_error:str_number;
-
-@ @<Set init...@>=interaction:=error_stop_mode;
-
-@ \TeX\ is careful not to call |error| when the print |selector| setting
-might be unusual. The only possible values of |selector| at the time of
-error messages are
-
-\yskip\hang|no_print| (when |interaction=batch_mode|
- and |log_file| not yet open);
-
-\hang|term_only| (when |interaction>batch_mode| and |log_file| not yet open);
-
-\hang|log_only| (when |interaction=batch_mode| and |log_file| is open);
-
-\hang|term_and_log| (when |interaction>batch_mode| and |log_file| is open).
-
-@<Initialize the print |selector| based on |interaction|@>=
-if interaction=batch_mode then selector:=no_print@+else selector:=term_only
-
-@ A global variable |deletions_allowed| is set |false| if the |get_next|
-routine is active when |error| is called; this ensures that |get_next|
-and related routines like |get_token| will never be called recursively.
-A similar interlock is provided by |set_box_allowed|.
-@^recursion@>
-
-The global variable |history| records the worst level of error that
-has been detected. It has four possible values: |spotless|, |warning_issued|,
-|error_message_issued|, and |fatal_error_stop|.
-
-Another global variable, |error_count|, is increased by one when an
-|error| occurs without an interactive dialog, and it is reset to zero at
-the end of every paragraph. If |error_count| reaches 100, \TeX\ decides
-that there is no point in continuing further.
-
-@d spotless=0 {|history| value when nothing has been amiss yet}
-@d warning_issued=1 {|history| value when |begin_diagnostic| has been called}
-@d error_message_issued=2 {|history| value when |error| has been called}
-@d fatal_error_stop=3 {|history| value when termination was premature}
-
-@<Glob...@>=
-@!deletions_allowed:boolean; {is it safe for |error| to call |get_token|?}
-@!set_box_allowed:boolean; {is it safe to do a \.{\\setbox} assignment?}
-@!history:spotless..fatal_error_stop; {has the source input been clean so far?}
-@!error_count:-1..100; {the number of scrolled errors since the
- last paragraph ended}
-
-@ The value of |history| is initially |fatal_error_stop|, but it will
-be changed to |spotless| if \TeX\ survives the initialization process.
-
-@<Set init...@>=
-deletions_allowed:=true; set_box_allowed:=true;
-error_count:=0; {|history| is initialized elsewhere}
-
-@ Since errors can be detected almost anywhere in \TeX, we want to declare the
-error procedures near the beginning of the program. But the error procedures
-in turn use some other procedures, which need to be declared |forward|
-before we get to |error| itself.
-
-It is possible for |error| to be called recursively if some error arises
-when |get_token| is being used to delete a token, and/or if some fatal error
-occurs while \TeX\ is trying to fix a non-fatal one. But such recursion
-@^recursion@>
-is never more than two levels deep.
-
-@<Error handling...@>=
-procedure@?normalize_selector; forward;@t\2@>@/
-procedure@?get_token; forward;@t\2@>@/
-procedure@?term_input; forward;@t\2@>@/
-procedure@?show_context; forward;@t\2@>@/
-procedure@?begin_file_reading; forward;@t\2@>@/
-procedure@?open_log_file; forward;@t\2@>@/
-procedure@?close_files_and_terminate; forward;@t\2@>@/
-procedure@?clear_for_error_prompt; forward;@t\2@>@/
-procedure@?give_err_help; forward;@t\2@>@/
-@t\4\hskip-\fontdimen2\font@>@;@+@!debug@+procedure@?debug_help;
- forward;@;@+gubed
-
-@ Individual lines of help are recorded in the array |help_line|, which
-contains entries in positions |0..(help_ptr-1)|. They should be printed
-in reverse order, i.e., with |help_line[0]| appearing last.
-
-@d hlp1(#)==help_line[0]:=#;@+end
-@d hlp2(#)==help_line[1]:=#; hlp1
-@d hlp3(#)==help_line[2]:=#; hlp2
-@d hlp4(#)==help_line[3]:=#; hlp3
-@d hlp5(#)==help_line[4]:=#; hlp4
-@d hlp6(#)==help_line[5]:=#; hlp5
-@d help0==help_ptr:=0 {sometimes there might be no help}
-@d help1==@+begin help_ptr:=1; hlp1 {use this with one help line}
-@d help2==@+begin help_ptr:=2; hlp2 {use this with two help lines}
-@d help3==@+begin help_ptr:=3; hlp3 {use this with three help lines}
-@d help4==@+begin help_ptr:=4; hlp4 {use this with four help lines}
-@d help5==@+begin help_ptr:=5; hlp5 {use this with five help lines}
-@d help6==@+begin help_ptr:=6; hlp6 {use this with six help lines}
-
-@p
-procedure dohelp5 (@!a,b,c,d,e:str_number);
-begin
- help5(a)(b)(c)(d)(e);
-end;
-@#
-procedure dohelp4 (@!a,b,c,d:str_number);
-begin
- help4(a)(b)(c)(d);
-end;
-@#
-procedure dohelp3 (@!a,b,c:str_number);
-begin
- help3(a)(b)(c);
-end;
-@#
-procedure dohelp2 (@!a,b:str_number);
-begin
- help2(a)(b);
-end;
-@#
-procedure dohelp1 (@!a:str_number);
-begin
- help1(a);
-end;
-@#
-procedure dohelp0;
-begin
- help0;
-end;
-@#
-procedure do_print_err (s:str_number);
-begin
- print_err(s);
-end;
-
-@ @<Glob...@>=
-@!help_line:array[0..5] of str_number; {helps for the next |error|}
-@!help_ptr:0..6; {the number of help lines present}
-@!use_err_help:boolean; {should the |err_help| list be shown?}
-
-@ @<Set init...@>=
-help_ptr:=0; use_err_help:=false;
-
-@ The |jump_out| procedure just cuts across all active procedure levels and
-goes to |end_of_TEX|. This is the only nontrivial |@!goto| statement in the
-whole program. It is used when there is no recovery from a particular error.
-
-Some \PASCAL\ compilers do not implement non-local |goto| statements.
-@^system dependencies@>
-In such cases the body of |jump_out| should simply be
-`|close_files_and_terminate|;\thinspace' followed by a call on some system
-procedure that quietly terminates the program.
-
-@<Error hand...@>=
-procedure jump_out;
-begin goto end_of_TEX;
-end;
-
-@ Here now is the general |error| routine.
-
-@<Error hand...@>=
-procedure error; {completes the job of error reporting}
-label continue,exit;
-var c:ASCII_code; {what the user types}
-callback_id:integer;
-@!s1,@!s2,@!s3,@!s4:integer;
- {used to save global variables when deleting tokens}
-@!t:boolean;
-begin if history<error_message_issued then history:=error_message_issued;
-print_char(".");
-callback_id := callback_defined(show_error_hook_callback) ;
-if callback_id>0 then t := run_callback(callback_id,'->');
-show_context;
-if interaction=error_stop_mode then @<Get user's advice and |return|@>;
-incr(error_count);
-if error_count=100 then
- begin print_nl("(That makes 100 errors; please try again.)");
-@.That makes 100 errors...@>
- history:=fatal_error_stop; jump_out;
- end;
-@<Put help message on the transcript file@>;
-exit:end;
-
-@ @<Get user's advice...@>=
-loop@+begin continue: clear_for_error_prompt; prompt_input("? ");
-@.?\relax@>
- if last=first then return;
- c:=buffer[first];
- if c>="a" then c:=c+"A"-"a"; {convert to uppercase}
- @<Interpret code |c| and |return| if done@>;
- end
-
-@ It is desirable to provide an `\.E' option here that gives the user
-an easy way to return from \TeX\ to the system editor, with the offending
-line ready to be edited. But such an extension requires some system
-wizardry, so the present implementation simply types out the name of the
-file that should be
-edited and the relevant line number.
-@^system dependencies@>
-
-There is a secret `\.D' option available when the debugging routines haven't
-been commented~out.
-@^debugging@>
-
-@<Interpret code |c| and |return| if done@>=
-case c of
-"0","1","2","3","4","5","6","7","8","9": if deletions_allowed then
- @<Delete \(c)|c-"0"| tokens and |goto continue|@>;
-@t\4\4@>@;@+@!debug "D": begin debug_help; goto continue;@+end;@+gubed@/
-"E": if base_ptr>0 then
- begin print_nl("You want to edit file ");
-@.You want to edit file x@>
- slow_print(input_stack[base_ptr].name_field);
- print(" at line "); print_int(line);
- interaction:=scroll_mode; jump_out;
- end;
-"H": @<Print the help information and |goto continue|@>;
-"I":@<Introduce new material from the terminal and |return|@>;
-"Q","R","S":@<Change the interaction level and |return|@>;
-"X":begin interaction:=scroll_mode; jump_out;
- end;
-othercases do_nothing
-endcases;@/
-@<Print the menu of available options@>
-
-@ @<Print the menu...@>=
-begin print("Type <return> to proceed, S to scroll future error messages,");@/
-@.Type <return> to proceed...@>
-print_nl("R to run without stopping, Q to run quietly,");@/
-print_nl("I to insert something, ");
-if base_ptr>0 then print("E to edit your file,");
-if deletions_allowed then
- print_nl("1 or ... or 9 to ignore the next 1 to 9 tokens of input,");
-print_nl("H for help, X to quit.");
-end
-
-@ Here the author of \TeX\ apologizes for making use of the numerical
-relation between |"Q"|, |"R"|, |"S"|, and the desired interaction settings
-|batch_mode|, |nonstop_mode|, |scroll_mode|.
-@^Knuth, Donald Ervin@>
-
-@<Change the interaction...@>=
-begin error_count:=0; interaction:=batch_mode+c-"Q";
-print("OK, entering ");
-case c of
-"Q":begin print_esc("batchmode"); decr(selector);
- end;
-"R":print_esc("nonstopmode");
-"S":print_esc("scrollmode");
-end; {there are no other cases}
-print("..."); print_ln; update_terminal; return;
-end
-
-@ When the following code is executed, |buffer[(first+1)..(last-1)]| may
-contain the material inserted by the user; otherwise another prompt will
-be given. In order to understand this part of the program fully, you need
-to be familiar with \TeX's input stacks.
-
-@<Introduce new material...@>=
-begin begin_file_reading; {enter a new syntactic level for terminal input}
-{now |state=mid_line|, so an initial blank space will count as a blank}
-if last>first+1 then
- begin loc:=first+1; buffer[first]:=" ";
- end
-else begin prompt_input("insert>"); loc:=first;
-@.insert>@>
- end;
-first:=last;
-cur_input.limit_field:=last-1; {no |end_line_char| ends this line}
-return;
-end
-
-@ We allow deletion of up to 99 tokens at a time.
-
-@<Delete \(c)|c-"0"| tokens...@>=
-begin s1:=cur_tok; s2:=cur_cmd; s3:=cur_chr; s4:=align_state;
-align_state:=1000000; OK_to_interrupt:=false;
-if (last>first+1) and (buffer[first+1]>="0")and(buffer[first+1]<="9") then
- c:=c*10+buffer[first+1]-"0"*11
-else c:=c-"0";
-while c>0 do
- begin get_token; {one-level recursive call of |error| is possible}
- decr(c);
- end;
-cur_tok:=s1; cur_cmd:=s2; cur_chr:=s3; align_state:=s4; OK_to_interrupt:=true;
-help2("I have just deleted some text, as you asked.")@/
-("You can now delete more, or insert, or whatever.");
-show_context; goto continue;
-end
-
-@ @<Print the help info...@>=
-begin if use_err_help then
- begin give_err_help; use_err_help:=false;
- end
-else begin if help_ptr=0 then
- help2("Sorry, I don't know how to help in this situation.")@/
- @t\kern1em@>("Maybe you should try asking a human?");
- repeat decr(help_ptr); print(help_line[help_ptr]); print_ln;
- until help_ptr=0;
- end;
-help4("Sorry, I already gave what help I could...")@/
- ("Maybe you should try asking a human?")@/
- ("An error might have occurred before I noticed any problems.")@/
- ("``If all else fails, read the instructions.''");@/
-goto continue;
-end
-
-@ @<Put help message on the transcript file@>=
-if interaction>batch_mode then decr(selector); {avoid terminal output}
-if use_err_help then
- begin print_ln; give_err_help;
- end
-else while help_ptr>0 do
- begin decr(help_ptr); print_nl(help_line[help_ptr]);
- end;
-print_ln;
-if interaction>batch_mode then incr(selector); {re-enable terminal output}
-print_ln
-
-@ A dozen or so error messages end with a parenthesized integer, so we
-save a teeny bit of program space by declaring the following procedure:
-
-@p procedure int_error(@!n:integer);
-begin print(" ("); print_int(n); print_char(")"); error;
-end;
-
-@ In anomalous cases, the print selector might be in an unknown state;
-the following subroutine is called to fix things just enough to keep
-running a bit longer.
-
-@p procedure normalize_selector;
-begin if log_opened then selector:=term_and_log
-else selector:=term_only;
-if job_name=0 then open_log_file;
-if interaction=batch_mode then decr(selector);
-end;
-
-@ The following procedure prints \TeX's last words before dying.
-
-@d succumb==begin if interaction=error_stop_mode then
- interaction:=scroll_mode; {no more interaction}
- if log_opened then error;
- @!debug if interaction>batch_mode then debug_help;@+gubed@;@/
- history:=fatal_error_stop; jump_out; {irrecoverable error}
- end
-
-@<Error hand...@>=
-procedure fatal_error(@!s:str_number); {prints |s|, and that's it}
-begin normalize_selector;@/
-print_err("Emergency stop"); help1(s); succumb;
-@.Emergency stop@>
-end;
-
-@ Here is the most dreaded error message.
-
-@<Error hand...@>=
-procedure lua_norm_error(@!s:str_number); {lua found a problem}
-var saved_new_line_char: integer;
-begin
-saved_new_line_char:=new_line_char;
-new_line_char:=10;
-print_err("LuaTeX error "); print(s);
-help2("The lua interpreter ran into a problem, so the")@/
- ("remainder of this lua chunk will be ignored.");
-error;
-new_line_char:=saved_new_line_char;
-end;
-
-procedure lua_fatal_error(@!s:str_number); {lua found a problem}
-begin new_line_char:=10; normalize_selector;
-print_err("LuaTeX fatal error "); print(s);
-succumb;
-end;
-
-procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
-begin normalize_selector;
-print_err("TeX capacity exceeded, sorry [");
-@.TeX capacity exceeded ...@>
-print(s); print_char("="); print_int(n); print_char("]");
-help2("If you really absolutely need more capacity,")@/
- ("you can ask a wizard to enlarge me.");
-succumb;
-end;
-
-procedure overflow_ocp_buf_size;
-begin
-overflow("ocp_buf_size",ocp_buf_size);
-end;
-
-procedure overflow_ocp_stack_size;
-begin
-overflow("ocp_stack_size",ocp_stack_size);
-end;
-
-
-@ The program might sometime run completely amok, at which point there is
-no choice but to stop. If no previous error has been detected, that's bad
-news; a message is printed that is really intended for the \TeX\
-maintenance person instead of the user (unless the user has been
-particularly diabolical). The index entries for `this can't happen' may
-help to pinpoint the problem.
-@^dry rot@>
-
-@<Error hand...@>=
-procedure confusion(@!s:str_number);
- {consistency check violated; |s| tells where}
-begin normalize_selector;
-if history<error_message_issued then
- begin print_err("This can't happen ("); print(s); print_char(")");
-@.This can't happen@>
- help1("I'm broken. Please show this to someone who can fix can fix");
- end
-else begin print_err("I can't go on meeting you like this");
-@.I can't go on...@>
- help2("One of your faux pas seems to have wounded me deeply...")@/
- ("in fact, I'm barely conscious. Please fix it and try again.");
- end;
-succumb;
-end;
-
-@ Users occasionally want to interrupt \TeX\ while it's running.
-If the \PASCAL\ runtime system allows this, one can implement
-a routine that sets the global variable |interrupt| to some nonzero value
-when such an interrupt is signalled. Otherwise there is probably at least
-a way to make |interrupt| nonzero using the \PASCAL\ debugger.
-@^system dependencies@>
-@^debugging@>
-
-@<Global...@>=
-@!interrupt:integer; {should \TeX\ pause for instructions?}
-@!OK_to_interrupt:boolean; {should interrupts be observed?}
-@!static_int_base:integer; {C version of |int_base|}
-@!static_glue_base:integer; {C version of |glue_base|}
-@!static_dimen_base:integer; {C version of |dimen_base|}
-@!static_local_base:integer; {C version of |local_base|}
-
-@ @p procedure check_interrupt;
-begin
-if interrupt<>0 then pause_for_instructions;
-end;
-
-
-@ @<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 some instructions for me (e.g.,`I\showlists'),")@/
- ("unless you just want to quit by typing `X'.");
- deletions_allowed:=false; error; deletions_allowed:=true;
- interrupt:=0;
- end;
-end;
-
-@* \[7] Arithmetic with scaled dimensions.
-The principal computations performed by \TeX\ are done entirely in terms of
-integers less than $2^{31}$ in magnitude; and divisions are done only when both
-dividend and divisor are nonnegative. Thus, the arithmetic specified in this
-program can be carried out in exactly the same way on a wide variety of
-computers, including some small ones. Why? Because the arithmetic
-calculations need to be spelled out precisely in order to guarantee that
-\TeX\ will produce identical output on different machines. If some
-quantities were rounded differently in different implementations, we would
-find that line breaks and even page breaks might occur in different places.
-Hence the arithmetic of \TeX\ has been designed with care, and systems that
-claim to be implementations of \TeX82 should follow precisely the
-@:TeX82}{\TeX82@>
-calculations as they appear in the present program.
-
-(Actually there are three places where \TeX\ uses |div| with a possibly negative
-numerator. These are harmless; see |div| in the index. Also if the user
-sets the \.{\\time} or the \.{\\year} to a negative value, some diagnostic
-information will involve negative-numerator division. The same remarks
-apply for |mod| as well as for |div|.)
-
-@ Here is a routine that calculates half of an integer, using an
-unambiguous convention with respect to signed odd numbers.
-
-@p function half(@!x:integer):integer;
-begin if odd(x) then half:=(x+1) div 2
-else half:=x @!div 2;
-end;
-
-@ Fixed-point arithmetic is done on {\sl scaled integers\/} that are multiples
-of $2^{-16}$. In other words, a binary point is assumed to be sixteen bit
-positions from the right end of a binary computer word.
-
-@d unity == @'200000 {$2^{16}$, represents 1.00000}
-@d two == @'400000 {$2^{17}$, represents 2.00000}
-
-@<Types...@>=
-@!scaled = integer; {this type is used for scaled integers}
-@!nonnegative_integer=0..@'17777777777; {$0\L x<2^{31}$}
-@!small_number=0..63; {this type is self-explanatory}
-
-@ The following function is used to create a scaled integer from a given decimal
-fraction $(.d_0d_1\ldots d_{k-1})$, where |0<=k<=17|. The digit $d_i$ is
-given in |dig[i]|, and the calculation produces a correctly rounded result.
-
-@p function round_decimals(@!k:small_number) : scaled;
- {converts a decimal fraction}
-var a:integer; {the accumulator}
-begin a:=0;
-while k>0 do
- begin decr(k); a:=(a+dig[k]*two) div 10;
- end;
-round_decimals:=(a+1) div 2;
-end;
-
-@ Conversely, here is a procedure analogous to |print_int|. If the output
-of this procedure is subsequently read by \TeX\ and converted by the
-|round_decimals| routine above, it turns out that the original value will
-be reproduced exactly; the ``simplest'' such decimal number is output,
-but there is always at least one digit following the decimal point.
-
-The invariant relation in the \&{repeat} loop is that a sequence of
-decimal digits yet to be printed will yield the original number if and only if
-they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$.
-We can stop if and only if $f=0$ satisfies this condition; the loop will
-terminate before $s$ can possibly become zero.
-
-@p procedure print_scaled(@!s:scaled); {prints scaled real, rounded to five
- digits}
-var delta:scaled; {amount of allowable inaccuracy}
-begin if s<0 then
- begin print_char("-"); negate(s); {print the sign, if negative}
- end;
-print_int(s div unity); {print the integer part}
-print_char(".");
-s:=10*(s mod unity)+5; delta:=10;
-repeat if delta>unity then s:=s+@'100000-50000; {round the last digit}
-print_char("0"+(s div unity)); s:=10*(s mod unity); delta:=delta*10;
-until s<=delta;
-end;
-
-@ Physical sizes that a \TeX\ user specifies for portions of documents are
-represented internally as scaled points. Thus, if we define an `sp' (scaled
-@^sp@>
-point) as a unit equal to $2^{-16}$ printer's points, every dimension
-inside of \TeX\ is an integer number of sp. There are exactly
-4,736,286.72 sp per inch. Users are not allowed to specify dimensions
-larger than $2^{30}-1$ sp, which is a distance of about 18.892 feet (5.7583
-meters); two such quantities can be added without overflow on a 32-bit
-computer.
-
-The present implementation of \TeX\ does not check for overflow when
-@^overflow in arithmetic@>
-dimensions are added or subtracted. This could be done by inserting a
-few dozen tests of the form `\ignorespaces|if x>=@'10000000000 then
-@t\\{report\_overflow}@>|', but the chance of overflow is so remote that
-such tests do not seem worthwhile.
-
-\TeX\ needs to do only a few arithmetic operations on scaled quantities,
-other than addition and subtraction, and the following subroutines do most of
-the work. A single computation might use several subroutine calls, and it is
-desirable to avoid producing multiple error messages in case of arithmetic
-overflow; so the routines set the global variable |arith_error| to |true|
-instead of reporting errors directly to the user. Another global variable,
-|remainder|, holds the remainder after a division.
-
-@<Glob...@>=
-@!arith_error:boolean; {has arithmetic overflow occurred recently?}
-@!remainder:scaled; {amount subtracted to get an exact division}
-
-@ The first arithmetical subroutine we need computes $nx+y$, where |x|
-and~|y| are |scaled| and |n| is an integer. We will also use it to
-multiply integers.
-
-@d nx_plus_y(#)==mult_and_add(#,@'7777777777)
-@d mult_integers(#)==mult_and_add(#,0,@'17777777777)
-
-@p function mult_and_add(@!n:integer;@!x,@!y,@!max_answer:scaled):scaled;
-begin if n<0 then
- begin negate(x); negate(n);
- end;
-if n=0 then mult_and_add:=y
-else if ((x<=(max_answer-y) div n)and(-x<=(max_answer+y) div n)) then
- mult_and_add:=n*x+y
-else begin arith_error:=true; mult_and_add:=0;
- end;
-end;
-
-@ We also need to divide scaled dimensions by integers.
-
-@p function x_over_n(@!x:scaled;@!n:integer):scaled;
-var negative:boolean; {should |remainder| be negated?}
-begin negative:=false;
-if n=0 then
- begin arith_error:=true; x_over_n:=0; remainder:=x;
- end
-else begin if n<0 then
- begin negate(x); negate(n); negative:=true;
- end;
- if x>=0 then
- begin x_over_n:=x div n; remainder:=x mod n;
- end
- else begin x_over_n:=-((-x) div n); remainder:=-((-x) mod n);
- end;
- end;
-if negative then negate(remainder);
-end;
-
-@ Then comes the multiplication of a scaled number by a fraction |n/d|,
-where |n| and |d| are nonnegative integers |<=@t$2^{16}$@>| and |d| is
-positive. It would be too dangerous to multiply by~|n| and then divide
-by~|d|, in separate operations, since overflow might well occur; and it
-would be too inaccurate to divide by |d| and then multiply by |n|. Hence
-this subroutine simulates 1.5-precision arithmetic.
-
-@p function xn_over_d(@!x:scaled; @!n,@!d:integer):scaled;
-var positive:boolean; {was |x>=0|?}
-@!t,@!u,@!v:nonnegative_integer; {intermediate quantities}
-begin if x>=0 then positive:=true
-else begin negate(x); positive:=false;
- end;
-t:=(x mod @'100000)*n;
-u:=(x div @'100000)*n+(t div @'100000);
-v:=(u mod d)*@'100000 + (t mod @'100000);
-if u div d>=@'100000 then arith_error:=true
-else u:=@'100000*(u div d) + (v div d);
-if positive then
- begin xn_over_d:=u; remainder:=v mod d;
- end
-else begin xn_over_d:=-u; remainder:=-(v mod d);
- end;
-end;
-
-@ The next subroutine is used to compute the ``badness'' of glue, when a
-total~|t| is supposed to be made from amounts that sum to~|s|. According
-to {\sl The \TeX book}, the badness of this situation is $100(t/s)^3$;
-however, badness is simply a heuristic, so we need not squeeze out the
-last drop of accuracy when computing it. All we really want is an
-approximation that has similar properties.
-@:TeXbook}{\sl The \TeX book@>
-
-The actual method used to compute the badness is easier to read from the
-program than to describe in words. It produces an integer value that is a
-reasonably close approximation to $100(t/s)^3$, and all implementations
-of \TeX\ should use precisely this method. Any badness of $2^{13}$ or more is
-treated as infinitely bad, and represented by 10000.
-
-It is not difficult to prove that $$\hbox{|badness(t+1,s)>=badness(t,s)
->=badness(t,s+1)|}.$$ The badness function defined here is capable of
-computing at most 1095 distinct values, but that is plenty.
-
-@d inf_bad = 10000 {infinitely bad value}
-
-@p function badness(@!t,@!s:scaled):halfword; {compute badness, given |t>=0|}
-var r:integer; {approximation to $\alpha t/s$, where $\alpha^3\approx
- 100\cdot2^{18}$}
-begin if t=0 then badness:=0
-else if s<=0 then badness:=inf_bad
-else begin if t<=7230584 then r:=(t*297) div s {$297^3=99.94\times2^{18}$}
- else if s>=1663497 then r:=t div (s div 297)
- else r:=t;
- if r>1290 then badness:=inf_bad {$1290^3<2^{31}<1291^3$}
- else badness:=(r*r*r+@'400000) div @'1000000;
- end; {that was $r^3/2^{18}$, rounded to the nearest integer}
-end;
-
-@ When \TeX\ ``packages'' a list into a box, it needs to calculate the
-proportionality ratio by which the glue inside the box should stretch
-or shrink. This calculation does not affect \TeX's decision making,
-so the precise details of rounding, etc., in the glue calculation are not
-of critical importance for the consistency of results on different computers.
-
-We shall use the type |glue_ratio| for such proportionality ratios.
-A glue ratio should take the same amount of memory as an
-|integer| (usually 32 bits) if it is to blend smoothly with \TeX's
-other data structures. Thus |glue_ratio| should be equivalent to
-|short_real| in some implementations of \PASCAL. Alternatively,
-it is possible to deal with glue ratios using nothing but fixed-point
-arithmetic; see {\sl TUGboat \bf3},1 (March 1982), 10--27. (But the
-routines cited there must be modified to allow negative glue ratios.)
-@^system dependencies@>
-
-@d set_glue_ratio_zero(#) == #:=0.0 {store the representation of zero ratio}
-@d set_glue_ratio_one(#) == #:=1.0 {store the representation of unit ratio}
-@d float(#) == # {convert from |glue_ratio| to type |real|}
-@d unfloat(#) == # {convert from |real| to type |glue_ratio|}
-@d float_constant(#) == #.0 {convert |integer| constant to |real|}
-
-@<Types...@>=
-@!glue_ratio=real; {one-word representation of a glue expansion factor}
-
-@* \[7b] Random numbers.
-
-\font\tenlogo=logo10 % font used for the METAFONT logo
-\def\MP{{\tenlogo META}\-{\tenlogo POST}}
-
-This section is (almost) straight from MetaPost. I had to change
-the types (use |integer| instead of |fraction|), but that should
-not have any influence on the actual calculations (the original
-comments refer to quantities like |fraction_four| ($2^{30}$), and
-that is the same as the numeric representation of |max_dimen|).
-
-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 begin
- if q>r then return_sign(1)@+else return_sign(-1);
- end;
- q := a mod d; r := c mod b;
- if r=0 then begin
- if q=0 then return_sign(0)@+else return_sign(1);
- end;
- 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 begin
- if ((a=0)or(b=0))and((c=0)or(d=0)) then return_sign(0)
- else return_sign(1);
- end;
- if d=0 then begin
- if a=0 then return_sign(0)@+else return_sign(-1);
- end;
- q:=a; a:=c; c:=q; q:=-b; b:=-d; d:=q;
- end
-else if b<=0 then
- begin if b<0 then if a>0 then return_sign(-1);
- if c=0 then return_sign(0) else return_sign(-1);
- end
-
-@ To consume a random integer, the program below will say `|next_random|'
-and then it will fetch |randoms[j_random]|.
-
-@d next_random==if j_random=0 then new_randoms
- else decr(j_random)
-
-@p procedure new_randoms;
-var @!k:0..54; {index into |randoms|}
-@!x:integer; {accumulator}
-begin for k:=0 to 23 do
- begin x:=randoms[k]-randoms[k+31];
- if x<0 then x:=x+fraction_one;
- randoms[k]:=x;
- end;
-for k:=24 to 54 do
- begin x:=randoms[k]-randoms[k-24];
- if x<0 then x:=x+fraction_one;
- randoms[k]:=x;
- end;
-j_random:=54;
-end;
-
-@ To initialize the |randoms| table, we call the following routine.
-
-@p procedure init_randoms(@!seed:integer);
-var @!j,@!jj,@!k:integer; {more or less random integers}
-@!i:0..54; {index into |randoms|}
-begin j:=abs(seed);
-while j>=fraction_one do j:=halfp(j);
-k:=1;
-for i:=0 to 54 do
- begin jj:=k; k:=j-k; j:=jj;
- if k<0 then k:=k+fraction_one;
- randoms[(i*21)mod 55]:=j;
- end;
-new_randoms; new_randoms; new_randoms; {``warm up'' the array}
-end;
-
-@ To produce a uniform random number in the range |0<=u<x| or |0>=u>x|
-or |0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
-
-Note that the call of |take_frac| will produce the values 0 and~|x|
-with about half the probability that it will produce any other particular
-values between 0 and~|x|, because it rounds its answers.
-
-@p function unif_rand(@!x:integer):integer;
-var @!y:integer; {trial value}
-begin next_random; y:=take_frac(abs(x),randoms[j_random]);
-if y=abs(x) then unif_rand:=0
-else if x>0 then unif_rand:=y
-else unif_rand:=-y;
-end;
-
-@ Finally, a normal deviate with mean zero and unit standard deviation
-can readily be obtained with the ratio method (Algorithm 3.4.1R in
-{\sl The Art of Computer Programming\/}).
-
-@p function norm_rand:integer;
-var @!x,@!u,@!l:integer; {what the book would call $2^{16}X$, $2^{28}U$,
- and $-2^{24}\ln U$}
-begin repeat
- repeat next_random;
- x:=take_frac(112429,randoms[j_random]-fraction_half);
- {$2^{16}\sqrt{8/e}\approx 112428.82793$}
- next_random; u:=randoms[j_random];
- until abs(x)<u;
-x:=make_frac(x,u);
-l:=139548960-m_log(u); {$2^{24}\cdot12\ln2\approx139548959.6165$}
-until ab_vs_cd(1024,l,x,x)>=0;
-norm_rand:=x;
-end;
-
-@* \[8] Packed data.
-In order to make efficient use of storage space, \TeX\ bases its major data
-structures on a |memory_word|, which contains either a (signed) integer,
-possibly scaled, or a (signed) |glue_ratio|, or a small number of
-fields that are one half or one quarter of the size used for storing
-integers.
-
-If |x| is a variable of type |memory_word|, it contains up to four
-fields that can be referred to as follows:
-$$\vbox{\halign{\hfil#&#\hfil&#\hfil\cr
-|x|&.|int|&(an |integer|)\cr
-|x|&.|sc|\qquad&(a |scaled| integer)\cr
-|x|&.|gr|&(a |glue_ratio|)\cr
-|x.hh.lh|, |x.hh|&.|rh|&(two halfword fields)\cr
-|x.hh.b0|, |x.hh.b1|, |x.hh|&.|rh|&(two quarterword fields, one halfword
- field)\cr
-|x.qqqq.b0|, |x.qqqq.b1|, |x.qqqq|&.|b2|, |x.qqqq.b3|\hskip-100pt
- &\qquad\qquad\qquad(four quarterword fields)\cr}}$$
-This is somewhat cumbersome to write, and not very readable either, but
-macros will be used to make the notation shorter and more transparent.
-The \PASCAL\ code below gives a formal definition of |memory_word| and
-its subsidiary types, using packed variant records. \TeX\ makes no
-assumptions about the relative positions of the fields within a word.
-
-We are assuming 32-bit integers, a halfword must contain at least
-32 bits, and a quarterword must contain at least 16 bits.
-@^system dependencies@>
-
-N.B.: Valuable memory space will be dreadfully wasted unless \TeX\ is compiled
-by a \PASCAL\ that packs all of the |memory_word| variants into
-the space of a single integer. This means, for example, that |glue_ratio|
-words should be |short_real| instead of |real| on some computers. Some
-\PASCAL\ compilers will pack an integer whose subrange is `|0..255|' into
-an eight-bit field, but others insist on allocating space for an additional
-sign bit; on such systems you can get 256 values into a quarterword only
-if the subrange is `|-128..127|'.
-
-The present implementation tries to accommodate as many variations as possible,
-so it makes few assumptions. If integers having the subrange
-`|min_quarterword..max_quarterword|' can be packed into a quarterword,
-and if integers having the subrange `|min_halfword..max_halfword|'
-can be packed into a halfword, everything should work satisfactorily.
-
-It is usually most efficient to have |min_quarterword=min_halfword=0|,
-so one should try to achieve this unless it causes a severe problem.
-The values defined here are recommended for most 32-bit computers.
-
-We cannot use the full range of 32 bits in a halfword, because we have
-to allow negative values for potential backend tricks like web2c's
-dynamic allocation, and parshapes pointers have to be able to store at
-least twice the value |max_halfword| (see below). Therefore,
-|max_halfword| is $2^{30}-1$
-
-@d min_quarterword=0 {smallest allowable value in a |quarterword|}
-@d max_quarterword=65535 {largest allowable value in a |quarterword|}
-@d min_halfword==-@"3FFFFFFF {smallest allowable value in a |halfword|}
-@d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|}
-
-@ Here are the inequalities that the quarterword and halfword values
-must satisfy (or rather, the inequalities that they mustn't satisfy):
-
-@<Check the ``constant''...@>=
-if (min_quarterword>0)or(max_quarterword<@"7FFF) then bad:=11;
-if (min_halfword>0)or(max_halfword<@"3FFFFFFF) then bad:=12;
-if (min_quarterword<min_halfword)or@|
- (max_quarterword>max_halfword) then bad:=13;
-if font_base<min_quarterword then bad:=15;
-if (save_size>max_halfword)or(max_strings>max_halfword) then bad:=17;
-if buf_size>max_halfword then bad:=18;
-if max_quarterword-min_quarterword<@"FFFF then bad:=19;
-
-@ The operation of adding or subtracting |min_quarterword| occurs quite
-frequently in \TeX, so it is convenient to abbreviate this operation
-by using the macros |qi| and |qo| for input and output to and from
-quarterword format.
-
-The inner loop of \TeX\ will run faster with respect to compilers
-that don't optimize expressions like `|x+0|' and `|x-0|', if these
-macros are simplified in the obvious way when |min_quarterword=0|.
-@^inner loop@>@^system dependencies@>
-
-@d qi(#)==#+min_quarterword
- {to put an |eight_bits| item into a quarterword}
-@d qo(#)==#-min_quarterword
- {to take an |eight_bits| item out of a quarterword}
-@d hi(#)==#+min_halfword
- {to put a sixteen-bit item into a halfword}
-@d ho(#)==#-min_halfword
- {to take a sixteen-bit item from a halfword}
-
-@ The reader should study the following definitions closely:
-@^system dependencies@>
-
-@d sc==int {|scaled| data is equivalent to |integer|}
-
-@<Types...@>=
-@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
-@!halfword=min_halfword..max_halfword; {1/2 of a word}
-@!two_choices = 1..2; {used when there are two variants in a record}
-@!four_choices = 1..4; {used when there are four variants in a record}
-@!two_halves = packed record@;@/
- @!rh:halfword;
- case two_choices of
- 1: (@!lh:halfword);
- 2: (@!b0:quarterword; @!b1:quarterword);
- end;
-@!four_quarters = packed record@;@/
- @!b0:quarterword;
- @!b1:quarterword;
- @!b2:quarterword;
- @!b3:quarterword;
- end;
-@!memory_word = record@;@/
- case four_choices of
- 1: (@!int:integer);
- 2: (@!gr:glue_ratio);
- 3: (@!hh:two_halves);
- 4: (@!qqqq:four_quarters);
- end;
-@!word_file = file of memory_word;
-
-@ When debugging, we may want to print a |memory_word| without knowing
-what type it is; so we print it in all modes.
-@^dirty \PASCAL@>@^debugging@>
-
-@p @!debug procedure print_word(@!w:memory_word);
- {prints |w| in all ways}
-begin print_int(w.int); print_char(" ");@/
-print_scaled(w.sc); print_char(" ");@/
-print_scaled(round(unity*float(w.gr))); print_ln;@/
-@^real multiplication@>
-print_int(w.hh.lh); print_char("="); print_int(w.hh.b0); print_char(":");
-print_int(w.hh.b1); print_char(";"); print_int(w.hh.rh); print_char(" ");@/
-print_int(w.qqqq.b0); print_char(":"); print_int(w.qqqq.b1); print_char(":");
-print_int(w.qqqq.b2); print_char(":"); print_int(w.qqqq.b3);
-end;
-gubed
-
-@* \[9] Dynamic memory allocation.
-The \TeX\ system does nearly all of its own memory allocation, so that it
-can readily be transported into environments that do not have automatic
-facilities for strings, garbage collection, etc., and so that it can be in
-control of what error messages the user receives. The dynamic storage
-requirements of \TeX\ are handled by providing two large arrays called
-|fixmem| and |varmem| in which consecutive blocks of words are used as
-nodes by the \TeX\ routines.
-
-Pointer variables are indices into this array, or into another array
-called |eqtb| that will be explained later. A pointer variable might
-also be a special flag that lies outside the bounds of |mem|, so we
-allow pointers to assume any |halfword| value. The minimum halfword
-value represents a null pointer. \TeX\ does not assume that |mem[null]| exists.
-
-@d pointer==halfword {a flag or a location in |mem| or |eqtb|}
-@d null==0 {the null pointer}
-
-@<Glob...@>=
-@!temp_ptr:pointer; {a pointer variable for occasional emergency use}
-
-@ @<Types...@>=
-@!smemory_word = packed record@;@/
- @!hhrh:halfword;
- @!hhlh:halfword;
- end;
-
-
-@ The |mem| array is divided into two items that are allocated separately;
-they grow until finding their ``natural'' size in a particular job.
-Locations in |varmem| are used for storing variable-length records
-consisting of two or more words each. This region
-is maintained using an algorithm similar to the one described in exercise
-2.5--19 of {\sl The Art of Computer Programming}. However, no size field
-appears in the allocated nodes; the program is responsible for knowing the
-relevant size when a node is freed. Locations in |fixmem| are used for storing
-one-word records; a conventional \.{AVAIL} stack is used for allocation
-in this array.
-
-Empirical tests show that the present implementation of \TeX\ tends to
-spend about 9\pct! of its running time allocating nodes, and about 6\pct!
-deallocating them after their use.
-
-@d fix_mem_init==10000
-
-@<Glob...@>=
-@!fixmem : ^smemory_word; {the big dynamic storage area}
-@!fix_mem_min : pointer; {the smallest location of one-word memory in use}
-@!fix_mem_max : pointer; {the largest location of one-word memory in use}
-
-@ In order to study the memory requirements of particular applications, it
-is possible to prepare a version of \TeX\ that keeps track of current and
-maximum memory usage. When code between the delimiters |@!stat| $\ldots$
-|tats| is not ``commented out,'' \TeX\ will run a bit slower but it will
-report these statistics when |tracing_stats| is sufficiently large.
-
-@<Glob...@>=
-@!var_used, @!dyn_used : integer; {how much memory is in use}
-
-@ Let's consider the one-word memory region first, since it's the
-simplest. The pointer variable |fix_mem_end| holds the highest-numbered location
-of |mem| that has ever been used. The free locations of |mem| that
-occur between |hi_mem_min| and |fix_mem_end|, inclusive, are of type
-|two_halves|, and we write |info(p)| and |link(p)| for the |lh|
-and |rh| fields of |mem[p]| when it is of this type. The single-word
-free locations form a linked list
-$$|avail|,\;\hbox{|link(avail)|},\;\hbox{|link(link(avail))|},\;\ldots$$
-terminated by |null|.
-
-@d mem(#) == fixmem[#]
-@d link(#) == mem(#).hhrh {the |link| field of a memory word}
-@d info(#) == mem(#).hhlh {the |info| field of a memory word}
-
-@<Glob...@>=
-@!avail : pointer; {head of the list of available one-word nodes}
-@!fix_mem_end : pointer; {the last one-word node used in |mem|}
-
-@ If memory is exhausted, it might mean that the user has forgotten
-a right brace. We will define some procedures later that try to help
-pinpoint the trouble.
-
-@p @<Declare the procedure called |show_token_list|@>@/
-@<Declare the procedure called |runaway|@>
-
-@ The function |get_avail| returns a pointer to a new one-word node whose
-|link| field is null. However, \TeX\ will halt if there is no more room left.
-@^inner loop@>
-
-If the available-space list is empty, i.e., if |avail=null|,
-we try first to increase |fix_mem_end|. If that cannot be done, i.e., if
-|fix_mem_end=fix_mem_max|, we try to reallocate array |fixmem|.
-If, that doesn't work, we have to quit.
-
-@p function get_avail : pointer; {single-word node allocation}
-var p:pointer; {the new node being got}
-t:integer;
-begin p:=avail; {get top location in the |avail| stack}
-if p<>null then avail:=link(avail) {and pop it off}
-else if fix_mem_end<fix_mem_max then {or go into virgin territory}
- begin incr(fix_mem_end); p:=fix_mem_end;
- end
-else begin
- t:=(fix_mem_max/5);
- fixmem := fixmemcast(realloc(fixmem,sizeof(smemory_word)*(fix_mem_max+t+1)));
- if fixmem=NULL then
- begin runaway; {if memory is exhausted, display possible runaway text}
- overflow("token memory size",fix_mem_max);
- {quit; all one-word nodes are busy}
-@:TeX capacity exceeded main memory size}{\quad main memory size@>
- end;
- memset (voidcast(fixmem+fix_mem_max+1),0,t*sizeof(smemory_word));
- fix_mem_max:=fix_mem_max+t; incr(fix_mem_end); p:=fix_mem_end;
- end;
-link(p):=null; {provide an oft-desired initialization of the new node}
-@!stat incr(dyn_used);@+tats@;{maintain statistics}
-get_avail:=p;
-end;
-
-@ Conversely, a one-word node is recycled by calling |free_avail|.
-This routine is part of \TeX's ``inner loop,'' so we want it to be fast.
-@^inner loop@>
-
-@d free_avail(#)== {single-word node liberation}
- begin link(#):=avail; avail:=#;
- @!stat decr(dyn_used);@+tats@/
- end
-
-@ There's also a |fast_get_avail| routine, which saves the procedure-call
-overhead at the expense of extra programming. This routine is used in
-the places that would otherwise account for the most calls of |get_avail|.
-@^inner loop@>
-
-@d fast_get_avail(#)==@t@>@;@/
- begin #:=avail; {avoid |get_avail| if possible, to save time}
- if #=null then #:=get_avail
- else begin avail:=link(#); link(#):=null;
- @!stat incr(dyn_used);@+tats@/
- end;
- end
-
-@ The procedure |flush_list(p)| frees an entire linked list of
-one-word nodes that starts at position |p|.
-@^inner loop@>
-
-@p procedure flush_list(@!p:pointer); {makes list of single-word nodes available}
-var @!q,@!r:pointer; {list traversers}
-begin if p<>null then
- begin r:=p;
- repeat q:=r; r:=link(r); @!stat decr(dyn_used);@+tats@/
- until r=null; {now |q| is the last node on the list}
- link(q):=avail; avail:=p;
- end;
-end;
-
-@ The available-space list that keeps track of the variable-size portion
-of |mem| is a nonempty, doubly-linked circular list of empty nodes,
-pointed to by the roving pointer |rover|.
-
-@d vmem(#) == varmem[#]
-@d vlink(#) == vmem(#).hh.rh {the |link| field of a memory word}
-@d vinfo(#) == vmem(#).hh.lh {the |info| field of a memory word}
-@d alink(#) == vlink(#+1) {backlink in doubly-linked list of empty nodes}
-
-@* \[10] Data structures for boxes and their friends.
-From the computer's standpoint, \TeX's chief mission is to create
-horizontal and vertical lists. We shall now investigate how the elements
-of these lists are represented internally as nodes in the dynamic memory.
-
-A horizontal or vertical list is linked together by |link| fields in
-the first word of each node. Individual nodes represent boxes, glue,
-penalties, or special things like discretionary hyphens; because of this
-variety, some nodes are longer than others, and we must distinguish different
-kinds of nodes. We do this by putting a `|type|' field in the first word,
-together with the link and an optional `|subtype|'.
-
-@d type(#) == vmem(#).hh.b0 {identifies what kind of node this is}
-@d subtype(#) == vmem(#).hh.b1 {secondary identification in some cases}
-
-@ TH: This module section is superceded.
-
-A |@!char_node|, which represents a single character, is the most important
-kind of node because it accounts for the vast majority of all boxes.
-Special precautions are therefore taken to ensure that a |char_node| does
-not take up much memory space. Every such node is one word long, and in fact
-it is identifiable by this property, since other kinds of nodes have at least
-two words, and they appear in |mem| locations less than |hi_mem_min|.
-This makes it possible to omit the |type| field in a |char_node|, leaving
-us room for two bytes that identify a |font| and a |character| within
-that font.
-
-Note that the format of a |char_node| allows for up to 256 different
-fonts and up to 256 characters per font; but most implementations will
-probably limit the total number of fonts to fewer than 75 per job,
-and most fonts will stick to characters whose codes are
-less than 128 (since higher codes
-are more difficult to access on most keyboards).
-
-Extensions of \TeX\ intended for oriental languages will need even more
-than $256\times256$ possible characters, when we consider different sizes
-@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
-and styles of type. It is suggested that Chinese and Japanese fonts be
-handled by representing such characters in two consecutive |char_node|
-entries: The first of these has |font=font_base|, and its |link| points
-to the second;
-the second identifies the font and the character dimensions.
-The saving feature about oriental characters is that most of them have
-the same box dimensions. The |character| field of the first |char_node|
-is a ``\\{charext}'' that distinguishes between graphic symbols whose
-dimensions are identical for typesetting purposes. (See the \MF\ manual.)
-Such an extension of \TeX\ would not be difficult; further details are
-left to the reader.
-
-In order to make sure that the |character| code fits in a quarterword,
-\TeX\ adds the quantity |min_quarterword| to the actual code.
-
-Character nodes appear only in horizontal lists, never in vertical lists.
-
-@ Attribute lists need two extra globals to increase processing efficiency.
-|max_used_attr| limits the test loop that checks for set attributes, and
-|attr_list_cache| contains a pointer to an already created attribute list. It is
-set to the special value |cache_disabled| when the current value can no longer be
-trusted: after an assignment to an attribute register, and after a group has
-ended.
-
-@d cache_disabled==max_halfword
-
-@<Glob...@>=
-max_used_attr:integer; { maximum assigned attribute id }
-attr_list_cache:pointer;
-
-@ @<Set init...@>=
-max_used_attr:=-1; attr_list_cache:=cache_disabled;
-
-@ Attribute lists are maintained in C, but they need access to the current
-attributes in eqtb.
-
-@p function get_attribute(i:halfword):halfword;
-begin
- get_attribute := attribute(i);
-end;
-
-
-@ An |hlist_node| stands for a box that was made from a horizontal list.
-Each |hlist_node| is seven words long, and contains the following fields
-(in addition to the mandatory |type| and |link|, which we shall not
-mention explicitly when discussing the other node types): The |height| and
-|width| and |depth| are scaled integers denoting the dimensions of the
-box. There is also a |shift_amount| field, a scaled integer indicating
-how much this box should be lowered (if it appears in a horizontal list),
-or how much it should be moved to the right (if it appears in a vertical
-list). There is a |list_ptr| field, which points to the beginning of the
-list from which this box was fabricated; if |list_ptr| is |null|, the box
-is empty. Finally, there are three fields that represent the setting of
-the glue: |glue_set(p)| is a word of type |glue_ratio| that represents
-the proportionality constant for glue setting; |glue_sign(p)| is
-|stretching| or |shrinking| or |normal| depending on whether or not the
-glue should stretch or shrink or remain rigid; and |glue_order(p)|
-specifies the order of infinity to which glue setting applies (|normal|,
-|sfi|, |fil|, |fill|, or |filll|). The |subtype| field is not used.
-
-@d width_offset=2 {position of |width| field in a box node}
-@d depth_offset=3 {position of |depth| field in a box node}
-@d height_offset=4 {position of |height| field in a box node}
-@d width(#) == vmem(#+width_offset).sc {width of the box, in sp}
-@d depth(#) == vmem(#+depth_offset).sc {depth of the box, in sp}
-@d height(#) == vmem(#+height_offset).sc {height of the box, in sp}
-@d shift_amount(#) == vlink(#+5) {repositioning distance, in sp}
-@d box_dir(#) == vinfo(#+5) {position of |box_dir| in a box node}
-@d list_offset=6 {position of |list_ptr| field in a box node}
-@d list_ptr(#) == vlink(#+list_offset) {beginning of the list inside the box}
-@d glue_order(#) == subtype(#+list_offset) {applicable order of infinity}
-@d glue_sign(#) == type(#+list_offset) {stretching or shrinking}
-@d normal=0 {the most common case when several cases are named}
-@d stretching = 1 {glue setting applies to the stretch components}
-@d shrinking = 2 {glue setting applies to the shrink components}
-@d glue_set(#) == vmem(#+7).gr {a word of type |glue_ratio| for glue setting}
-
-@ The |new_null_box| function returns a pointer to an |hlist_node| in
-which all subfields have the values corresponding to `\.{\\hbox\{\}}'.
-The |subtype| field is set to |min_quarterword|, since that's the desired
-|span_count| value if this |hlist_node| is changed to an |unset_node|.
-
-@p function new_null_box:pointer; {creates a new box node}
-var p:pointer; {the new node}
-begin p:=new_node(hlist_node,min_quarterword);
-box_dir(p):=text_direction;
-new_null_box:=p;
-end;
-
-@ A |vlist_node| is like an |hlist_node| in all respects except that it
-contains a vertical list.
-
-@ 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 null_flag==-@'10000000000 {$-2^{30}$, signifies a missing item}
-@d is_running(#) == (#=null_flag) {tests for a running dimension}
-@d rule_dir(#)==vlink(#+5)
-
-@ A new rule node is delivered by the |new_rule| function. It
-makes all the dimensions ``running,'' so you have to change the
-ones that are not allowed to run.
-
-@p
-function new_rule:pointer;
-var p:pointer; {the new node}
-begin p:=new_node(rule_node,0); {the |subtype| is not used}
-new_rule:=p;
-end;
-
-
-@ Insertions are represented by |ins_node| records, where the |subtype|
-indicates the corresponding box number. For example, `\.{\\insert 250}'
-leads to an |ins_node| whose |subtype| is |250+min_quarterword|.
-The |height| field of an |ins_node| is slightly misnamed; it actually holds
-the natural height plus depth of the vertical list being inserted.
-The |depth| field holds the |split_max_depth| to be used in case this
-insertion is split, and the |split_top_ptr| points to the corresponding
-|split_top_skip|. The |float_cost| field holds the |floating_penalty| that
-will be used if this insertion floats to a subsequent page after a
-split insertion of the same class. There is one more field, the
-|ins_ptr|, which points to the beginning of the vlist for the insertion.
-
-@d float_cost(#)==vmem(#+2).int {the |floating_penalty| to be used}
-@d ins_ptr(#)==vinfo(#+5) {the vertical list to be inserted}
-@d split_top_ptr(#)==vlink(#+5) {the |split_top_skip| to be used}
-
-@ A |mark_node| has a |mark_ptr| field that points to the reference count
-of a token list that contains the user's \.{\\mark} text.
-In addition there is a |mark_class| field that contains the mark class.
-
-@d mark_ptr(#)==vlink(#+2) {head of the token list for a mark}
-@d mark_class(#)==vinfo(#+2) {the mark class}
-
-@ An |adjust_node|, which occurs only in horizontal lists,
-specifies material that will be moved out into the surrounding
-vertical list; i.e., it is used to implement \TeX's `\.{\\vadjust}'
-operation. The |adjust_ptr| field points to the vlist containing this
-material.
-
-@d adjust_pre == subtype {pre-adjustment?}
-@d adjust_ptr(#)==vlink(#+2) {vertical list to be moved out of horizontal list}
-@#{|append_list| is used to append a list to |tail|}
-@d append_list(#) == begin vlink(tail) := vlink(#); append_list_end
-@d append_list_end(#) == tail := #; end
-
-@ A |glyph_node|, which occurs only in horizontal lists, specifies a
-glyph in a particular font, along with its attribute list. Older
-versions of \TeX\ could use token memory for characters, because the
-font,char combination would fit in a single word (both values were
-required to be strictly less than $2^{16}$). In \LuaTeX, room is
-needed for characters that are larger than that, as well as a pointer
-to a potential attribute list, and the two displacement values.
-
-In turn, that made the node so large that it made sense to merge
-ligature glyphs as well, as that requires only one extra pointer. A
-few extra classes of glyph nodes will be introduced later. The
-unification of all those types makes it easier to manipulate lists of
-glyphs. The subtype differentiates various glyph kinds.
-
-First, here is a function that returns a pointer to a glyph node for a given
-glyph in a given font. If that glyph doesn't exist, |null| is returned
-instead. Nodes of this subtype are directly created only for accents
-and their base (through |make_accent|), and math nucleus items (in the
-conversion from |mlist| to |hlist|).
-
-
-@d is_char_node(#) == ((#<>null)and(type(#)=glyph_node))
-@d font(#)==vlink(#+2) {the font code in a |glyph_node|}
-@d character(#)==vinfo(#+2) {the character code in a |glyph_node|}
-@d lig_ptr(#)==vlink(#+3) {the list of characters for ligature replacements }
-@d lang_data(#)==vinfo(#+3) {language information }
-@d x_displace(#)==vinfo(#+4) { horizontal displacement }
-@d y_displace(#)==vlink(#+4) { vertical displacement }
-
-@p function new_glyph(@!f,@!c:integer):pointer;
-var p:pointer; {the new node}
-begin p:=null;
-if (f=0) or (char_exists(f,c)) then begin
- p:=new_glyph_node;
- set_to_glyph(p); font(p):=f; character(p):=c;
- end;
-new_glyph:=p;
-end;
-
-
-@ A subset of the glyphs nodes represent ligatures: characters
-fabricated from the interaction of two or more actual characters. The
-characters that generated the ligature have not been forgotten, since
-they are needed for diagnostic messages; the |lig_ptr| field points to
-a linked list of character nodes for all original characters that have
-been deleted. (This list might be empty if the characters that
-generated the ligature were retained in other nodes.)
-
-The |subtype| field of these |glyph_node|s is 1, plus 2 and/or 1 if
-the original source of the ligature included implicit left and/or
-right boundaries. These nodes are created by the C function |new_ligkern|.
-
-@ A third general type of glyphs could be called a character, as it
-only appears in lists that are not yet processed by the ligaturing and
-kerning steps of the program.
-
-|main_control| inserts these, and they are later converted to
-|subtype_normal| by |new_ligkern|.
-
-@p function norm_min(@!h:integer):quarterword;
-begin if h<=0 then norm_min:=1@+else if h>=255 then norm_min:=255@+
-else norm_min:=h;
-end;
-@#
-function new_char(@!f,@!c:integer):pointer;
-var p:pointer; {the new node}
-begin p:=new_glyph_node;
-set_to_character(p); font(p):=f; character(p):=c;
-lang_data(p):=make_lang_data(uc_hyph,cur_lang,left_hyphen_min,right_hyphen_min);
-new_char:=p;
-end;
-
-@ Left and right ghost glyph nodes are the result of \.{\\leftghost}
-and \.{\\rightghost}, respectively. They are going to be removed by
-|new_ligkern|, at the end of which they are no longer needed.
-
-@ Here are a few handy helpers used by the list output routines.
-
-@p
-function glyph_width(@!p:halfword):pointer;
-var w:integer;
-begin
- w := char_width(font(p),character(p)); { |+ x_displace(p);| }
- glyph_width := w;
-end;
-@#
-function glyph_height(@!p:halfword):pointer;
-var w:integer;
-begin
- w := char_height(font(p),character(p)) + y_displace(p);
- if w<0 then w:=0;
- glyph_height := w;
-end;
-@#
-function glyph_depth(@!p:halfword):pointer;
-var w:integer;
-begin
- w := char_depth(font(p),character(p));
- if y_displace(p)>0 then w := w - y_displace(p);
- if w<0 then w:=0;
- glyph_depth := w;
-end;
-
-
-@ A |disc_node|, which occurs only in horizontal lists, specifies a
-``dis\-cretion\-ary'' line break. If such a break occurs at node |p|, the text
-that starts at |pre_break(p)| will precede the break, the text that starts at
-|post_break(p)| will follow the break, and text that appears in
-|no_break(p)| nodes will be ignored. For example, an ordinary
-discretionary hyphen, indicated by `\.{\\-}', yields a |disc_node| with
-|pre_break| pointing to a |char_node| containing a hyphen, |post_break=null|,
-and |no_break=null|.
-
-{TODO: Knuth said: All three of the discretionary texts must be lists
-that consist entirely of character, kern, box and rule nodes.}
-
-If |subtype(p)=automatic_disc|, the |ex_hyphen_penalty| will be charged for this
-break. Otherwise the |hyphen_penalty| will be charged. The texts will
-actually be substituted into the list by the line-breaking algorithm if it
-decides to make the break, and the discretionary node will disappear at
-that time; thus, the output routine sees only discretionaries that were
-not chosen.
-
-@d automatic_disc=2
-@d syllable_disc=3
-@d disc_type==subtype {the kind of discretionary}
-@d pre_break(#)==vinfo(#+2) {text that precedes a discretionary break}
-@d post_break(#)==vlink(#+2) {text that follows a discretionary break}
-@d no_break(#)==vlink(#+3) {text this discretionary break replaces}
-@d pre_break_head(#)==(#+4)
-@d post_break_head(#)==(#+6)
-@d no_break_head(#)==(#+8)
-@d tlink(#)==vinfo(#+1)
-
-@p function new_disc:pointer; {creates an empty |disc_node|}
-var p:pointer; {the new node}
-begin p:=new_node(disc_node,0);
-new_disc:=p;
-end;
-
-@ A |whatsit_node| is a wild card reserved for extensions to \TeX. The
-|subtype| field in its first word says what `\\{whatsit}' it is, and
-implicitly determines the node size (which must be 2 or more) and the
-format of the remaining words. When a |whatsit_node| is encountered
-in a list, special actions are invoked; knowledgeable people who are
-careful not to mess up the rest of \TeX\ are able to make \TeX\ do new
-things by adding code at the end of the program. For example, there
-might be a `\TeX nicolor' extension to specify different colors of ink,
-@^extensions to \TeX@>
-and the whatsit node might contain the desired parameters.
-
-The present implementation of \TeX\ treats the features associated with
-`\.{\\write}' and `\.{\\special}' as if they were extensions, in order to
-illustrate how such routines might be coded. We shall defer further
-discussion of extensions until the end of this program.
-
-@ A |math_node|, which occurs only in horizontal lists, appears before and
-after mathematical formulas. The |subtype| field is |before| before the
-formula and |after| after it. There is a |surround| field, which represents
-the amount of surrounding space inserted by \.{\\mathsurround}.
-
-@d surround(#)==vlink(#+2)
-@d before=0 {|subtype| for math node that introduces a formula}
-@d after=1 {|subtype| for math node that winds up a formula}
-
-@p function new_math(@!w:scaled;@!s:small_number):pointer;
-var p:pointer; {the new node}
-begin p:=new_node(math_node,s);
-surround(p):=w; new_math:=p;
-end;
-
-@ \TeX\ makes use of the fact that |hlist_node|, |vlist_node|,
-|rule_node|, |ins_node|, |mark_node|, |adjust_node|,
-|disc_node|, |whatsit_node|, and |math_node| are at the low end of the
-type codes, by permitting a break at glue in a list if and only if the
-|type| of the previous node is less than |math_node|. Furthermore, a
-node is discarded after a break if its type is |math_node| or~more.
-
-@d precedes_break(#)==(type(#)<math_node)
-@d non_discardable(#)==(type(#)<math_node)
-
-@ A |glue_node| represents glue in a list. However, it is really only
-a pointer to a separate glue specification, since \TeX\ makes use of the
-fact that many essentially identical nodes of glue are usually present.
-If |p| points to a |glue_node|, |glue_ptr(p)| points to
-another packet of words that specify the stretch and shrink components, etc.
-
-Glue nodes also serve to represent leaders; the |subtype| is used to
-distinguish between ordinary glue (which is called |normal|) and the three
-kinds of leaders (which are called |a_leaders|, |c_leaders|, and |x_leaders|).
-The |leader_ptr| field points to a rule node or to a box node containing the
-leaders; it is set to |null| in ordinary glue nodes.
-
-Many kinds of glue are computed from \TeX's ``skip'' parameters, and
-it is helpful to know which parameter has led to a particular glue node.
-Therefore the |subtype| is set to indicate the source of glue, whenever
-it originated as a parameter. We will be defining symbolic names for the
-parameter numbers later (e.g., |line_skip_code=0|, |baseline_skip_code=1|,
-etc.); it suffices for now to say that the |subtype| of parametric glue
-will be the same as the parameter number, plus~one.
-
-In math formulas there are two more possibilities for the |subtype| in a
-glue node: |mu_glue| denotes an \.{\\mskip} (where the units are scaled \.{mu}
-instead of scaled \.{pt}); and |cond_math_glue| denotes the `\.{\\nonscript}'
-feature that cancels the glue node immediately following if it appears
-in a subscript.
-
-@d cond_math_glue=98 {special |subtype| to suppress glue in the next node}
-@d mu_glue=99 {|subtype| for math glue}
-@d a_leaders=100 {|subtype| for aligned leaders}
-@d c_leaders=101 {|subtype| for centered leaders}
-@d x_leaders=102 {|subtype| for expanded leaders}
-@d glue_ptr(#)==vinfo(#+2) {pointer to a glue specification}
-@d leader_ptr(#)==vlink(#+2) {pointer to box or rule node for leaders}
-
-@ A glue specification has a halfword reference count in its first word,
-@^reference counts@>
-representing |null| plus the number of glue nodes that point to it (less one).
-Note that the reference count appears in the same position as
-the |link| field in list nodes; this is the field that is initialized
-to |null| when a node is allocated, and it is also the field that is flagged
-by |empty_flag| in empty nodes.
-
-Glue specifications also contain three |scaled| fields, for the |width|,
-|stretch|, and |shrink| dimensions. Finally, there are two one-byte
-fields called |stretch_order| and |shrink_order|; these contain the
-orders of infinity (|normal|, |sfi|, |fil|, |fill|, or |filll|)
-corresponding to the stretch and shrink values.
-
-@d glue_ref_count(#) == vlink(#+3) {reference count of a glue specification}
-@d stretch(#) == vlink(#+1) {the stretchability of this glob of glue}
-@d shrink(#) == vinfo(#+1) {the shrinkability of this glob of glue}
-@d stretch_order(#) == type(#+3) {order of infinity for stretching}
-@d shrink_order(#) == subtype(#+3) {order of infinity for shrinking}
-@d sfi=1 {first-order infinity}
-@d fil=2 {second-order infinity}
-@d fill=3 {third-order infinity}
-@d filll=4 {fourth-order infinity}
-
-@<Types...@>=
-@!glue_ord=normal..filll; {infinity to the 0, 1, 2, 3, or 4 power}
-
-@ Here is a function that returns a pointer to a copy of a glue spec.
-The reference count in the copy is |null|, because there is assumed
-to be exactly one reference to the new specification.
-
-@p function new_spec(@!p:pointer):pointer; {duplicates a glue specification}
-var q:pointer; {the new spec}
-begin q:=copy_node(p);
-glue_ref_count(q):=null;
-new_spec:=q;
-end;
-
-@ And here's a function that creates a glue node for a given parameter
-identified by its code number; for example,
-|new_param_glue(line_skip_code)| returns a pointer to a glue node for the
-current \.{\\lineskip}.
-
-@p function new_param_glue(@!n:small_number):pointer;
-var p:pointer; {the new node}
-@!q:pointer; {the glue specification}
-begin p:=new_node(glue_node,n+1);
-q:=@<Current |mem| equivalent of glue parameter number |n|@>@t@>;
-glue_ptr(p):=q; incr(glue_ref_count(q));
-new_param_glue:=p;
-end;
-
-@ Glue nodes that are more or less anonymous are created by |new_glue|,
-whose argument points to a glue specification.
-
-@p function new_glue(@!q:pointer):pointer;
-var p:pointer; {the new node}
-begin p:=new_node(glue_node,normal);
-glue_ptr(p):=q; incr(glue_ref_count(q));
-new_glue:=p;
-end;
-
-@ Still another subroutine is needed: This one is sort of a combination
-of |new_param_glue| and |new_glue|. It creates a glue node for one of
-the current glue parameters, but it makes a fresh copy of the glue
-specification, since that specification will probably be subject to change,
-while the parameter will stay put. The global variable |temp_ptr| is
-set to the address of the new spec.
-
-@p function new_skip_param(@!n:small_number):pointer;
-var p:pointer; {the new node}
-begin temp_ptr:=new_spec(@<Current |mem| equivalent of glue parameter...@>);
-p:=new_glue(temp_ptr); glue_ref_count(temp_ptr):=null; subtype(p):=n+1;
-new_skip_param:=p;
-end;
-
-@ A |kern_node| has a |width| field to specify a (normally negative)
-amount of spacing. This spacing correction appears in horizontal lists
-between letters like A and V when the font designer said that it looks
-better to move them closer together or further apart. A kern node can
-also appear in a vertical list, when its `|width|' denotes additional
-spacing in the vertical direction. The |subtype| is either |normal| (for
-kerns inserted from font information or math mode calculations) or |explicit|
-(for kerns inserted from \.{\\kern} and \.{\\/} commands) or |acc_kern|
-(for kerns inserted from non-math accents) or |mu_glue| (for kerns
-inserted from \.{\\mkern} specifications in math formulas).
-
-@d explicit=1 {|subtype| of kern nodes from \.{\\kern} and \.{\\/}}
-@d acc_kern=2 {|subtype| of kern nodes from accents}
-
-@# {memory structure for marginal kerns}
-@d margin_char(#) == vlink(#+3)
-
-@# {|subtype| of marginal kerns}
-@d left_side == 0
-@d right_side == 1
-
-@# {base for lp/rp/ef codes starts from 2:
- 0 for |hyphen_char|,
- 1 for |skew_char|}
-@d lp_code_base == 2
-@d rp_code_base == 3
-@d ef_code_base == 4
-@d tag_code == 5
-
-@d auto_kern == explicit
-@d no_lig_code == 6
-
-@ The |new_kern| function creates a kern node having a given width.
-
-@p function new_kern(@!w:scaled):pointer;
-var p:pointer; {the new node}
-begin p:=new_node(kern_node,normal);
-width(p):=w;
-new_kern:=p;
-end;
-
-@ A |penalty_node| specifies the penalty associated with line or page
-breaking, in its |penalty| field. This field is a fullword integer, but
-the full range of integer values is not used: Any penalty |>=10000| is
-treated as infinity, and no break will be allowed for such high values.
-Similarly, any penalty |<=-10000| is treated as negative infinity, and a
-break will be forced.
-
-@d inf_penalty=inf_bad {``infinite'' penalty value}
-@d eject_penalty=-inf_penalty {``negatively infinite'' penalty value}
-@d penalty(#) == vlink(#+2) {the added cost of breaking a list here}
-
-@ Anyone who has been reading the last few sections of the program will
-be able to guess what comes next.
-
-@p function new_penalty(@!m:integer):pointer;
-var p:pointer; {the new node}
-begin p:=new_node(penalty_node,0); {the |subtype| is not used}
-penalty(p):=m; new_penalty:=p;
-end;
-
-@ You might think that we have introduced enough node types by now. Well,
-almost, but there is one more: An |unset_node| has nearly the same format
-as an |hlist_node| or |vlist_node|; it is used for entries in \.{\\halign}
-or \.{\\valign} that are not yet in their final form, since the box
-dimensions are their ``natural'' sizes before any glue adjustment has been
-made. The |glue_set| word is not present; instead, we have a |glue_stretch|
-field, which contains the total stretch of order |glue_order| that is
-present in the hlist or vlist being boxed.
-Similarly, the |shift_amount| field is replaced by a |glue_shrink| field,
-containing the total shrink of order |glue_sign| that is present.
-The |subtype| field is called |span_count|; an unset box typically
-contains the data for |qo(span_count)+1| columns.
-Unset nodes will be changed to box nodes when alignment is completed.
-
-@d glue_stretch(#)==vmem(#+7).sc {total stretch in an unset node}
-@d glue_shrink==shift_amount {total shrink in an unset node}
-@d span_count==subtype {indicates the number of spanned columns}
-
-@ In fact, there are still more types coming. When we get to math formula
-processing we will see that a |style_node| has |type=14|; and a number
-of larger type codes will also be defined, for use in math mode only.
-
-@ Warning: If any changes are made to these data structure layouts, such as
-changing any of the node sizes or even reordering the words of nodes,
-the |copy_node_list| procedure and the memory initialization code
-below may have to be changed. Such potentially dangerous parts of the
-program are listed in the index under `data structure assumptions'.
-@!@^data structure assumptions@>
-However, other references to the nodes are made symbolically in terms of
-the \.{WEB} macro definitions above, so that format changes will leave
-\TeX's other algorithms intact.
-@^system dependencies@>
-
-@* \[11] Memory layout.
-
-Some areas of |mem| are dedicated to fixed usage, since static
-allocation is more efficient than dynamic allocation when we can get
-away with it. For example, |zero_glue| used for glue that is `\.{0pt
-plus 0pt minus 0pt}'. A few C macro definitions accomplish the static
-allocation of node memory locations by giving symbolic names to fixed
-positions. The list of imported constant identifiers is: |zero_glue|,
-|sfi_glue|, |fil_glue|, |fill_glue|, |ss_glue|, |fil_neg_glue| (all
-glue specs), |page_ins_head| (list of insertion data for current
-page), |contrib_head| (list of insertion data for current page),
-|page_head| (list for current page), |temp_head| and |hold_head|
-(temporary lists), |adjust_head| (head of adjustment list returned by
-|hpack|), |pre_adjust_head| (head of pre-adjustment list returned by
-|hpack|), |align_head| (head of alignment preamble), and
-|end_span| (tail of spanned-width lists).
-
-
-@<Glob...@>=
-garbage:pointer; {head of a junk list, write only}
-temp_token_head:pointer; {head of a temporary list of some kind}
-hold_token_head:pointer; {head of a temporary list of another kind}
-omit_template:pointer; {a constant token list}
-null_list:pointer; {permanently empty list}
-backup_head:pointer; {head of token list built by |scan_keyword|}
-
-@ The following code gets |mem| off to a good start, when \TeX\ is
-initializing itself the slow~way.
-
-@<Local variables for init...@>=
-@!k:integer; {index into |mem|, |eqtb|, etc.}
-
-@ @<Initialize table entries...@>=
-procedure init_link_heads;forward;
-init_node_mem(500);
-avail:=null; fix_mem_end:=0;
-init_list_heads;
-@<Initialize the special list heads and constant nodes@>;
-initialize_active;
-dyn_used:=0; {initialize statistics}
-
-@ @p procedure init_list_heads; {initialize token list heads}
-var p:halfword;
-begin
-p:=get_avail; temp_token_head:=p; info(temp_token_head):=0;
-p:=get_avail; hold_token_head:=p; info(hold_token_head):=0;
-p:=get_avail; omit_template:=p; info(omit_template):=0;
-p:=get_avail; null_list:=p; info(null_list):=0;
-p:=get_avail; backup_head:=p; info(backup_head):=0;
-p:=get_avail; garbage:=p; info(garbage):=0;
-end;
-
-@ @p
-@<Declare procedures that need to be declared forward for \pdfTeX@>
-
-@* \[12] Displaying boxes.
-We can reinforce our knowledge of the data structures just introduced
-by considering two procedures that display a list in symbolic form.
-The first of these, called |short_display|, is used in ``overfull box''
-messages to give the top-level description of a list. The other one,
-called |show_node_list|, prints a detailed description of exactly what
-is in the data structure.
-
-The philosophy of |short_display| is to ignore the fine points about exactly
-what is inside boxes, except that ligatures and discretionary breaks are
-expanded. As a result, |short_display| is a recursive procedure, but the
-recursion is never more than one level deep.
-@^recursion@>
-
-A global variable |font_in_short_display| keeps track of the font code that
-is assumed to be present when |short_display| begins; deviations from this
-font will be printed.
-
-@<Glob...@>=
-@!font_in_short_display:integer; {an internal font number}
-
-@ Boxes, rules, inserts, whatsits, marks, and things in general that are
-sort of ``complicated'' are indicated only by printing `\.{[]}'.
-
-@p
-procedure print_font_identifier(f: internal_font_number);
-var fonttext:str_number;
-begin
- if pdf_font_blink(f) = null_font then
- fonttext := font_id_text(f)
- else
- fonttext := font_id_text(pdf_font_blink(f));
- if fonttext>0 then
- print_esc(fonttext)
- else begin
- print_esc("FONT");
- if pdf_font_blink(f) = null_font then
- print_int(f)
- else
- print_int(pdf_font_blink(f));
- end;
- if pdf_tracing_fonts > 0 then begin
- print(" (");
- print_font_name(f);
- if font_size(f) <> font_dsize(f) then begin
- print("@@");
- print_scaled(font_size(f));
- print("pt");
- end;
- print(")");
- end else
- if pdf_font_expand_ratio(f) <> 0 then begin
- print(" (");
- if pdf_font_expand_ratio(f) > 0 then
- print("+");
- print_int(pdf_font_expand_ratio(f));
- print(")");
- end;
-end;
-
-procedure short_display(@!p:integer); {prints highlights of list |p|}
-begin while p<>null do
- begin if is_char_node(p) then
- begin if lig_ptr(p)<>null then
- short_display(lig_ptr(p))
- else begin
- if font(p)<>font_in_short_display then
- begin if not is_valid_font(font(p)) then
- print_char("*")
-@.*\relax@>
- else print_font_identifier(font(p));
- print_char(" "); font_in_short_display:=font(p);
- end;
- print(qo(character(p)));
- end;
- end
- else @<Print a short indication of the contents of node |p|@>;
- p:=vlink(p);
- end;
-end;
-
-@ @<Print a short indication of the contents of node |p|@>=
-print_short_node_contents(p)
-
-@ The |show_node_list| routine requires some auxiliary subroutines: one to
-print a font-and-character combination, one to print a token list without
-its reference count, and one to print a rule dimension.
-
-@p procedure print_font_and_char(@!p:integer); {prints |char_node| data}
-begin if not is_valid_font(font(p)) then print_char("*")
-@.*\relax@>
- else print_font_identifier(font(p));
- print_char(" "); print(character(p));
-end;
-@#
-procedure print_mark(@!p:integer); {prints token list data in braces}
-begin print_char("{");
-if (p<fix_mem_min)or(p>fix_mem_end) then print_esc("CLOBBERED.")
-else show_token_list(link(p),null,max_print_line-10);
-print_char("}");
-end;
-@#
-procedure print_rule_dimen(@!d:scaled); {prints dimension in rule node}
-begin if is_running(d) then print_char("*") else print_scaled(d);
-@.*\relax@>
-end;
-@#
-procedure print_dir(d:integer);
-begin
-print(dir_names[dir_primary[d]]);
-print(dir_names[dir_secondary[d]]);
-print(dir_names[dir_tertiary[d]]);
-end;
-
-
-@ Then there is a subroutine that prints glue stretch and shrink, possibly
-followed by the name of finite units:
-
-@p procedure print_glue(@!d:scaled;@!order:integer;@!s:str_number);
- {prints a glue component}
-begin print_scaled(d);
-if (order<normal)or(order>filll) then print("foul")
-else if order>normal then
- begin print("fi");
- while order>sfi do
- begin print_char("l"); decr(order);
- end;
- end
-else if s<>0 then print(s);
-end;
-
-@ The next subroutine prints a whole glue specification.
-
-@p procedure print_spec(@!p:integer;@!s:str_number);
- {prints a glue specification}
-begin if p<0 then print_char("*")
-@.*\relax@>
-else begin print_scaled(width(p));
- if s<>0 then print(s);
- if stretch(p)<>0 then
- begin print(" plus "); print_glue(stretch(p),stretch_order(p),s);
- end;
- if shrink(p)<>0 then
- begin print(" minus "); print_glue(shrink(p),shrink_order(p),s);
- end;
- end;
-end;
-
-@ We also need to declare some procedures that appear later in this
-documentation.
-
-@p @<Declare 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.
-
-@ 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}
-
-
-@ The recursive machinery is started by calling |show_box|.
-@^recursion@>
-
-@p procedure show_box(@!p:pointer);
-begin @<Assign the values |depth_threshold:=show_box_depth| and
- |breadth_max:=show_box_breadth|@>;
-if breadth_max<=0 then breadth_max:=5;
-if pool_ptr+depth_threshold>=pool_size then
- depth_threshold:=pool_size-pool_ptr-1;
- {now there's enough room for prefix string}
-show_node_list(p); {the show starts at |p|}
-print_ln;
-end;
-
-@* \[13] Destroying boxes.
-When we are done with a node list, we are obliged to return it to free
-storage, including all of its sublists. The recursive procedure
-|flush_node_list| does this for us.
-
-@ First, however, we shall consider two non-recursive procedures that do
-simpler tasks. The first of these, |delete_token_ref|, is called when
-a pointer to a token list's reference count is being removed. This means
-that the token list should disappear if the reference count was |null|,
-otherwise the count should be decreased by one.
-@^reference counts@>
-
-@d token_ref_count(#) == info(#) {reference count preceding a token list}
-
-@p procedure delete_token_ref(@!p:pointer); {|p| points to the reference count
- of a token list that is losing one reference}
-begin pdfassert(token_ref_count(p)>=0);
-if token_ref_count(p)=0 then flush_list(p)
-else decr(token_ref_count(p));
-end;
-
-@ Similarly, |delete_glue_ref| is called when a pointer to a glue
-specification is being withdrawn.
-@^reference counts@>
-@d fast_delete_glue_ref(#)==@t@>@;@/
- begin if glue_ref_count(#)=null then begin
- flush_node(#);
- end
- else decr(glue_ref_count(#));
- end
-
-@p procedure delete_glue_ref(@!p:pointer); {|p| points to a glue specification}
-begin
- pdfassert(type(p)=glue_spec_node);
- fast_delete_glue_ref(p);
-end;
-
-@ Now we are ready to delete any node list, recursively.
-In practice, the nodes deleted are usually charnodes (about 2/3 of the time),
-and they are glue nodes in about half of the remaining cases.
-@^recursion@>
-
-
-@* \[14] Copying boxes.
-Another recursive operation that acts on boxes is sometimes needed: The
-procedure |copy_node_list| returns a pointer to another node list that has
-the same structure and meaning as the original. Note that since glue
-specifications and token lists have reference counts, we need not make
-copies of them. Reference counts can never get too large to fit in a
-halfword, since each pointer to a node is in a different memory address,
-and the total number of memory addresses fits in a halfword.
-@^recursion@>
-@^reference counts@>
-
-(Well, there actually are also references from outside |mem|; if the
-|save_stack| is made arbitrarily large, it would theoretically be possible
-to break \TeX\ by overflowing a reference count. But who would want to do that?)
-
-@d add_token_ref(#)==incr(token_ref_count(#)) {new reference to a token list}
-@d add_glue_ref(#)==incr(glue_ref_count(#)) {new reference to a glue spec}
-
-@p function tail_of_list (@!p:pointer):pointer;
-var q:pointer;
-begin
- q:=p;
- while vlink(q)<>null do q:=vlink(q);
- tail_of_list:=q;
-end;
-
-@* \[15] The command codes.
-Before we can go any further, we need to define symbolic names for the internal
-code numbers that represent the various commands obeyed by \TeX. These codes
-are somewhat arbitrary, but not completely so. For example, the command
-codes for character types are fixed by the language, since a user says,
-e.g., `\.{\\catcode \`\\\${} = 3}' to make \.{\char'44} a math delimiter,
-and the command code |math_shift| is equal to~3. Some other codes have
-been made adjacent so that |case| statements in the program need not consider
-cases that are widely spaced, or so that |case| statements can be replaced
-by |if| statements.
-
-At any rate, here is the list, for future reference. First come the
-``catcode'' commands, several of which share their numeric codes with
-ordinary commands when the catcode cannot emerge from \TeX's scanning routine.
-
-@d escape=0 {escape delimiter (called \.\\ in {\sl The \TeX book\/})}
-@:TeXbook}{\sl The \TeX book@>
-@d relax=0 {do nothing ( \.{\\relax} )}
-@d left_brace=1 {beginning of a group ( \.\{ )}
-@d right_brace=2 {ending of a group ( \.\} )}
-@d math_shift=3 {mathematics shift character ( \.\$ )}
-@d tab_mark=4 {alignment delimiter ( \.\&, \.{\\span} )}
-@d car_ret=5 {end of line ( |carriage_return|, \.{\\cr}, \.{\\crcr} )}
-@d out_param=5 {output a macro parameter}
-@d mac_param=6 {macro parameter symbol ( \.\# )}
-@d sup_mark=7 {superscript ( \.{\char'136} )}
-@d sub_mark=8 {subscript ( \.{\char'137} )}
-@d ignore=9 {characters to ignore ( \.{\^\^@@} )}
-@d endv=9 {end of \<v_j> list in alignment template}
-@d spacer=10 {characters equivalent to blank space ( \.{\ } )}
-@d letter=11 {characters regarded as letters ( \.{A..Z}, \.{a..z} )}
-@d other_char=12 {none of the special character types}
-@d active_char=13 {characters that invoke macros ( \.{\char`\~} )}
-@d par_end=13 {end of paragraph ( \.{\\par} )}
-@d match=13 {match a macro parameter}
-@d comment=14 {characters that introduce comments ( \.\% )}
-@d end_match=14 {end of parameters to macro}
-@d stop=14 {end of job ( \.{\\end}, \.{\\dump} )}
-@d invalid_char=15 {characters that shouldn't appear ( \.{\^\^?} )}
-@d delim_num=15 {specify delimiter numerically ( \.{\\delimiter} )}
-@d max_char_code=15 {largest catcode for individual characters}
-
-@ Next are the ordinary run-of-the-mill command codes. Codes that are
-|min_internal| or more represent internal quantities that might be
-expanded by `\.{\\the}'.
-
-@d char_num=16 {character specified numerically ( \.{\\char} )}
-@d math_char_num=17 {explicit math code ( \.{\\mathchar} )}
-@d mark=18 {mark definition ( \.{\\mark} )}
-@d xray=19 {peek inside of \TeX\ ( \.{\\show}, \.{\\showbox}, etc.~)}
-@d make_box=20 {make a box ( \.{\\box}, \.{\\copy}, \.{\\hbox}, etc.~)}
-@d hmove=21 {horizontal motion ( \.{\\moveleft}, \.{\\moveright} )}
-@d vmove=22 {vertical motion ( \.{\\raise}, \.{\\lower} )}
-@d un_hbox=23 {unglue a box ( \.{\\unhbox}, \.{\\unhcopy} )}
-@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
- {( or \.{\\pagediscards}, \.{\\splitdiscards} )}
-@d remove_item=25 {nullify last item ( \.{\\unpenalty},
- \.{\\unkern}, \.{\\unskip} )}
-@d hskip=26 {horizontal glue ( \.{\\hskip}, \.{\\hfil}, etc.~)}
-@d vskip=27 {vertical glue ( \.{\\vskip}, \.{\\vfil}, etc.~)}
-@d mskip=28 {math glue ( \.{\\mskip} )}
-@d kern=29 {fixed space ( \.{\\kern})}
-@d mkern=30 {math kern ( \.{\\mkern} )}
-@d leader_ship=31 {use a box ( \.{\\shipout}, \.{\\leaders}, etc.~)}
-@d halign=32 {horizontal table alignment ( \.{\\halign} )}
-@d valign=33 {vertical table alignment ( \.{\\valign} )}
-@d no_align=34 {temporary escape from alignment ( \.{\\noalign} )}
-@d vrule=35 {vertical rule ( \.{\\vrule} )}
-@d hrule=36 {horizontal rule ( \.{\\hrule} )}
-@d insert=37 {vlist inserted in box ( \.{\\insert} )}
-@d vadjust=38 {vlist inserted in enclosing paragraph ( \.{\\vadjust} )}
-@d ignore_spaces=39 {gobble |spacer| tokens ( \.{\\ignorespaces} )}
-@d after_assignment=40 {save till assignment is done ( \.{\\afterassignment} )}
-@d after_group=41 {save till group is done ( \.{\\aftergroup} )}
-@d break_penalty=42 {additional badness ( \.{\\penalty} )}
-@d start_par=43 {begin paragraph ( \.{\\indent}, \.{\\noindent} )}
-@d ital_corr=44 {italic correction ( \.{\\/} )}
-@d accent=45 {attach accent in text ( \.{\\accent} )}
-@d math_accent=46 {attach accent in math ( \.{\\mathaccent} )}
-@d discretionary=47 {discretionary texts ( \.{\\-}, \.{\\discretionary} )}
-@d eq_no=48 {equation number ( \.{\\eqno}, \.{\\leqno} )}
-@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
- {( or \.{\\middle} )}
-@d math_comp=50 {component of formula ( \.{\\mathbin}, etc.~)}
-@d limit_switch=51 {diddle limit conventions ( \.{\\displaylimits}, etc.~)}
-@d above=52 {generalized fraction ( \.{\\above}, \.{\\atop}, etc.~)}
-@d math_style=53 {style specification ( \.{\\displaystyle}, etc.~)}
-@d math_choice=54 {choice specification ( \.{\\mathchoice}, \.{\\Ustack} )}
-@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 super_sub_script=67 {explicit super ( \.{\\Usuperscript} ) or subscript ( \.{\\Usubscript} )}
-@d math_shift_cs=68 {explicit math switch ( \.{\\Ustartmath}, etc.~)}
-@d end_cs_name=69 {end control sequence ( \.{\\endcsname} )}
-@d char_ghost=end_cs_name+1
- {\.{\\ghostleft}, \.{\\ghostright} character for kerning}
-@d assign_local_box=char_ghost+1
- {box for guillemets \.{\\localleftbox} or \.{\\localrightbox}}
-@d min_internal=assign_local_box+1 {the smallest code that can follow \.{\\the}}
-@d char_given=min_internal {character code defined by \.{\\chardef}}
-@d math_given=char_given+1 {math code defined by \.{\\mathchardef}}
-@d omath_given=math_given+1 {math code defined by \.{\\omathchardef}}
-@d xmath_given=omath_given+1 {math code defined by \.{\\Umathchardef}}
-@d last_item=xmath_given+1 {most recent item ( \.{\\lastpenalty},
- \.{\\lastkern}, \.{\\lastskip} )}
-@d max_non_prefixed_command=last_item
- {largest command code that can't be \.{\\global}}
-
-@ The next codes are special; they all relate to mode-independent
-assignment of values to \TeX's internal registers or tables.
-Codes that are |max_internal| or less represent internal quantities
-that might be expanded by `\.{\\the}'.
-
-There is no matching primitive to go with |assign_attr|, but even if
-there was no \.{\\attributedef}, a reserved number would still be
-needed because there is an implied correspondence between the
-|assign_xxx| commands and |xxx_val| expression values. That would
-break down otherwise.
-
-@d toks_register=max_non_prefixed_command+1
- {token list register ( \.{\\toks} )}
-@d assign_toks=toks_register+1
- {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
-@d assign_int=assign_toks+1
- {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
-@d assign_attr=assign_int+1 { user-defined attributes }
-@d assign_dimen=assign_attr+1
- {user-defined length ( \.{\\hsize}, etc.~)}
-@d assign_glue=assign_dimen+1
- {user-defined glue ( \.{\\baselineskip}, etc.~)}
-@d assign_mu_glue=assign_glue+1
- {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
-@d assign_font_dimen=assign_mu_glue+1
- {user-defined font dimension ( \.{\\fontdimen} )}
-@d assign_font_int=assign_font_dimen+1
- {user-defined font integer ( \.{\\hyphenchar}, \.{\\skewchar} )}
-@d set_aux=assign_font_int+1
- {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
-@d set_prev_graf=set_aux+1
- {specify state info ( \.{\\prevgraf} )}
-@d set_page_dimen=set_prev_graf+1
- {specify state info ( \.{\\pagegoal}, etc.~)}
-@d set_page_int=set_page_dimen+1
- {specify state info ( \.{\\deadcycles},
- \.{\\insertpenalties} )}
-@d set_box_dimen=set_page_int+1
- {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
-@d set_tex_shape=set_box_dimen+1
- {specify fancy paragraph shape ( \.{\\parshape} )}
-@d set_etex_shape=set_tex_shape+1
- {specify etex specials ( \.{\\interlinepenalties}, etc.~)}
-@d def_char_code=set_etex_shape+1
- {define a character code ( \.{\\catcode}, etc.~)}
-@d def_del_code=def_char_code+1
- {define a delimiter code ( \.{\\delcode})}
-@d extdef_math_code=def_del_code+1
- {define an extended character code ( \.{\\omathcode}, etc.~)}
-@d extdef_del_code=extdef_math_code+1
- {define an extended delimiter code ( \.{\\odelcode}, etc.~)}
-@d def_family=extdef_del_code+1
- {declare math fonts ( \.{\\textfont}, etc.~)}
-@d set_math_param=def_family+1
- {declare math parameters ( \.{\\Umathquad}, etc.~)}
-@d set_font=set_math_param+1
- {set current font ( font identifiers )}
-@d def_font=set_font+1
- {define a font file ( \.{\\font} )}
-@d register=def_font+1
- {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
-@d assign_box_dir=register+1 {(\.{\\boxdir})}
-@d assign_dir=register+2 {(\.{\\pagedir}, \.{\\bodydir}, \.{\\pardir}, \.{\\textdir}), \.{\\mathdir}}
-@d max_internal=assign_dir
- {the largest code that can follow \.{\\the}}
-@d advance=max_internal+1
- {advance a register or parameter ( \.{\\advance} )}
-@d multiply=advance+1
- {multiply a register or parameter ( \.{\\multiply} )}
-@d divide=multiply+1
- {divide a register or parameter ( \.{\\divide} )}
-@d prefix=divide+1
- {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
-@d let=prefix+1
- {assign a command code ( \.{\\let}, \.{\\futurelet} )}
-@d shorthand_def=let+1
- {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
-@d read_to_cs=shorthand_def+1
- {read into a control sequence ( \.{\\read} )}
-@d def=read_to_cs+1
- {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
-@d set_box=def+1
- {set a box ( \.{\\setbox} )}
-@d hyph_data=set_box+1
- {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
-@d set_interaction=hyph_data+1
- {define level of interaction ( \.{\\batchmode}, etc.~)}
-@d letterspace_font=set_interaction+1
- {letterspace a font ( \.{\\letterspacefont} )}
-@d pdf_copy_font=letterspace_font+1
- {create a new font instance ( \.{\\pdfcopyfont} )}
-@d set_ocp=pdf_copy_font+1
- {Place a translation process in the stream}
-@d def_ocp=set_ocp+1
- {Define and load a translation process}
-@d set_ocp_list=def_ocp+1
- {Place a list of OCPs in the stream}
-@d def_ocp_list=set_ocp_list+1
- {Define a list of OCPs}
-@d clear_ocp_lists=def_ocp_list+1
- {Remove all active OCP lists}
-@d push_ocp_list=clear_ocp_lists+1
- {Add to the sequence of active OCP lists}
-@d pop_ocp_list=push_ocp_list+1
- {Remove from the sequence of active OCP lists}
-@d ocp_list_op=pop_ocp_list+1
- {Operations for building a list of OCPs}
-@d ocp_trace_level=ocp_list_op+1
- {Tracing of active OCPs, either 0 or 1}
-@d max_command=ocp_trace_level
- {the largest command code seen at |big_switch|}
-
-@ The remaining command codes are extra special, since they cannot get through
-\TeX's scanner to the main control routine. They have been given values higher
-than |max_command| so that their special nature is easily discernible.
-The ``expandable'' commands come first.
-
-@d undefined_cs=max_command+1 {initial state of most |eq_type| fields}
-@d expand_after=max_command+2 {special expansion ( \.{\\expandafter} )}
-@d no_expand=max_command+3 {special nonexpansion ( \.{\\noexpand} )}
-@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
- {( or \.{\\scantokens} or \.{\\scantextokens} )}
-@d if_test=max_command+5 {conditional text ( \.{\\if}, \.{\\ifcase}, etc.~)}
-@d fi_or_else=max_command+6 {delimiters for conditionals ( \.{\\else}, etc.~)}
-@d cs_name=max_command+7 {make a control sequence from tokens ( \.{\\csname} )}
-@d convert=max_command+8 {convert to text ( \.{\\number}, \.{\\string}, etc.~)}
-@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
- {( or \.{\\unexpanded}, \.{\\detokenize} )}
-@d top_bot_mark=max_command+10 {inserted mark ( \.{\\topmark}, etc.~)}
-@d call=max_command+11 {non-long, non-outer control sequence}
-@d long_call=max_command+12 {long, non-outer control sequence}
-@d outer_call=max_command+13 {non-long, outer control sequence}
-@d long_outer_call=max_command+14 {long, outer control sequence}
-@d end_template=max_command+15 {end of an alignment template}
-@d dont_expand=max_command+16 {the following token was marked by \.{\\noexpand}}
-@d glue_ref=max_command+17 {the equivalent points to a glue specification}
-@d shape_ref=max_command+18 {the equivalent points to a parshape specification}
-@d box_ref=max_command+19 {the equivalent points to a box node, or is |null|}
-@d data=max_command+20 {the equivalent is simply a halfword number}
-
-@* \[16] The semantic nest.
-\TeX\ is typically in the midst of building many lists at once. For example,
-when a math formula is being processed, \TeX\ is in math mode and
-working on an mlist; this formula has temporarily interrupted \TeX\ from
-being in horizontal mode and building the hlist of a paragraph; and this
-paragraph has temporarily interrupted \TeX\ from being in vertical mode
-and building the vlist for the next page of a document. Similarly, when a
-\.{\\vbox} occurs inside of an \.{\\hbox}, \TeX\ is temporarily
-interrupted from working in restricted horizontal mode, and it enters
-internal vertical mode. The ``semantic nest'' is a stack that
-keeps track of what lists and modes are currently suspended.
-
-At each level of processing we are in one of six modes:
-
-\yskip\hang|vmode| stands for vertical mode (the page builder);
-
-\hang|hmode| stands for horizontal mode (the paragraph builder);
-
-\hang|mmode| stands for displayed formula mode;
-
-\hang|-vmode| stands for internal vertical mode (e.g., in a \.{\\vbox});
-
-\hang|-hmode| stands for restricted horizontal mode (e.g., in an \.{\\hbox});
-
-\hang|-mmode| stands for math formula mode (not displayed).
-
-\yskip\noindent The mode is temporarily set to zero while processing \.{\\write}
-texts in the |ship_out| routine.
-
-Numeric values are assigned to |vmode|, |hmode|, and |mmode| so that
-\TeX's ``big semantic switch'' can select the appropriate thing to
-do by computing the value |abs(mode)+cur_cmd|, where |mode| is the current
-mode and |cur_cmd| is the current command code.
-
-@d vmode=1 {vertical mode}
-@d hmode=vmode+max_command+1 {horizontal mode}
-@d mmode=hmode+max_command+1 {math mode}
-
-@p procedure print_mode(@!m:integer); {prints the mode represented by |m|}
-begin if m>0 then
- case m div (max_command+1) of
- 0:print("vertical");
- 1:print("horizontal");
- 2:print("display math");
- end
-else if m=0 then print("no")
-else case (-m) div (max_command+1) of
- 0:print("internal vertical");
- 1:print("restricted horizontal");
- 2:print("math");
- end;
-print(" mode");
-end;
-function get_mode_id:integer; {returns the mode represented by |m|}
-var m:integer ;
-begin
- m := mode;
- if m>0 then
- case m div (max_command+1) of
- 0:get_mode_id := "v";
- 1:get_mode_id := "h";
- 2:get_mode_id := "m";
- othercases get_mode_id := "";
- end
-else if m=0 then get_mode_id := "n"
-else case (-m) div (max_command+1) of
- 0:get_mode_id := "V";
- 1:get_mode_id := "H";
- 2:get_mode_id := "M";
- othercases get_mode_id := "";
- end;
-end;
-
-@ The state of affairs at any semantic level can be represented by
-five values:
-
-\yskip\hang|mode| is the number representing the semantic mode, as
-just explained.
-
-\yskip\hang|head| is a |pointer| to a list head for the list being built;
-|link(head)| therefore points to the first element of the list, or
-to |null| if the list is empty.
-
-\yskip\hang|tail| is a |pointer| to the final node of the list being
-built; thus, |tail=head| if and only if the list is empty.
-
-\yskip\hang|prev_graf| is the number of lines of the current paragraph that
-have already been put into the present vertical list.
-
-\yskip\hang|aux| is an auxiliary |memory_word| that gives further information
-that is needed to characterize the situation.
-
-\yskip\noindent
-In vertical mode, |aux| is also known as |prev_depth|; it is the scaled
-value representing the depth of the previous box, for use in baseline
-calculations, or it is |<=-1000|pt if the next box on the vertical list is to
-be exempt from baseline calculations. In horizontal mode, |aux| is also
-known as |space_factor|; it holds the current space factor used in
-spacing calculations. In math mode, |aux| is also known as |incompleat_noad|;
-if not |null|, it points to a record that represents the numerator of a
-generalized fraction for which the denominator is currently being formed
-in the current list.
-
-There is also a sixth quantity, |mode_line|, which correlates
-the semantic nest with the user's input; |mode_line| contains the source
-line number at which the current level of nesting was entered. The negative
-of this line number is the |mode_line| at the level of the
-user's output routine.
-
-A seventh quantity, |eTeX_aux|, is used by the extended features \eTeX.
-In math mode it is known as |delim_ptr| and points to the most
-recent |fence_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.
-
-The math field is used by various bits and pieces in |math.c|
-
-@d ignore_depth==-65536000 {magic dimension value to mean `ignore me'}
-
-@<Types...@>=
-@!list_state_record=record@!mode_field:-mmode..mmode;@+
- @!head_field,@!tail_field: pointer;
- @!eTeX_aux_field: pointer;
- @!pg_field,@!ml_field: integer;@+
- @!aux_field: memory_word;
- @!dirs_field: halfword;
- @!math_field: integer;
- @!math_style_field: integer;
- 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 prev_graf==cur_list.pg_field {number of paragraph lines accumulated}
-@d aux==cur_list.aux_field {auxiliary data about the current list}
-@d prev_depth==aux.sc {the name of |aux| in vertical mode}
-@d space_factor==aux.hh.lh {part of |aux| in horizontal mode}
-@d incompleat_noad==aux.int {the name of |aux| in math mode}
-@d mode_line==cur_list.ml_field {source file line number at beginning of list}
-@d dir_save==cur_list.dirs_field {dir stack when a paragraph is interrupted}
-
-@<Glob...@>=
-@!nest:array[0..nest_size] of list_state_record;
-@!nest_ptr:0..nest_size; {first unused location of |nest|}
-@!max_nest_stack:0..nest_size; {maximum of |nest_ptr| when pushing}
-@!cur_list:list_state_record; {the ``top'' semantic state}
-@!shown_mode:-mmode..mmode; {most recent mode shown by \.{\\tracingcommands}}
-@!save_tail: pointer; {save |tail| so we can examine whether we have an auto
- kern before a glue}
-
-@ Here is a common way to make the current list grow:
-
-@p
-procedure tail_append(p:pointer);
-begin
-vlink(tail):=p; tail:=vlink(tail);
-end;
-@#
-procedure new_tail_append(p:pointer);
-begin
-couple_nodes(tail,p); tail:=vlink(tail);
-end;
-@#
-function pop_tail:pointer;
-label exit;
-var n,r:pointer;
-begin
- if tail<>head then begin
- r:=tail;
- if vlink(alink(tail))=tail then
- n:=alink(tail)
- else begin
- n:=head;
- while vlink(n)<>tail do n:=vlink(n);
- end;
- flush_node(tail);
- tail:=n;
- vlink(n):=null;
- pop_tail:=r;
- end
- else
- pop_tail:=null;
-exit:end;
-
-
-@ We will see later that the vertical list at the bottom semantic level is split
-into two parts; the ``current page'' runs from |page_head| to |page_tail|,
-and the ``contribution list'' runs from |contrib_head| to |tail| of
-semantic level zero. The idea is that contributions are first formed in
-vertical mode, then ``contributed'' to the current page (during which time
-the page-breaking decisions are made). For now, we don't need to know
-any more details about the page-building process.
-
-@<Set init...@>=
-nest_ptr:=0; max_nest_stack:=0;
-mode:=vmode; head:=contrib_head; tail:=contrib_head;
-eTeX_aux:=null;
-prev_depth:=ignore_depth; mode_line:=0;
-prev_graf:=0; shown_mode:=0;
-dir_save:=null; init_math_fields;
-@<Start a new current page@>;
-
-@ @p @<LOCAL: Declare |make_local_par_node|@>;
-
-@ @p @<DIR: Declare |new_dir|@>;
-
-@ When \TeX's work on one level is interrupted, the state is saved by
-calling |push_nest|. This routine changes |head| and |tail| so that
-a new (empty) list is begun; it does not change |mode| or |aux|.
-
-@p procedure push_nest; {enter a new semantic level, save the old}
-begin if nest_ptr>max_nest_stack then
- begin max_nest_stack:=nest_ptr;
- if nest_ptr=nest_size then overflow("semantic nest size",nest_size);
-@:TeX capacity exceeded semantic nest size}{\quad semantic nest size@>
- end;
-nest[nest_ptr]:=cur_list; {stack the record}
-incr(nest_ptr); head:=new_node(temp_node,0); tail:=head; prev_graf:=0; mode_line:=line;
-dir_save:=null; init_math_fields;
-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
-flush_node(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
-end;
-
-@ Here is a procedure that displays what \TeX\ is working on, at all levels.
-
-@p procedure@?print_totals; forward;@t\2@>
-procedure show_activities;
-var p:0..nest_size; {index into |nest|}
-@!m:-mmode..mmode; {mode}
-@!a:memory_word; {auxiliary}
-@!q,@!r:pointer; {for showing the current page}
-@!t:integer; {ditto}
-begin nest[nest_ptr]:=cur_list; {put the top level into the array}
-print_nl(""); print_ln;
-for p:=nest_ptr downto 0 do
- begin m:=nest[p].mode_field; a:=nest[p].aux_field;
- print_nl("### "); print_mode(m);
- print(" entered at line "); print_int(abs(nest[p].ml_field));
- if m=hmode then if nest[p].pg_field <> @'40600000 then
- begin print(" (language"); print_int(nest[p].pg_field mod @'200000);
- print(":hyphenmin"); print_int(nest[p].pg_field div @'20000000);
- print_char(","); print_int((nest[p].pg_field div @'200000) mod @'100);
- print_char(")");
- end;
- if nest[p].ml_field<0 then print(" (\output routine)");
- if p=0 then
- begin @<Show the status of the current page@>;
- if vlink(contrib_head)<>null then
- print_nl("### recent contributions:");
- end;
- show_box(vlink(nest[p].head_field));
- @<Show the auxiliary field, |a|@>;
- end;
-end;
-
-@ @<Show the auxiliary...@>=
-case abs(m) div (max_command+1) of
-0: begin print_nl("prevdepth ");
- if a.sc<=pdf_ignored_dimen then print("ignored")
- else print_scaled(a.sc);
- if nest[p].pg_field<>0 then
- begin print(", prevgraf ");
- print_int(nest[p].pg_field); print(" line");
- if nest[p].pg_field<>1 then print_char("s");
- end;
- end;
-1: begin print_nl("spacefactor "); print_int(a.hh.lh);
- if m>0 then@+ if a.hh.rh>0 then
- begin print(", current language "); print_int(a.hh.rh);@+
- end;
- end;
-2: if a.int<>null then
- begin print("this will be denominator of:"); show_box(a.int);@+
- end;
-end {there are no other cases}
-
-@* \[17] The table of equivalents.
-Now that we have studied the data structures for \TeX's semantic routines,
-we ought to consider the data structures used by its syntactic routines. In
-other words, our next concern will be
-the tables that \TeX\ looks at when it is scanning
-what the user has written.
-
-The biggest and most important such table is called |eqtb|. It holds the
-current ``equivalents'' of things; i.e., it explains what things mean
-or what their current values are, for all quantities that are subject to
-the nesting structure provided by \TeX's grouping mechanism. There are six
-parts to |eqtb|:
-
-\yskip\hangg 1) |eqtb[null_cs]| holds the current equivalent of the
-zero-length control sequence.
-
-\yskip\hangg 2) |eqtb[hash_base..(glue_base-1)]| holds the current
-equivalents of single- and 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 a single entry for the `null csname' of
-length zero. In luatex, the active characters and and single-letter
-control sequence names are part of the next region.
-
-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 null_cs=1 {equivalent of \.{\\csname\\endcsname}}
-@d hash_base=null_cs+1 {beginning of region 2, for the hash table}
-@d frozen_control_sequence=hash_base+hash_size {for error recovery}
-@d frozen_protection=frozen_control_sequence {inaccessible but definable}
-@d frozen_cr=frozen_control_sequence+1 {permanent `\.{\\cr}'}
-@d frozen_end_group=frozen_control_sequence+2 {permanent `\.{\\endgroup}'}
-@d frozen_right=frozen_control_sequence+3 {permanent `\.{\\right}'}
-@d frozen_fi=frozen_control_sequence+4 {permanent `\.{\\fi}'}
-@d frozen_end_template=frozen_control_sequence+5 {permanent `\.{\\endtemplate}'}
-@d frozen_endv=frozen_control_sequence+6 {second permanent `\.{\\endtemplate}'}
-@d frozen_relax=frozen_control_sequence+7 {permanent `\.{\\relax}'}
-@d end_write=frozen_control_sequence+8 {permanent `\.{\\endwrite}'}
-@d frozen_dont_expand=frozen_control_sequence+9
- {permanent `\.{\\notexpanded:}'}
-@d frozen_primitive=frozen_control_sequence+11
- {permanent `\.{\\pdfprimitive}'}
-@d frozen_special=frozen_control_sequence+12
- {permanent `\.{\\special}'}
-@d frozen_null_font=frozen_control_sequence+13
- {permanent `\.{\\nullfont}'}
-@d font_id_base=frozen_null_font-font_base
- {begins table of |number_fonts| permanent font identifiers}
-@d frozen_null_ocp=frozen_null_font+number_fonts
- {permanent `\.{\\nullocp}'}
-@d ocp_id_base=frozen_null_ocp-ocp_base
- {begins table of |number_ocps| permanent ocp identifiers}
-@d frozen_null_ocp_list=frozen_null_ocp+number_ocps
- {permanent `\.{\\nullocplist}'}
-@d ocp_list_id_base=frozen_null_ocp_list-ocp_list_base
- {begins table of |number_ocp_lists| permanent ocp list identifiers}
-@d undefined_control_sequence=frozen_null_ocp_list+number_ocp_lists
-@d glue_base=undefined_control_sequence+1 {beginning of region 3}
-
-@<Initialize table entries...@>=
-eq_type(undefined_control_sequence):=undefined_cs;
-equiv(undefined_control_sequence):=null;
-eq_level(undefined_control_sequence):=level_zero;
-for k:=null_cs to undefined_control_sequence-1 do
- eqtb[k]:=eqtb[undefined_control_sequence];
-
-@ Create a C version of |undefined_control_sequence|.
-
-@<Global...@>=
-@!static_undefined_control_sequence:integer;
-
-@ @<Set init...@>=
-static_undefined_control_sequence:=undefined_control_sequence;
-
-@ Here is a routine that displays the current meaning of an |eqtb| entry
-in region 1 or~2. (Similar routines for the other regions will appear
-below.)
-
-@<Show equivalent |n|, in region 1 or 2@>=
-begin sprint_cs(n); print_char("="); print_cmd_chr(eq_type(n),equiv(n));
-if eq_type(n)>=call then
- begin print_char(":"); show_token_list(link(equiv(n)),null,32);
- end;
-end
-
-@ Region 3 of |eqtb| contains the |number_regs| \.{\\skip} registers, as well as the
-glue parameters defined here. It is important that the ``muskip''
-parameters have larger numbers than the others.
-
-@d line_skip_code=0 {interline glue if |baseline_skip| is infeasible}
-@d baseline_skip_code=1 {desired glue between baselines}
-@d par_skip_code=2 {extra glue just above a paragraph}
-@d above_display_skip_code=3 {extra glue just above displayed math}
-@d below_display_skip_code=4 {extra glue just below displayed math}
-@d above_display_short_skip_code=5
- {glue above displayed math following short lines}
-@d below_display_short_skip_code=6
- {glue below displayed math following short lines}
-@d left_skip_code=7 {glue at left of justified lines}
-@d right_skip_code=8 {glue at right of justified lines}
-@d top_skip_code=9 {glue at top of main pages}
-@d split_top_skip_code=10 {glue at top of split pages}
-@d tab_skip_code=11 {glue between aligned entries}
-@d space_skip_code=12 {glue between words (if not |zero_glue|)}
-@d xspace_skip_code=13 {glue after sentences (if not |zero_glue|)}
-@d par_fill_skip_code=14 {glue on last line of paragraph}
-@d thin_mu_skip_code=15 {thin space in math formula}
-@d med_mu_skip_code=16 {medium space in math formula}
-@d thick_mu_skip_code=17 {thick space in math formula}
-@d glue_pars=18 {total number of glue parameters}
-@d skip_base=glue_base+glue_pars {table of |number_regs| ``skip'' registers}
-@d mu_skip_base=skip_base+number_regs {table of |number_regs| ``muskip'' registers}
-@d local_base=mu_skip_base+number_regs {beginning of region 4}
-@#
-@d skip(#)==equiv(skip_base+#) {|mem| location of glue specification}
-@d mu_skip(#)==equiv(mu_skip_base+#) {|mem| location of math glue spec}
-@d glue_par(#)==equiv(glue_base+#) {|mem| location of glue specification}
-@d line_skip==glue_par(line_skip_code)
-@d baseline_skip==glue_par(baseline_skip_code)
-@d par_skip==glue_par(par_skip_code)
-@d above_display_skip==glue_par(above_display_skip_code)
-@d below_display_skip==glue_par(below_display_skip_code)
-@d above_display_short_skip==glue_par(above_display_short_skip_code)
-@d below_display_short_skip==glue_par(below_display_short_skip_code)
-@d left_skip==glue_par(left_skip_code)
-@d right_skip==glue_par(right_skip_code)
-@d top_skip==glue_par(top_skip_code)
-@d split_top_skip==glue_par(split_top_skip_code)
-@d tab_skip==glue_par(tab_skip_code)
-@d space_skip==glue_par(space_skip_code)
-@d xspace_skip==glue_par(xspace_skip_code)
-@d par_fill_skip==glue_par(par_fill_skip_code)
-@d thin_mu_skip==glue_par(thin_mu_skip_code)
-@d med_mu_skip==glue_par(med_mu_skip_code)
-@d thick_mu_skip==glue_par(thick_mu_skip_code)
-
-@<Current |mem| equivalent of glue parameter number |n|@>=glue_par(n)
-
-@ @<Set init...@>=
-static_local_base:=local_base;
-static_glue_base:=glue_base;
-
-@ Sometimes we need to convert \TeX's internal code numbers into symbolic
-form. The |print_skip_param| routine gives the symbolic name of a glue
-parameter.
-
-@<Declare the procedure called |print_skip_param|@>=
-procedure print_skip_param(@!n:integer);
-begin case n of
-line_skip_code: print_esc("lineskip");
-baseline_skip_code: print_esc("baselineskip");
-par_skip_code: print_esc("parskip");
-above_display_skip_code: print_esc("abovedisplayskip");
-below_display_skip_code: print_esc("belowdisplayskip");
-above_display_short_skip_code: print_esc("abovedisplayshortskip");
-below_display_short_skip_code: print_esc("belowdisplayshortskip");
-left_skip_code: print_esc("leftskip");
-right_skip_code: print_esc("rightskip");
-top_skip_code: print_esc("topskip");
-split_top_skip_code: print_esc("splittopskip");
-tab_skip_code: print_esc("tabskip");
-space_skip_code: print_esc("spaceskip");
-xspace_skip_code: print_esc("xspaceskip");
-par_fill_skip_code: print_esc("parfillskip");
-thin_mu_skip_code: print_esc("thinmuskip");
-med_mu_skip_code: print_esc("medmuskip");
-thick_mu_skip_code: print_esc("thickmuskip");
-othercases print("[unknown glue parameter!]")
-endcases;
-end;
-
-@ The symbolic names for glue parameters are put into \TeX's hash table
-by using the routine called |primitive|, defined below. Let us enter them
-now, so that we don't have to list all those parameter names anywhere else.
-
-@<Put each of \TeX's primitives into the hash table@>=
-primitive_tex("lineskip",assign_glue,glue_base+line_skip_code,glue_base);@/
-@!@:line_skip_}{\.{\\lineskip} primitive@>
-primitive_tex("baselineskip",assign_glue,glue_base+baseline_skip_code,glue_base);@/
-@!@:baseline_skip_}{\.{\\baselineskip} primitive@>
-primitive_tex("parskip",assign_glue,glue_base+par_skip_code,glue_base);@/
-@!@:par_skip_}{\.{\\parskip} primitive@>
-primitive_tex("abovedisplayskip",assign_glue,glue_base+above_display_skip_code,glue_base);@/
-@!@:above_display_skip_}{\.{\\abovedisplayskip} primitive@>
-primitive_tex("belowdisplayskip",assign_glue,glue_base+below_display_skip_code,glue_base);@/
-@!@:below_display_skip_}{\.{\\belowdisplayskip} primitive@>
-primitive_tex("abovedisplayshortskip",assign_glue,glue_base+above_display_short_skip_code,glue_base);@/
-@!@:above_display_short_skip_}{\.{\\abovedisplayshortskip} primitive@>
-primitive_tex("belowdisplayshortskip",assign_glue,glue_base+below_display_short_skip_code,glue_base);@/
-@!@:below_display_short_skip_}{\.{\\belowdisplayshortskip} primitive@>
-primitive_tex("leftskip",assign_glue,glue_base+left_skip_code,glue_base);@/
-@!@:left_skip_}{\.{\\leftskip} primitive@>
-primitive_tex("rightskip",assign_glue,glue_base+right_skip_code,glue_base);@/
-@!@:right_skip_}{\.{\\rightskip} primitive@>
-primitive_tex("topskip",assign_glue,glue_base+top_skip_code,glue_base);@/
-@!@:top_skip_}{\.{\\topskip} primitive@>
-primitive_tex("splittopskip",assign_glue,glue_base+split_top_skip_code,glue_base);@/
-@!@:split_top_skip_}{\.{\\splittopskip} primitive@>
-primitive_tex("tabskip",assign_glue,glue_base+tab_skip_code,glue_base);@/
-@!@:tab_skip_}{\.{\\tabskip} primitive@>
-primitive_tex("spaceskip",assign_glue,glue_base+space_skip_code,glue_base);@/
-@!@:space_skip_}{\.{\\spaceskip} primitive@>
-primitive_tex("xspaceskip",assign_glue,glue_base+xspace_skip_code,glue_base);@/
-@!@:xspace_skip_}{\.{\\xspaceskip} primitive@>
-primitive_tex("parfillskip",assign_glue,glue_base+par_fill_skip_code,glue_base);@/
-@!@:par_fill_skip_}{\.{\\parfillskip} primitive@>
-primitive_tex("thinmuskip",assign_mu_glue,glue_base+thin_mu_skip_code,glue_base+thin_mu_skip_code);@/
-@!@:thin_mu_skip_}{\.{\\thinmuskip} primitive@>
-primitive_tex("medmuskip",assign_mu_glue,glue_base+med_mu_skip_code,glue_base+thin_mu_skip_code);@/
-@!@:med_mu_skip_}{\.{\\medmuskip} primitive@>
-primitive_tex("thickmuskip",assign_mu_glue,glue_base+thick_mu_skip_code,glue_base+thin_mu_skip_code);@/
-@!@:thick_mu_skip_}{\.{\\thickmuskip} primitive@>
-
-@ 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@>=
-begin
-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;
-end
-
-@ Region 4 of |eqtb| contains the local quantities defined here. The
-bulk of this region is taken up by five tables that are indexed by eight-bit
-characters; these tables are important to both the syntactic and semantic
-portions of \TeX. There are also a bunch of special things like font and
-token parameters, as well as the tables of \.{\\toks} and \.{\\box}
-registers.
-
-@d par_shape_loc=local_base {specifies paragraph shape}
-@d output_routine_loc=local_base+1 {points to token list for \.{\\output}}
-@d every_par_loc=local_base+2 {points to token list for \.{\\everypar}}
-@d every_math_loc=local_base+3 {points to token list for \.{\\everymath}}
-@d every_display_loc=local_base+4 {points to token list for \.{\\everydisplay}}
-@d every_hbox_loc=local_base+5 {points to token list for \.{\\everyhbox}}
-@d every_vbox_loc=local_base+6 {points to token list for \.{\\everyvbox}}
-@d every_job_loc=local_base+7 {points to token list for \.{\\everyjob}}
-@d every_cr_loc=local_base+8 {points to token list for \.{\\everycr}}
-@d err_help_loc=local_base+9 {points to token list for \.{\\errhelp}}
-@d tex_toks=local_base+10 {end of \TeX's token list parameters}
-@#
-@d pdftex_first_loc = tex_toks {base for \pdfTeX's token list parameters}
-@d pdf_pages_attr_loc = pdftex_first_loc + 0 {points to token list for \.{\\pdfpagesattr}}
-@d pdf_page_attr_loc = pdftex_first_loc + 1 {points to token list for \.{\\pdfpageattr}}
-@d pdf_page_resources_loc = pdftex_first_loc + 2 {points to token list for \.{\\pdfpageresources}}
-@d pdf_pk_mode_loc = pdftex_first_loc + 3 {points to token list for \.{\\pdfpkmode}}
-@d pdf_toks=pdftex_first_loc+4 {end of \pdfTeX's token list parameters}
-@#
-@d etex_toks_base=pdf_toks {base for \eTeX's token list parameters}
-@d every_eof_loc=etex_toks_base {points to token list for \.{\\everyeof}}
-@d etex_toks=etex_toks_base+1 {end of \eTeX's token list parameters}
-@#
-@d ocp_trace_level_base=etex_toks
-@d ocp_active_number_base=ocp_trace_level_base+1
-@d ocp_active_min_ptr_base = ocp_active_number_base+1
-@d ocp_active_max_ptr_base = ocp_active_min_ptr_base+1
-@d ocp_active_base = ocp_active_max_ptr_base+1
-@d toks_base = ocp_active_base+max_active_ocp_lists
- {table of |number_regs| token list registers}
-@#
-@d etex_pen_base=toks_base+number_regs {start of table of \eTeX's penalties}
-@d inter_line_penalties_loc=etex_pen_base {additional penalties between lines}
-@d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines}
-@d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines}
-@d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display}
-@d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties}
-@#
-@d local_left_box_base=etex_pens
-@d local_right_box_base=local_left_box_base+1
-@d box_base=local_right_box_base+1 {table of |number_regs| box registers}
-@d cur_font_loc=box_base+number_regs {internal font number outside math mode}
-@d math_param_base=cur_font_loc+1 {current math parameter data index }
-@d cat_code_base=math_param_base+1 {current category code data index }
-@d lc_code_base=cat_code_base+1 {table of |number_chars| lowercase mappings}
-@d uc_code_base=lc_code_base+1 {table of |number_chars| uppercase mappings}
-@d sf_code_base=uc_code_base+1 {table of |number_chars| spacefactor mappings}
-@d math_code_base=sf_code_base+1 {table of |number_chars| math mode mappings}
-@d int_base=math_code_base+1 {beginning of region 5}
-@#
-@d par_shape_ptr==equiv(par_shape_loc)
-@d output_routine==equiv(output_routine_loc)
-@d every_par==equiv(every_par_loc)
-@d every_math==equiv(every_math_loc)
-@d every_display==equiv(every_display_loc)
-@d every_hbox==equiv(every_hbox_loc)
-@d every_vbox==equiv(every_vbox_loc)
-@d every_job==equiv(every_job_loc)
-@d every_cr==equiv(every_cr_loc)
-@d err_help==equiv(err_help_loc)
-@d pdf_pages_attr==equiv(pdf_pages_attr_loc)
-@d pdf_page_attr==equiv(pdf_page_attr_loc)
-@d pdf_page_resources==equiv(pdf_page_resources_loc)
-@d pdf_pk_mode==equiv(pdf_pk_mode_loc)
-@d toks(#)==equiv(toks_base+#)
-@d local_left_box==equiv(local_left_box_base)
-@d local_right_box==equiv(local_right_box_base)
-@d box(#)==equiv(box_base+#)
-@d cur_font==equiv(cur_font_loc)
-
-@<Put each...@>=
-primitive_tex("output",assign_toks,output_routine_loc,local_base);
-@!@:output_}{\.{\\output} primitive@>
-primitive_tex("everypar",assign_toks,every_par_loc,local_base);
-@!@:every_par_}{\.{\\everypar} primitive@>
-primitive_tex("everymath",assign_toks,every_math_loc,local_base);
-@!@:every_math_}{\.{\\everymath} primitive@>
-primitive_tex("everydisplay",assign_toks,every_display_loc,local_base);
-@!@:every_display_}{\.{\\everydisplay} primitive@>
-primitive_tex("everyhbox",assign_toks,every_hbox_loc,local_base);
-@!@:every_hbox_}{\.{\\everyhbox} primitive@>
-primitive_tex("everyvbox",assign_toks,every_vbox_loc,local_base);
-@!@:every_vbox_}{\.{\\everyvbox} primitive@>
-primitive_tex("everyjob",assign_toks,every_job_loc,local_base);
-@!@:every_job_}{\.{\\everyjob} primitive@>
-primitive_tex("everycr",assign_toks,every_cr_loc,local_base);
-@!@:every_cr_}{\.{\\everycr} primitive@>
-primitive_tex("errhelp",assign_toks,err_help_loc,local_base);
-@!@:err_help_}{\.{\\errhelp} primitive@>
-primitive_pdftex("pdfpagesattr",assign_toks,pdf_pages_attr_loc,local_base);
-@!@:pdf_pages_attr_}{\.{\\pdfpagesattr} primitive@>
-primitive_pdftex("pdfpageattr",assign_toks,pdf_page_attr_loc,local_base);
-@!@:pdf_page_attr_}{\.{\\pdfpageattr} primitive@>
-primitive_pdftex("pdfpageresources",assign_toks,pdf_page_resources_loc,local_base);
-@!@:pdf_page_resources_}{\.{\\pdfpageresources} primitive@>
-primitive_pdftex("pdfpkmode",assign_toks,pdf_pk_mode_loc,local_base);
-@!@:pdf_pk_mode_}{\.{\\pdfpkmode} primitive@>
-
-
-@ We initialize most things to null or undefined values. An undefined font
-is represented by the internal code |font_base|.
-
-However, the character code tables are given initial values based on the
-conventional interpretation of ASCII code. These initial values should
-not be changed when \TeX\ is adapted for use with non-English languages;
-all changes to the initialization conventions should be made in format
-packages, not in \TeX\ itself, so that global interchange of formats is
-possible.
-
-@d null_font==font_base
-@d null_ocp==ocp_base
-@d null_ocp_list==ocp_list_base
-@d var_code==7 {math code meaning ``use the current family''}
-
-@<Initialize table entries...@>=
-par_shape_ptr:=null; eq_type(par_shape_loc):=shape_ref;
-eq_level(par_shape_loc):=level_one;@/
-for k:=etex_pen_base to etex_pens-1 do
- eqtb[k]:=eqtb[par_shape_loc];
-for k:=output_routine_loc to toks_base+biggest_reg do
- eqtb[k]:=eqtb[undefined_control_sequence];
-box(0):=null; eq_type(box_base):=box_ref; eq_level(box_base):=level_one;
-for k:=box_base+1 to box_base+biggest_reg do eqtb[k]:=eqtb[box_base];
-cur_font:=null_font; eq_type(cur_font_loc):=data;
-eq_level(cur_font_loc):=level_one;@/
-equiv(cat_code_base):=0; eq_type(cat_code_base):=data;
-eq_level(cat_code_base):=level_one;@/
-eqtb[math_param_base]:=eqtb[cat_code_base];
-eqtb[lc_code_base] :=eqtb[cat_code_base];
-eqtb[uc_code_base] :=eqtb[cat_code_base];
-eqtb[sf_code_base] :=eqtb[cat_code_base];
-eqtb[math_code_base]:=eqtb[cat_code_base];@/
-cat_code_table:=0;
-initialize_math_codes;
-initialize_text_codes;
-initex_cat_codes(0);
-for k:="0" to "9" do set_math_code(k,tex_mathcode,var_code,0,k,level_one);@/
-for k:="A" to "Z" do begin
- set_math_code(k,tex_mathcode,var_code,1,k,level_one);
- set_math_code((k+32),tex_mathcode,var_code,1,(k+32),level_one);@/
- set_lc_code(k,k+32,level_one); set_lc_code(k+32,k+32,level_one);@/
- set_uc_code(k,k,level_one); set_uc_code(k+32,k,level_one);@/
- set_sf_code(k,999,level_one);
- end;
-
-@ @<Set init...@>=
-static_int_base:=int_base;
-
-@ @<Show equivalent |n|, in region 4@>=
-begin
-if (n=par_shape_loc) or ((n>=etex_pen_base) and (n<etex_pens)) then
- begin if n=par_shape_loc then print_cmd_chr(set_tex_shape,n)
- else print_cmd_chr(set_etex_shape,n);
- print_char("=");
- if equiv(n)=null then print_char("0")
- else if n>par_shape_loc then
- begin print_int(penalty(equiv(n))); print_char(" ");
- print_int(penalty(equiv(n)+1));
- if penalty(equiv(n))>1 then print_esc("ETC.");
- end
- else print_int(vinfo(par_shape_ptr+1));
- end
-else if n<toks_base then
- {TH TODO make extra cases for ocps here! }
- begin print_cmd_chr(assign_toks,n); print_char("=");
- if equiv(n)<>null then show_token_list(link(equiv(n)),null,32);
- end
-else if n<box_base then
- begin print_esc("toks"); print_int(n-toks_base); print_char("=");
- if equiv(n)<>null then show_token_list(link(equiv(n)),null,32);
- end
-else if n<cur_font_loc then
- begin print_esc("box"); print_int(n-box_base); print_char("=");
- if equiv(n)=null then print("void")
- else begin depth_threshold:=0; breadth_max:=1; show_node_list(equiv(n));
- end;
- end
-else if n=cur_font_loc then @<Show the font identifier in |eqtb[n]|@>;
-end
-
-@ @<Show the font identifier in |eqtb[n]|@>=
-begin print("current font"); print_char("=");@/
-print_esc(hash[font_id_base+equiv(n)].rh);
- {that's |font_id_text(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 heldover after a split}
-@d global_defs_code=43 {override \.{\\global} specifications}
-@d cur_fam_code=44 {current family}
-@d escape_char_code=45 {escape character for token output}
-@d default_hyphen_char_code=46 {value of \.{\\hyphenchar} when a font is loaded}
-@d default_skew_char_code=47 {value of \.{\\skewchar} when a font is loaded}
-@d end_line_char_code=48 {character placed at the right end of the buffer}
-@d new_line_char_code=49 {character that prints as |print_ln|}
-@d language_code=50 {current hyphenation table}
-@d left_hyphen_min_code=51 {minimum left hyphenation fragment size}
-@d right_hyphen_min_code=52 {minimum right hyphenation fragment size}
-@d holding_inserts_code=53 {do not remove insertion nodes from \.{\\box255}}
-@d error_context_lines_code=54 {maximum intermediate line pairs shown}
-@d local_inter_line_penalty_code=55 {local \.{\\interlinepenalty}}
-@d local_broken_penalty_code=56 {local \.{\\brokenpenalty}}
-@d no_local_whatsits_code=57 {counts local whatsits}
-@d no_local_dirs_code=58
-@d level_local_dir_code=59
-@d luastartup_id_code=60
-@d disable_lig_code=61
-@d disable_kern_code=62
-@d cat_code_table_code=63
-@d output_box_code=64
-@d cur_lang_code=65 {current language id}
-@d ex_hyphen_char_code=66
-@d tex_int_pars=67 {total number of \.{\\TeX} + Aleph integer parameters}
-@#
-@d dir_base=int_base+tex_int_pars
-@d page_direction_code=0
-@d body_direction_code=1
-@d par_direction_code=2
-@d text_direction_code=3
-@d math_direction_code=4
-@d dir_pars=5
-@#
-@d pdftex_first_integer_code = tex_int_pars+dir_pars {base for \pdfTeX's integer parameters}
-@d pdf_output_code = pdftex_first_integer_code + 0 {switch on PDF output if positive}
-@d pdf_compress_level_code = pdftex_first_integer_code + 1 {compress level of streams}
-@d pdf_decimal_digits_code = pdftex_first_integer_code + 2 {digits after the decimal point of numbers}
-@d pdf_move_chars_code = pdftex_first_integer_code + 3 {move chars 0..31 to higher area if possible}
-@d pdf_image_resolution_code = pdftex_first_integer_code + 4 {default image resolution}
-@d pdf_pk_resolution_code = pdftex_first_integer_code + 5 {default resolution of PK font}
-@d pdf_unique_resname_code = pdftex_first_integer_code + 6 {generate unique names for resouces}
-@d pdf_option_always_use_pdfpagebox_code = pdftex_first_integer_code + 7 {if the PDF inclusion should always use a specific PDF page box}
-@d pdf_option_pdf_inclusion_errorlevel_code = pdftex_first_integer_code + 8 {if the PDF inclusion should treat pdfs newer than |pdf_minor_version| as an error}
-@d pdf_minor_version_code = pdftex_first_integer_code + 9 {fractional part of the PDF version produced}
-@d pdf_force_pagebox_code = pdftex_first_integer_code + 10 {if the PDF inclusion should always use a specific PDF page box}
-@d pdf_pagebox_code = pdftex_first_integer_code + 11 {default pagebox to use for PDF inclusion}
-@d pdf_inclusion_errorlevel_code = pdftex_first_integer_code + 12 {if the PDF inclusion should treat pdfs newer than |pdf_minor_version| as an error}
-@d pdf_gamma_code = pdftex_first_integer_code + 13
-@d pdf_image_gamma_code = pdftex_first_integer_code + 14
-@d pdf_image_hicolor_code = pdftex_first_integer_code + 15
-@d pdf_image_apply_gamma_code = pdftex_first_integer_code + 16
-@d pdf_adjust_spacing_code = pdftex_first_integer_code + 17 {level of spacing adjusting}
-@d pdf_protrude_chars_code = pdftex_first_integer_code + 18 {protrude chars at left/right edge of paragraphs}
-@d pdf_tracing_fonts_code = pdftex_first_integer_code + 19 {level of font detail in log}
-@d pdf_objcompresslevel_code = pdftex_first_integer_code + 20 {activate object streams}
-@d pdf_gen_tounicode_code = pdftex_first_integer_code + 24 {generate ToUnicode for fonts?}
-@d pdf_draftmode_code = pdftex_first_integer_code + 25 {switch on draftmode if positive}
-@d pdf_replace_font_code = pdftex_first_integer_code + 26 {generate ToUnicode for fonts?}
-@d pdf_inclusion_copy_font_code = pdftex_first_integer_code + 27 {generate ToUnicode for fonts?}
-@d pdf_int_pars=pdftex_first_integer_code + 28 {total number of \pdfTeX's integer parameters}
-@#
-@d etex_int_base=pdf_int_pars {base for \eTeX's integer parameters}
-@d tracing_assigns_code=etex_int_base {show assignments}
-@d tracing_groups_code=etex_int_base+1 {show save/restore groups}
-@d tracing_ifs_code=etex_int_base+2 {show conditionals}
-@d tracing_scan_tokens_code=etex_int_base+3 {show pseudo file open and close}
-@d tracing_nesting_code=etex_int_base+4 {show incomplete groups and ifs within files}
-@d pre_display_direction_code=etex_int_base+5 {text direction preceding a display}
-@d last_line_fit_code=etex_int_base+6 {adjustment for last line of paragraph}
-@d saving_vdiscards_code=etex_int_base+7 {save items discarded from vlists}
-@d saving_hyph_codes_code=etex_int_base+8 {save hyphenation codes for languages}
-@d suppress_fontnotfound_error_code=etex_int_base+9 {surpress errors for missing fonts}
-@d suppress_long_error_code=etex_int_base+10 {surpress errors for missing fonts}
-@d suppress_ifcsname_error_code=etex_int_base+11 {surpress errors for failed \.{\\ifcsname}}
-@d suppress_outer_error_code=etex_int_base+12 {surpress errors for \.{\\outer}}
-@d etex_int_pars=etex_int_base+13 {total number of \eTeX's integer parameters}
-@#
-@d synctex_code=etex_int_pars { is synctex file generation enabled ? }
-@d int_pars=synctex_code+1 {total number of integer parameters}
-@d count_base=int_base+int_pars {|number_regs| user \.{\\count} registers}
-@d attribute_base=count_base+number_regs {|number_attrs| user \.{\\attribute} registers}
-@d del_code_base=attribute_base+number_attrs {|number_chars| delimiter code mappings}
-@d dimen_base=del_code_base+1 {beginning of region 6}
-@#
-@d count(#)==eqtb[count_base+#].int
-@d attribute(#)==eqtb[attribute_base+#].int
-@d int_par(#)==eqtb[int_base+#].int {an integer parameter}
-@d pretolerance==int_par(pretolerance_code)
-@d tolerance==int_par(tolerance_code)
-@d line_penalty==int_par(line_penalty_code)
-@d hyphen_penalty==int_par(hyphen_penalty_code)
-@d ex_hyphen_penalty==int_par(ex_hyphen_penalty_code)
-@d club_penalty==int_par(club_penalty_code)
-@d widow_penalty==int_par(widow_penalty_code)
-@d display_widow_penalty==int_par(display_widow_penalty_code)
-@d broken_penalty==int_par(broken_penalty_code)
-@d bin_op_penalty==int_par(bin_op_penalty_code)
-@d rel_penalty==int_par(rel_penalty_code)
-@d pre_display_penalty==int_par(pre_display_penalty_code)
-@d post_display_penalty==int_par(post_display_penalty_code)
-@d inter_line_penalty==int_par(inter_line_penalty_code)
-@d double_hyphen_demerits==int_par(double_hyphen_demerits_code)
-@d final_hyphen_demerits==int_par(final_hyphen_demerits_code)
-@d adj_demerits==int_par(adj_demerits_code)
-@d mag==int_par(mag_code)
-@d delimiter_factor==int_par(delimiter_factor_code)
-@d looseness==int_par(looseness_code)
-@d time==int_par(time_code)
-@d day==int_par(day_code)
-@d month==int_par(month_code)
-@d year==int_par(year_code)
-@d show_box_breadth==int_par(show_box_breadth_code)
-@d show_box_depth==int_par(show_box_depth_code)
-@d hbadness==int_par(hbadness_code)
-@d vbadness==int_par(vbadness_code)
-@d pausing==int_par(pausing_code)
-@d tracing_online==int_par(tracing_online_code)
-@d tracing_macros==int_par(tracing_macros_code)
-@d tracing_stats==int_par(tracing_stats_code)
-@d tracing_paragraphs==int_par(tracing_paragraphs_code)
-@d tracing_pages==int_par(tracing_pages_code)
-@d tracing_output==int_par(tracing_output_code)
-@d tracing_lost_chars==int_par(tracing_lost_chars_code)
-@d tracing_commands==int_par(tracing_commands_code)
-@d tracing_restores==int_par(tracing_restores_code)
-@d uc_hyph==int_par(uc_hyph_code)
-@d output_penalty==int_par(output_penalty_code)
-@d max_dead_cycles==int_par(max_dead_cycles_code)
-@d hang_after==int_par(hang_after_code)
-@d floating_penalty==int_par(floating_penalty_code)
-@d global_defs==int_par(global_defs_code)
-@d cur_fam==int_par(cur_fam_code)
-@d escape_char==int_par(escape_char_code)
-@d default_hyphen_char==int_par(default_hyphen_char_code)
-@d default_skew_char==int_par(default_skew_char_code)
-@d end_line_char==int_par(end_line_char_code)
-@d new_line_char==int_par(new_line_char_code)
-@d local_inter_line_penalty==int_par(local_inter_line_penalty_code)
-@d local_broken_penalty==int_par(local_broken_penalty_code)
-@d no_local_whatsits==int_par(no_local_whatsits_code)
-@d no_local_dirs==int_par(no_local_dirs_code)
-@d level_local_dir==int_par(level_local_dir_code)
-@d dir_par(#)==eqtb[dir_base+#].int {a direction parameter}
-@d page_direction==dir_par(page_direction_code)
-@d body_direction==dir_par(body_direction_code)
-@d par_direction==dir_par(par_direction_code)
-@d text_direction==dir_par(text_direction_code)
-@d math_direction==dir_par(math_direction_code)
-@d language==int_par(language_code)
-@d cur_lang==int_par(cur_lang_code)
-@d ex_hyphen_char==int_par(ex_hyphen_char_code)
-@d left_hyphen_min==int_par(left_hyphen_min_code)
-@d right_hyphen_min==int_par(right_hyphen_min_code)
-@d holding_inserts==int_par(holding_inserts_code)
-@d error_context_lines==int_par(error_context_lines_code)
-@d luastartup_id==int_par(luastartup_id_code)
-@d disable_lig==int_par(disable_lig_code)
-@d disable_kern==int_par(disable_kern_code)
-@d cat_code_table==int_par(cat_code_table_code)
-@d output_box==int_par(output_box_code)
-@#
-@d pdf_adjust_spacing == int_par(pdf_adjust_spacing_code)
-@d pdf_protrude_chars == int_par(pdf_protrude_chars_code)
-@d pdf_tracing_fonts == int_par(pdf_tracing_fonts_code)
-@d pdf_gen_tounicode == int_par(pdf_gen_tounicode_code)
-@d pdf_output == int_par(pdf_output_code)
-@d pdf_compress_level == int_par(pdf_compress_level_code)
-@d pdf_objcompresslevel == int_par(pdf_objcompresslevel_code)
-@d pdf_decimal_digits == int_par(pdf_decimal_digits_code)
-@d pdf_move_chars == int_par(pdf_move_chars_code)
-@d pdf_image_resolution == int_par(pdf_image_resolution_code)
-@d pdf_pk_resolution == int_par(pdf_pk_resolution_code)
-@d pdf_unique_resname == int_par(pdf_unique_resname_code)
-@d pdf_option_always_use_pdfpagebox == int_par(pdf_option_always_use_pdfpagebox_code)
-@d pdf_option_pdf_inclusion_errorlevel == int_par(pdf_option_pdf_inclusion_errorlevel_code)
-@d pdf_minor_version == int_par(pdf_minor_version_code)
-@d pdf_force_pagebox == int_par(pdf_force_pagebox_code)
-@d pdf_pagebox == int_par(pdf_pagebox_code)
-@d pdf_inclusion_errorlevel == int_par(pdf_inclusion_errorlevel_code)
-@d pdf_gamma == int_par(pdf_gamma_code)
-@d pdf_image_gamma == int_par(pdf_image_gamma_code)
-@d pdf_image_hicolor == int_par(pdf_image_hicolor_code)
-@d pdf_image_apply_gamma == int_par(pdf_image_apply_gamma_code)
-@d pdf_draftmode == int_par(pdf_draftmode_code)
-@d pdf_inclusion_copy_font == int_par(pdf_inclusion_copy_font_code)
-@d pdf_replace_font == int_par(pdf_replace_font_code)
-@#
-@d tracing_assigns==int_par(tracing_assigns_code)
-@d tracing_groups==int_par(tracing_groups_code)
-@d tracing_ifs==int_par(tracing_ifs_code)
-@d tracing_scan_tokens==int_par(tracing_scan_tokens_code)
-@d tracing_nesting==int_par(tracing_nesting_code)
-@d pre_display_direction==int_par(pre_display_direction_code)
-@d last_line_fit==int_par(last_line_fit_code)
-@d saving_vdiscards==int_par(saving_vdiscards_code)
-@d saving_hyph_codes==int_par(saving_hyph_codes_code)
-@d suppress_fontnotfound_error==int_par(suppress_fontnotfound_error_code)
-@d suppress_long_error==int_par(suppress_long_error_code)
-@d suppress_ifcsname_error==int_par(suppress_ifcsname_error_code)
-@d synctex==int_par(synctex_code)
-
-@<Assign the values |depth_threshold:=show_box_depth|...@>=
-depth_threshold:=show_box_depth;
-breadth_max:=show_box_breadth
-
-
-@ @<Set init...@>=
-static_dimen_base:=dimen_base;
-
-@ We can print the symbolic name of an integer parameter as follows.
-
-@p procedure print_param(@!n:integer);
-begin case n of
-pretolerance_code:print_esc("pretolerance");
-tolerance_code:print_esc("tolerance");
-line_penalty_code:print_esc("linepenalty");
-hyphen_penalty_code:print_esc("hyphenpenalty");
-ex_hyphen_penalty_code:print_esc("exhyphenpenalty");
-club_penalty_code:print_esc("clubpenalty");
-widow_penalty_code:print_esc("widowpenalty");
-display_widow_penalty_code:print_esc("displaywidowpenalty");
-broken_penalty_code:print_esc("brokenpenalty");
-bin_op_penalty_code:print_esc("binoppenalty");
-rel_penalty_code:print_esc("relpenalty");
-pre_display_penalty_code:print_esc("predisplaypenalty");
-post_display_penalty_code:print_esc("postdisplaypenalty");
-inter_line_penalty_code:print_esc("interlinepenalty");
-double_hyphen_demerits_code:print_esc("doublehyphendemerits");
-final_hyphen_demerits_code:print_esc("finalhyphendemerits");
-adj_demerits_code:print_esc("adjdemerits");
-mag_code:print_esc("mag");
-delimiter_factor_code:print_esc("delimiterfactor");
-looseness_code:print_esc("looseness");
-time_code:print_esc("time");
-day_code:print_esc("day");
-month_code:print_esc("month");
-year_code:print_esc("year");
-show_box_breadth_code:print_esc("showboxbreadth");
-show_box_depth_code:print_esc("showboxdepth");
-hbadness_code:print_esc("hbadness");
-vbadness_code:print_esc("vbadness");
-pausing_code:print_esc("pausing");
-tracing_online_code:print_esc("tracingonline");
-tracing_macros_code:print_esc("tracingmacros");
-tracing_stats_code:print_esc("tracingstats");
-tracing_paragraphs_code:print_esc("tracingparagraphs");
-tracing_pages_code:print_esc("tracingpages");
-tracing_output_code:print_esc("tracingoutput");
-tracing_lost_chars_code:print_esc("tracinglostchars");
-tracing_commands_code:print_esc("tracingcommands");
-tracing_restores_code:print_esc("tracingrestores");
-uc_hyph_code:print_esc("uchyph");
-output_penalty_code:print_esc("outputpenalty");
-max_dead_cycles_code:print_esc("maxdeadcycles");
-hang_after_code:print_esc("hangafter");
-floating_penalty_code:print_esc("floatingpenalty");
-global_defs_code:print_esc("globaldefs");
-cur_fam_code:print_esc("fam");
-escape_char_code:print_esc("escapechar");
-default_hyphen_char_code:print_esc("defaulthyphenchar");
-default_skew_char_code:print_esc("defaultskewchar");
-end_line_char_code:print_esc("endlinechar");
-new_line_char_code:print_esc("newlinechar");
-language_code:print_esc("language");
-cur_lang_code:print_esc("setlanguage");
-ex_hyphen_char_code:print_esc("exhyphenchar");
-left_hyphen_min_code:print_esc("lefthyphenmin");
-right_hyphen_min_code:print_esc("righthyphenmin");
-holding_inserts_code:print_esc("holdinginserts");
-error_context_lines_code:print_esc("errorcontextlines");
-luastartup_id_code:print_esc("luastartup");
-disable_lig_code:print_esc("noligs");
-disable_kern_code:print_esc("nokerns");
-cat_code_table_code:print_esc("catcodetable");
-output_box_code:print_esc("outputbox");
-@#
-local_inter_line_penalty_code: print_esc("localinterlinepenalty");
-local_broken_penalty_code: print_esc("localbrokenpenalty");
-{the next three do not have a matching primitive}
-no_local_whatsits_code: print("[no_local_whatsits]");
-no_local_dirs_code: print("[no_local_dirs]");
-level_local_dir_code: print("[level_local_dir]");
-@#
-pdf_output_code: print_esc("pdfoutput");
-pdf_compress_level_code: print_esc("pdfcompresslevel");
-pdf_objcompresslevel_code: print_esc("pdfobjcompresslevel");
-pdf_decimal_digits_code: print_esc("pdfdecimaldigits");
-pdf_move_chars_code: print_esc("pdfmovechars");
-pdf_image_resolution_code: print_esc("pdfimageresolution");
-pdf_pk_resolution_code: print_esc("pdfpkresolution");
-pdf_unique_resname_code: print_esc("pdfuniqueresname");
-pdf_option_always_use_pdfpagebox_code: print_esc("pdfoptionalwaysusepdfpagebox");
-pdf_option_pdf_inclusion_errorlevel_code: print_esc("pdfoptionpdfinclusionerrorlevel");
-pdf_minor_version_code: print_esc("pdfminorversion");
-pdf_force_pagebox_code: print_esc("pdfforcepagebox");
-pdf_pagebox_code: print_esc("pdfpagebox");
-pdf_inclusion_errorlevel_code: print_esc("pdfinclusionerrorlevel");
-pdf_gamma_code: print_esc("pdfgamma");
-pdf_image_gamma_code: print_esc("pdfimagegamma");
-pdf_image_hicolor_code: print_esc("pdfimagehicolor");
-pdf_image_apply_gamma_code: print_esc("pdfimageapplygamma");
-pdf_adjust_spacing_code: print_esc("pdfadjustspacing");
-pdf_protrude_chars_code: print_esc("pdfprotrudechars");
-pdf_tracing_fonts_code: print_esc("pdftracingfonts");
-pdf_gen_tounicode_code: print_esc("pdfgentounicode");
-pdf_draftmode_code: print_esc("pdfdraftmode");
-pdf_inclusion_copy_font_code: print_esc("pdfinclusioncopyfonts");
-pdf_replace_font_code: print_esc("pdfreplacefont");
-@/@<Cases for |print_param|@>@/
-othercases begin print("[unknown integer parameter!]"); end
-endcases;
-end;
-
-@ The integer parameter names must be entered into the hash table.
-
-@<Put each...@>=
-primitive_tex("pretolerance",assign_int,int_base+pretolerance_code,int_base);@/
-@!@:pretolerance_}{\.{\\pretolerance} primitive@>
-primitive_tex("tolerance",assign_int,int_base+tolerance_code,int_base);@/
-@!@:tolerance_}{\.{\\tolerance} primitive@>
-primitive_tex("linepenalty",assign_int,int_base+line_penalty_code,int_base);@/
-@!@:line_penalty_}{\.{\\linepenalty} primitive@>
-primitive_tex("hyphenpenalty",assign_int,int_base+hyphen_penalty_code,int_base);@/
-@!@:hyphen_penalty_}{\.{\\hyphenpenalty} primitive@>
-primitive_tex("exhyphenpenalty",assign_int,int_base+ex_hyphen_penalty_code,int_base);@/
-@!@:ex_hyphen_penalty_}{\.{\\exhyphenpenalty} primitive@>
-primitive_tex("clubpenalty",assign_int,int_base+club_penalty_code,int_base);@/
-@!@:club_penalty_}{\.{\\clubpenalty} primitive@>
-primitive_tex("widowpenalty",assign_int,int_base+widow_penalty_code,int_base);@/
-@!@:widow_penalty_}{\.{\\widowpenalty} primitive@>
-primitive_tex("displaywidowpenalty", assign_int,int_base+display_widow_penalty_code,int_base);@/
-@!@:display_widow_penalty_}{\.{\\displaywidowpenalty} primitive@>
-primitive_tex("brokenpenalty",assign_int,int_base+broken_penalty_code,int_base);@/
-@!@:broken_penalty_}{\.{\\brokenpenalty} primitive@>
-primitive_tex("binoppenalty",assign_int,int_base+bin_op_penalty_code,int_base);@/
-@!@:bin_op_penalty_}{\.{\\binoppenalty} primitive@>
-primitive_tex("relpenalty",assign_int,int_base+rel_penalty_code,int_base);@/
-@!@:rel_penalty_}{\.{\\relpenalty} primitive@>
-primitive_tex("predisplaypenalty",assign_int,int_base+pre_display_penalty_code,int_base);@/
-@!@:pre_display_penalty_}{\.{\\predisplaypenalty} primitive@>
-primitive_tex("postdisplaypenalty",assign_int,int_base+post_display_penalty_code,int_base);@/
-@!@:post_display_penalty_}{\.{\\postdisplaypenalty} primitive@>
-primitive_tex("interlinepenalty",assign_int,int_base+inter_line_penalty_code,int_base);@/
-@!@:inter_line_penalty_}{\.{\\interlinepenalty} primitive@>
-primitive_tex("doublehyphendemerits", assign_int,int_base+double_hyphen_demerits_code,int_base);@/
-@!@:double_hyphen_demerits_}{\.{\\doublehyphendemerits} primitive@>
-primitive_tex("finalhyphendemerits", assign_int,int_base+final_hyphen_demerits_code,int_base);@/
-@!@:final_hyphen_demerits_}{\.{\\finalhyphendemerits} primitive@>
-primitive_tex("adjdemerits",assign_int,int_base+adj_demerits_code,int_base);@/
-@!@:adj_demerits_}{\.{\\adjdemerits} primitive@>
-primitive_tex("mag",assign_int,int_base+mag_code,int_base);@/
-@!@:mag_}{\.{\\mag} primitive@>
-primitive_tex("delimiterfactor",assign_int,int_base+delimiter_factor_code,int_base);@/
-@!@:delimiter_factor_}{\.{\\delimiterfactor} primitive@>
-primitive_tex("looseness",assign_int,int_base+looseness_code,int_base);@/
-@!@:looseness_}{\.{\\looseness} primitive@>
-primitive_tex("time",assign_int,int_base+time_code,int_base);@/
-@!@:time_}{\.{\\time} primitive@>
-primitive_tex("day",assign_int,int_base+day_code,int_base);@/
-@!@:day_}{\.{\\day} primitive@>
-primitive_tex("month",assign_int,int_base+month_code,int_base);@/
-@!@:month_}{\.{\\month} primitive@>
-primitive_tex("year",assign_int,int_base+year_code,int_base);@/
-@!@:year_}{\.{\\year} primitive@>
-primitive_tex("showboxbreadth",assign_int,int_base+show_box_breadth_code,int_base);@/
-@!@:show_box_breadth_}{\.{\\showboxbreadth} primitive@>
-primitive_tex("showboxdepth",assign_int,int_base+show_box_depth_code,int_base);@/
-@!@:show_box_depth_}{\.{\\showboxdepth} primitive@>
-primitive_tex("hbadness",assign_int,int_base+hbadness_code,int_base);@/
-@!@:hbadness_}{\.{\\hbadness} primitive@>
-primitive_tex("vbadness",assign_int,int_base+vbadness_code,int_base);@/
-@!@:vbadness_}{\.{\\vbadness} primitive@>
-primitive_tex("pausing",assign_int,int_base+pausing_code,int_base);@/
-@!@:pausing_}{\.{\\pausing} primitive@>
-primitive_tex("tracingonline",assign_int,int_base+tracing_online_code,int_base);@/
-@!@:tracing_online_}{\.{\\tracingonline} primitive@>
-primitive_tex("tracingmacros",assign_int,int_base+tracing_macros_code,int_base);@/
-@!@:tracing_macros_}{\.{\\tracingmacros} primitive@>
-primitive_tex("tracingstats",assign_int,int_base+tracing_stats_code,int_base);@/
-@!@:tracing_stats_}{\.{\\tracingstats} primitive@>
-primitive_tex("tracingparagraphs",assign_int,int_base+tracing_paragraphs_code,int_base);@/
-@!@:tracing_paragraphs_}{\.{\\tracingparagraphs} primitive@>
-primitive_tex("tracingpages",assign_int,int_base+tracing_pages_code,int_base);@/
-@!@:tracing_pages_}{\.{\\tracingpages} primitive@>
-primitive_tex("tracingoutput",assign_int,int_base+tracing_output_code,int_base);@/
-@!@:tracing_output_}{\.{\\tracingoutput} primitive@>
-primitive_tex("tracinglostchars",assign_int,int_base+tracing_lost_chars_code,int_base);@/
-@!@:tracing_lost_chars_}{\.{\\tracinglostchars} primitive@>
-primitive_tex("tracingcommands",assign_int,int_base+tracing_commands_code,int_base);@/
-@!@:tracing_commands_}{\.{\\tracingcommands} primitive@>
-primitive_tex("tracingrestores",assign_int,int_base+tracing_restores_code,int_base);@/
-@!@:tracing_restores_}{\.{\\tracingrestores} primitive@>
-primitive_tex("uchyph",assign_int,int_base+uc_hyph_code,int_base);@/
-@!@:uc_hyph_}{\.{\\uchyph} primitive@>
-primitive_tex("outputpenalty",assign_int,int_base+output_penalty_code,int_base);@/
-@!@:output_penalty_}{\.{\\outputpenalty} primitive@>
-primitive_tex("maxdeadcycles",assign_int,int_base+max_dead_cycles_code,int_base);@/
-@!@:max_dead_cycles_}{\.{\\maxdeadcycles} primitive@>
-primitive_tex("hangafter",assign_int,int_base+hang_after_code,int_base);@/
-@!@:hang_after_}{\.{\\hangafter} primitive@>
-primitive_tex("floatingpenalty",assign_int,int_base+floating_penalty_code,int_base);@/
-@!@:floating_penalty_}{\.{\\floatingpenalty} primitive@>
-primitive_tex("globaldefs",assign_int,int_base+global_defs_code,int_base);@/
-@!@:global_defs_}{\.{\\globaldefs} primitive@>
-primitive_tex("fam",assign_int,int_base+cur_fam_code,int_base);@/
-@!@:fam_}{\.{\\fam} primitive@>
-primitive_tex("escapechar",assign_int,int_base+escape_char_code,int_base);@/
-@!@:escape_char_}{\.{\\escapechar} primitive@>
-primitive_tex("defaulthyphenchar",assign_int,int_base+default_hyphen_char_code,int_base);@/
-@!@:default_hyphen_char_}{\.{\\defaulthyphenchar} primitive@>
-primitive_tex("defaultskewchar",assign_int,int_base+default_skew_char_code,int_base);@/
-@!@:default_skew_char_}{\.{\\defaultskewchar} primitive@>
-primitive_tex("endlinechar",assign_int,int_base+end_line_char_code,int_base);@/
-@!@:end_line_char_}{\.{\\endlinechar} primitive@>
-primitive_tex("newlinechar",assign_int,int_base+new_line_char_code,int_base);@/
-@!@:new_line_char_}{\.{\\newlinechar} primitive@>
-primitive_tex("language",assign_int,int_base+language_code,int_base);@/
-@!@:language_}{\.{\\language} primitive@>
-primitive_tex("setlanguage",assign_int,int_base+cur_lang_code,int_base);@/
-@!@:cur_lang_}{\.{\\setlanguage} primitive@>
-primitive_tex("exhyphenchar",assign_int,int_base+ex_hyphen_char_code,int_base);@/
-@!@:ex_hyphen_char_}{\.{\\exhyphenchar} primitive@>
-primitive_tex("lefthyphenmin",assign_int,int_base+left_hyphen_min_code,int_base);@/
-@!@:left_hyphen_min_}{\.{\\lefthyphenmin} primitive@>
-primitive_tex("righthyphenmin",assign_int,int_base+right_hyphen_min_code,int_base);@/
-@!@:right_hyphen_min_}{\.{\\righthyphenmin} primitive@>
-primitive_tex("holdinginserts",assign_int,int_base+holding_inserts_code,int_base);@/
-@!@:holding_inserts_}{\.{\\holdinginserts} primitive@>
-primitive_tex("errorcontextlines",assign_int,int_base+error_context_lines_code,int_base);@/
-@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
-primitive_luatex("luastartup",assign_int,int_base+luastartup_id_code,int_base);@/
-@!@:luastartup_id_}{\.{\\luastartup} primitive@>
-primitive_luatex("nokerns",assign_int,int_base+disable_kern_code,int_base);@/
-@!@:disable_kern_}{\.{\\noligkerns} primitive@>
-primitive_luatex("noligs",assign_int,int_base+disable_lig_code,int_base);@/
-@!@:disable_lig_}{\.{\\noligs} primitive@>
-primitive_luatex("catcodetable",assign_int,int_base+cat_code_table_code,int_base);@/
-@!@:cat_code_table_}{\.{\\catcodetable} primitive@>
-primitive_luatex("outputbox",assign_int,int_base+output_box_code,int_base);@/
-@!@:output_box_}{\.{\\outputbox} primitive@>
-primitive_pdftex("pdfoutput",assign_int,int_base+pdf_output_code,int_base);@/
-@!@:pdf_output_}{\.{\\pdfoutput} primitive@>
-primitive_pdftex("pdfcompresslevel",assign_int,int_base+pdf_compress_level_code,int_base);@/
-@!@:pdf_compress_level_}{\.{\\pdfcompresslevel} primitive@>
-primitive_pdftex("pdfobjcompresslevel",assign_int,int_base+pdf_objcompresslevel_code,int_base);@/
-@!@:pdf_objcompresslevel_}{\.{\\pdfobjcompresslevel} primitive@>
-primitive_pdftex("pdfdecimaldigits",assign_int,int_base+pdf_decimal_digits_code,int_base);@/
-@!@:pdf_decimal_digits_}{\.{\\pdfdecimaldigits} primitive@>
-primitive_pdftex("pdfmovechars",assign_int,int_base+pdf_move_chars_code,int_base);@/
-@!@:pdf_move_chars_}{\.{\\pdfmovechars} primitive@>
-primitive_pdftex("pdfimageresolution",assign_int,int_base+pdf_image_resolution_code,int_base);@/
-@!@:pdf_image_resolution_}{\.{\\pdfimageresolution} primitive@>
-primitive_pdftex("pdfpkresolution",assign_int,int_base+pdf_pk_resolution_code,int_base);@/
-@!@:pdf_pk_resolution_}{\.{\\pdfpkresolution} primitive@>
-primitive_pdftex("pdfuniqueresname",assign_int,int_base+pdf_unique_resname_code,int_base);@/
-@!@:pdf_unique_resname_}{\.{\\pdfuniqueresname} primitive@>
-primitive_pdftex("pdfoptionpdfminorversion",assign_int,int_base+pdf_minor_version_code,int_base);@/
-@!@:pdf_minor_version_}{\.{\\pdfoptionpdfminorversion} primitive@>
-primitive_pdftex("pdfoptionalwaysusepdfpagebox",assign_int,int_base+pdf_option_always_use_pdfpagebox_code,int_base);@/
-@!@:pdf_option_always_use_pdfpagebox_}{\.{\\pdfoptionalwaysusepdfpagebox} primitive@>
-primitive_pdftex("pdfoptionpdfinclusionerrorlevel",assign_int,int_base+pdf_option_pdf_inclusion_errorlevel_code,int_base);@/
-@!@:pdf_option_pdf_inclusion_errorlevel_}{\.{\\pdfoptionpdfinclusionerrorlevel} primitive@>
-primitive_pdftex("pdfminorversion",assign_int,int_base+pdf_minor_version_code,int_base);@/
-@!@:pdf_minor_version_}{\.{\\pdfminorversion} primitive@>
-primitive_pdftex("pdfforcepagebox",assign_int,int_base+pdf_force_pagebox_code,int_base);@/
-@!@:pdf_force_pagebox_}{\.{\\pdfforcepagebox} primitive@>
-primitive_pdftex("pdfpagebox",assign_int,int_base+pdf_pagebox_code,int_base);@/
-@!@:pdf_pagebox_}{\.{\\pdfpagebox} primitive@>
-primitive_pdftex("pdfinclusionerrorlevel",assign_int,int_base+pdf_inclusion_errorlevel_code,int_base);@/
-@!@:pdf_inclusion_errorlevel_}{\.{\\pdfinclusionerrorlevel} primitive@>
-primitive_pdftex("pdfgamma",assign_int,int_base+pdf_gamma_code,int_base);@/
-@!@:pdf_gamma_}{\.{\\pdfgamma} primitive@>
-primitive_pdftex("pdfimagegamma",assign_int,int_base+pdf_image_gamma_code,int_base);@/
-@!@:pdf_image_gamma_}{\.{\\pdfimagegamma} primitive@>
-primitive_pdftex("pdfimagehicolor",assign_int,int_base+pdf_image_hicolor_code,int_base);@/
-@!@:pdf_image_hicolor_}{\.{\\pdfimagehicolor} primitive@>
-primitive_pdftex("pdfimageapplygamma",assign_int,int_base+pdf_image_apply_gamma_code,int_base);@/
-@!@:pdf_image_apply_gamma_}{\.{\\pdfimageapplygamma} primitive@>
-primitive_pdftex("pdfadjustspacing",assign_int,int_base+pdf_adjust_spacing_code,int_base);@/
-@!@:pdf_adjust_spacing_}{\.{\\pdfadjustspacing} primitive@>
-primitive_pdftex("pdfprotrudechars",assign_int,int_base+pdf_protrude_chars_code,int_base);@/
-@!@:pdf_protrude_chars_}{\.{\\pdfprotrudechars} primitive@>
-primitive_pdftex("pdftracingfonts",assign_int,int_base+pdf_tracing_fonts_code,int_base);@/
-@!@:pdf_tracing_fonts_}{\.{\\pdftracingfonts} primitive@>
-primitive_pdftex("pdfgentounicode",assign_int,int_base+pdf_gen_tounicode_code,int_base);@/
-@!@:pdf_gen_tounicode_}{\.{\\pdfgentounicode} primitive@>
-primitive_pdftex("pdfdraftmode",assign_int,int_base+pdf_draftmode_code,int_base);@/
-@!@:pdf_draftmode_}{\.{\\pdfdraftmode} primitive@>
-primitive_pdftex("pdfinclusioncopyfonts",assign_int,int_base+pdf_inclusion_copy_font_code,int_base);@/
-@!@:pdf_inclusion_copy_font_}{\.{\\pdfinclusioncopyfonts} primitive@>
-primitive_pdftex("pdfreplacefont",assign_int,int_base+pdf_replace_font_code,int_base);@/
-@!@:pdf_replace_font_}{\.{\\pdfreplacefont} primitive@>
-
-@ The integer parameters should really be initialized by a macro package;
-the following initialization does the minimum to keep \TeX\ from
-complete failure.
-@^null delimiter@>
-
-@<Initialize table entries...@>=
-for k:=int_base to attribute_base-1 do eqtb[k].int:=0;
-for k:=attribute_base to del_code_base-1 do eqtb[k].int:=UNUSED_ATTRIBUTE;
-mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25;
-escape_char:="\"; end_line_char:=carriage_return;
-eqtb[int_base+level_local_dir_code].int:=level_one;
-set_del_code(".",tex_mathcode,0,0,0,0,level_one); {this null delimiter is used in error recovery}
-ex_hyphen_char:="-";
-output_box:=255;
-
-@ The following procedure, which is called just before \TeX\ initializes its
-input and output, establishes the initial values of the date and time.
-@^system dependencies@>
-Since standard \PASCAL\ cannot provide such information, something special
-is needed. The program here simply specifies July 4, 1776, at noon; but
-users probably want a better approximation to the truth.
-
-@p procedure fix_date_and_time;
-begin time:=12*60; {minutes since midnight}
-day:=4; {fourth day of the month}
-month:=7; {seventh month of the year}
-year:=1776; {Anno Domini}
-end;
-
-@ @<Show equivalent |n|, in region 5@>=
-begin if n<count_base then begin print_param(n-int_base);
- print_char("="); print_int(eqtb[n].int);
- end
-else if n<attribute_base then
- begin print_esc("count"); print_int(n-count_base);
- print_char("="); print_int(eqtb[n].int);
- end
-else if n<del_code_base then
- begin print_esc("attribute"); print_int(n-attribute_base);
- print_char("="); print_int(eqtb[n].int);
- end;
-end
-
-@ @<Set variable |c| to the current escape character@>=c:=escape_char
-
-@ @<Character |s| is the current new-line character@>=s=new_line_char
-
-@ \TeX\ is occasionally supposed to print diagnostic information that
-goes only into the transcript file, unless |tracing_online| is positive.
-Here are two routines that adjust the destination of print commands:
-
-@p procedure begin_diagnostic; {prepare to do some tracing}
-begin global_old_setting:=selector;
-if (tracing_online<=0)and(selector=term_and_log) then
- begin decr(selector);
- if history=spotless then history:=warning_issued;
- end;
-end;
-@#
-procedure end_diagnostic(@!blank_line:boolean);
- {restore proper conditions after tracing}
-begin print_nl("");
-if blank_line then print_ln;
-selector:=global_old_setting;
-end;
-
-@ Of course we had better declare another global variable, if the previous
-routines are going to work.
-
-@<Glob...@>=
-@!global_old_setting:0..max_selector;
-
-@ The final region of |eqtb| contains the dimension parameters defined
-here, and the |number_regs| \.{\\dimen} registers.
-
-@d par_indent_code=0 {indentation of paragraphs}
-@d math_surround_code=1 {space around math in text}
-@d line_skip_limit_code=2 {threshold for |line_skip| instead of |baseline_skip|}
-@d hsize_code=3 {line width in horizontal mode}
-@d vsize_code=4 {page height in vertical mode}
-@d max_depth_code=5 {maximum depth of boxes on main pages}
-@d split_max_depth_code=6 {maximum depth of boxes on split pages}
-@d box_max_depth_code=7 {maximum depth of explicit vboxes}
-@d hfuzz_code=8 {tolerance for overfull hbox messages}
-@d vfuzz_code=9 {tolerance for overfull vbox messages}
-@d delimiter_shortfall_code=10 {maximum amount uncovered by variable delimiters}
-@d null_delimiter_space_code=11 {blank space in null delimiters}
-@d script_space_code=12 {extra space after subscript or superscript}
-@d pre_display_size_code=13 {length of text preceding a display}
-@d display_width_code=14 {length of line for displayed equation}
-@d display_indent_code=15 {indentation of line for displayed equation}
-@d overfull_rule_code=16 {width of rule that identifies overfull hboxes}
-@d hang_indent_code=17 {amount of hanging indentation}
-@d h_offset_code=18 {amount of horizontal offset when shipping pages out}
-@d v_offset_code=19 {amount of vertical offset when shipping pages out}
-@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking}
-@d page_left_offset_code=21
-@d page_top_offset_code=22
-@d page_right_offset_code=23
-@d page_bottom_offset_code=24
-@d pdftex_first_dimen_code = 25 {first number defined in this section}
-@d pdf_h_origin_code = pdftex_first_dimen_code + 0 {horigin of the PDF output}
-@d pdf_v_origin_code = pdftex_first_dimen_code + 1 {vorigin of the PDF output}
-@d page_width_code = pdftex_first_dimen_code + 2 {page width of the PDF output}
-@d page_height_code = pdftex_first_dimen_code + 3 {page height of the PDF output}
-@d pdf_link_margin_code = pdftex_first_dimen_code + 4 {link margin in the PDF output}
-@d pdf_dest_margin_code = pdftex_first_dimen_code + 5 {dest margin in the PDF output}
-@d pdf_thread_margin_code = pdftex_first_dimen_code + 6 {thread margin in the PDF output}
-@d pdf_first_line_height_code = pdftex_first_dimen_code + 7
-@d pdf_last_line_depth_code = pdftex_first_dimen_code + 8
-@d pdf_each_line_height_code = pdftex_first_dimen_code + 9
-@d pdf_each_line_depth_code = pdftex_first_dimen_code + 10
-@d pdf_ignored_dimen_code = pdftex_first_dimen_code + 11
-@d pdf_px_dimen_code = pdftex_first_dimen_code + 12
-@d pdftex_last_dimen_code = pdftex_first_dimen_code + 12 {last number defined in this section}
-@d dimen_pars = pdftex_last_dimen_code + 1 {total number of dimension parameters}
-@d scaled_base=dimen_base+dimen_pars
- {table of |number_regs| user-defined \.{\\dimen} registers}
-@d eqtb_size=scaled_base+biggest_reg {largest subscript of |eqtb|}
-@#
-@d dimen(#)==eqtb[scaled_base+#].sc
-@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity}
-@d par_indent==dimen_par(par_indent_code)
-@d math_surround==dimen_par(math_surround_code)
-@d line_skip_limit==dimen_par(line_skip_limit_code)
-@d hsize==dimen_par(hsize_code)
-@d vsize==dimen_par(vsize_code)
-@d max_depth==dimen_par(max_depth_code)
-@d split_max_depth==dimen_par(split_max_depth_code)
-@d box_max_depth==dimen_par(box_max_depth_code)
-@d hfuzz==dimen_par(hfuzz_code)
-@d vfuzz==dimen_par(vfuzz_code)
-@d delimiter_shortfall==dimen_par(delimiter_shortfall_code)
-@d null_delimiter_space==dimen_par(null_delimiter_space_code)
-@d script_space==dimen_par(script_space_code)
-@d pre_display_size==dimen_par(pre_display_size_code)
-@d display_width==dimen_par(display_width_code)
-@d display_indent==dimen_par(display_indent_code)
-@d overfull_rule==dimen_par(overfull_rule_code)
-@d hang_indent==dimen_par(hang_indent_code)
-@d h_offset==dimen_par(h_offset_code)
-@d v_offset==dimen_par(v_offset_code)
-@d emergency_stretch==dimen_par(emergency_stretch_code)
-@d page_left_offset==dimen_par(page_left_offset_code)
-@d page_top_offset==dimen_par(page_top_offset_code)
-@d page_right_offset==dimen_par(page_right_offset_code)
-@d page_bottom_offset==dimen_par(page_bottom_offset_code)
-@d pdf_h_origin == dimen_par(pdf_h_origin_code)
-@d pdf_v_origin == dimen_par(pdf_v_origin_code)
-@d page_width == dimen_par(page_width_code)
-@d page_height == dimen_par(page_height_code)
-@d pdf_link_margin == dimen_par(pdf_link_margin_code)
-@d pdf_dest_margin == dimen_par(pdf_dest_margin_code)
-@d pdf_thread_margin == dimen_par(pdf_thread_margin_code)
-@d pdf_first_line_height == dimen_par(pdf_first_line_height_code)
-@d pdf_last_line_depth == dimen_par(pdf_last_line_depth_code)
-@d pdf_each_line_height == dimen_par(pdf_each_line_height_code)
-@d pdf_each_line_depth == dimen_par(pdf_each_line_depth_code)
-@d pdf_ignored_dimen == dimen_par(pdf_ignored_dimen_code)
-@d pdf_px_dimen == dimen_par(pdf_px_dimen_code)
-
-@p procedure print_length_param(@!n:integer);
-begin case n of
-par_indent_code:print_esc("parindent");
-math_surround_code:print_esc("mathsurround");
-line_skip_limit_code:print_esc("lineskiplimit");
-hsize_code:print_esc("hsize");
-vsize_code:print_esc("vsize");
-max_depth_code:print_esc("maxdepth");
-split_max_depth_code:print_esc("splitmaxdepth");
-box_max_depth_code:print_esc("boxmaxdepth");
-hfuzz_code:print_esc("hfuzz");
-vfuzz_code:print_esc("vfuzz");
-delimiter_shortfall_code:print_esc("delimitershortfall");
-null_delimiter_space_code:print_esc("nulldelimiterspace");
-script_space_code:print_esc("scriptspace");
-pre_display_size_code:print_esc("predisplaysize");
-display_width_code:print_esc("displaywidth");
-display_indent_code:print_esc("displayindent");
-overfull_rule_code:print_esc("overfullrule");
-hang_indent_code:print_esc("hangindent");
-h_offset_code:print_esc("hoffset");
-v_offset_code:print_esc("voffset");
-emergency_stretch_code:print_esc("emergencystretch");
-page_left_offset_code: print_esc("pageleftoffset");
-page_top_offset_code: print_esc("pagetopoffset");
-page_right_offset_code: print_esc("pagerightoffset");
-page_bottom_offset_code:print_esc("pagebottomoffset");
-pdf_h_origin_code: print_esc("pdfhorigin");
-pdf_v_origin_code: print_esc("pdfvorigin");
-page_width_code: print_esc("pagewidth");
-page_height_code: print_esc("pageheight");
-pdf_link_margin_code: print_esc("pdflinkmargin");
-pdf_dest_margin_code: print_esc("pdfdestmargin");
-pdf_thread_margin_code: print_esc("pdfthreadmargin");
-pdf_first_line_height_code: print_esc("pdffirstlineheight");
-pdf_last_line_depth_code: print_esc("pdflastlinedepth");
-pdf_each_line_height_code: print_esc("pdfeachlineheight");
-pdf_each_line_depth_code: print_esc("pdfeachlinedepth");
-pdf_ignored_dimen_code: print_esc("pdfignoreddimen");
-pdf_px_dimen_code: print_esc("pdfpxdimen");
-othercases print("[unknown dimen parameter!]")
-endcases;
-end;
-
-@ @<Put each...@>=
-primitive_tex("parindent",assign_dimen,dimen_base+par_indent_code,dimen_base);@/
-@!@:par_indent_}{\.{\\parindent} primitive@>
-primitive_tex("mathsurround",assign_dimen,dimen_base+math_surround_code,dimen_base);@/
-@!@:math_surround_}{\.{\\mathsurround} primitive@>
-primitive_tex("lineskiplimit",assign_dimen,dimen_base+line_skip_limit_code,dimen_base);@/
-@!@:line_skip_limit_}{\.{\\lineskiplimit} primitive@>
-primitive_tex("hsize",assign_dimen,dimen_base+hsize_code,dimen_base);@/
-@!@:hsize_}{\.{\\hsize} primitive@>
-primitive_tex("vsize",assign_dimen,dimen_base+vsize_code,dimen_base);@/
-@!@:vsize_}{\.{\\vsize} primitive@>
-primitive_tex("maxdepth",assign_dimen,dimen_base+max_depth_code,dimen_base);@/
-@!@:max_depth_}{\.{\\maxdepth} primitive@>
-primitive_tex("splitmaxdepth",assign_dimen,dimen_base+split_max_depth_code,dimen_base);@/
-@!@:split_max_depth_}{\.{\\splitmaxdepth} primitive@>
-primitive_tex("boxmaxdepth",assign_dimen,dimen_base+box_max_depth_code,dimen_base);@/
-@!@:box_max_depth_}{\.{\\boxmaxdepth} primitive@>
-primitive_tex("hfuzz",assign_dimen,dimen_base+hfuzz_code,dimen_base);@/
-@!@:hfuzz_}{\.{\\hfuzz} primitive@>
-primitive_tex("vfuzz",assign_dimen,dimen_base+vfuzz_code,dimen_base);@/
-@!@:vfuzz_}{\.{\\vfuzz} primitive@>
-primitive_tex("delimitershortfall", assign_dimen,dimen_base+delimiter_shortfall_code,dimen_base);@/
-@!@:delimiter_shortfall_}{\.{\\delimitershortfall} primitive@>
-primitive_tex("nulldelimiterspace", assign_dimen,dimen_base+null_delimiter_space_code,dimen_base);@/
-@!@:null_delimiter_space_}{\.{\\nulldelimiterspace} primitive@>
-primitive_tex("scriptspace",assign_dimen,dimen_base+script_space_code,dimen_base);@/
-@!@:script_space_}{\.{\\scriptspace} primitive@>
-primitive_tex("predisplaysize",assign_dimen,dimen_base+pre_display_size_code,dimen_base);@/
-@!@:pre_display_size_}{\.{\\predisplaysize} primitive@>
-primitive_tex("displaywidth",assign_dimen,dimen_base+display_width_code,dimen_base);@/
-@!@:display_width_}{\.{\\displaywidth} primitive@>
-primitive_tex("displayindent",assign_dimen,dimen_base+display_indent_code,dimen_base);@/
-@!@:display_indent_}{\.{\\displayindent} primitive@>
-primitive_tex("overfullrule",assign_dimen,dimen_base+overfull_rule_code,dimen_base);@/
-@!@:overfull_rule_}{\.{\\overfullrule} primitive@>
-primitive_tex("hangindent",assign_dimen,dimen_base+hang_indent_code,dimen_base);@/
-@!@:hang_indent_}{\.{\\hangindent} primitive@>
-primitive_tex("hoffset",assign_dimen,dimen_base+h_offset_code,dimen_base);@/
-@!@:h_offset_}{\.{\\hoffset} primitive@>
-primitive_tex("voffset",assign_dimen,dimen_base+v_offset_code,dimen_base);@/
-@!@:v_offset_}{\.{\\voffset} primitive@>
-primitive_tex("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code,dimen_base);@/
-@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@>
-primitive_pdftex("pdfhorigin",assign_dimen,dimen_base+pdf_h_origin_code,dimen_base);@/
-@!@:pdf_h_origin_}{\.{\\pdfhorigin} primitive@>
-primitive_pdftex("pdfvorigin",assign_dimen,dimen_base+pdf_v_origin_code,dimen_base);@/
-@!@:pdf_v_origin_}{\.{\\pdfvorigin} primitive@>
-@#
-primitive_omega("pagewidth",assign_dimen,dimen_base+page_width_code,dimen_base);@/
-primitive_pdftex("pdfpagewidth",assign_dimen,dimen_base+page_width_code,dimen_base);@/
-@!@:page_width_}{\.{\\pdfpagewidth} primitive@>
-primitive_omega("pageheight",assign_dimen,dimen_base+page_height_code,dimen_base);@/
-primitive_pdftex("pdfpageheight",assign_dimen,dimen_base+page_height_code,dimen_base);@/
-@!@:page_height_}{\.{\\pdfpageheight} primitive@>
-@#
-primitive_pdftex("pdflinkmargin",assign_dimen,dimen_base+pdf_link_margin_code,dimen_base);@/
-@!@:pdf_link_margin_}{\.{\\pdflinkmargin} primitive@>
-primitive_pdftex("pdfdestmargin",assign_dimen,dimen_base+pdf_dest_margin_code,dimen_base);@/
-@!@:pdf_dest_margin_}{\.{\\pdfdestmargin} primitive@>
-primitive_pdftex("pdfthreadmargin",assign_dimen,dimen_base+pdf_thread_margin_code,dimen_base);@/
-@!@:pdf_thread_margin_}{\.{\\pdfthreadmargin} primitive@>
-primitive_pdftex("pdffirstlineheight",assign_dimen,dimen_base+pdf_first_line_height_code,dimen_base);@/
-@!@:pdf_first_line_height_}{\.{\\pdffirstlineheight} primitive@>
-primitive_pdftex("pdflastlinedepth",assign_dimen,dimen_base+pdf_last_line_depth_code,dimen_base);@/
-@!@:pdf_last_line_depth_}{\.{\\pdflastlinedepth} primitive@>
-primitive_pdftex("pdfeachlineheight",assign_dimen,dimen_base+pdf_each_line_height_code,dimen_base);@/
-@!@:pdf_each_line_height_}{\.{\\pdfeachlineheight} primitive@>
-primitive_pdftex("pdfeachlinedepth",assign_dimen,dimen_base+pdf_each_line_depth_code,dimen_base);@/
-@!@:pdf_each_line_depth_}{\.{\\pdfeachlinedepth} primitive@>
-primitive_pdftex("pdfignoreddimen",assign_dimen,dimen_base+pdf_ignored_dimen_code,dimen_base);@/
-@!@:pdf_ignored_dimen_}{\.{\\pdfignoreddimen} primitive@>
-primitive_pdftex("pdfpxdimen",assign_dimen,dimen_base+pdf_px_dimen_code,dimen_base);@/
-@!@:pdf_px_dimen_}{\.{\\pdfpxdimen} primitive@>
-
-@ @<Initialize table entries...@>=
-for k:=dimen_base to eqtb_size do eqtb[k].sc:=0;
-page_left_offset := one_inch;
-page_top_offset := one_inch;
-page_right_offset := one_inch;
-page_bottom_offset := one_inch;
-
-@ @<Initialize table entries...@>=
-pdf_ignored_dimen := ignore_depth;
-pdf_each_line_height := pdf_ignored_dimen;
-pdf_each_line_depth := pdf_ignored_dimen;
-pdf_first_line_height := pdf_ignored_dimen;
-pdf_last_line_depth := pdf_ignored_dimen;
-
-
-@ @<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
-@!stat procedure show_eqtb(@!n:pointer);
-begin if n<null_cs 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[null_cs..eqtb_size] of memory_word;
-@!xeq_level:array[null_cs..eqtb_size] of quarterword;
-
-@ @<Set init...@>=
-for k:=int_base to eqtb_size do xeq_level[k]:=level_one;
-
-@* \[18] The hash table.
-Control sequences are stored and retrieved by means of a fairly standard hash
-table algorithm called the method of ``coalescing lists'' (cf.\ Algorithm 6.4C
-in {\sl The Art of Computer Programming\/}). Once a control sequence enters the
-table, it is never removed, because there are complicated situations
-involving \.{\\gdef} where the removal of a control sequence at the end of
-a group would be a mistake preventable only by the introduction of a
-complicated reference-count mechanism.
-
-The actual sequence of letters forming a control sequence identifier is
-stored in the |str_pool| array together with all the other strings. An
-auxiliary array |hash| consists of items with two halfword fields per
-word. The first of these, called |next(p)|, points to the next identifier
-belonging to the same coalesced list as the identifier corresponding to~|p|;
-and the other, called |text(p)|, points to the |str_start| entry for
-|p|'s identifier. If position~|p| of the hash table is empty, we have
-|text(p)=0|; if position |p| is either empty or the end of a coalesced
-hash list, we have |next(p)=0|. An auxiliary pointer variable called
-|hash_used| is maintained in such a way that all locations |p>=hash_used|
-are nonempty. The global variable |cs_count| tells how many multiletter
-control sequences have been defined, if statistics are being kept.
-
-A global boolean variable called |no_new_control_sequence| is set to
-|true| during the time that new hash table entries are forbidden.
-
-@d next(#) == hash[#].lh {link for coalesced lists}
-@d text(#) == hash[#].rh {string number for control sequence name}
-@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
-@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name}
-@d ocp_id_text(#) == text(ocp_id_base+#) {a frozen ocp identifier's name}
-@d ocp_list_id_text(#) == text(ocp_list_id_base+#)
- {a frozen ocp list identifier's name}
-
-@<Glob...@>=
-@!hash: array[hash_base..undefined_control_sequence-1] of two_halves;
- {the hash table}
-@!hash_used:pointer; {allocation pointer for |hash|}
-@!no_new_control_sequence:boolean; {are new identifiers legal?}
-@!cs_count:integer; {total number of known identifiers}
-
-@ The extra set of functions make sure we can query the
-primitive meanings of thing s from C code
-
-@p
-function get_eq_type(p:integer):quarterword;
-begin
- get_eq_type := eq_type(p);
-end;
-function get_eq_level(p:integer):quarterword;
-begin
- get_eq_level := eq_level(p);
-end;
-function is_undefined_cs(cs:integer):boolean;
-begin
- is_undefined_cs := (cs=undefined_cs);
-end;
-function get_equiv(p:integer):halfword;
-begin
- get_equiv := equiv(p);
-end;
-function get_cs_text(cs:integer):str_number;
-begin if cs=null_cs then get_cs_text := "\csname\endcsname"
- else if (text(cs)<0)or(text(cs)>=str_ptr) then get_cs_text := ""
- else get_cs_text := text(cs);
-end;
-function get_max_command:integer;
-begin
- get_max_command := max_command;
-end;
-function get_count_base:halfword;
-begin
- get_count_base := count_base;
-end;
-function get_skip_base:halfword;
-begin
- get_skip_base := skip_base;
-end;
-function get_mu_skip_base:halfword;
-begin
- get_mu_skip_base := mu_skip_base;
-end;
-function get_attribute_base:halfword;
-begin
- get_attribute_base := attribute_base;
-end;
-function get_scaled_base:halfword;
-begin
- get_scaled_base := scaled_base;
-end;
-function get_int_base:halfword;
-begin
- get_int_base := int_base;
-end;
-function get_dimen_base:halfword;
-begin
- get_dimen_base := dimen_base;
-end;
-function get_toks_base:halfword;
-begin
- get_toks_base := toks_base;
-end;
-function get_del_code_base:halfword;
-begin
- get_del_code_base := del_code_base;
-end;
-function get_every_eof:halfword;
-begin
- get_every_eof := every_eof;
-end;
-function get_suppress_fontnotfound_error:boolean;
-begin
- get_suppress_fontnotfound_error := suppress_fontnotfound_error;
-end;
-function get_pdf_image_resolution:integer;
-begin
- get_pdf_image_resolution := pdf_image_resolution;
-end;
-function get_pdf_minor_version:integer;
-begin
- get_pdf_minor_version := pdf_minor_version;
-end;
-function get_pdf_inclusion_errorlevel:integer;
-begin
- get_pdf_inclusion_errorlevel := pdf_inclusion_errorlevel;
-end;
-
-@ @<Set init...@>=
-no_new_control_sequence:=true; {new identifiers are usually forbidden}
-init_primitives;
-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...@>=
-ini_init_primitives;
-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";
-
-
-@ The procedure |print_cs| prints the name of a control sequence, given
-a pointer to its address in |eqtb|. A space is printed after the name
-unless it is a single nonletter or an active character. This procedure
-might be invoked with invalid data, so it is ``extra robust.'' The
-individual characters must be printed one at a time using |print|, since
-they may be unprintable.
-
-@d single_letter(#)==(length(#)=1)or
- ((length(#)=4)and(str_pool[str_start_macro(#)]>=@"F0))or
- ((length(#)=3)and(str_pool[str_start_macro(#)]>=@"E0))or
- ((length(#)=2)and(str_pool[str_start_macro(#)]>=@"C0))
-
-@d is_active_csname(#)==((length(text(#))>3)and
- (str_pool[str_start_macro(text(#))]=@"EF)and
- (str_pool[str_start_macro(text(#))+1]=@"BF)and
- (str_pool[str_start_macro(text(#))+2]=@"BF))
-
-@d active_csname_value(#)==pool_to_unichar(str_start_macro(text(#))+3)
-
-@<Basic printing...@>=
-procedure print_cs(@!p:integer); {prints a purported control sequence}
-begin if p<hash_base then { nullcs}
- if p=null_cs then
- begin print_esc("csname"); print_esc("endcsname");
- end
- else print_esc("IMPOSSIBLE.")
-@.IMPOSSIBLE@>
-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 is_active_csname(p) then
- print(active_csname_value(p))
- else begin
- print_esc(text(p));
- if single_letter(text(p)) then begin
- if get_cat_code(cat_code_table,pool_to_unichar(str_start_macro(text(p))))=letter then
- print_char(" ")
- else
- do_nothing;
- end
- else
- print_char(" ");
- end
- end;
-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=null_cs then begin
- print_esc("csname"); print_esc("endcsname");
- end
-else begin
- if is_active_csname(p) then
- print(active_csname_value(p))
- else
- print_esc(text(p));
- end;
-end;
-
-
-@ 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_tex(" ",ex_space,0,0);@/
-@!@:Single-character primitives /}{\quad\.{\\\ }@>
-primitive_tex("/",ital_corr,0,0);@/
-@!@:Single-character primitives /}{\quad\.{\\/}@>
-primitive_tex("accent",accent,0,0);@/
-@!@:accent_}{\.{\\accent} primitive@>
-primitive_tex("advance",advance,0,0);@/
-@!@:advance_}{\.{\\advance} primitive@>
-primitive_tex("afterassignment",after_assignment,0,0);@/
-@!@:after_assignment_}{\.{\\afterassignment} primitive@>
-primitive_tex("aftergroup",after_group,0,0);@/
-@!@:after_group_}{\.{\\aftergroup} primitive@>
-primitive_tex("begingroup",begin_group,0,0);@/
-@!@:begin_group_}{\.{\\begingroup} primitive@>
-primitive_tex("char",char_num,0,0);@/
-@!@:char_}{\.{\\char} primitive@>
-primitive_tex("csname",cs_name,0,0);@/
-@!@:cs_name_}{\.{\\csname} primitive@>
-primitive_tex("delimiter",delim_num,0,0);@/
-@!@:delimiter_}{\.{\\delimiter} primitive@>
-primitive_omega("odelimiter",delim_num,1,0);@/
-@!@:odelimiter_}{\.{\\odelimiter} primitive@>
-primitive_luatex("Udelimiter",delim_num,2,0);@/
-@!@:odelimiter_}{\.{\\Udelimiter} primitive@>
-primitive_tex("divide",divide,0,0);@/
-@!@:divide_}{\.{\\divide} primitive@>
-primitive_tex("endcsname",end_cs_name,0,0);@/
-@!@:end_cs_name_}{\.{\\endcsname} primitive@>
-primitive_tex("endgroup",end_group,0,0);
-@!@:end_group_}{\.{\\endgroup} primitive@>
-text(frozen_end_group):="endgroup"; eqtb[frozen_end_group]:=eqtb[cur_val];@/
-primitive_tex("expandafter",expand_after,0,0);@/
-@!@:expand_after_}{\.{\\expandafter} primitive@>
-primitive_tex("font",def_font,0,0);@/
-@!@:font_}{\.{\\font} primitive@>
-primitive_pdftex("letterspacefont",letterspace_font,0,0);@/
-@!@:letterspace_font_}{\.{\\letterspacefont} primitive@>
-primitive_pdftex("pdfcopyfont",pdf_copy_font,0,0);@/
-@!@:pdf_copy_font_}{\.{\\pdfcopyfont} primitive@>
-primitive_tex("fontdimen",assign_font_dimen,0,0);@/
-@!@:font_dimen_}{\.{\\fontdimen} primitive@>
-primitive_tex("halign",halign,0,0);@/
-@!@:halign_}{\.{\\halign} primitive@>
-primitive_tex("hrule",hrule,0,0);@/
-@!@:hrule_}{\.{\\hrule} primitive@>
-primitive_tex("ignorespaces",ignore_spaces,0,0);@/
-@!@:ignore_spaces_}{\.{\\ignorespaces} primitive@>
-primitive_tex("insert",insert,0,0);@/
-@!@:insert_}{\.{\\insert} primitive@>
-primitive_omega("leftghost",char_ghost,0,0);@/
-@!@:leftghost_}{\.{\\leftghost} primitive@>
-primitive_tex("mark",mark,0,0);@/
-@!@:mark_}{\.{\\mark} primitive@>
-primitive_tex("mathaccent",math_accent,0,0);@/
-@!@:math_accent_}{\.{\\mathaccent} primitive@>
-primitive_omega("omathaccent",math_accent,1,0);@/
-@!@:math_accent_}{\.{\\omathaccent} primitive@>
-primitive_luatex("Umathaccent",math_accent,2,0);@/
-@!@:math_accent_}{\.{\\Umathaccent} primitive@>
-primitive_luatex("Umathbotaccent",math_accent,3,0);@/
-@!@:math_accent_}{\.{\\Umathbotaccent} primitive@>
-primitive_luatex("Umathaccents",math_accent,4,0);@/
-@!@:math_accent_}{\.{\\Umathaccents} primitive@>
-primitive_tex("mathchar",math_char_num,0,0);@/
-@!@:math_char_}{\.{\\mathchar} primitive@>
-primitive_omega("omathchar",math_char_num,1,0);@/
-@!@:math_char_}{\.{\\omathchar} primitive@>
-primitive_luatex("Umathchar",math_char_num,2,0);@/
-@!@:math_char_}{\.{\\Umathchar} primitive@>
-primitive_luatex("Umathcharnum",math_char_num,3,0);@/
-@!@:math_char_}{\.{\\Umathcharnum} primitive@>
-primitive_tex("mathchoice",math_choice,0,0);@/
-@!@:math_choice_}{\.{\\mathchoice} primitive@>
-primitive_luatex("Ustack",math_choice,1,0);@/
-@!@:math_choice_}{\.{\\Ustack} primitive@>
-primitive_tex("multiply",multiply,0,0);@/
-@!@:multiply_}{\.{\\multiply} primitive@>
-primitive_tex("noalign",no_align,0,0);@/
-@!@:no_align_}{\.{\\noalign} primitive@>
-primitive_tex("noboundary",no_boundary,0,0);@/
-@!@:no_boundary_}{\.{\\noboundary} primitive@>
-primitive_tex("noexpand",no_expand,0,0);@/
-@!@:no_expand_}{\.{\\noexpand} primitive@>
-primitive_luatex("primitive",no_expand,1,0);@/
-@!@:primitive_}{\.{\\primitive} primitive@>
-primitive_pdftex("pdfprimitive",no_expand,1,0);@/
-@!@:pdfprimitive_}{\.{\\pdfprimitive} primitive@>
-primitive_tex("nonscript",non_script,0,0);@/
-@!@:non_script_}{\.{\\nonscript} primitive@>
-primitive_tex("omit",omit,0,0);@/
-@!@:omit_}{\.{\\omit} primitive@>
-primitive_tex("parshape",set_tex_shape,par_shape_loc,par_shape_loc);@/
-@!@:par_shape_}{\.{\\parshape} primitive@>
-primitive_tex("penalty",break_penalty,0,0);@/
-@!@:penalty_}{\.{\\penalty} primitive@>
-primitive_tex("prevgraf",set_prev_graf,0,0);@/
-@!@:prev_graf_}{\.{\\prevgraf} primitive@>
-primitive_tex("radical",radical,0,0);@/
-@!@:radical_}{\.{\\radical} primitive@>
-primitive_omega("oradical",radical,1,0);@/
-@!@:radical_}{\.{\\oradical} primitive@>
-primitive_luatex("Uradical",radical,2,0);@/
-@!@:radical_}{\.{\\Uradical} primitive@>
-primitive_luatex("Uroot",radical,3,0);@/
-@!@:radical_}{\.{\\Uroot} primitive@>
-primitive_luatex("Uunderdelimiter",radical,4,0);@/
-@!@:radical_}{\.{\\Uunderdelimiter} primitive@>
-primitive_luatex("Uoverdelimiter",radical,5,0);@/
-@!@:radical_}{\.{\\Uoverdelimiter} primitive@>
-primitive_luatex("Udelimiterunder",radical,6,0);@/
-@!@:radical_}{\.{\\Udelimiterunder} primitive@>
-primitive_luatex("Udelimiterover",radical,7,0);@/
-@!@:radical_}{\.{\\Udelimiterover} primitive@>
-primitive_tex("read",read_to_cs,0,0);@/
-@!@:read_}{\.{\\read} primitive@>
-primitive_tex("relax",relax,too_big_char,too_big_char);
-@!@:relax_}{\.{\\relax} primitive@>
-text(frozen_relax):="relax"; eqtb[frozen_relax]:=eqtb[cur_val];@/
-primitive_omega("rightghost",char_ghost,1,0);@/
-@!@:rightghost_}{\.{\\rightghost} primitive@>
-primitive_tex("setbox",set_box,0,0);@/
-@!@:set_box_}{\.{\\setbox} primitive@>
-primitive_tex("the",the,0,0);@/
-@!@:the_}{\.{\\the} primitive@>
-primitive_tex("toks",toks_register,0,0);@/
-@!@:toks_}{\.{\\toks} primitive@>
-primitive_tex("vadjust",vadjust,0,0);@/
-@!@:vadjust_}{\.{\\vadjust} primitive@>
-primitive_tex("valign",valign,0,0);@/
-@!@:valign_}{\.{\\valign} primitive@>
-primitive_tex("vcenter",vcenter,0,0);@/
-@!@:vcenter_}{\.{\\vcenter} primitive@>
-primitive_tex("vrule",vrule,0,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.
-
-@ We will deal with the other primitives later, at some point in the program
-where their |eq_type| and |equiv| values are more meaningful. For example,
-the primitives for math mode will be loaded when we consider the routines
-that deal with formulas. It is easy to find where each particular
-primitive was treated by looking in the index at the end; for example, the
-section where |"radical"| entered |eqtb| is listed under `\.{\\radical}
-primitive'. (Primitives consisting of a single nonalphabetic character,
-@!like `\.{\\/}', are listed under `Single-character primitives'.)
-@!@^Single-character primitives@>
-
-
-@* \[19] Saving and restoring equivalents.
-The nested structure provided by `$\.{\char'173}\ldots\.{\char'175}$' groups
-in \TeX\ means that |eqtb| entries valid in outer groups should be saved
-and restored later if they are overridden inside the braces. When a new |eqtb|
-value is being assigned, the program therefore checks to see if the previous
-entry belongs to an outer level. In such a case, the old value is placed
-on the |save_stack| just before the new value enters |eqtb|. At the
-end of a grouping level, i.e., when the right brace is sensed, the
-|save_stack| is used to restore the outer values, and the inner ones are
-destroyed.
-
-Entries on the |save_stack| are of type |memory_word|. The top item on
-this stack is |save_stack[p]|, where |p=save_ptr-1|; it contains three
-fields called |save_type|, |save_level|, and |save_index|, and it is
-interpreted in one of four ways:
-
-\yskip\hangg 1) If |save_type(p)=restore_old_value|, then
-|save_index(p)| is a location in |eqtb| whose current value should
-be destroyed at the end of the current group and replaced by |save_stack[p-1]|.
-Furthermore if |save_index(p)>=int_base|, then |save_level(p)|
-should replace the corresponding entry in |xeq_level|.
-
-\yskip\hangg 2) If |save_type(p)=restore_zero|, then |save_index(p)|
-is a location in |eqtb| whose current value should be destroyed at the end
-of the current group, when it should be
-replaced by the current value of |eqtb[undefined_control_sequence]|.
-
-\yskip\hangg 3) If |save_type(p)=insert_token|, then |save_index(p)|
-is a token that should be inserted into \TeX's input when the current
-group ends.
-
-\yskip\hangg 4) If |save_type(p)=level_boundary|, then |save_level(p)|
-is a code explaining what kind of group we were previously in, and
-|save_index(p)| points to the level boundary word at the bottom of
-the entries for that group.
-Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
-source line number at which the current level of grouping was entered.
-
-@d save_type(#)==save_stack[#].hh.b0 {classifies a |save_stack| entry}
-@d save_level(#)==save_stack[#].hh.b1
- {saved level for regions 5 and 6, or group code}
-@d save_index(#)==save_stack[#].hh.rh
- {|eqtb| location or 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}
-
-@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
-
-@ Here are the group codes that are used to discriminate between different
-kinds of groups. They allow \TeX\ to decide what special actions, if any,
-should be performed when a group ends.
-\def\grp{\.{\char'173...\char'175}}
-
-Some groups are not supposed to be ended by right braces. For example,
-the `\.\$' that begins a math formula causes a |math_shift_group| to
-be started, and this should be terminated by a matching `\.\$'. Similarly,
-a group that starts with \.{\\left} should end with \.{\\right}, and
-one that starts with \.{\\begingroup} should end with \.{\\endgroup}.
-
-@d bottom_level=0 {group code for the outside world}
-@d simple_group=1 {group code for local structure only}
-@d hbox_group=2 {code for `\.{\\hbox}\grp'}
-@d adjusted_hbox_group=3 {code for `\.{\\hbox}\grp' in vertical mode}
-@d vbox_group=4 {code for `\.{\\vbox}\grp'}
-@d vtop_group=5 {code for `\.{\\vtop}\grp'}
-@d align_group=6 {code for `\.{\\halign}\grp', `\.{\\valign}\grp'}
-@d no_align_group=7 {code for `\.{\\noalign}\grp'}
-@d output_group=8 {code for output routine}
-@d math_group=9 {code for, e.g., `\.{\char'136}\grp'}
-@d disc_group=10 {code for `\.{\\discretionary}\grp\grp\grp'}
-@d insert_group=11 {code for `\.{\\insert}\grp', `\.{\\vadjust}\grp'}
-@d vcenter_group=12 {code for `\.{\\vcenter}\grp'}
-@d math_choice_group=13 {code for `\.{\\mathchoice}\grp\grp\grp\grp'}
-@d semi_simple_group=14 {code for `\.{\\begingroup...\\endgroup}'}
-@d math_shift_group=15 {code for `\.{\$...\$}'}
-@d math_left_group=16 {code for `\.{\\left...\\right}'}
-@d local_box_group=17 {code for `\.{\\localleftbox...\\localrightbox}'}
-@d max_group_code=17
-@d split_off_group=18 {box code for the top part of a \.{\\vsplit}}
-@d split_keep_group=19 {box code for the bottom part of a \.{\\vsplit}}
-@d preamble_group=20 {box code for the preamble processing in an alignment}
-@d align_set_group=21 {box code for the final item pass in an alignment}
-@d fin_row_group=22 {box code for a provisory line in an alignment}
-
-@<Types...@>=
-@!group_code=0..max_group_code; {|save_level| for a level boundary}
-
-@ The global variable |cur_group| keeps track of what sort of group we are
-currently in. Another global variable, |cur_boundary|, points to the
-topmost |level_boundary| word. And |cur_level| is the current depth of
-nesting. The routines are designed to preserve the condition that no entry
-in the |save_stack| or in |eqtb| ever has a level greater than |cur_level|.
-
-@ @<Glob...@>=
-@!save_stack : array[0..save_size] of memory_word;
-@!save_ptr : 0..save_size; {first unused entry on |save_stack|}
-@!max_save_stack:0..save_size; {maximum usage of save stack}
-@!cur_level: quarterword; {current nesting level for groups}
-@!cur_group: group_code; {current group type}
-@!cur_boundary: 0..save_size; {where the current level begins}
-
-@ At this time it might be a good idea for the reader to review the introduction
-to |eqtb| that was given above just before the long lists of parameter names.
-Recall that the ``outer level'' of the program is |level_one|, since
-undefined control sequences are assumed to be ``defined'' at |level_zero|.
-
-@<Set init...@>=
-save_ptr:=0; cur_level:=level_one; cur_group:=bottom_level; cur_boundary:=0;
-max_save_stack:=0;
-
-@ The following macro is used to test if there is room for up to eight more
-entries on |save_stack|. By making a conservative test like this, we can
-get by with testing for overflow in only a few places.
-
-@d check_full_save_stack==if save_ptr>max_save_stack then
- begin max_save_stack:=save_ptr;
- if max_save_stack>save_size-8 then overflow("save size",save_size);
-@:TeX capacity exceeded save size}{\quad save size@>
- end
-
-@ Procedure |new_save_level| is called when a group begins. The
-argument is a group identification code like `|hbox_group|'. After
-calling this routine, it is safe to put six more entries on |save_stack|.
-
-In some cases integer-valued items are placed onto the
-|save_stack| just below a |level_boundary| word, because this is a
-convenient place to keep information that is supposed to ``pop up'' just
-when the group has finished.
-For example, when `\.{\\hbox to 100pt}\grp' is being treated, the 100pt
-dimension is stored on |save_stack| just before |new_save_level| is
-called.
-
-We use the notation |saved(k)| to stand for an integer item that
-appears in location |save_ptr+k| of the save stack.
-
-@d saved(#)==save_stack[save_ptr+#].int
-
-@p procedure new_save_level(@!c:group_code); {begin a new level of grouping}
-begin check_full_save_stack;
-saved(0):=line; incr(save_ptr);
-save_type(save_ptr):=level_boundary; save_level(save_ptr):=cur_group;
-save_index(save_ptr):=cur_boundary;
-if cur_level=max_quarterword then overflow("grouping levels",
-@:TeX capacity exceeded grouping levels}{\quad grouping levels@>
- max_quarterword-min_quarterword);
- {quit if |(cur_level+1)| is too big to be stored in |eqtb|}
-cur_boundary:=save_ptr; cur_group:=c;
-@!stat if tracing_groups>0 then group_trace(false);@+tats@;@/
-incr(cur_level); incr(save_ptr);
-end;
-
-@ Just before an entry of |eqtb| is changed, the following procedure should
-be called to update the other data structures properly. It is important
-to keep in mind that reference counts in |mem| include references from
-within |save_stack|, so these counts must be handled carefully.
-@^reference counts@>
-
-@p procedure eq_destroy(@!w:memory_word); {gets ready to forget |w|}
-var q:pointer; {|equiv| field of |w|}
-begin case eq_type_field(w) of
-call,long_call,outer_call,long_outer_call: delete_token_ref(equiv_field(w));
-glue_ref: delete_glue_ref(equiv_field(w));
-shape_ref: begin q:=equiv_field(w); {we need to free a \.{\\parshape} block}
- if q<>null then flush_node(q);
- end; {such a block is |2n+1| words long, where |n=vinfo(q)|}
-box_ref: flush_node_list(equiv_field(w));
-othercases do_nothing
-endcases;
-end;
-
-@ To save a value of |eqtb[p]| that was established at level |l|, we
-can use the following subroutine.
-
-@p procedure eq_save(@!p:pointer;@!l:quarterword); {saves |eqtb[p]|}
-begin check_full_save_stack;
-if l=level_zero then save_type(save_ptr):=restore_zero
-else begin save_stack[save_ptr]:=eqtb[p]; incr(save_ptr);
- save_type(save_ptr):=restore_old_value;
- end;
-save_level(save_ptr):=l; save_index(save_ptr):=p; incr(save_ptr);
-end;
-
-@ The procedure |eq_define| defines an |eqtb| entry having specified
-|eq_type| and |equiv| fields, and saves the former value if appropriate.
-This procedure is used only for entries in the first four regions of |eqtb|,
-i.e., only for entries that have |eq_type| and |equiv| fields.
-After calling this routine, it is safe to put four more entries on
-|save_stack|, provided that there was room for four more entries before
-the call, since |eq_save| makes the necessary test.
-
-@d assign_trace(#)==@!stat if tracing_assigns>0 then restore_trace(#);
- tats
-
-@p procedure eq_define(@!p:pointer;@!t:quarterword;@!e:halfword);
- {new data for |eqtb|}
-label exit;
-begin if (eq_type(p)=t)and(equiv(p)=e) then
- begin assign_trace(p,"reassigning")@;@/
- eq_destroy(eqtb[p]); return;
- end;
-assign_trace(p,"changing")@;@/
-if eq_level(p)=cur_level then eq_destroy(eqtb[p])
-else if cur_level>level_one then eq_save(p,eq_level(p));
-eq_level(p):=cur_level; eq_type(p):=t; equiv(p):=e;
-assign_trace(p,"into")@;@/
-exit:end;
-
-@ The counterpart of |eq_define| for the remaining (fullword) positions in
-|eqtb| is called |eq_word_define|. Since |xeq_level[p]>=level_one| for all
-|p|, a `|restore_zero|' will never be used in this case.
-
-@p procedure eq_word_define(@!p:pointer;@!w:integer);
-label exit;
-begin if eqtb[p].int=w then
- begin assign_trace(p,"reassigning")@;@/
- return;
- end;
-assign_trace(p,"changing")@;@/
-if xeq_level[p]<>cur_level then
- begin eq_save(p,xeq_level[p]); xeq_level[p]:=cur_level;
- end;
-eqtb[p].int:=w;
-assign_trace(p,"into")@;@/
-exit:end;
-
-@ The |eq_define| and |eq_word_define| routines take care of local definitions.
-@^global definitions@>
-Global definitions are done in almost the same way, but there is no need
-to save old values, and the new value is associated with |level_one|.
-
-@p procedure geq_define(@!p:pointer;@!t:quarterword;@!e:halfword);
- {global |eq_define|}
-begin assign_trace(p,"globally changing")@;@/
-begin eq_destroy(eqtb[p]);
-eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
-end;
-assign_trace(p,"into")@;@/
-end;
-@#
-procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|}
-begin assign_trace(p,"globally changing")@;@/
-begin eqtb[p].int:=w; xeq_level[p]:=level_one;
-end;
-assign_trace(p,"into")@;@/
-end;
-
-@ Subroutine |save_for_after| puts a token on the stack for save-keeping.
-
-@p procedure save_for_after(@!t:halfword);
-begin if cur_level>level_one then
- begin check_full_save_stack;
- save_type(save_ptr):=insert_token; save_level(save_ptr):=level_zero;
- save_index(save_ptr):=t; incr(save_ptr);
- end;
-end;
-
-@ The |unsave| routine goes the other way, taking items off of |save_stack|.
-This routine takes care of restoration when a level ends; everything
-belonging to the topmost group is cleared off of the save stack.
-
-@p
-procedure@?back_input; forward; @t\2@>
-procedure unsave; {pops the top level off the save stack}
-label done;
-var p:pointer; {position to be restored}
-@!l:quarterword; {saved level, if in fullword regions of |eqtb|}
-@!t:halfword; {saved value of |cur_tok|}
-@!a:boolean; {have we already processed an \.{\\aftergroup} ?}
-begin a:=false; l:=level_one; {just in case}
-unsave_math_codes(cur_level);
-unsave_cat_codes (cat_code_table,cur_level);
-unsave_text_codes(cur_level);
-unsave_math_data(cur_level);
-if cur_level>level_one then
- begin decr(cur_level);
- @<Clear off top level from |save_stack|@>;
- end
-else confusion("curlevel"); {|unsave| is not used when |cur_group=bottom_level|}
-@:this can't happen curlevel}{\quad curlevel@>
-attr_list_cache:=cache_disabled;
-end;
-
-@ @<Clear off...@>=
-loop@+begin decr(save_ptr);
- if save_type(save_ptr)=level_boundary then goto done;
- p:=save_index(save_ptr);
- if save_type(save_ptr)=insert_token then
- @<Insert token |p| into \TeX's input@>
- else begin if save_type(save_ptr)=restore_old_value then
- begin l:=save_level(save_ptr); decr(save_ptr);
- end
- else save_stack[save_ptr]:=eqtb[undefined_control_sequence];
- @<Store \(s)|save_stack[save_ptr]| in |eqtb[p]|, unless
- |eqtb[p]| holds a global value@>;
- end;
- end;
-done: @!stat if tracing_groups>0 then group_trace(true);@+tats@;@/
-if grp_stack[in_open]=cur_boundary then group_warning;
- {groups possibly not properly nested with files}
-cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr);
-decr(save_ptr)
-
-@ A global definition, which sets the level to |level_one|,
-@^global definitions@>
-will not be undone by |unsave|. If at least one global definition of
-|eqtb[p]| has been carried out within the group that just ended, the
-last such definition will therefore survive.
-
-@<Store \(s)|save...@>=
-if p<int_base then
- if eq_level(p)=level_one then
- begin eq_destroy(save_stack[save_ptr]); {destroy the saved value}
- @!stat if tracing_restores>0 then restore_trace(p,"retaining");@+tats@;@/
- end
- else begin eq_destroy(eqtb[p]); {destroy the current value}
- eqtb[p]:=save_stack[save_ptr]; {restore the saved value}
- @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
- end
-else if xeq_level[p]<>level_one then
- begin eqtb[p]:=save_stack[save_ptr]; xeq_level[p]:=l;
- @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
- end
-else begin
- @!stat if tracing_restores>0 then restore_trace(p,"retaining");@+tats@;@/
- end
-
-@ @<Declare \eTeX\ procedures for tr...@>=
-@!stat procedure restore_trace(@!p:pointer;@!s:str_number);
- {|eqtb[p]| has just been restored or retained}
-begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
-show_eqtb(p); print_char("}");
-end_diagnostic(false);
-end;
-tats
-
-@ Most of the parameters kept in |eqtb| can be changed freely, but there's
-an exception: The magnification should not be used with two different
-values during any \TeX\ job, since a single magnification is applied to an
-entire run. The global variable |mag_set| is set to the current magnification
-whenever it becomes necessary to ``freeze'' it at a particular value.
-
-@<Glob...@>=
-@!mag_set:integer; {if nonzero, this magnification should be used henceforth}
-
-@ @<Set init...@>=
-mag_set:=0;
-
-@ The |prepare_mag| subroutine is called whenever \TeX\ wants to use |mag|
-for magnification.
-
-@p procedure prepare_mag;
-begin if (mag_set>0)and(mag<>mag_set) then
- begin print_err("Incompatible magnification ("); print_int(mag);
-@.Incompatible magnification@>
- print(");"); print_nl(" the previous value will be retained");
- help2("I can handle only one magnification ratio per job. So I've")@/
- ("reverted to the magnification you used earlier on this run.");@/
- int_error(mag_set);
- geq_word_define(int_base+mag_code,mag_set); {|mag:=mag_set|}
- end;
-if (mag<=0)or(mag>32768) then
- begin print_err("Illegal magnification has been changed to 1000");@/
-@.Illegal magnification...@>
- help1("The magnification ratio must be between 1 and 32768.");
- int_error(mag); geq_word_define(int_base+mag_code,1000);
- end;
-if (mag_set=0) and (mag<>mag_set) then begin
- if mag<>1000 then
- one_true_inch:=xn_over_d(one_hundred_inch,10,mag)
- else
- one_true_inch:=one_inch;
-end;
-mag_set:=mag;
-end;
-
-@* \[20] Token lists.
-A \TeX\ token is either a character or a control sequence, and it is
-@^token@>
-represented internally in one of two ways: (1)~A character whose ASCII
-code number is |c| and whose command code is |m| is represented as the
-number $2^{21}m+c$; the command code is in the range |1<=m<=14|. (2)~A control
-sequence whose |eqtb| address is |p| is represented as the number
-|cs_token_flag+p|. Here |cs_token_flag=@t$2^{25}-1$@>| is larger than
-$2^{21}m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|;
-thus, a token fits comfortably in a halfword.
-
-A token |t| represents a |left_brace| command if and only if
-|t<left_brace_limit|; it represents a |right_brace| command if and only if
-we have |left_brace_limit<=t<right_brace_limit|; and it represents a |match| or
-|end_match| command if and only if |match_token<=t<=end_match_token|.
-The following definitions take care of these token-oriented constants
-and a few others.
-
-@d cs_token_flag==@"1FFFFFFF {amount added to the |eqtb| location in a
- token that stands for a control sequence; is a multiple of~$2^{21}$, less~1}
-@d left_brace_token=@"200000 {$2^{21}\cdot|left_brace|$}
-@d left_brace_limit=@"400000 {$2^{21}\cdot(|left_brace|+1)$}
-@d right_brace_token=@"400000 {$2^{21}\cdot|right_brace|$}
-@d right_brace_limit=@"600000 {$2^{21}\cdot(|right_brace|+1)$}
-@d math_shift_token= @"600000 {$2^{21}\cdot|math_shift|$}
-@d tab_token=@"800000 {$2^{21}\cdot|tab_mark|$}
-@d out_param_token=@"A00000 {$2^{21}\cdot|out_param|$}
-@d space_token=@"1400020 {$2^{21}\cdot|spacer|+|" "|$}
-@d letter_token=@"1600000 {$2^{21}\cdot|letter|$}
-@d other_token=@"1800000 {$2^{21}\cdot|other_char|$}
-@d match_token=@"1A00000 {$2^{21}\cdot|match|$}
-@d end_match_token=@"1C00000 {$2^{21}\cdot|end_match|$}
-@d protected_token=@"1C00001 {$2^{21}\cdot|end_match|+1$}
-
-@ @<Check the ``constant''...@>=
-if cs_token_flag+undefined_control_sequence>max_halfword then bad:=21;
-
-@ A token list is a singly linked list of one-word nodes in |mem|, where
-each word contains a token and a link. Macro definitions, output-routine
-definitions, marks, \.{\\write} texts, and a few other things
-are remembered by \TeX\ in the form
-of token lists, usually preceded by a node with a reference count in its
-|token_ref_count| field. The token stored in location |p| is called
-|info(p)|.
-
-Three special commands appear in the token lists of macro definitions.
-When |m=match|, it means that \TeX\ should scan a parameter
-for the current macro; when |m=end_match|, it means that parameter
-matching should end and \TeX\ should start reading the macro text; and
-when |m=out_param|, it means that \TeX\ should insert parameter
-number |c| into the text at this point.
-
-The enclosing \.{\char'173} and \.{\char'175} characters of a macro
-definition are omitted, but the final right brace of an output routine
-is included at the end of its token list.
-
-Here is an example macro definition that illustrates these conventions.
-After \TeX\ processes the text
-$$\.{\\def\\mac a\#1\#2 \\b \{\#1\\-a \#\#1\#2 \#2\}}$$
-the definition of \.{\\mac} is represented as a token list containing
-$$\def\,{\hskip2pt}
-\vbox{\halign{\hfil#\hfil\cr
-(reference count), |letter|\,\.a, |match|\,\#, |match|\,\#, |spacer|\,\.\ ,
-\.{\\b}, |end_match|,\cr
-|out_param|\,1, \.{\\-}, |letter|\,\.a, |spacer|\,\.\ , |mac_param|\,\#,
-|other_char|\,\.1,\cr
-|out_param|\,2, |spacer|\,\.\ , |out_param|\,2.\cr}}$$
-The procedure |scan_toks| builds such token lists, and |macro_call|
-does the parameter matching.
-@^reference counts@>
-
-Examples such as
-$$\.{\\def\\m\{\\def\\m\{a\}\ b\}}$$
-explain why reference counts would be needed even if \TeX\ had no \.{\\let}
-operation: When the token list for \.{\\m} is being read, the redefinition of
-\.{\\m} changes the |eqtb| entry before the token list has been fully
-consumed, so we dare not simply destroy a token list when its
-control sequence is being redefined.
-
-If the parameter-matching part of a definition ends with `\.{\#\{}',
-the corresponding token list will have `\.\{' just before the `|end_match|'
-and also at the very end. The first `\.\{' is used to delimit the parameter; the
-second one keeps the first from disappearing.
-
-@ The procedure |show_token_list|, which prints a symbolic form of
-the token list that starts at a given node |p|, illustrates these
-conventions. The token list being displayed should not begin with a reference
-count. However, the procedure is intended to be robust, so that if the
-memory links are awry or if |p| is not really a pointer to a token list,
-nothing catastrophic will happen.
-
-An additional parameter |q| is also given; this parameter is either null
-or it points to a node in the token list where a certain magic computation
-takes place that will be explained later. (Basically, |q| is non-null when
-we are printing the two-line context information at the time of an error
-message; |q| marks the place corresponding to where the second line
-should begin.)
-
-For example, if |p| points to the node containing the first \.a in the
-token list above, then |show_token_list| will print the string
-$$\hbox{`\.{a\#1\#2\ \\b\ ->\#1\\-a\ \#\#1\#2\ \#2}';}$$
-and if |q| points to the node containing the second \.a,
-the magic computation will be performed just before the second \.a is printed.
-
-The generation will stop, and `\.{\\ETC.}' will be printed, if the length
-of printing exceeds a given limit~|l|. Anomalous entries are printed in the
-form of control sequences that are not followed by a blank space, e.g.,
-`\.{\\BAD.}'; this cannot be confused with actual control sequences because
-a real control sequence named \.{BAD} would come out `\.{\\BAD\ }'.
-
-@<Declare the procedure called |show_token_list|@>=
-procedure show_token_list(@!p,@!q:integer;@!l:integer);
-label exit;
-var m,@!c:integer; {pieces of a token}
-@!match_chr:ASCII_code; {character used in a `|match|'}
-@!n:ASCII_code; {the highest parameter number, as an ASCII digit}
-begin match_chr:="#"; n:="0"; tally:=0;
-while (p<>null) and (tally<l) do
- begin if p=q then @<Do magic computation@>;
- @<Display token |p|, and |return| if there are problems@>;
- p:=link(p);
- end;
-if p<>null then print_esc("ETC.");
-@.ETC@>
-exit:
-end;
-
-@ @<Display token |p|...@>=
-if (p<fix_mem_min) or (p>fix_mem_end) then
- begin print_esc("CLOBBERED."); return;
-@.CLOBBERED@>
- end;
-if info(p)>=cs_token_flag then begin
- if not ((inhibit_par_tokens) and (info(p)=par_token)) then
- print_cs(info(p)-cs_token_flag);
- end
-else begin m:=info(p) div string_offset; c:=info(p) mod string_offset;
- if info(p)<0 then print_esc("BAD.")
-@.BAD@>
- else @<Display the token $(|m|,|c|)$@>;
- end
-
-@ The procedure usually ``learns'' the character code used for macro
-parameters by seeing one in a |match| command before it runs into any
-|out_param| commands.
-
-@<Display the token ...@>=
-case m of
-left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer,
- letter,other_char: print(c);
-mac_param: begin if not in_lua_escape then print(c); print(c);
- end;
-out_param: begin print(match_chr);
- if c<=9 then print_char(c+"0")
- else begin print_char("!"); return;
- end;
- end;
-match: begin match_chr:=c; print(c); incr(n); print_char(n);
- if n>"9" then return;
- end;
-end_match: if c=0 then print("->");
-@.->@>
-othercases print_esc("BAD.")
-@.BAD@>
-endcases
-
-@ Here's the way we sometimes want to display a token list, given a pointer
-to its reference count; the pointer may be null.
-
-@p procedure token_show(@!p:pointer);
-begin if p<>null then show_token_list(link(p),null,10000000);
-end;
-
-@ The |print_meaning| subroutine displays |cur_cmd| and |cur_chr| in
-symbolic form, including the expansion of a macro or mark.
-
-@p procedure print_meaning;
-begin print_cmd_chr(cur_cmd,cur_chr);
-if cur_cmd>=call then
- begin print_char(":"); print_ln; token_show(cur_chr);
- end
-else @<Show the meaning of a mark node@>;
-end;
-
-@* \[21] Introduction to the syntactic routines.
-Let's pause a moment now and try to look at the Big Picture.
-The \TeX\ program consists of three main parts: syntactic routines,
-semantic routines, and output routines. The chief purpose of the
-syntactic routines is to deliver the user's input to the semantic routines,
-one token at a time. The semantic routines act as an interpreter
-responding to these tokens, which may be regarded as commands. And the
-output routines are periodically called on to convert box-and-glue
-lists into a compact set of instructions that will be sent
-to a typesetter. We have discussed the basic data structures and utility
-routines of \TeX, so we are good and ready to plunge into the real activity by
-considering the syntactic routines.
-
-Our current goal is to come to grips with the |get_next| procedure,
-which is the keystone of \TeX's input mechanism. Each call of |get_next|
-sets the value of three variables |cur_cmd|, |cur_chr|, and |cur_cs|,
-representing the next input token.
-$$\vbox{\halign{#\hfil\cr
- \hbox{|cur_cmd| denotes a command code from the long list of codes
- given above;}\cr
- \hbox{|cur_chr| denotes a character code or other modifier of the command
- code;}\cr
- \hbox{|cur_cs| is the |eqtb| location of the current control sequence,}\cr
- \hbox{\qquad if the current token was a control sequence,
- otherwise it's zero.}\cr}}$$
-Underlying this external behavior of |get_next| is all the machinery
-necessary to convert from character files to tokens. At a given time we
-may be only partially finished with the reading of several files (for
-which \.{\\input} was specified), and partially finished with the expansion
-of some user-defined macros and/or some macro parameters, and partially
-finished with the generation of some text in a template for \.{\\halign},
-and so on. When reading a character file, special characters must be
-classified as math delimiters, etc.; comments and extra blank spaces must
-be removed, paragraphs must be recognized, and control sequences must be
-found in the hash table. Furthermore there are occasions in which the
-scanning routines have looked ahead for a word like `\.{plus}' but only
-part of that word was found, hence a few characters must be put back
-into the input and scanned again.
-
-To handle these situations, which might all be present simultaneously,
-\TeX\ uses various stacks that hold information about the incomplete
-activities, and there is a finite state control for each level of the
-input mechanism. These stacks record the current state of an implicitly
-recursive process, but the |get_next| procedure is not recursive.
-Therefore it will not be difficult to translate these algorithms into
-low-level languages that do not support recursion.
-
-@<Glob...@>=
-@!cur_cmd: eight_bits; {current command set by |get_next|}
-@!cur_chr: halfword; {operand of current command}
-@!cur_cs: pointer; {control sequence found here, zero if none found}
-@!cur_tok: halfword; {packed representative of |cur_cmd| and |cur_chr|}
-
-@ Here is a procedure that displays the current command.
-
-@p procedure show_cur_cmd_chr;
-var n:integer; {level of \.{\\if...\\fi} nesting}
-@!l:integer; {line where \.{\\if} started}
-@!p:pointer;
-begin begin_diagnostic; print_nl("{");
-if mode<>shown_mode then
- begin print_mode(mode); print(": "); shown_mode:=mode;
- end;
-print_cmd_chr(cur_cmd,cur_chr);
-if tracing_ifs>0 then
- if cur_cmd>=if_test then if cur_cmd<=fi_or_else then
- begin print(": ");
- if cur_cmd=fi_or_else then
- begin print_cmd_chr(if_test,cur_if); print_char(" ");
- n:=0; l:=if_line;
- end
- else begin n:=1; l:=line;
- end;
- p:=cond_ptr;
- while p<>null do
- begin incr(n); p:=vlink(p);
- end;
- print("(level "); print_int(n); print_char(")"); print_if_line(l);
- end;
-print_char("}");
-end_diagnostic(false);
-end;
-
-@* \[22] Input stacks and states.
-This implementation of
-\TeX\ uses two different conventions for representing sequential stacks.
-@^stack conventions@>@^conventions for representing stacks@>
-
-\yskip\hangg 1) If there is frequent access to the top entry, and if the
-stack is essentially never empty, then the top entry is kept in a global
-variable (even better would be a machine register), and the other entries
-appear in the array $\\{stack}[0\to(\\{ptr}-1)]$. For example, the
-semantic stack described above is handled this way, and so is the input
-stack that we are about to study.
-
-\yskip\hangg 2) If there is infrequent top access, the entire stack contents
-are in the array $\\{stack}[0\to(\\{ptr}-1)]$. For example, the |save_stack|
-is treated this way, as we have seen.
-
-\yskip\noindent
-The state of \TeX's input mechanism appears in the input stack, whose
-entries are records with six fields, called |state|, |index|, |start|, |loc|,
-|limit|, and |name|. This stack is maintained with
-convention~(1), so it is declared in the following way:
-
-@<Types...@>=
-@!in_state_record = record
- @!state_field, @!index_field: quarterword;
- @!start_field,@!loc_field, @!limit_field, @!name_field,
- @!ocp_lstack_field: halfword; {used for omega translation processes}
- @!ocp_no_field: halfword; {used for omega translation processes}
- @!synctex_tag_field: integer; {stack the tag of the current file}
- @!cattable_field: integer; {category table used by the current line (see textoken.c)}
- @!partial_field: boolean; {is the current line partial? (see textoken.c)}
- @!nofilter_field: boolean; {used by token filtering}
- end;
-
-@ @<Glob...@>=
-@!input_stack : array[0..stack_size] of in_state_record;
-@!input_ptr : 0..stack_size; {first unused location of |input_stack|}
-@!max_in_stack: 0..stack_size; {largest value of |input_ptr| when pushing}
-@!cur_input : in_state_record;
- {the ``top'' input state, according to convention (1)}
-
-@ We've already defined the special variable |loc==cur_input.loc_field|
-in our discussion of basic input-output routines. The other components of
-|cur_input| are defined in the same way:
-
-@d state==cur_input.state_field {current scanner state}
-@d index==cur_input.index_field {reference for buffer information}
-@d start==cur_input.start_field {starting position in |buffer|}
-@d limit==cur_input.limit_field {end of current line in |buffer|}
-@d nofilter==cur_input.nofilter_field {is token filtering explicitly disallowed?}
-@d name==cur_input.name_field {name of the current file}
-@d synctex_tag==cur_input.synctex_tag_field {{\sl Sync\TeX} tag of the current file}
-@d current_ocp_lstack==cur_input.ocp_lstack_field {name of the current ocp}
-@d current_ocp_no==cur_input.ocp_no_field {name of the current ocp}
-@d line_catcode_table==cur_input.cattable_field
-@d line_partial==cur_input.partial_field
-
-@ Let's look more closely now at the control variables
-(|state|,~|index|,~|start|,~|loc|,~|limit|,~|name|),
-assuming that \TeX\ is reading a line of characters that have been input
-from some file or from the user's terminal. There is an array called
-|buffer| that acts as a stack of all lines of characters that are
-currently being read from files, including all lines on subsidiary
-levels of the input stack that are not yet completed. \TeX\ will return to
-the other lines when it is finished with the present input file.
-
-(Incidentally, on a machine with byte-oriented addressing, it might be
-appropriate to combine |buffer| with the |str_pool| array,
-letting the buffer entries grow downward from the top of the string pool
-and checking that these two tables don't bump into each other.)
-
-The line we are currently working on begins in position |start| of the
-buffer; the next character we are about to read is |buffer[loc]|; and
-|limit| is the location of the last character present. If |loc>limit|,
-the line has been completely read. Usually |buffer[limit]| is the
-|end_line_char|, denoting the end of a line, but this is not
-true if the current line is an insertion that was entered on the user's
-terminal in response to an error message.
-
-The |name| variable is a string number that designates the name of
-the current file, if we are reading a text file. It is zero if we
-are reading from the terminal; it is |n+1| if we are reading from
-input stream |n|, where |0<=n<=16|. (Input stream 16 stands for
-an invalid stream number; in such cases the input is actually from
-the terminal, under control of the procedure |read_toks|.)
-Finally |18<=name<=20| indicates that we are reading a pseudo file
-created by the \.{\\scantokens} or \.{\\scantextokens} command.
-
-The |state| variable has one of three values, when we are scanning such
-files:
-$$\baselineskip 15pt\vbox{\halign{#\hfil\cr
-1) |state=mid_line| is the normal state.\cr
-2) |state=skip_blanks| is like |mid_line|, but blanks are ignored.\cr
-3) |state=new_line| is the state at the beginning of a line.\cr}}$$
-These state values are assigned numeric codes so that if we add the state
-code to the next character's command code, we get distinct values. For
-example, `|mid_line+spacer|' stands for the case that a blank
-space character occurs in the middle of a line when it is not being
-ignored; after this case is processed, the next value of |state| will
-be |skip_blanks|.
-
-@d mid_line=1 {|state| code when scanning a line of characters}
-@d skip_blanks=2+max_char_code {|state| code when ignoring blanks}
-@d new_line=3+max_char_code+max_char_code {|state| code at start of line}
-
-@ Additional information about the current line is available via the
-|index| variable, which counts how many lines of characters are present
-in the buffer below the current level. We have |index=0| when reading
-from the terminal and prompting the user for each line; then if the user types,
-e.g., `\.{\\input paper}', we will have |index=1| while reading
-the file \.{paper.tex}. However, it does not follow that |index| is the
-same as the input stack pointer, since many of the levels on the input
-stack may come from token lists. For example, the instruction `\.{\\input
-paper}' might occur in a token list.
-
-The global variable |in_open| is equal to the |index|
-value of the highest non-token-list level. Thus, the number of partially read
-lines in the buffer is |in_open+1|, and we have |in_open=index|
-when we are not reading a token list.
-
-If we are not currently reading from the terminal, or from an input
-stream, we are reading from the file variable |input_file[index]|. We use
-the notation |terminal_input| as a convenient abbreviation for |name=0|,
-and |cur_file| as an abbreviation for |input_file[index]|.
-
-The global variable |line| contains the line number in the topmost
-open file, for use in error messages. If we are not reading from
-the terminal, |line_stack[index]| holds the line number for the
-enclosing level, so that |line| can be restored when the current
-file has been read. Line numbers should never be negative, since the
-negative of the current line number is used to identify the user's output
-routine in the |mode_line| field of the semantic nest entries.
-
-If more information about the input state is needed, it can be
-included in small arrays like those shown here. For example,
-the current page or segment number in the input file might be
-put into a variable |@!page|, maintained for enclosing levels in
-`\ignorespaces|@!page_stack:array[1..max_in_open] of integer|\unskip'
-by analogy with |line_stack|.
-@^system dependencies@>
-
-@d terminal_input==(name=0) {are we reading from the terminal?}
-@d cur_file==input_file[index] {the current |alpha_file| variable}
-
-@<Glob...@>=
-@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
-@!open_parens : 0..max_in_open; {the number of open text files}
-@!input_file : array[1..max_in_open] of alpha_file;
-@!line : integer; {current line number in the current source file}
-@!line_stack : array[1..max_in_open] of integer;
-
-@ Users of \TeX\ sometimes forget to balance left and right braces properly,
-and one of the ways \TeX\ tries to spot such errors is by considering an
-input file as broken into subfiles by control sequences that
-are declared to be \.{\\outer}.
-
-A variable called |scanner_status| tells \TeX\ whether or not to complain
-when a subfile ends. This variable has six possible values:
-
-\yskip\hang|normal|, means that a subfile can safely end here without incident.
-
-\yskip\hang|skipping|, means that a subfile can safely end here, but not a file,
-because we're reading past some conditional text that was not selected.
-
-\yskip\hang|defining|, means that a subfile shouldn't end now because a
-macro is being defined.
-
-\yskip\hang|matching|, means that a subfile shouldn't end now because a
-macro is being used and we are searching for the end of its arguments.
-
-\yskip\hang|aligning|, means that a subfile shouldn't end now because we are
-not finished with the preamble of an \.{\\halign} or \.{\\valign}.
-
-\yskip\hang|absorbing|, means that a subfile shouldn't end now because we are
-reading a balanced token list for \.{\\message}, \.{\\write}, etc.
-
-\yskip\noindent
-If the |scanner_status| is not |normal|, the variable |warning_index| points
-to the |eqtb| location for the relevant control sequence name to print
-in an error message.
-
-@d skipping=1 {|scanner_status| when passing conditional text}
-@d defining=2 {|scanner_status| when reading a macro definition}
-@d matching=3 {|scanner_status| when reading macro arguments}
-@d aligning=4 {|scanner_status| when reading an alignment preamble}
-@d absorbing=5 {|scanner_status| when reading a balanced text}
-
-@<Glob...@>=
-@!scanner_status : normal..absorbing; {can a subfile end now?}
-@!warning_index : pointer; {identifier relevant to non-|normal| scanner status}
-@!def_ref : pointer; {reference count of token list being defined}
-
-@ Here is a procedure that uses |scanner_status| to print a warning message
-when a subfile has ended, and at certain other crucial times:
-
-@<Declare the procedure called |runaway|@>=
-procedure runaway;
-var p:pointer; {head of runaway list}
-begin p:=null;
- if scanner_status>skipping then
- begin print_nl("Runaway ");
-@.Runaway...@>
- case scanner_status of
- defining: begin print("definition"); p:=def_ref;
- end;
- matching: begin print("argument"); p:=temp_token_head;
- end;
- aligning: begin print("preamble"); p:=hold_token_head;
- end;
- absorbing: begin print("text"); p:=def_ref;
- end;
- end; {there are no other cases}
- print_char("?");print_ln; show_token_list(link(p),null,error_line-10);
- end;
-end;
-
-@ However, all this discussion about input state really applies only to the
-case that we are inputting from a file. There is another important case,
-namely when we are currently getting input from a token list. In this case
-|state=token_list|, and the conventions about the other state variables
-are different:
-
-\yskip\hang|loc| is a pointer to the current node in the token list, i.e.,
-the node that will be read next. If |loc=null|, the token list has been
-fully read.
-
-\yskip\hang|start| points to the first node of the token list; this node
-may or may not contain a reference count, depending on the type of token
-list involved.
-
-\yskip\hang|token_type|, which takes the place of |index| in the
-discussion above, is a code number that explains what kind of token list
-is being scanned.
-
-\yskip\hang|name| points to the |eqtb| address of the control sequence
-being expanded, if the current token list is a macro.
-
-\yskip\hang|param_start|, which takes the place of |limit|, tells where
-the parameters of the current macro begin in the |param_stack|, if the
-current token list is a macro.
-
-\yskip\noindent The |token_type| can take several values, depending on
-where the current token list came from:
-
-\yskip\hang|parameter|, if a parameter is being scanned;
-
-\hang|u_template|, if the \<u_j> part of an alignment
-template is being scanned;
-
-\hang|v_template|, if the \<v_j> part of an alignment
-template is being scanned;
-
-\hang|backed_up|, if the token list being scanned has been inserted as
-`to be read again'.
-
-\hang|inserted|, if the token list being scanned has been inserted as
-the text expansion of a \.{\\count} or similar variable;
-
-\hang|macro|, if a user-defined control sequence is being scanned;
-
-\hang|output_text|, if an \.{\\output} routine is being scanned;
-
-\hang|every_par_text|, if the text of \.{\\everypar} is being scanned;
-
-\hang|every_math_text|, if the text of \.{\\everymath} is being scanned;
-
-\hang|every_display_text|, if the text of \.{\\everydisplay} is being scanned;
-
-\hang|every_hbox_text|, if the text of \.{\\everyhbox} is being scanned;
-
-\hang|every_vbox_text|, if the text of \.{\\everyvbox} is being scanned;
-
-\hang|every_job_text|, if the text of \.{\\everyjob} is being scanned;
-
-\hang|every_cr_text|, if the text of \.{\\everycr} is being scanned;
-
-\hang|mark_text|, if the text of a \.{\\mark} is being scanned;
-
-\hang|write_text|, if the text of a \.{\\write} is being scanned.
-
-\yskip\noindent
-The codes for |output_text|, |every_par_text|, etc., are equal to a constant
-plus the corresponding codes for token list parameters |output_routine_loc|,
-|every_par_loc|, etc. The token list begins with a reference count if and
-only if |token_type>=macro|.
-@^reference counts@>
-
-Since \eTeX's additional token list parameters precede |toks_base|, the
-corresponding token types must precede |write_text|.
-
-@d token_list=0 {|state| code when scanning a token list}
-@d token_type==index {type of current token list}
-@d param_start==limit {base of macro parameters in |param_stack|}
-@d parameter=0 {|token_type| code for parameter}
-@d u_template=1 {|token_type| code for \<u_j> template}
-@d v_template=2 {|token_type| code for \<v_j> template}
-@d backed_up=3 {|token_type| code for text to be reread}
-@d inserted=4 {|token_type| code for inserted texts}
-@d macro=5 {|token_type| code for defined control sequences}
-@d output_text=6 {|token_type| code for output routines}
-@d every_par_text=7 {|token_type| code for \.{\\everypar}}
-@d every_math_text=8 {|token_type| code for \.{\\everymath}}
-@d every_display_text=9 {|token_type| code for \.{\\everydisplay}}
-@d every_hbox_text=10 {|token_type| code for \.{\\everyhbox}}
-@d every_vbox_text=11 {|token_type| code for \.{\\everyvbox}}
-@d every_job_text=12 {|token_type| code for \.{\\everyjob}}
-@d every_cr_text=13 {|token_type| code for \.{\\everycr}}
-@d mark_text=14 {|token_type| code for \.{\\topmark}, etc.}
-@#
-@d eTeX_text_offset=output_routine_loc-output_text
-@d every_eof_text=every_eof_loc-eTeX_text_offset
- {|token_type| code for \.{\\everyeof}}
-@#
-@d write_text=etex_toks-eTeX_text_offset {|token_type| code for \.{\\write}}
-
-@ The |param_stack| is an auxiliary array used to hold pointers to the token
-lists for parameters at the current level and subsidiary levels of input.
-This stack is maintained with convention (2), and it grows at a different
-rate from the others.
-
-@<Glob...@>=
-@!param_stack:array [0..param_size] of pointer;
- {token list pointers for parameters}
-@!param_ptr:0..param_size; {first unused entry in |param_stack|}
-@!max_param_stack:integer;
- {largest value of |param_ptr|, will be |<=param_size+9|}
-
-@ The input routines must also interact with the processing of
-\.{\\halign} and \.{\\valign}, since the appearance of tab marks and
-\.{\\cr} in certain places is supposed to trigger the beginning of special
-\<v_j> template text in the scanner. This magic is accomplished by an
-|align_state| variable that is increased by~1 when a `\.{\char'173}' is
-scanned and decreased by~1 when a `\.{\char'175}' is scanned. The |align_state|
-is nonzero during the \<u_j> template, after which it is set to zero; the
-\<v_j> template begins when a tab mark or \.{\\cr} occurs at a time that
-|align_state=0|.
-
-@<Glob...@>=
-@!align_state:integer; {group level with respect to current alignment}
-
-@ Thus, the ``current input state'' can be very complicated indeed; there
-can be many levels and each level can arise in a variety of ways. The
-|show_context| procedure, which is used by \TeX's error-reporting routine to
-print out the current input state on all levels down to the most recent
-line of characters from an input file, illustrates most of these conventions.
-The global variable |base_ptr| contains the lowest level that was
-displayed by this procedure.
-
-@<Glob...@>=
-@!base_ptr:0..stack_size; {shallowest level shown by |show_context|}
-
-@ The status at each level is indicated by printing two lines, where the first
-line indicates what was read so far and the second line shows what remains
-to be read. The context is cropped, if necessary, so that the first line
-contains at most |half_error_line| characters, and the second contains
-at most |error_line|. Non-current input levels whose |token_type| is
-`|backed_up|' are shown only if they have not been fully read.
-
-@p procedure show_context; {prints where the scanner is}
-label done;
-var old_setting:0..max_selector; {saved |selector| setting}
-@!nn:integer; {number of contexts shown so far, less one}
-@!bottom_line:boolean; {have we reached the final context to be shown?}
-@<Local variables for formatting calculations@>@/
-begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
- {store current state}
-nn:=-1; bottom_line:=false;
-loop@+begin cur_input:=input_stack[base_ptr]; {enter into the context}
- if (state<>token_list) then
- if (name>21) or (base_ptr=0) then bottom_line:=true;
- if (base_ptr=input_ptr)or bottom_line or(nn<error_context_lines) then
- @<Display the current context@>
- else if nn=error_context_lines then
- begin print_nl("..."); incr(nn); {omitted if |error_context_lines<0|}
- end;
- if bottom_line then goto done;
- decr(base_ptr);
- end;
-done: cur_input:=input_stack[input_ptr]; {restore original state}
-end;
-
-@ @<Display the current context@>=
-begin if (base_ptr=input_ptr) or (state<>token_list) or
- (token_type<>backed_up) or (loc<>null) then
- {we omit backed-up token lists that have already been read}
- begin tally:=0; {get ready to count characters}
- old_setting:=selector;
- if current_ocp_lstack>0 then
- begin print_nl("OCP stack "); print_scaled(current_ocp_lstack);
- print(" entry "); print_int(current_ocp_no); print(":");
- @<Pseudoprint the line@>;
- end
- else if state<>token_list then
- begin @<Print location of current line@>;
- @<Pseudoprint the line@>;
- end
- else begin @<Print type of token list@>;
- @<Pseudoprint the token list@>;
- end;
- selector:=old_setting; {stop pseudoprinting}
- @<Print two lines using the tricky pseudoprinted information@>;
- incr(nn);
- end;
-end
-
-@ This routine should be changed, if necessary, to give the best possible
-indication of where the current line resides in the input file.
-For example, on some systems it is best to print both a page and line number.
-@^system dependencies@>
-
-@<Print location of current line@>=
-if name<=17 then
- if terminal_input then
- if base_ptr=0 then print_nl("<*>") else print_nl("<insert> ")
- else begin print_nl("<read ");
- if name=17 then print_char("*")@+else print_int(name-1);
-@.*\relax@>
- print_char(">");
- end
-else if index<>in_open then {input from a pseudo file}
- begin print_nl("l."); print_int(line_stack[index+1]);
- end
-else begin print_nl("l."); print_int(line);
- end;
-print_char(" ")
-
-@ @<Print type of token list@>=
-case token_type of
-parameter: print_nl("<argument> ");
-u_template,v_template: print_nl("<template> ");
-backed_up: if loc=null then print_nl("<recently read> ")
- else print_nl("<to be read again> ");
-inserted: print_nl("<inserted text> ");
-macro: begin print_ln; print_cs(name);
- end;
-output_text: print_nl("<output> ");
-every_par_text: print_nl("<everypar> ");
-every_math_text: print_nl("<everymath> ");
-every_display_text: print_nl("<everydisplay> ");
-every_hbox_text: print_nl("<everyhbox> ");
-every_vbox_text: print_nl("<everyvbox> ");
-every_job_text: print_nl("<everyjob> ");
-every_cr_text: print_nl("<everycr> ");
-mark_text: print_nl("<mark> ");
-every_eof_text: print_nl("<everyeof> ");
-write_text: print_nl("<write> ");
-othercases print_nl("?") {this should never happen}
-endcases
-
-@ Here it is necessary to explain a little trick. We don't want to store a long
-string that corresponds to a token list, because that string might take up
-lots of memory; and we are printing during a time when an error message is
-being given, so we dare not do anything that might overflow one of \TeX's
-tables. So `pseudoprinting' is the answer: We enter a mode of printing
-that stores characters into a buffer of length |error_line|, where character
-$k+1$ is placed into \hbox{|trick_buf[k mod error_line]|} if
-|k<trick_count|, otherwise character |k| is dropped. Initially we set
-|tally:=0| and |trick_count:=1000000|; then when we reach the
-point where transition from line 1 to line 2 should occur, we
-set |first_count:=tally| and |trick_count:=@tmax@>(error_line,
-tally+1+error_line-half_error_line)|. At the end of the
-pseudoprinting, the values of |first_count|, |tally|, and
-|trick_count| give us all the information we need to print the two lines,
-and all of the necessary text is in |trick_buf|.
-
-Namely, let |l| be the length of the descriptive information that appears
-on the first line. The length of the context information gathered for that
-line is |k=first_count|, and the length of the context information
-gathered for line~2 is $m=\min(|tally|, |trick_count|)-k$. If |l+k<=h|,
-where |h=half_error_line|, we print |trick_buf[0..k-1]| after the
-descriptive information on line~1, and set |n:=l+k|; here |n| is the
-length of line~1. If $l+k>h$, some cropping is necessary, so we set |n:=h|
-and print `\.{...}' followed by
-$$\hbox{|trick_buf[(l+k-h+3)..k-1]|,}$$
-where subscripts of |trick_buf| are circular modulo |error_line|. The
-second line consists of |n|~spaces followed by |trick_buf[k..(k+m-1)]|,
-unless |n+m>error_line|; in the latter case, further cropping is done.
-This is easier to program than to explain.
-
-@<Local variables for formatting...@>=
-@!i:0..buf_size; {index into |buffer|}
-@!j:0..buf_size; {end of current line in |buffer|}
-@!l:0..half_error_line; {length of descriptive information on line 1}
-@!m:integer; {context information gathered for line 2}
-@!n:0..error_line; {length of line 1}
-@!p: integer; {starting or ending place in |trick_buf|}
-@!q: integer; {temporary index}
-
-@ The following code sets up the print routines so that they will gather
-the desired information.
-
-@d begin_pseudoprint==
- begin l:=tally; tally:=0; selector:=pseudo;
- trick_count:=1000000;
- end
-@d set_trick_count==
- begin first_count:=tally;
- trick_count:=tally+1+error_line-half_error_line;
- if trick_count<error_line then trick_count:=error_line;
- end
-
-@ And the following code uses the information after it has been gathered.
-
-@<Print two lines using the tricky pseudoprinted information@>=
-if trick_count=1000000 then set_trick_count;
- {|set_trick_count| must be performed}
-if tally<trick_count then m:=tally-first_count
-else m:=trick_count-first_count; {context on line 2}
-if l+first_count<=half_error_line then
- begin p:=0; n:=l+first_count;
- end
-else begin print("..."); p:=l+first_count-half_error_line+3;
- n:=half_error_line;
- end;
-for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]);
-print_ln;
-for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2}
-if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3);
-for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]);
-if m+n>error_line then print("...")
-
-@ But the trick is distracting us from our current goal, which is to
-understand the input state. So let's concentrate on the data structures that
-are being pseudoprinted as we finish up the |show_context| procedure.
-
-@<Pseudoprint the line@>=
-begin_pseudoprint;
-if buffer[limit]=end_line_char then j:=limit
-else j:=limit+1; {determine the effective end of the line}
-if j>0 then for i:=start to j-1 do
- begin if i=loc then set_trick_count;
- print_char(buffer[i]);
- end
-
-@ @<Pseudoprint the token list@>=
-begin_pseudoprint;
-if token_type<macro then show_token_list(start,loc,100000)
-else show_token_list(link(start),loc,100000) {avoid reference count}
-
-@ Here is the missing piece of |show_token_list| that is activated when the
-token beginning line~2 is about to be shown:
-
-@<Do magic computation@>=set_trick_count
-
-@* \[23] Maintaining the input stacks.
-The following subroutines change the input status in commonly needed ways.
-
-First comes |push_input|, which stores the current state and creates a
-new level (having, initially, the same properties as the old).
-
-@d push_input==@t@> {enter a new input level, save the old}
- begin if input_ptr>max_in_stack then
- begin max_in_stack:=input_ptr;
- if input_ptr=stack_size then overflow("input stack size",stack_size);
-@:TeX capacity exceeded input stack size}{\quad input stack size@>
- end;
- input_stack[input_ptr]:=cur_input; {stack the record}
- nofilter:=false;
- incr(input_ptr);
- end
-
-@ And of course what goes up must come down.
-
-@d pop_input==@t@> {leave an input level, re-enter the old}
- begin decr(input_ptr); cur_input:=input_stack[input_ptr];
- end
-
-@ Here is a procedure that starts a new level of token-list input, given
-a token list |p| and its type |t|. If |t=macro|, the calling routine should
-set |name| and |loc|.
-
-@d back_list(#)==begin_token_list(#,backed_up) {backs up a simple token list}
-@d ins_list(#)==begin_token_list(#,inserted) {inserts a simple token list}
-
-@p procedure begin_token_list(@!p:pointer;@!t:quarterword);
-begin push_input; state:=token_list; start:=p; token_type:=t;
-if t>=macro then {the token list starts with a reference count}
- begin add_token_ref(p);
- if t=macro then param_start:=param_ptr
- else begin loc:=link(p);
- if tracing_macros>1 then
- begin begin_diagnostic; print_nl("");
- case t of
- mark_text:print_esc("mark");
- write_text:print_esc("write");
- othercases print_cmd_chr(assign_toks,t-output_text+output_routine_loc)
- endcases;@/
- print("->"); token_show(p); end_diagnostic(false);
- end;
- end;
- end
-else loc:=p;
-end;
-
-@ When a token list has been fully scanned, the following computations
-should be done as we leave that level of input. The |token_type| tends
-to be equal to either |backed_up| or |inserted| about 2/3 of the time.
-@^inner loop@>
-
-@p procedure end_token_list; {leave a token-list input level}
-begin if token_type>=backed_up then {token list to be deleted}
- begin if token_type<=inserted then flush_list(start)
- else begin delete_token_ref(start); {update reference count}
- if token_type=macro then {parameters must be flushed}
- while param_ptr>param_start do
- begin decr(param_ptr);
- flush_list(param_stack[param_ptr]);
- end;
- end;
- end
-else if token_type=u_template then begin
- if align_state>500000 then align_state:=0
- else fatal_error("(interwoven alignment preambles are not allowed)");
-@.interwoven alignment preambles...@>
- end;
-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 begin
- if cur_tok<left_brace_limit then decr(align_state)
- else incr(align_state);
- end;
-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 begin
- if cur_tok<left_brace_limit then decr(align_state)
- else incr(align_state);
- end;
- end
-else begin back_input; a:=1; { etex is always on }
- end;
-cur_tok:=t;
-end
-
-@ The |back_error| routine is used when we want to replace an offending token
-just before issuing an error message. This routine, like |back_input|,
-requires that |cur_tok| has been set. We disable interrupts during the
-call of |back_input| so that the help message won't be lost.
-
-@p procedure back_error; {back up one token and call |error|}
-begin OK_to_interrupt:=false; back_input; OK_to_interrupt:=true; error;
-end;
-@#
-procedure ins_error; {back up one inserted token and call |error|}
-begin OK_to_interrupt:=false; back_input; token_type:=inserted;
-OK_to_interrupt:=true; error;
-end;
-
-@ The |begin_file_reading| procedure starts a new level of input for lines
-of characters to be read from a file, or as an insertion from the
-terminal. It does not take care of opening the file, nor does it set |loc|
-or |limit| or |line|.
-@^system dependencies@>
-
-@p procedure begin_file_reading;
-begin if in_open=max_in_open then overflow("text input levels",max_in_open);
-@:TeX capacity exceeded text input levels}{\quad text input levels@>
-if first=buf_size then check_buffer_overflow(first);
-@:TeX capacity exceeded buffer size}{\quad buffer size@>
-incr(in_open); push_input; index:=in_open;
-eof_seen[index]:=false;
-grp_stack[index]:=cur_boundary; if_stack[index]:=cond_ptr;
-line_stack[index]:=line; start:=first; state:=mid_line;
-name:=0; {|terminal_input| is now |true|}
-line_catcode_table:=DEFAULT_CAT_TABLE; line_partial:=false;
-@<Prepare terminal input {\sl Sync\TeX} information@>;
-end;
-
-@ Conversely, the variables must be downdated when such a level of input
-is finished:
-
-@p procedure end_file_reading;
-begin first:=start; line:=line_stack[index];
-if (name>=18)and(name<=20) then pseudo_close else
-if name=21 then luacstring_close(index) else
-if name>17 then lua_a_close_in(cur_file,0); {forget it}
-pop_input; decr(in_open);
-end;
-
-@ In order to keep the stack from overflowing during a long sequence of
-inserted `\.{\\show}' commands, the following routine removes completed
-error-inserted lines from memory.
-
-@p procedure clear_for_error_prompt;
-begin while (state<>token_list)and terminal_input and@|
- (input_ptr>0)and(loc>limit) do end_file_reading;
-print_ln; clear_terminal;
-end;
-
-@ To get \TeX's whole input mechanism going, we perform the following
-actions.
-
-@<Initialize the input routines@>=
-begin input_ptr:=0; max_in_stack:=0;
-in_open:=0; open_parens:=0; max_buf_stack:=0;
-grp_stack[0]:=0; if_stack[0]:=null;
-param_ptr:=0; max_param_stack:=0;
-first:=buf_size; repeat buffer[first]:=0; decr(first); until first=0;
-scanner_status:=normal; warning_index:=null; first:=1;
-state:=new_line; start:=1; index:=0; line:=0; name:=0;
-current_ocp_lstack:=0; current_ocp_no:=0; nofilter:=false;
-force_eof:=false; luacstrings :=0;
-line_catcode_table:=DEFAULT_CAT_TABLE; line_partial:=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_tex("par",par_end,too_big_char,too_big_char); {cf.\ |scan_file_name|}
-@!@:par_}{\.{\\par} primitive@>
-par_loc:=cur_val; par_token:=cs_token_flag+par_loc;
-
-@ The function |get_next| is now defined in |textoken.c|. Parts of
-this routine are executed more often than any other instructions of \TeX.
-@^mastication@>@^inner loop@>
-
-@ The global variable |force_eof| is normally |false|; it is set |true|
-by an \.{\\endinput} command. |luacstrings| is the number of lua print
-statements waiting to be input, it is changed by |luatokencall|.
-
-|no_expand_flag| is a special character value that is inserted by
-|get_next| if it wants to suppress expansion.
-
-@d no_expand_flag==special_char {this characterizes a special variant of |relax|}
-@d end_line_char_inactive==(end_line_char<0)or(end_line_char>127)
-
-
-@<Glob...@>=
-@!force_eof:boolean; {should the next \.{\\input} be aborted early?}
-@!luacstrings:integer; {how many lua strings are waiting to be input?}
-
-@ If the user has set the |pausing| parameter to some positive value,
-and if nonstop mode has not been selected, each line of input is displayed
-on the terminal and the transcript file, followed by `\.{=>}'.
-\TeX\ waits for a response. If the response is simply |carriage_return|, the
-line is accepted as it stands, otherwise the line typed is
-used instead of the line in the file.
-
-@p procedure firm_up_the_line;
-var k:0..buf_size; {an index into |buffer|}
-begin limit:=last;
-if pausing>0 then if interaction>nonstop_mode then
- begin wake_up_terminal; print_ln;
- if start<limit then for k:=start to limit-1 do print(buffer[k]);
- first:=limit; prompt_input("=>"); {wait for user response}
-@.=>@>
- if last>first then
- begin for k:=first to last-1 do {move line down in buffer}
- buffer[k+start-first]:=buffer[k];
- limit:=start+last-first;
- end;
- end;
-end;
-
-@ Since |get_next| is used so frequently in \TeX, it is convenient
-to define three related procedures that do a little more:
-
-\yskip\hang|get_token| not only sets |cur_cmd| and |cur_chr|, it
-also sets |cur_tok|, a packed halfword version of the current token.
-
-\yskip\hang|get_x_token|, meaning ``get an expanded token,'' is like
-|get_token|, but if the current token turns out to be a user-defined
-control sequence (i.e., a macro call), or a conditional,
-or something like \.{\\topmark} or \.{\\expandafter} or \.{\\csname},
-it is eliminated from the input by beginning the expansion of the macro
-or the evaluation of the conditional.
-
-\yskip\hang|x_token| is like |get_x_token| except that it assumes that
-|get_next| has already been called.
-
-\yskip\noindent
-In fact, these three procedures account for 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_filtered_next; no_new_control_sequence:=true;
-@^inner loop@>
-if cur_cs=0 then cur_tok:=(cur_cmd*string_offset)+cur_chr
-else cur_tok:=cs_token_flag+cur_cs;
-end;
-
-@* \[25] Expanding the next token.
-Only a dozen or so command codes |>max_command| can possibly be returned by
-|get_next|; in increasing order, they are |undefined_cs|, |expand_after|,
-|no_expand|, |input|, |if_test|, |fi_or_else|, |cs_name|, |convert|, |the|,
-|top_bot_mark|, |call|, |long_call|, |outer_call|, |long_outer_call|, and
-|end_template|.{\emergencystretch=40pt\par}
-
-@ Sometimes, recursive calls to the following |expand| routine may
-cause exhaustion of the run-time calling stack, resulting in
-forced execution stops by the operating system. To diminish the chance
-of this happening, a counter is used to keep track of the recursion
-depth, in conjunction with a constant called |expand_depth|.
-
-Note that this does not catch all possible infinite recursion loops,
-just the ones that exhaust the application calling stack. The
-actual maximum value of |expand_depth| is outside of our control, but
-the initial setting of |100| should be enough to prevent problems.
-@^system dependencies@>
-
-@<Global...@>=
-expand_depth_count:integer;
-
-@ @<Initialize whatever ...@>=
-expand_depth_count:=0;
-
-@ The |expand| subroutine is used when |cur_cmd>max_command|. It removes a
-``call'' or a conditional or one of the other special operations just
-listed. It follows that |expand| might invoke itself recursively. In all
-cases, |expand| destroys the current token, but it sets things up so that
-the next |get_next| will deliver the appropriate next token. The value of
-|cur_tok| need not be known when |expand| is called.
-
-Since several of the basic scanning routines communicate via global variables,
-their values are saved as local variables of |expand| so that
-recursive calls don't invalidate them.
-@^recursion@>
-
-@p@t\4@>@<Declare the procedure called |macro_call|@>@;@/
-@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
-@t\4@>@<Declare \eTeX\ procedures for expanding@>@;@/
-procedure@?pass_text; forward;@t\2@>
-procedure@?start_input; forward;@t\2@>
-procedure@?conditional; forward;@t\2@>
-procedure@?get_x_token; forward;@t\2@>
-procedure@?conv_toks; forward;@t\2@>
-procedure@?ins_the_toks; forward;@t\2@>
-procedure expand;
-label reswitch;
-var t:halfword; {token that is being ``expanded after''}
-@!p,@!q,@!r:pointer; {for list manipulation}
-@!cur_ptr:pointer; { for a local token list pointer }
-@!j:0..buf_size; {index into |buffer|}
-@!s:ASCII_code; { a character }
-@!cv_backup:integer; {to save the global quantity |cur_val|}
-@!cvl_backup,@!radix_backup,@!co_backup:small_number;
- {to save |cur_val_level|, etc.}
-@!backup_backup:pointer; {to save |link(backup_head)|}
-@!save_scanner_status:small_number; {temporary storage of |scanner_status|}
-begin
-incr(expand_depth_count);
-if expand_depth_count>=expand_depth then overflow("expansion depth",expand_depth);
-cv_backup:=cur_val; cvl_backup:=cur_val_level; radix_backup:=radix;
-co_backup:=cur_order; backup_backup:=link(backup_head);
-reswitch:
-if cur_cmd<call then @<Expand a nonmacro@>
-else if cur_cmd<end_template then macro_call
-else @<Insert a token containing |frozen_endv|@>;
-cur_val:=cv_backup; cur_val_level:=cvl_backup; radix:=radix_backup;
-cur_order:=co_backup; link(backup_head):=backup_backup;
-decr(expand_depth_count);
-end;
-
-@ @<Glob...@>=
-@!is_in_csname: boolean;
-
-@ @<Set init...@>=
-is_in_csname := false;
-
-@ @<Expand a nonmacro@>=
-begin if tracing_commands>1 then show_cur_cmd_chr;
-case cur_cmd of
-top_bot_mark:@<Insert the \(a)appropriate mark text into the scanner@>;
-expand_after:if cur_chr=0 then @<Expand the token after the next token@>
- else @<Negate a boolean conditional and |goto reswitch|@>;
-no_expand: if cur_chr=0 then @<Suppress expansion of the next token@>
- else @<Implement \.{\\primitive}@>;
-cs_name:@<Manufacture a control sequence name@>;
-convert:conv_toks; {this procedure is discussed in Part 27 below}
-the:ins_the_toks; {this procedure is discussed in Part 27 below}
-if_test:conditional; {this procedure is discussed in Part 28 below}
-fi_or_else:@<Terminate the current conditional and skip to \.{\\fi}@>;
-input:@<Initiate or terminate input from a file@>;
-othercases @<Complain about an undefined macro@>
-endcases;
-end
-
-@ It takes only a little shuffling to do what \TeX\ calls \.{\\expandafter}.
-
-@<Expand the token after...@>=
-begin get_token; t:=cur_tok; get_token;
-if cur_cmd>max_command then expand@+else back_input;
-cur_tok:=t; back_input;
-end
-
-@ The implementation of \.{\\noexpand} is a bit trickier, because it is
-necessary to insert a special `|dont_expand|' marker into \TeX's reading
-mechanism. This special marker is processed by |get_next|, but it does
-not slow down the inner loop.
-
-Since \.{\\outer} macros might arise here, we must also
-clear the |scanner_status| temporarily.
-
-@<Suppress expansion...@>=
-begin save_scanner_status:=scanner_status; scanner_status:=normal;
-get_token; scanner_status:=save_scanner_status; t:=cur_tok;
-back_input; {now |start| and |loc| point to the backed-up token |t|}
-if t>=cs_token_flag then
- begin p:=get_avail; info(p):=cs_token_flag+frozen_dont_expand;
- link(p):=loc; start:=p; loc:=p;
- end;
-end
-
-@ The \.{\\primitive} handling. If the primitive meaning of the next
-token is an expandable command, it suffices to replace the current
-token with the primitive one and restart |expand|.
-
-Otherwise, the token we just read has to be pushed back, as well
-as a token matching the internal form of \.{\\primitive}, that is
-sneaked in as an alternate form of |ignore_spaces|.
-@!@:primitive_}{\.{\\primitive} primitive (internalized)@>
-
-An implementation problem surfaces: There really is no |cur_cs|
-attached to the inserted primitive command, so it is safer to set
-|cur_cs| to zero. |cur_tok| has a similar problem. And for the
-non-expanded branch, simply pushing back a token that matches the
-correct internal command does not work, because that approach would
-not survive roundtripping to a temporary file or even a token list.
-
-In a next version, it would be smart to create |frozen_| versions of
-all the primitives. Then, this problem would not happen, at the
-expense of a few hundred extra control sequences.
-
-@<Implement \.{\\primitive}@>=
-begin save_scanner_status := scanner_status; scanner_status:=normal;
-get_token; scanner_status:=save_scanner_status;
-cur_cs := prim_lookup(text(cur_cs));
-if cur_cs<>undefined_primitive then begin
- t:=get_prim_eq_type(cur_cs);
- if t>max_command then begin
- cur_cmd := t;
- cur_chr := get_prim_equiv(cur_cs);
- cur_tok := (cur_cmd*string_offset)+cur_chr;
- cur_cs := 0;
- goto reswitch;
- end
- else begin
- back_input; { now |loc| and |start| point to a one-item list }
- p:=get_avail; info(p):=cs_token_flag+frozen_primitive;
- link(p):=loc; loc:=p; start:=p;
- end;
- end
-else begin
- print_err("Missing primitive name");
- help2("The control sequence marked <to be read again> does not")@/
- ("represent any known primitive.");
- back_error;
- 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;
-cur_cs := prim_lookup(text(cur_cs));
-if cur_cs<>undefined_primitive then begin
- cur_cmd := get_prim_eq_type(cur_cs);
- cur_chr := get_prim_equiv(cur_cs);
- cur_tok := (cur_cmd*string_offset)+cur_chr;
- 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}
-is_in_csname := true;
-repeat get_x_token;
-if cur_cs=0 then store_new_token(cur_tok);
-until cur_cs<>0;
-if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
-is_in_csname := false;
-@<Look up the characters of list |r| in the hash table, and set |cur_cs|@>;
-flush_list(r);
-if eq_type(cur_cs)=undefined_cs then
- begin eq_define(cur_cs,relax,too_big_char); {N.B.: The |save_stack| might change}
- end; {the control sequence will now match `\.{\\relax}'}
-cur_tok:=cur_cs+cs_token_flag; back_input;
-end
-
-@ @<Complain about missing \.{\\endcsname}@>=
-begin print_err("Missing "); print_esc("endcsname"); print(" inserted");
-@.Missing \\endcsname...@>
-help2("The control sequence marked <to be read again> should")@/
- ("not appear between \csname and \endcsname.");
-back_error;
-end
-
-@ @<Look up the characters of list |r| in the hash table...@>=
-j:=first; p:=link(r);
-while p<>null do
- begin if j>=max_buf_stack then
- begin max_buf_stack:=j+4;
- if max_buf_stack=buf_size then
- check_buffer_overflow(max_buf_stack);
-@:TeX capacity exceeded buffer size}{\quad buffer size@>
- end;
- s := info(p) mod string_offset;
- if s <= @"7F then begin
- buffer[j]:=s; incr(j);
- end
- else if s<=@"7FF then begin
- buffer[j]:=@"C0 + s div @"40; incr(j);
- buffer[j]:=@"80 + s mod @"40; incr(j);
- end
- else if s<=@"FFFF then begin
- buffer[j]:=@"E0 + s div @"1000; incr(j);
- buffer[j]:=@"80 + (s mod @"1000) div @"40; incr(j);
- buffer[j]:=@"80 + (s mod @"1000) mod @"40; incr(j);
- end
- else begin
- buffer[j]:=@"F0 + s div @"40000; incr(j);
- buffer[j]:=@"80 + (s mod @"40000) div @"1000; incr(j);
- buffer[j]:=@"80 + ((s mod @"40000) mod @"1000) div @"40; incr(j);
- buffer[j]:=@"80 + ((s mod @"40000) mod @"1000) mod @"40; incr(j);
- end;
- p:=link(p);
- end;
-if j>first then
- begin no_new_control_sequence:=false; cur_cs:=id_lookup(first,j-first);
- no_new_control_sequence:=true;
- end
-else if j=first then cur_cs:=null_cs {the list is empty}
-
-@ An |end_template| command is effectively changed to an |endv| command
-by the following code. (The reason for this is discussed below; the
-|frozen_end_template| at the end of the template has passed the
-|check_outer_validity| test, so its mission of error detection has been
-accomplished.)
-
-@<Insert a token containing |frozen_endv|@>=
-begin cur_tok:=cs_token_flag+frozen_endv; back_input;
-end
-
-@ The processing of \.{\\input} involves the |start_input| subroutine,
-which will be declared later; the processing of \.{\\endinput} is trivial.
-
-@<Put each...@>=
-primitive_tex("input",input,0,0);@/
-@!@:input_}{\.{\\input} primitive@>
-primitive_tex("endinput",input,1,0);@/
-@!@:end_input_}{\.{\\endinput} primitive@>
-
-@ @<Initiate or terminate input...@>=
-if cur_chr=1 then force_eof:=true
-@/@<Cases for |input|@>@/
-else if name_in_progress then insert_relax
-else start_input
-
-@ Sometimes the expansion looks too far ahead, so we want to insert
-a harmless \.{\\relax} into the user's input.
-
-@<Declare the procedure called |insert_relax|@>=
-procedure insert_relax;
-begin cur_tok:=cs_token_flag+cur_cs; back_input;
-cur_tok:=cs_token_flag+frozen_relax; back_input; token_type:=inserted;
-end;
-
-@ Here is a recursive procedure that is \TeX's usual way to get the
-next token of input. It has been slightly optimized to take account of
-common cases.
-
-@p procedure get_x_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
- and expands macros}
-label restart,done;
-begin restart: get_filtered_next;
-@^inner loop@>
-if cur_cmd<=max_command then goto done;
-if cur_cmd>=call then
- if cur_cmd<end_template then macro_call
- else begin cur_cs:=frozen_endv; cur_cmd:=endv;
- goto done; {|cur_chr=null_list|}
- end
-else expand;
-goto restart;
-done: if cur_cs=0 then cur_tok:=(cur_cmd*string_offset)+cur_chr
-else cur_tok:=cs_token_flag+cur_cs;
-end;
-
-@ The |get_x_token| procedure is equivalent to two consecutive
-procedure calls: |get_next; x_token|.
-
-@p procedure x_token; {|get_x_token| without the initial |get_next|}
-begin while cur_cmd>max_command do
- begin expand;
- get_filtered_next;
- end;
-if cur_cs=0 then cur_tok:=(cur_cmd*string_offset)+cur_chr
-else cur_tok:=cs_token_flag+cur_cs;
-end;
-
-@ The |get_filtered_next| procedure allows Lua code to mutate the
-output of |get_next| before \TeX\ looks at it. The implementation
-is in the C file |luatoken.c|.
-
-@d get_filtered_next==get_token_lua
-
-
-
-@ A control sequence that has been \.{\\def}'ed by the user is expanded by
-\TeX's |macro_call| procedure.
-
-Before we get into the details of |macro_call|, however, let's consider the
-treatment of primitives like \.{\\topmark}, since they are essentially
-macros without parameters. The token lists for such marks are kept in five
-global arrays of pointers; we refer to the individual entries of these
-arrays by symbolic macros |top_mark|, etc. The value of |top_mark(x)|, etc.
-is either |null| or a pointer to the reference count of a token list.
-
-The variable |biggest_used_mark| is an aid to try and keep the code
-somehwat efficient without too much extra work: it registers the
-highest mark class ever instantiated by the user, so the loops
-in |fire_up| and |vsplit| do not have to traverse the full range
-|0..biggest_mark|.
-
-@d top_mark_code=0 {the mark in effect at the previous page break}
-@d first_mark_code=1 {the first mark between |top_mark| and |bot_mark|}
-@d bot_mark_code=2 {the mark in effect at the current page break}
-@d split_first_mark_code=3 {the first mark found by \.{\\vsplit}}
-@d split_bot_mark_code=4 {the last mark found by \.{\\vsplit}}
-@#
-@d top_mark(#)==top_marks_array[#]
-@d first_mark(#)==first_marks_array[#]
-@d bot_mark(#)==bot_marks_array[#]
-@d split_first_mark(#)==split_first_marks_array[#]
-@d split_bot_mark(#)==split_bot_marks_array[#]
-@#
-@d delete_top_mark(#)==begin if top_mark(#)<>null then
- delete_token_ref(top_mark(#)); top_mark(#):=null; end
-@d delete_bot_mark(#)==begin if bot_mark(#)<>null then
- delete_token_ref(bot_mark(#)); bot_mark(#):=null; end
-@d delete_first_mark(#)==begin if first_mark(#)<>null then
- delete_token_ref(first_mark(#)); first_mark(#):=null; end
-@d delete_split_first_mark(#)==begin if split_first_mark(#)<>null then
- delete_token_ref(split_first_mark(#)); split_first_mark(#):=null; end
-@d delete_split_bot_mark(#)==begin if split_bot_mark(#)<>null then
- delete_token_ref(split_bot_mark(#)); split_bot_mark(#):=null; end
-@#
-@d clear_marks_code=1
-@d marks_code=5
-@#
-
-@<Glob...@>=
-@!top_marks_array:array[0..biggest_mark] of pointer;
-@!first_marks_array:array[0..biggest_mark] of pointer;
-@!bot_marks_array:array[0..biggest_mark] of pointer;
-@!split_first_marks_array:array[0..biggest_mark] of pointer;
-@!split_bot_marks_array:array[0..biggest_mark] of pointer;
-biggest_used_mark:halfword;
-
-@ @<Set init...@>=
-biggest_used_mark:=0;
-for i:=0 to biggest_mark do begin
- top_mark(i):=null;
- first_mark(i):=null;
- bot_mark(i):=null;
- split_first_mark(i):=null;
- split_bot_mark(i):=null;
-end;
-
-@ @<Put each...@>=
-primitive_tex("topmark",top_bot_mark,top_mark_code,0);
-@!@:top_mark_}{\.{\\topmark} primitive@>
-primitive_tex("firstmark",top_bot_mark,first_mark_code,0);
-@!@:first_mark_}{\.{\\firstmark} primitive@>
-primitive_tex("botmark",top_bot_mark,bot_mark_code,0);
-@!@:bot_mark_}{\.{\\botmark} primitive@>
-primitive_tex("splitfirstmark",top_bot_mark,split_first_mark_code,0);
-@!@:split_first_mark_}{\.{\\splitfirstmark} primitive@>
-primitive_tex("splitbotmark",top_bot_mark,split_bot_mark_code,0);
-@!@:split_bot_mark_}{\.{\\splitbotmark} primitive@>
-primitive_luatex("clearmarks",mark,clear_marks_code,0);@/
-@!@:clearmarks_}{\.{\\clearmarks} primitive@>
-primitive_etex("marks",mark,marks_code,0);
-@!@:marks_}{\.{\\marks} primitive@>
-primitive_etex("topmarks",top_bot_mark,top_mark_code+marks_code,0);
-@!@:top_marks_}{\.{\\topmarks} primitive@>
-primitive_etex("firstmarks",top_bot_mark,first_mark_code+marks_code,0);
-@!@:first_marks_}{\.{\\firstmarks} primitive@>
-primitive_etex("botmarks",top_bot_mark,bot_mark_code+marks_code,0);
-@!@:bot_marks_}{\.{\\botmarks} primitive@>
-primitive_etex("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code,0);
-@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
-primitive_etex("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code,0);
-@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
-
-@ The following code is activated when |cur_cmd=top_bot_mark| and
-when |cur_chr| is a code like |top_mark_code|.
-
-@<Insert the \(a)appropriate mark text into the scanner@>=
-begin t:=cur_chr mod marks_code;
-if cur_chr>=marks_code then scan_mark_num@+else cur_val:=0;
-case t of
- first_mark_code: cur_ptr:=first_mark(cur_val);
- bot_mark_code: cur_ptr:=bot_mark(cur_val);
- split_first_mark_code: cur_ptr:=split_first_mark(cur_val);
- split_bot_mark_code: cur_ptr:=split_bot_mark(cur_val);
- othercases cur_ptr:=top_mark(cur_val)
-endcases;
-if cur_ptr<>null then begin_token_list(cur_ptr,mark_text);
-end
-
-@ Now let's consider |macro_call| itself, which is invoked when \TeX\ is
-scanning a control sequence whose |cur_cmd| is either |call|, |long_call|,
-|outer_call|, or |long_outer_call|. The control sequence definition
-appears in the token list whose reference count is in location |cur_chr|
-of |mem|.
-
-The global variable |long_state| will be set to |call| or to |long_call|,
-depending on whether or not the control sequence disallows \.{\\par}
-in its parameters. The |get_next| routine will set |long_state| to
-|outer_call| and emit \.{\\par}, if a file ends or if an \.{\\outer}
-control sequence occurs in the midst of an argument.
-
-@<Glob...@>=
-@!long_state:call..long_outer_call; {governs the acceptance of \.{\\par}}
-
-@ The parameters, if any, must be scanned before the macro is expanded.
-Parameters are token lists without reference counts. They are placed on
-an auxiliary stack called |pstack| while they are being scanned, since
-the |param_stack| may be losing entries during the matching process.
-(Note that |param_stack| can't be gaining entries, since |macro_call| is
-the only routine that puts anything onto |param_stack|, and it
-is not recursive.)
-
-@<Glob...@>=
-@!pstack:array[0..8] of pointer; {arguments supplied to a macro}
-
-@ After parameter scanning is complete, the parameters are moved to the
-|param_stack|. Then the macro body is fed to the scanner; in other words,
-|macro_call| places the defined text of the control sequence at the
-top of\/ \TeX's input stack, so that |get_next| will proceed to read it
-next.
-
-The global variable |cur_cs| contains the |eqtb| address of the control sequence
-being expanded, when |macro_call| begins. If this control sequence has not been
-declared \.{\\long}, i.e., if its command code in the |eq_type| field is
-not |long_call| or |long_outer_call|, its parameters are not allowed to contain
-the control sequence \.{\\par}. If an illegal \.{\\par} appears, the macro
-call is aborted, and the \.{\\par} will be rescanned.
-
-@<Declare the procedure called |macro_call|@>=
-procedure macro_call; {invokes a user-defined control sequence}
-label exit, continue, done, done1, found;
-var r:pointer; {current node in the macro's token list}
-@!p:pointer; {current node in parameter token list being built}
-@!q:pointer; {new node being put into the token list}
-@!s:pointer; {backup pointer for parameter matching}
-@!t:pointer; {cycle pointer for backup recovery}
-@!u,@!v:pointer; {auxiliary pointers for backup recovery}
-@!rbrace_ptr:pointer; {one step before the last |right_brace| token}
-@!n:small_number; {the number of parameters scanned}
-@!unbalance:halfword; {unmatched left braces in current parameter}
-@!m:halfword; {the number of tokens or groups (usually)}
-@!ref_count:pointer; {start of the token list}
-@!save_scanner_status:small_number; {|scanner_status| upon entry}
-@!save_warning_index:pointer; {|warning_index| upon entry}
-@!match_chr:ASCII_code; {character used in parameter}
-begin save_scanner_status:=scanner_status; save_warning_index:=warning_index;
-warning_index:=cur_cs; ref_count:=cur_chr; r:=link(ref_count); n:=0;
-p:=null; m:=0; rbrace_ptr:=null; match_chr:=0;
-if tracing_macros>0 then @<Show the text of the macro being expanded@>;
-if info(r)=protected_token then r:=link(r);
-if info(r)<>end_match_token then
- @<Scan the parameters and make |link(r)| point to the macro body; but
- |return| if an illegal \.{\\par} is detected@>;
-@<Feed the macro body and its parameters to the scanner@>;
-exit:scanner_status:=save_scanner_status; warning_index:=save_warning_index;
-end;
-
-@ Before we put a new token list on the input stack, it is wise to clean off
-all token lists that have recently been depleted. Then a user macro that ends
-with a call to itself will not require unbounded stack space.
-
-@<Feed the macro body and its parameters to the scanner@>=
-while (state=token_list)and(loc=null)and(token_type<>v_template) do
- end_token_list; {conserve stack space}
-begin_token_list(ref_count,macro); name:=warning_index; loc:=link(r);
-if n>0 then
- begin if param_ptr+n>max_param_stack then
- begin max_param_stack:=param_ptr+n;
- if max_param_stack>param_size then
- overflow("parameter stack size",param_size);
-@:TeX capacity exceeded parameter stack size}{\quad parameter stack size@>
- end;
- for m:=0 to n-1 do param_stack[param_ptr+m]:=pstack[m];
- param_ptr:=param_ptr+n;
- end
-
-@ At this point, the reader will find it advisable to review the explanation
-of token list format that was presented earlier, since many aspects of that
-format are of importance chiefly in the |macro_call| routine.
-
-The token list might begin with a string of compulsory tokens before the
-first |match| or |end_match|. In that case the macro name is supposed to be
-followed by those tokens; the following program will set |s=null| to
-represent this restriction. Otherwise |s| will be set to the first token of
-a string that will delimit the next parameter.
-
-@<Scan the parameters and make |link(r)| point to the macro body...@>=
-begin scanner_status:=matching; unbalance:=0;
-long_state:=eq_type(cur_cs);
-if long_state>=outer_call then long_state:=long_state-2;
-repeat link(temp_token_head):=null;
-if (info(r)>=end_match_token)or(info(r)<match_token) then s:=null
-else begin match_chr:=info(r)-match_token; s:=link(r); r:=s;
- p:=temp_token_head; m:=0;
- end;
-@<Scan a parameter until its delimiter string has been found; or, if |s=null|,
- simply scan the delimiter string@>;@/
-{now |info(r)| is a token whose command code is either |match| or |end_match|}
-until info(r)=end_match_token;
-end
-
-@ If |info(r)| is a |match| or |end_match| command, it cannot be equal to
-any token found by |get_token|. Therefore an undelimited parameter---i.e.,
-a |match| that is immediately followed by |match| or |end_match|---will
-always fail the test `|cur_tok=info(r)|' in the following algorithm.
-
-@<Scan a parameter until its delimiter string has been found; or, ...@>=
-continue: get_token; {set |cur_tok| to the next token of input}
-if cur_tok=info(r) then
- @<Advance \(r)|r|; |goto found| if the parameter delimiter has been
- fully matched, otherwise |goto continue|@>;
-@<Contribute the recently matched tokens to the current parameter, and
- |goto continue| if a partial match is still in effect;
- but abort if |s=null|@>;
-if cur_tok=par_token then if long_state<>long_call then
- if not suppress_long_error 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_token_head); align_state:=align_state-unbalance;
-for m:=0 to n do flush_list(pstack[m]);
-return;
-end
-
-@ When the following code becomes active, we have matched tokens from |s| to
-the predecessor of |r|, and we have found that |cur_tok<>info(r)|. An
-interesting situation now presents itself: If the parameter is to be
-delimited by a string such as `\.{ab}', and if we have scanned `\.{aa}',
-we want to contribute one `\.a' to the current parameter and resume
-looking for a `\.b'. The program must account for such partial matches and
-for others that can be quite complex. But most of the time we have |s=r|
-and nothing needs to be done.
-
-Incidentally, it is possible for \.{\\par} tokens to sneak in to certain
-parameters of non-\.{\\long} macros. For example, consider a case like
-`\.{\\def\\a\#1\\par!\{...\}}' where the first \.{\\par} is not followed
-by an exclamation point. In such situations it does not seem appropriate
-to prohibit the \.{\\par}, so \TeX\ keeps quiet about this bending of
-the rules.
-
-@<Contribute the recently matched tokens to the current parameter...@>=
-if s<>r then begin
- 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 begin
- if cur_tok<>info(v) then goto done
- else begin r:=link(v); goto continue;
- end;
- 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;
- 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
- if not suppress_long_error then
- @<Report a runaway argument and abort@>;
- if cur_tok<right_brace_limit then begin
- if cur_tok<left_brace_limit then incr(unbalance)
- else begin decr(unbalance);
- if unbalance=0 then goto done1;
- end;
- end;
- end;
-done1: rbrace_ptr:=p; store_new_token(cur_tok);
-end
-
-@ If the parameter consists of a single group enclosed in braces, we must
-strip off the enclosing braces. That's why |rbrace_ptr| was introduced.
-
-@<Tidy up the parameter just scanned, and tuck it away@>=
-begin if (m=1)and(info(p)<right_brace_limit)and(p<>temp_token_head) then
- begin link(rbrace_ptr):=null; free_avail(p);
- p:=link(temp_token_head); pstack[n]:=link(p); free_avail(p);
- end
-else pstack[n]:=link(temp_token_head);
-incr(n);
-if tracing_macros>0 then
- begin begin_diagnostic; print_nl(match_chr); print_int(n);
- print("<-"); show_token_list(pstack[n-1],null,1000);
- end_diagnostic(false);
- end;
-end
-
-@ @<Show the text of the macro being expanded@>=
-begin begin_diagnostic; print_ln; print_cs(warning_index);
-token_show(ref_count); end_diagnostic(false);
-end
-
-@* \[26] Basic scanning subroutines.
-Let's turn now to some procedures that \TeX\ calls upon frequently to digest
-certain kinds of patterns in the input. Most of these are quite simple;
-some are quite elaborate. Almost all of the routines call |get_x_token|,
-which can cause them to be invoked recursively.
-@^stomach@>
-@^recursion@>
-
-@ The |scan_left_brace| routine is called when a left brace is supposed to be
-the next non-blank token. (The term ``left brace'' means, more precisely,
-a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to
-appear before the |left_brace|.
-
-@p procedure scan_left_brace; {reads a mandatory |left_brace|}
-begin @<Get the next non-blank non-relax non-call token@>;
-if cur_cmd<>left_brace then
- begin print_err("Missing { inserted");
-@.Missing \{ inserted@>
- help4("A left brace was mandatory here, so I've put one in.")@/
- ("You might want to delete and/or insert some corrections")@/
- ("so that I will find a matching right brace soon.")@/
- ("(If you're confused by all this, try typing `I}' now.)");
- back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace;
- cur_chr:="{"; incr(align_state);
- end;
-end;
-
-@ @<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
-
-@ Here is a procedure that sounds an alarm when mu and non-mu units
-are being switched.
-
-@p procedure mu_error;
-begin print_err("Incompatible glue units");
-@.Incompatible glue units@>
-help1("I'm going to assume that 1mu=1pt when they're mixed.");
-error;
-end;
-
-@ The next routine `|scan_something_internal|' is used to fetch internal
-numeric quantities like `\.{\\hsize}', and also to handle the `\.{\\the}'
-when expanding constructions like `\.{\\the\\toks0}' and
-`\.{\\the\\baselineskip}'. Soon we will be considering the |scan_int|
-procedure, which calls |scan_something_internal|; on the other hand,
-|scan_something_internal| also calls |scan_int|, for constructions like
-`\.{\\catcode\`\\\$}' or `\.{\\fontdimen} \.3 \.{\\ff}'. So we
-have to declare |scan_int| as a |forward| procedure. A few other
-procedures are also declared at this point.
-
-@p procedure@?scan_int; forward; {scans an integer value}
-@t\4\4@>@<Declare procedures that scan restricted classes of integers@>@;
-@t\4\4@>@<Declare \eTeX\ procedures for scanning@>@;
-@t\4\4@>@<Declare procedures that scan font-related stuff@>
-@t\4\4@>@<Declare procedures that scan ocp-related stuff@>
-
-@ \TeX\ doesn't know exactly what to expect when
-|scan_something_internal| begins. For example, an integer or
-dimension or glue value could occur immediately after `\.{\\hskip}';
-and one can even say \.{\\the} with respect to token lists in
-constructions like `\.{\\xdef\\o\{\\the\\output\}}'. On the other
-hand, only integers are allowed after a construction like
-`\.{\\count}'. To handle the various possibilities,
-|scan_something_internal| has a |level| parameter, which tells the
-``highest'' kind of quantity that |scan_something_internal| is allowed
-to produce. Eight levels are distinguished, namely |int_val|,
-|attr_val|, |dimen_val|, |glue_val|, |mu_val|, |dir_val|, |ident_val|,
-and |tok_val|.
-
-The output of |scan_something_internal| (and of the other routines
-|scan_int|, |scan_dimen|, and |scan_glue| below) is put into the global
-variable |cur_val|, and its level is put into |cur_val_level|. The highest
-values of |cur_val_level| are special: |mu_val| is used only when
-|cur_val| points to something in a ``muskip'' register, or to one of the
-three parameters \.{\\thinmuskip}, \.{\\medmuskip}, \.{\\thickmuskip};
-|ident_val| is used only when |cur_val| points to a font identifier;
-|tok_val| is used only when |cur_val| points to |null| or to the reference
-count of a token list. The last two cases are allowed only when
-|scan_something_internal| is called with |level=tok_val|.
-
-If the output is glue, |cur_val| will point to a glue specification, and
-the reference count of that glue will have been updated to reflect this
-reference; if the output is a nonempty token list, |cur_val| will point to
-its reference count, but in this case the count will not have been updated.
-Otherwise |cur_val| will contain the integer or scaled value in question.
-
-@d int_val=0 {integer values}
-@d attr_val=1 {integer values}
-@d dimen_val=2 {dimension values}
-@d glue_val=3 {glue specifications}
-@d mu_val=4 {math glue specifications}
-@d dir_val=5 {directions}
-@d ident_val=6 {font identifier}
-@d tok_val=7 {token lists}
-
-@<Glob...@>=
-@!cur_val:integer; {value returned by numeric scanners}
-@!cur_val1:integer; {delcodes are now 51 digits}
-@!cur_val_level:int_val..tok_val; {the ``level'' of this value}
-
-@ The hash table is initialized with `\.{\\count}', `\.{\\attribute}',
-`\.{\\dimen}', `\.{\\skip}', and `\.{\\muskip}' all having |register|
-as their command code; they are distinguished by the |chr_code|, which
-is either |int_val|, |attr_val|, |dimen_val|, |glue_val|, or |mu_val|.
-
-@<Put each...@>=
-primitive_tex("count",register,int_val,0);
-@!@:count_}{\.{\\count} primitive@>
-primitive_luatex("attribute",register,attr_val,0);
-@!@:count_}{\.{\\attribute} primitive@>
-primitive_tex("dimen",register,dimen_val,0);
-@!@:dimen_}{\.{\\dimen} primitive@>
-primitive_tex("skip",register,glue_val,0);
-@!@:skip_}{\.{\\skip} primitive@>
-primitive_tex("muskip",register,mu_val,0);
-
-@ OK, we're ready for |scan_something_internal| itself. A second parameter,
-|negative|, is set |true| if the value that is found should be negated.
-It is assumed that |cur_cmd| and |cur_chr| represent the first token of
-the internal quantity to be scanned; an error will be signalled if
-|cur_cmd<min_internal| or |cur_cmd>max_internal|.
-
-@d scanned_result_end(#)==cur_val_level:=#;@+end
-@d scanned_result(#)==@+begin cur_val:=#;scanned_result_end
-
-@p procedure scan_something_internal(@!level:small_number;@!negative:boolean);
- {fetch an internal parameter}
-label exit, restart;
-var m:halfword; {|chr_code| part of the operand token}
- n, k: integer; {accumulators}
-@!q:halfword; {general purpose index}
-@!p:0..nest_size; {index into |nest|}
-begin restart: m:=cur_chr;
-case cur_cmd of
-def_char_code: @<Fetch a character code from some table@>;
-def_del_code: @<Fetch a character code from some table@>;
-extdef_math_code: @<Fetch an ext character code from some table@>;
-extdef_del_code: @<Fetch an ext character code from some table@>;
-toks_register,assign_toks,set_font,def_font,letterspace_font,pdf_copy_font:
- @<Fetch a token list or font identifier, provided that |level=tok_val|@>;
-def_family:
- @<Fetch a math font identifier@>;
-set_math_param:
- @<Fetch a math param@>;
-assign_int: scanned_result(eqtb[m].int)(int_val);
-assign_attr: scanned_result(eqtb[m].int)(int_val);
-assign_box_dir: begin
- scan_register_num;
- m:=cur_val;
- if box(m)<>null then cur_val:=box_dir(box(m))
- else cur_val:=0;
- cur_val_level:=dir_val;
- end;
-assign_dir: scanned_result(eqtb[m].int)(dir_val);
-assign_dimen: scanned_result(eqtb[m].sc)(dimen_val);
-assign_glue: scanned_result(equiv(m))(glue_val);
-assign_mu_glue: scanned_result(equiv(m))(mu_val);
-math_style: scanned_result(m)(int_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_tex_shape: @<Fetch the |par_shape| size@>;
-set_etex_shape: @<Fetch a penalties array element@>;
-set_box_dimen: @<Fetch a box dimension@>;
-char_given,math_given,omath_given,xmath_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;
-
-procedure scan_something_simple(@!cmd:halfword;@!subitem:halfword);
- {fetch an internal parameter}
-label exit;
-var m:halfword; {|chr_code| part of the operand token}
-@!q:halfword; {general purpose index}
-@!p:0..nest_size; {index into |nest|}
-@!level:small_number; { allowed level}
-@!negative:boolean;
-@!save_cur_chr:integer;
-begin m:=subitem; level:=tok_val;
-negative:=false; {never actually used, added for etexs |last_item| cases}
-case cmd of
-assign_toks: scanned_result(equiv(m))(tok_val);
-assign_int: scanned_result(eqtb[m].int)(int_val);
-assign_attr: scanned_result(eqtb[m].int)(int_val);
-assign_dir: scanned_result(eqtb[m].int)(dir_val);
-assign_dimen: scanned_result(eqtb[m].sc)(dimen_val);
-assign_glue: scanned_result(equiv(m))(glue_val);
-assign_mu_glue: scanned_result(equiv(m))(mu_val);
-math_style: scanned_result(m)(int_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_tex_shape: @<Fetch the |par_shape| size@>;
-set_etex_shape: @<Fetch a penalties array element@>;
-last_item: begin
- save_cur_chr:=cur_chr;
- cur_chr:=subitem;
- @<Fetch an item in the current node, if appropriate@>;
- cur_chr:=save_cur_chr;
- end;
-char_given,math_given,omath_given,xmath_given:
- scanned_result(m)(int_val); {TH: TODO, doesnt work}
-othercases @<Complain that |texlib| can't do this; give zero result@>
-endcases;@/
-exit:end;
-
-@ @<Fetch a character code from some table@>=
-begin scan_char_num;
-if m=math_code_base then begin
- cur_val1:=get_math_code_num(cur_val);
- scanned_result(cur_val1)(int_val);
- end
-else if m=lc_code_base then begin
- cur_val1:=get_lc_code(cur_val);
- scanned_result(cur_val1)(int_val);
- end
-else if m=uc_code_base then begin
- cur_val1:=get_uc_code(cur_val);
- scanned_result(cur_val1)(int_val);
- end
-else if m=sf_code_base then begin
- cur_val1:=get_sf_code(cur_val);
- scanned_result(cur_val1)(int_val);
- end
-else if m=cat_code_base then begin
- cur_val1:=get_cat_code(cat_code_table,cur_val);
- scanned_result(cur_val1)(int_val);
- end
-else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val)
-else scanned_result(eqtb[m+cur_val].int)(int_val);
-end
-
-@ @<Fetch an ext character code from some table@>=
-begin scan_char_num;
-if m=math_code_base then begin
- cur_val1:=get_math_code_num(cur_val);
- scanned_result(cur_val1)(int_val);
- end
-{ TH: next two lines should not be possible }
-else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val)
-else scanned_result(eqtb[m+cur_val].int)(int_val);
-end
-
-@ @<Fetch a token list...@>=
-if level<>tok_val then
- begin print_err("Missing number, treated as zero");
-@.Missing number...@>
- help3("A number should have been here; I inserted `0'.")@/
- ("(If you can't figure out why I needed to see a number,")@/
- ("look up `weird error' in the index to The TeXbook.)");
-@:TeXbook}{\sl The \TeX book@>
- back_error; scanned_result(0)(dimen_val);
- end
-else if cur_cmd<=assign_toks then
- begin if cur_cmd<assign_toks then {|cur_cmd=toks_register|}
- begin scan_register_num; m:=toks_base+cur_val;
- end;
- scanned_result(equiv(m))(tok_val);
- end
-else begin back_input; scan_font_ident;
- scanned_result(font_id_base+cur_val)(ident_val);
- end
-
-@ @<Fetch a math font identifier@>=
-begin scan_char_num; cur_val1:=fam_fnt(cur_val,m);
- scanned_result(font_id_base+cur_val1)(ident_val);
- end
-
-@ @<Fetch a math param@>=
-begin cur_val1:=cur_chr; get_token;
- if cur_cmd<>math_style then
- begin print_err("Missing math style, treated as \\displaystyle");
-@.Missing number...@>
- help1("A style should have been here; I inserted `\\displaystyle'.");
- cur_val:=display_style;
- back_error;
- end
- else
- cur_val:=cur_chr;
- if cur_val1<math_param_first_mu_glue then begin
- if cur_val1=math_param_radical_degree_raise then begin
- cur_val1 := get_math_param(cur_val1,cur_chr);
- scanned_result(cur_val1)(int_val);
- end
- else begin
- cur_val1 := get_math_param(cur_val1,cur_chr);
- scanned_result(cur_val1)(dimen_val);
- end;
- end
- else begin
- cur_val1 := get_math_param(cur_val1,cur_chr);
- if cur_val1=thin_mu_skip_code then cur_val1:=thin_mu_skip
- else if cur_val1=med_mu_skip_code then cur_val1:=med_mu_skip
- else if cur_val1=thick_mu_skip_code then cur_val1:=thick_mu_skip;
- scanned_result(cur_val1)(mu_val);
- end;
- end
-
-
-@ Users refer to `\.{\\the\\spacefactor}' only in horizontal
-mode, and to `\.{\\the\\prevdepth}' only in vertical mode; so we put the
-associated mode in the modifier part of the |set_aux| command.
-The |set_page_int| command has modifier 0 or 1, for `\.{\\deadcycles}' and
-`\.{\\insertpenalties}', respectively. The |set_box_dimen| command is
-modified by either |width_offset|, |height_offset|, or |depth_offset|.
-And the |last_item| command is modified by either |int_val|, |dimen_val|,
-|glue_val|, |input_line_no_code|, or |badness_code|.
-\pdfTeX\ adds the codes for its extensions: |pdftex_version_code|, \dots\ .
-\eTeX\ inserts |last_node_type_code| after |glue_val| and adds
-the codes for its extensions: |eTeX_version_code|, \dots\ .
-
-@d last_node_type_code=glue_val+1 {code for \.{\\lastnodetype}}
-@d input_line_no_code=glue_val+2 {code for \.{\\inputlineno}}
-@d badness_code=input_line_no_code+1 {code for \.{\\badness}}
-@#
-@d pdftex_first_rint_code = badness_code + 1 {base for \pdfTeX's command codes}
-@d pdftex_version_code = pdftex_first_rint_code + 0 {code for \.{\\pdftexversion}}
-@d pdf_last_obj_code = pdftex_first_rint_code + 1 {code for \.{\\pdflastobj}}
-@d pdf_last_xform_code = pdftex_first_rint_code + 2 {code for \.{\\pdflastxform}}
-@d pdf_last_ximage_code = pdftex_first_rint_code + 3 {code for \.{\\pdflastximage}}
-@d pdf_last_ximage_pages_code = pdftex_first_rint_code + 4 {code for \.{\\pdflastximagepages}}
-@d pdf_last_annot_code = pdftex_first_rint_code + 5 {code for \.{\\pdflastannot}}
-@d pdf_last_x_pos_code = pdftex_first_rint_code + 6 {code for \.{\\pdflastxpos}}
-@d pdf_last_y_pos_code = pdftex_first_rint_code + 7 {code for \.{\\pdflastypos}}
-@d pdf_retval_code = pdftex_first_rint_code + 8 {global multi-purpose return value}
-@d pdf_last_ximage_colordepth_code = pdftex_first_rint_code + 9 {code for \.{\\pdflastximagecolordepth}}
-@d random_seed_code = pdftex_first_rint_code + 10 {code for \.{\\pdfrandomseed}}
-@d pdf_last_link_code = pdftex_first_rint_code + 11 {code for \.{\\pdflastlink}}
-@d luatex_version_code = pdftex_first_rint_code + 12 {code for \.{\\luatexversion}}
-@d pdftex_last_item_codes = pdftex_first_rint_code + 12 {end of \pdfTeX's command codes}
-@#
-@d Aleph_int=pdftex_last_item_codes+1 {first of \Aleph\ codes for integers}
-@d Aleph_int_num=5 {number of \Aleph\ integers}
-@d eTeX_int=Aleph_int+Aleph_int_num {first of \eTeX\ codes for integers}
-@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions}
-@d eTeX_glue=eTeX_dim+9 {first of \eTeX\ codes for glue}
-@d eTeX_mu=eTeX_glue+1 {first of \eTeX\ codes for muglue}
-@d eTeX_expr=eTeX_mu+1 {first of \eTeX\ codes for expressions}
-
-@<Put each...@>=
-primitive_tex("spacefactor",set_aux,hmode,0);
-@!@:space_factor_}{\.{\\spacefactor} primitive@>
-primitive_tex("prevdepth",set_aux,vmode,0);@/
-@!@:prev_depth_}{\.{\\prevdepth} primitive@>
-primitive_tex("deadcycles",set_page_int,0,0);
-@!@:dead_cycles_}{\.{\\deadcycles} primitive@>
-primitive_tex("insertpenalties",set_page_int,1,0);
-@!@:insert_penalties_}{\.{\\insertpenalties} primitive@>
-primitive_tex("wd",set_box_dimen,width_offset,0);
-@!@:wd_}{\.{\\wd} primitive@>
-primitive_tex("ht",set_box_dimen,height_offset,0);
-@!@:ht_}{\.{\\ht} primitive@>
-primitive_tex("dp",set_box_dimen,depth_offset,0);
-@!@:dp_}{\.{\\dp} primitive@>
-primitive_tex("lastpenalty",last_item,int_val,0);
-@!@:last_penalty_}{\.{\\lastpenalty} primitive@>
-primitive_tex("lastkern",last_item,dimen_val,0);
-@!@:last_kern_}{\.{\\lastkern} primitive@>
-primitive_tex("lastskip",last_item,glue_val,0);
-@!@:last_skip_}{\.{\\lastskip} primitive@>
-primitive_tex("inputlineno",last_item,input_line_no_code,0);
-@!@:input_line_no_}{\.{\\inputlineno} primitive@>
-primitive_tex("badness",last_item,badness_code,0);
-@!@:badness_}{\.{\\badness} primitive@>
-primitive_pdftex("pdftexversion",last_item,pdftex_version_code,0);@/
-@!@:pdftex_version_}{\.{\\pdftexversion} primitive@>
-primitive_luatex("luatexversion",last_item,luatex_version_code,0);@/
-@!@:luatex_version_}{\.{\\luatexversion} primitive@>
-primitive_pdftex("pdflastobj",last_item,pdf_last_obj_code,0);@/
-@!@:pdf_last_obj_}{\.{\\pdflastobj} primitive@>
-primitive_pdftex("pdflastxform",last_item,pdf_last_xform_code,0);@/
-@!@:pdf_last_xform_}{\.{\\pdflastxform} primitive@>
-primitive_pdftex("pdflastximage",last_item,pdf_last_ximage_code,0);@/
-@!@:pdf_last_ximage_}{\.{\\pdflastximage} primitive@>
-primitive_pdftex("pdflastximagepages",last_item,pdf_last_ximage_pages_code,0);@/
-@!@:pdf_last_ximage_pages_}{\.{\\pdflastximagepages} primitive@>
-primitive_pdftex("pdflastannot",last_item,pdf_last_annot_code,0);@/
-@!@:pdf_last_annot_}{\.{\\pdflastannot} primitive@>
-primitive_pdftex("pdflastxpos",last_item,pdf_last_x_pos_code,0);@/
-@!@:pdf_last_x_pos_}{\.{\\pdflastxpos} primitive@>
-primitive_pdftex("pdflastypos",last_item,pdf_last_y_pos_code,0);@/
-@!@:pdf_last_y_pos_}{\.{\\pdflastypos} primitive@>
-primitive_pdftex("pdfretval",last_item,pdf_retval_code,0);@/
-@!@:pdf_retval_}{\.{\\pdfretval} primitive@>
-primitive_pdftex("pdflastximagecolordepth",last_item,pdf_last_ximage_colordepth_code,0);@/
-@!@:pdf_last_ximage_colordepth_}{\.{\\pdflastximagecolordepth} primitive@>
-primitive_pdftex("pdfrandomseed",last_item,random_seed_code,0);
-@!@:random_seed_}{\.{\\pdfrandomseed} primitive@>
-primitive_pdftex("pdflastlink",last_item,pdf_last_link_code,0);@/
-@!@:pdf_last_link_}{\.{\\pdflastlink} primitive@>
-
-@ @<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;
-if box(cur_val)=null then cur_val:=0 @+else cur_val:=vmem(box(cur_val)+m).sc;
-cur_val_level:=dimen_val;
-end
-
-@ Inside an \.{\\output} routine, a user may wish to look at the page totals
-that were present at the moment when output was triggered.
-
-@d max_dimen==@'7777777777 {$2^{30}-1$}
-
-@<Fetch something on the |page_so_far|@>=
-begin if (page_contents=empty) and (not output_active) then
- if m=0 then cur_val:=max_dimen@+else cur_val:=0
-else cur_val:=page_so_far[m];
-cur_val_level:=dimen_val;
-end
-
-@ @<Fetch the |prev_graf|@>=
-if mode=0 then scanned_result(0)(int_val) {|prev_graf=0| within \.{\\write}}
-else begin nest[nest_ptr]:=cur_list; p:=nest_ptr;
- while abs(nest[p].mode_field)<>vmode do decr(p);
- scanned_result(nest[p].pg_field)(int_val);
- end
-
-@ @<Fetch the |par_shape| size@>=
-begin if par_shape_ptr=null then cur_val:=0
-else cur_val:=vinfo(par_shape_ptr+1);
-cur_val_level:=int_val;
-end
-
-@ Here is where \.{\\lastpenalty}, \.{\\lastkern}, and \.{\\lastskip} are
-implemented. The reference count for \.{\\lastskip} will be updated later.
-
-We also handle \.{\\inputlineno} and \.{\\badness} here, because they are
-legal in similar contexts.
-
-@<Fetch an item in the current node...@>=
-if m>=input_line_no_code then
- if m>=eTeX_glue then @<Process an expression and |return|@>@;
- else if m>=eTeX_dim then
- begin case m of
- @/@<Cases for fetching a dimension value@>@/
- end; {there are no other cases}
- cur_val_level:=dimen_val;
- end
- else begin case m of
- input_line_no_code: cur_val:=line;
- badness_code: cur_val:=last_badness;
- pdftex_version_code: cur_val := pdftex_version;
- luatex_version_code: cur_val := luatex_version;
- pdf_last_obj_code: cur_val := pdf_last_obj;
- pdf_last_xform_code: cur_val := pdf_last_xform;
- pdf_last_ximage_code: cur_val := pdf_last_ximage;
- pdf_last_ximage_pages_code: cur_val := pdf_last_ximage_pages;
- pdf_last_annot_code: cur_val := pdf_last_annot;
- pdf_last_x_pos_code: cur_val := pdf_last_x_pos;
- pdf_last_y_pos_code: cur_val := pdf_last_y_pos;
- pdf_retval_code: cur_val := pdf_retval;
- pdf_last_ximage_colordepth_code: cur_val := pdf_last_ximage_colordepth;
- random_seed_code: cur_val := random_seed;
- pdf_last_link_code: cur_val := pdf_last_link;
- @/@<Cases for fetching an integer value@>@/
- end; {there are no other cases}
- cur_val_level:=int_val;
- end
-else begin if cur_chr=glue_val then cur_val:=zero_glue@+else cur_val:=0;
- if cur_chr=last_node_type_code then
- begin cur_val_level:=int_val;
- if (tail=head)or(mode=0) then cur_val:=-1;
- end
- else cur_val_level:=cur_chr;
- {TODO: check this thoroughly! The structural change to the
- |is_char_node| macro was wreaking havoc here, and possibly elsewhere.}
- if tail<>contrib_head and not is_char_node(tail)and(mode<>0) then
- case cur_chr of
- int_val: if type(tail)=penalty_node then cur_val:=penalty(tail);
- dimen_val: if type(tail)=kern_node then cur_val:=width(tail);
- glue_val: if type(tail)=glue_node then
- begin cur_val:=glue_ptr(tail);
- if subtype(tail)=mu_glue then cur_val_level:=mu_val;
- end;
- last_node_type_code:
- cur_val := visible_last_node_type(tail);
- end {there are no other cases}
- else if (mode=vmode)and(tail=head) then
- case cur_chr of
- int_val: cur_val:=last_penalty;
- dimen_val: cur_val:=last_kern;
- glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
- last_node_type_code: cur_val:=last_node_type;
- end; {there are no other cases}
- end
-
-@ @<Fetch a font dimension@>=
-get_font_dimen
-
-@ @<Fetch a font integer@>=
-begin scan_font_ident;
-if m=0 then scanned_result(hyphen_char(cur_val))(int_val)
-else if m=1 then scanned_result(skew_char(cur_val))(int_val)
-else if m=no_lig_code then scanned_result(test_no_ligatures(cur_val))(int_val)
-else begin
- n := cur_val;
- scan_char_num;
- k := cur_val;
- case m of
- lp_code_base: scanned_result(get_lp_code(n, k))(int_val);
- rp_code_base: scanned_result(get_rp_code(n, k))(int_val);
- ef_code_base: scanned_result(get_ef_code(n, k))(int_val);
- tag_code: scanned_result(get_tag_code(n, k))(int_val);
- end;
-end;
-end
-
-@ @<Fetch a register@>=
-begin scan_register_num;
-case m of
-int_val:cur_val:=count(cur_val);
-attr_val:cur_val:=attribute(cur_val);
-dimen_val:cur_val:=dimen(cur_val);
-glue_val: cur_val:=skip(cur_val);
-mu_val: cur_val:=mu_skip(cur_val);
-end; {there are no other cases}
-cur_val_level:=m;
-end
-
-@ @<Complain that \.{\\the} can't do this; give zero result@>=
-begin print_err("You can't use `"); print_cmd_chr(cur_cmd,cur_chr);
-@.You can't use x after ...@>
-print("' after "); print_esc("the");
-help1("I'm forgetting what you said and using zero instead.");
-error;
-if level<>tok_val then scanned_result(0)(dimen_val)
-else scanned_result(0)(int_val);
-end
-
-@ @<Complain that |texlib| can't do this; give zero result@>=
-begin print_err("You can't use `"); print_cmd_chr(cmd,m);
-print("' as tex library index");
-help1("I'm forgetting what you said and using zero instead.");
-error;
-if level<>tok_val then scanned_result(0)(dimen_val)
-else scanned_result(0)(int_val);
-end
-
-
-@ When a |glue_val| changes to a |dimen_val|, we use the width component
-of the glue; there is no need to decrease the reference count, since it
-has not yet been increased. When a |dimen_val| changes to an |int_val|,
-we use scaled points so that the value doesn't actually change. And when a
-|mu_val| changes to a |glue_val|, the value doesn't change either.
-
-@<Convert \(c)|cur_val| to a lower level@>=
-begin if cur_val_level=glue_val then cur_val:=width(cur_val)
-else if cur_val_level=mu_val then mu_error;
-decr(cur_val_level);
-end
-
-@ If |cur_val| points to a glue specification at this point, the reference
-count for the glue does not yet include the reference by |cur_val|.
-If |negative| is |true|, |cur_val_level| is known to be |<=mu_val|.
-
-@<Fix the reference count, if any, ...@>=
-if negative then begin
- 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);
- end
-else if (cur_val_level>=glue_val)and(cur_val_level<=mu_val) then
- add_glue_ref(cur_val)
-
-@ @<Negate all three...@>=
-begin negate(width(cur_val));
-negate(stretch(cur_val));
-negate(shrink(cur_val));
-end
-
-@ Our next goal is to write the |scan_int| procedure, which scans anything that
-\TeX\ treats as an integer. But first we might as well look at some simple
-applications of |scan_int| that have already been made inside of
-|scan_something_internal|.
-
-@
-@d dir_T=0
-@d dir_L=1
-@d dir_B=2
-@d dir_R=3
-@d dir_eq_end(#)==(#)
-@d dir_eq(#)==(#)=dir_eq_end
-@d dir_ne_end(#)==(#)
-@d dir_ne(#)==(#)<>dir_ne_end
-@d dir_opposite_end(#)==((#) mod 4)
-@d dir_opposite(#)==(((#)+2) mod 4)=dir_opposite_end
-@d dir_parallel_end(#)==((#) mod 2)
-@d dir_parallel(#)==((#) mod 2)=dir_parallel_end
-@d dir_orthogonal_end(#)==(# mod 2)
-@d dir_orthogonal(#)==((#) mod 2)<>dir_orthogonal_end
-@d dir_next_end(#)==((#) mod 4)
-@d dir_next(#)==(((#)+3) mod 4)=dir_next_end
-@d dir_prev_end(#)==((#) mod 4)
-@d dir_prev(#)==(((#)+1) mod 4)=dir_prev_end
-
-@d dir_horizontal(#)==(((#)=dir_L) or ((#)=dir_R))
-@d dir_vertical(#)==(((#)=dir_T) or ((#)=dir_B))
-
-{box directions}
-@d dir_TL_=0
-@d dir_TR_=1
-@d dir_LT_=2
-@d dir_LB_=3
-@d dir_BL_=4
-@d dir_BR_=5
-@d dir_RT_=6
-@d dir_RB_=7
-
-{font directions}
-@d dir__LT= 0
-@d dir__LL= 1
-@d dir__LB= 2
-@d dir__LR= 3
-@d dir__RT= 4
-@d dir__RL= 5
-@d dir__RB= 6
-@d dir__RR= 7
-@d dir__TT= 8
-@d dir__TL= 9
-@d dir__TB=10
-@d dir__TR=11
-@d dir__BT=12
-@d dir__BL=13
-@d dir__BB=14
-@d dir__BR=15
-
-@d is_mirrored(#)==(dir_opposite(dir_primary[#])(dir_tertiary[#]))
-@d is_rotated(#)==(dir_parallel(dir_secondary[#])(dir_tertiary[#]))
-@d font_direction(#)==(# mod 16)
-@d box_direction(#)==(# div 4)
-
-@ It is nice to have routines that say what they do, so the original
-|scan_eight_bit_int| is superceded by |scan_register_num| and
-|scan_mark_num|. It may become split up even further in the future.
-
-@<Declare procedures that scan restricted classes of integers@>=
-procedure scan_register_num;
-begin scan_int;
-if (cur_val<0)or(cur_val>biggest_reg) then
- begin print_err("Bad register code");
-@.Bad register code@>
- help2("A register number must be between 0 and 65535.")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-end;
-procedure scan_mark_num;
-begin scan_int;
-if (cur_val<0)or(cur_val>biggest_mark) then
- begin print_err("Bad marks code");
-@.Bad marks code@>
- help2("A marks class must be between 0 and 65535.")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-end;
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-procedure scan_char_num;
-begin scan_int;
-if (cur_val<0)or(cur_val>biggest_char) then
- begin print_err("Bad character code");
-@.Bad character code@>
- help2("A character number must be between 0 and biggest_char.")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-end;
-
-@ While we're at it, we might as well deal with similar routines that
-will be needed later.
-
-@<Declare procedures that scan restricted classes of integers@>=
-procedure scan_four_bit_int;
-begin scan_int;
-if (cur_val<0)or(cur_val>15) then
- begin print_err("Bad number");
-@.Bad number@>
- help2("Since I expected to read a number between 0 and 15,")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-end;
-procedure scan_math_family_int;
-begin scan_int;
-if (cur_val<0)or(cur_val>255) then
- begin print_err("Bad number");
-@.Bad number@>
- help2("Since I expected to read a number between 0 and 255,")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-end;
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-procedure scan_real_fifteen_bit_int;
-begin scan_int;
-if (cur_val<0)or(cur_val>@'77777) then
- begin print_err("Bad mathchar");
-@.Bad mathchar@>
- help2("A mathchar number must be between 0 and 32767.")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-end;
-procedure scan_fifteen_bit_int;
-begin scan_int;
-if (cur_val<0)or(cur_val>@'77777) then
- begin print_err("Bad mathchar");
-@.Bad mathchar@>
- help2("A mathchar number must be between 0 and 32767.")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-cur_val := ((cur_val div @"1000) * @"1000000) +
- (((cur_val mod @"1000) div @"100) * @"10000) +
- (cur_val mod @"100);
-end;
-procedure scan_big_fifteen_bit_int;
-begin scan_int;
-if (cur_val<0)or(cur_val>@"7FFFFFF) then
- begin print_err("Bad extended mathchar");
-@.Bad mathchar@>
- help2("An extended mathchar number must be between 0 and ""7FFFFFF.")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-end;
-
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-procedure scan_twenty_seven_bit_int;
-begin scan_int;
-if (cur_val<0)or(cur_val>@'777777777) then
- begin print_err("Bad delimiter code");
-@.Bad delimiter code@>
- help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-end;
-
-procedure scan_fifty_one_bit_int;
-var iiii:integer;
-begin scan_int;
-if (cur_val<0)or(cur_val>@'777777777) then
- begin print_err("Bad delimiter code");
-@.Bad delimiter code@>
- help2("A numeric delimiter (first part) must be between 0 and 2^{27}-1.")
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-iiii:=cur_val;
-scan_int;
-if (cur_val<0)or(cur_val>@"FFFFFF) then
- begin print_err("Bad delimiter code");
-@.Bad delimiter code@>
-help2("A numeric delimiter (second part) must be between 0 and 2^{24}-1.")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-cur_val1:=cur_val;
-cur_val:=iiii;
-end;
-
-
-procedure scan_string_argument;
-var s:integer;
-begin
-scan_left_brace;
-get_x_token;
-while (cur_cmd<>right_brace) do
- begin
- if (cur_cmd=letter) or (cur_cmd=other_char) then begin
- str_room(1); append_char(cur_chr);
- end
- else if (cur_cmd=spacer) then begin
- str_room(1); append_char(" ");
- end
- else begin
- print("Bad token appearing in string argument");
- end;
- get_x_token;
- end;
-s:=make_string;
-if str_eq_str("mi",s) then s:="mi";
-if str_eq_str("mo",s) then s:="mo";
-if str_eq_str("mn",s) then s:="mn";
-cur_val:=s;
-end;
-
-@ An integer number can be preceded by any number of spaces and `\.+' or
-`\.-' signs. Then comes either a decimal constant (i.e., radix 10), an
-octal constant (i.e., radix 8, preceded by~\.\'), a hexadecimal constant
-(radix 16, preceded by~\."), an alphabetic constant (preceded by~\.\`), or
-an internal variable. After scanning is complete,
-|cur_val| will contain the answer, which must be at most
-$2^{31}-1=2147483647$ in absolute value. The value of |radix| is set to
-10, 8, or 16 in the cases of decimal, octal, or hexadecimal constants,
-otherwise |radix| is set to zero. An optional space follows a constant.
-
-@d octal_token=other_token+"'" {apostrophe, indicates an octal constant}
-@d hex_token=other_token+"""" {double quote, indicates a hex constant}
-@d alpha_token=other_token+"`" {reverse apostrophe, precedes alpha constants}
-@d point_token=other_token+"." {decimal point}
-@d continental_point_token=other_token+"," {decimal point, Eurostyle}
-
-@<Glob...@>=
-@!radix:small_number; {|scan_int| sets this to 8, 10, 16, or zero}
-
-@ We initialize the following global variables just in case |expand|
-comes into action before any of the basic scanning routines has assigned
-them a value.
-
-@<Set init...@>=
-cur_val:=0; cur_val_level:=int_val; radix:=0; cur_order:=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=math_style then
- cur_val:=cur_chr
-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 begin
- if cur_cmd=right_brace then incr(align_state)
- else decr(align_state);
- end;
- end
-else begin {the value of a csname in this context is its name}
- if is_active_csname(cur_tok-cs_token_flag) then
- cur_val:=active_csname_value(cur_tok-cs_token_flag)
- else if single_letter(text(cur_tok-cs_token_flag)) then
- cur_val:=pool_to_unichar(str_start_macro(text(cur_tok-cs_token_flag)))
- else
- cur_val:=too_big_char;
-end;
-if cur_val>biggest_char then
- begin print_err("Improper alphabetic constant");
-@.Improper alphabetic constant@>
- help2("A one-character control sequence belongs after a ` mark.")@/
- ("So I'm essentially inserting \0 here.");
- cur_val:="0"; back_error;
- end
-else @<Scan an optional space@>;
-end
-
-@ @<Scan an optional space@>=
-begin get_x_token; if cur_cmd<>spacer then back_input;
-end
-
-@ @<Scan a numeric constant@>=
-begin radix:=10; m:=214748364;
-if cur_tok=octal_token then
- begin radix:=8; m:=@'2000000000; get_x_token;
- end
-else if cur_tok=hex_token then
- begin radix:=16; m:=@'1000000000; get_x_token;
- end;
-vacuous:=true; cur_val:=0;@/
-@<Accumulate the constant until |cur_tok| is not a suitable digit@>;
-if vacuous then @<Express astonishment that no number was here@>
-else if cur_cmd<>spacer then back_input;
-end
-
-@ @d infinity==@'17777777777 {the largest positive value that \TeX\ knows}
-@d zero_token=other_token+"0" {zero, the smallest digit}
-@d A_token=letter_token+"A" {the smallest special hex digit}
-@d other_A_token=other_token+"A" {special hex digit of type |other_char|}
-
-@<Accumulate the constant...@>=
-loop@+ begin if (cur_tok<zero_token+radix)and(cur_tok>=zero_token)and
- (cur_tok<=zero_token+9) then d:=cur_tok-zero_token
- else if radix=16 then
- if (cur_tok<=A_token+5)and(cur_tok>=A_token) then d:=cur_tok-A_token+10
- else if (cur_tok<=other_A_token+5)and(cur_tok>=other_A_token) then
- d:=cur_tok-other_A_token+10
- else goto done
- else goto done;
- vacuous:=false;
- if (cur_val>=m)and((cur_val>m)or(d>7)or(radix<>10)) then
- begin if OK_so_far then
- begin print_err("Number too big");
-@.Number too big@>
- help2("I can only go up to 2147483647='17777777777=""7FFFFFFF,")@/
- ("so I'm using that number instead of yours.");
- error; cur_val:=infinity; OK_so_far:=false;
- end;
- end
- else cur_val:=cur_val*radix+d;
- get_x_token;
- end;
-done:
-
-@ @<Express astonishment...@>=
-begin print_err("Missing number, treated as zero");
-@.Missing number...@>
-help3("A number should have been here; I inserted `0'.")@/
- ("(If you can't figure out why I needed to see a number,")@/
- ("look up `weird error' in the index to The TeXbook.)");
-@:TeXbook}{\sl The \TeX book@>
-back_error;
-end
-
-@ The |scan_dimen| routine is similar to |scan_int|, but it sets |cur_val| to
-a |scaled| value, i.e., an integral number of sp. One of its main tasks
-is therefore to interpret the abbreviations for various kinds of units and
-to convert measurements to scaled points.
-
-There are three parameters: |mu| is |true| if the finite units must be
-`\.{mu}', while |mu| is |false| if `\.{mu}' units are disallowed;
-|inf| is |true| if the infinite units `\.{fil}', `\.{fill}', `\.{filll}'
-are permitted; and |shortcut| is |true| if |cur_val| already contains
-an integer and only the units need to be considered.
-
-The order of infinity that was found in the case of infinite glue is returned
-in the global variable |cur_order|.
-
-@<Glob...@>=
-@!cur_order:glue_ord; {order of infinity found by |scan_dimen|}
-
-@ Constructions like `\.{-\'77 pt}' are legal dimensions, so |scan_dimen|
-may begin with |scan_int|. This explains why it is convenient to use
-|scan_int| also for the integer part of a decimal fraction.
-
-Several branches of |scan_dimen| work with |cur_val| as an integer and
-with an auxiliary fraction |f|, so that the actual quantity of interest is
-$|cur_val|+|f|/2^{16}$. At the end of the routine, this ``unpacked''
-representation is put into the single word |cur_val|, which suddenly
-switches significance from |integer| to |scaled|.
-
-@d attach_fraction=88 {go here to pack |cur_val| and |f| into |cur_val|}
-@d attach_sign=89 {go here when |cur_val| is correct except perhaps for sign}
-@d scan_normal_dimen==scan_dimen(false,false,false)
-
-@p procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean);
- {sets |cur_val| to a dimension}
-label done, done1, done2, found, not_found, attach_fraction, attach_sign;
-var negative:boolean; {should the answer be negated?}
-@!f:integer; {numerator of a fraction whose denominator is $2^{16}$}
-@<Local variables for dimension calculations@>@;
-begin f:=0; arith_error:=false; cur_order:=normal; negative:=false;
-if not shortcut then
- begin @<Get the next non-blank non-sign...@>;
- if (cur_cmd>=min_internal)and(cur_cmd<=max_internal) then
- @<Fetch an internal dimension and |goto attach_sign|,
- or fetch an internal integer@>
- else begin back_input;
- if cur_tok=continental_point_token then cur_tok:=point_token;
- if cur_tok<>point_token then scan_int
- else begin radix:=10; cur_val:=0;
- end;
- if cur_tok=continental_point_token then cur_tok:=point_token;
- if (radix=10)and(cur_tok=point_token) then @<Scan decimal fraction@>;
- end;
- end;
-if cur_val<0 then {in this case |f=0|}
- begin negative := not negative; negate(cur_val);
- end;
-@<Scan units and set |cur_val| to $x\cdot(|cur_val|+f/2^{16})$, where there
- are |x| sp per unit; |goto attach_sign| if the units are internal@>;
-@<Scan an optional space@>;
-attach_sign: if arith_error or(abs(cur_val)>=@'10000000000) then
- @<Report that this dimension is out of range@>;
-if negative then negate(cur_val);
-end;
-
-@ @<Fetch an internal dimension and |goto attach_sign|...@>=
-if mu then
- begin scan_something_internal(mu_val,false);
- @<Coerce glue to a dimension@>;
- if cur_val_level=mu_val then goto attach_sign;
- if cur_val_level<>int_val then mu_error;
- end
-else begin scan_something_internal(dimen_val,false);
- if cur_val_level=dimen_val then goto attach_sign;
- end
-
-@ @<Local variables for dimension calculations@>=
-@!num,@!denom:1..65536; {conversion ratio for the scanned units}
-@!k,@!kk:small_number; {number of digits in a decimal fraction}
-@!p,@!q:pointer; {top of decimal digit stack}
-@!v:scaled; {an internal dimension}
-@!save_cur_val:integer; {temporary storage of |cur_val|}
-
-@ The following code is executed when |scan_something_internal| was
-called asking for |mu_val|, when we really wanted a ``mudimen'' instead
-of ``muglue.''
-
-@<Coerce glue to a dimension@>=
-if cur_val_level>=glue_val then
- begin v:=width(cur_val); delete_glue_ref(cur_val); cur_val:=v;
- end
-
-@ When the following code is executed, we have |cur_tok=point_token|, but this
-token has been backed up using |back_input|; we must first discard it.
-
-It turns out that a decimal point all by itself is equivalent to `\.{0.0}'.
-Let's hope people don't use that fact.
-
-@<Scan decimal fraction@>=
-begin k:=0; p:=null; get_token; {|point_token| is being re-scanned}
-loop@+ begin get_x_token;
- if (cur_tok>zero_token+9)or(cur_tok<zero_token) then goto done1;
- if k<17 then {digits for |k>=17| cannot affect the result}
- begin q:=get_avail; link(q):=p; info(q):=cur_tok-zero_token;
- p:=q; incr(k);
- end;
- end;
-done1: for kk:=k downto 1 do
- begin dig[kk-1]:=info(p); q:=p; p:=link(p); free_avail(q);
- end;
-f:=round_decimals(k);
-if cur_cmd<>spacer then back_input;
-end
-
-@ Now comes the harder part: At this point in the program, |cur_val| is a
-nonnegative integer and $f/2^{16}$ is a nonnegative fraction less than 1;
-we want to multiply the sum of these two quantities by the appropriate
-factor, based on the specified units, in order to produce a |scaled|
-result, and we want to do the calculation with fixed point arithmetic that
-does not overflow.
-
-@<Scan units and set |cur_val| to $x\cdot(|cur_val|+f/2^{16})$...@>=
-if inf then @<Scan for \(f)\.{fil} units; |goto attach_fraction| if found@>;
-@<Scan for \(u)units that are internal dimensions;
- |goto attach_sign| with |cur_val| set if found@>;
-if mu then @<Scan for \(m)\.{mu} units and |goto attach_fraction|@>;
-if scan_keyword('true') then @<Adjust \(f)for the magnification ratio@>;
-@.true@>
-if scan_keyword('pt') then goto attach_fraction; {the easy case}
-@.pt@>
-@<Scan for \(a)all other units and adjust |cur_val| and |f| accordingly;
- |goto done| in the case of scaled points@>;
-attach_fraction: if cur_val>=@'40000 then arith_error:=true
-else cur_val:=cur_val*unity+f;
-done:
-
-@ In traditional TeX, a specification like `\.{filllll}' or `\.{fill L L
-L}' will lead to two error messages (one for each additional keyword
-\.{"l"}).
-
-Not so for luatex, it just parses the construct in reverse.
-
-@<Scan for \(f)\.{fil} units...@>=
-begin
-if scan_keyword('filll') then begin cur_order:=filll; goto attach_fraction; end
-else if scan_keyword('fill') then begin cur_order:=fill; goto attach_fraction; end
-else if scan_keyword('fil') then begin cur_order:=fil; goto attach_fraction; end
-else if scan_keyword('fi') then begin cur_order:=sfi; goto attach_fraction; end;
-end
-
-@ @<Scan for \(u)units that are internal dimensions...@>=
-save_cur_val:=cur_val;
-@<Get the next non-blank non-call...@>;
-if (cur_cmd<min_internal)or(cur_cmd>max_internal) then back_input
-else begin if mu then
- begin scan_something_internal(mu_val,false); @<Coerce glue...@>;
- if cur_val_level<>mu_val then mu_error;
- end
- else scan_something_internal(dimen_val,false);
- v:=cur_val; goto found;
- end;
-if mu then goto not_found;
-if scan_keyword('em') then v:=(@<The em width for |cur_font|@>)
-@.em@>
-else if scan_keyword('ex') then v:=(@<The x-height for |cur_font|@>)
-@.ex@>
-else if scan_keyword('px') then v:=pdf_px_dimen
-@.px@>
-else goto not_found;
-@<Scan an optional space@>;
-found:cur_val:=nx_plus_y(save_cur_val,v,xn_over_d(v,f,@'200000));
-goto attach_sign;
-not_found:
-
-@ @<Scan for \(m)\.{mu} units and |goto attach_fraction|@>=
-begin
-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;
-end
-
-@ @<Adjust \(f)for the magnification ratio@>=
-begin prepare_mag;
-if mag<>1000 then
- begin cur_val:=xn_over_d(cur_val,1000,mag);
- f:=(1000*f+@'200000*remainder) div mag;
- cur_val:=cur_val+(f div @'200000); f:=f mod @'200000;
- end;
-end
-
-@ The necessary conversion factors can all be specified exactly as
-fractions whose numerator and denominator add to 32768 or less.
-According to the definitions here, $\rm2660\,dd\approx1000.33297\,mm$;
-this agrees well with the value $\rm1000.333\,mm$ cited by Bosshard
-@^Bosshard, Hans Rudolf@>
-in {\sl Technische Grundlagen zur Satzherstellung\/} (Bern, 1980).
-The Didot point has been newly standardized in 1978;
-it's now exactly $\rm 1\,nd=0.375\,mm$.
-Conversion uses the equation $0.375=21681/20320/72.27\cdot25.4$.
-The new Cicero follows the new Didot point; $\rm 1\,nc=12\,nd$.
-These would lead to the ratios $21681/20320$ and $65043/5080$,
-respectively.
-The closest approximations supported by the algorithm would be
-$11183/10481$ and $1370/107$. In order to maintain the
-relation $\rm 1\,nc=12\,nd$, we pick the ratio $685/642$ for
-$\rm nd$, however.
-
-@d set_conversion_end(#)== denom:=#; end
-@d set_conversion(#)==@+begin num:=#; set_conversion_end
-
-@<Scan for \(a)all other units and adjust |cur_val| and |f|...@>=
-if scan_keyword('in') then set_conversion(7227)(100)
-@.in@>
-else if scan_keyword('pc') then set_conversion(12)(1)
-@.pc@>
-else if scan_keyword('cm') then set_conversion(7227)(254)
-@.cm@>
-else if scan_keyword('mm') then set_conversion(7227)(2540)
-@.mm@>
-else if scan_keyword('bp') then set_conversion(7227)(7200)
-@.bp@>
-else if scan_keyword('dd') then set_conversion(1238)(1157)
-@.dd@>
-else if scan_keyword('cc') then set_conversion(14856)(1157)
-@.cc@>
-else if scan_keyword('nd') then set_conversion(685)(642)
-@.nd@>
-else if scan_keyword('nc') then set_conversion(1370)(107)
-@.nc@>
-else if scan_keyword('sp') then goto done
-@.sp@>
-else @<Complain about unknown unit and |goto done2|@>;
-cur_val:=xn_over_d(cur_val,num,denom);
-f:=(num*f+@'200000*remainder) div denom;@/
-cur_val:=cur_val+(f div @'200000); f:=f mod @'200000;
-done2:
-
-@ @<Complain about unknown unit...@>=
-begin print_err("Illegal unit of measure ("); print("pt inserted)");
-@.Illegal unit of measure@>
-help6("Dimensions can be in units of em, ex, in, pt, pc,")@/
- ("cm, mm, dd, cc, nd, nc, bp, or sp; but yours is a new one!")@/
- ("I'll assume that you meant to say pt, for printer's points.")@/
- ("To recover gracefully from this error, it's best to")@/
- ("delete the erroneous units; e.g., type `2' to delete")@/
- ("two letters. (See Chapter 27 of The TeXbook.)");
-@:TeXbook}{\sl The \TeX book@>
-error; goto done2;
-end
-
-
-@ @<Report that this dimension is out of range@>=
-begin print_err("Dimension too large");
-@.Dimension too large@>
-help2("I can't work with sizes bigger than about 19 feet.")@/
- ("Continue and I'll use the largest value I can.");@/
-error; cur_val:=max_dimen; arith_error:=false;
-end
-
-@ The final member of \TeX's value-scanning trio is |scan_glue|, which
-makes |cur_val| point to a glue specification. The reference count of that
-glue spec will take account of the fact that |cur_val| is pointing to~it.
-
-The |level| parameter should be either |glue_val| or |mu_val|.
-
-Since |scan_dimen| was so much more complex than |scan_int|, we might expect
-|scan_glue| to be even worse. But fortunately, it is very simple, since
-most of the work has already been done.
-
-@p procedure scan_glue(@!level:small_number);
- {sets |cur_val| to a glue spec pointer}
-label exit;
-var negative:boolean; {should the answer be negated?}
-@!q:pointer; {new glue specification}
-@!mu:boolean; {does |level=mu_val|?}
-begin mu:=(level=mu_val); @<Get the next non-blank non-sign...@>;
-if (cur_cmd>=min_internal)and(cur_cmd<=max_internal) then
- begin scan_something_internal(level,negative);
- if cur_val_level>=glue_val then
- begin if cur_val_level<>level then mu_error;
- return;
- end;
- if cur_val_level=int_val then scan_dimen(mu,false,true)
- else if level=mu_val then mu_error;
- end
-else begin back_input; scan_dimen(mu,false,false);
- if negative then negate(cur_val);
- end;
-@<Create a new glue specification whose width is |cur_val|; scan for its
- stretch and shrink components@>;
-exit:end;
-@#
-@<Declare procedures needed for expressions@>@;
-
-@ @<Create a new glue specification whose width is |cur_val|...@>=
-q:=new_spec(zero_glue); width(q):=cur_val;
-if scan_keyword('plus') then
-@.plus@>
- begin scan_dimen(mu,true,false);
- stretch(q):=cur_val; stretch_order(q):=cur_order;
- end;
-if scan_keyword('minus') then
-@.minus@>
- begin scan_dimen(mu,true,false);
- shrink(q):=cur_val; shrink_order(q):=cur_order;
- end;
-cur_val:=q
-
-@ Here's a similar procedure that returns a pointer to a rule node. This
-routine is called just after \TeX\ has seen \.{\\hrule} or \.{\\vrule};
-therefore |cur_cmd| will be either |hrule| or |vrule|. The idea is to store
-the default rule dimensions in the node, then to override them if
-`\.{height}' or `\.{width}' or `\.{depth}' specifications are
-found (in any order).
-
-@d default_rule=26214 {0.4\thinspace pt}
-
-@p function scan_rule_spec:pointer;
-label reswitch;
-var q:pointer; {the rule node being created}
-begin q:=new_rule; {|width|, |depth|, and |height| all equal |null_flag| now}
-if cur_cmd=vrule then begin
- width(q):=default_rule;
- rule_dir(q):=body_direction;
- end
-else begin
- height(q):=default_rule; depth(q):=0;
- rule_dir(q):=text_direction;
-end;
-reswitch: if scan_keyword('width') then
-@.width@>
- begin scan_normal_dimen; width(q):=cur_val; goto reswitch;
- end;
-if scan_keyword('height') then
-@.height@>
- begin scan_normal_dimen; height(q):=cur_val; goto reswitch;
- end;
-if scan_keyword('depth') then
-@.depth@>
- begin scan_normal_dimen; depth(q):=cur_val; goto reswitch;
- end;
-scan_rule_spec:=q;
-end;
-
-@* \[27] Building token lists.
-The token lists for macros and for other things like \.{\\mark} and \.{\\output}
-and \.{\\write} are produced by a procedure called |scan_toks|.
-
-Before we get into the details of |scan_toks|, let's consider a much
-simpler task, that of converting the current string into a token list.
-The |str_toks| function does this; it classifies spaces as type |spacer|
-and everything else as type |other_char|.
-
-The token list created by |str_toks| begins at |link(temp_token_head)| and ends
-at the value |p| that is returned. (If |p=temp_token_head|, the list is empty.)
-
-|lua_str_toks| is almost identical, but it also escapes the three
-symbols that |lua| considers special while scanning a literal string
-
-@d unicode_incr(#)==if str_pool[#]>=@"F0 then #:=#+4 else if str_pool[#]>=@"E0
- then #:=#+3 else if str_pool[#]>=@"C0 then #:=#+2 else incr(#)
-
-
-@p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/
-function lua_str_toks(@!b:pool_pointer):pointer;
- {changes the string |str_pool[b..pool_ptr]| to a token list}
-var p:pointer; {tail of the token list}
-@!q:pointer; {new node being added to the token list via |store_new_token|}
-@!t:halfword; {token being appended}
-@!k:pool_pointer; {index into |str_pool|}
-begin
-p:=temp_token_head; link(p):=null; k:=b;
-while k<pool_ptr do
- begin t:=pool_to_unichar(k);
- if t=" " then t:=space_token
- else
- begin
- if (t="\") or (t="""") or (t="'") or (t=10) or (t=13) then
- fast_store_new_token(other_token+"\");
- if (t=10) then
- t:="n";
- if (t=13) then
- t:="r";
- t:=other_token+t;
- end;
- fast_store_new_token(t);
- unicode_incr(k);
- end;
-pool_ptr:=b; lua_str_toks:=p;
-end;
-
-function str_toks(@!b:pool_pointer):pointer;
- {changes the string |str_pool[b..pool_ptr]| to a token list}
-var p:pointer; {tail of the token list}
-@!q:pointer; {new node being added to the token list via |store_new_token|}
-@!t:halfword; {token being appended}
-@!k:pool_pointer; {index into |str_pool|}
-begin
-p:=temp_token_head; link(p):=null; k:=b;
-while k<pool_ptr do
- begin t:=pool_to_unichar(k);
- if t=" " then t:=space_token
- else t:=other_token+t;
- fast_store_new_token(t);
- unicode_incr(k);
- end;
-pool_ptr:=b; str_toks:=p;
-end;
-
-@ The main reason for wanting |str_toks| is the next function,
-|the_toks|, which has similar input/output characteristics.
-
-This procedure is supposed to scan something like `\.{\\skip\\count12}',
-i.e., whatever can follow `\.{\\the}', and it constructs a token list
-containing something like `\.{-3.0pt minus 0.5fill}'.
-
-@p function the_toks:pointer;
-label exit;
-var old_setting:0..max_selector; {holds |selector| setting}
-@!p,@!q,@!r:pointer; {used for copying a token list}
-@!b:pool_pointer; {base of temporary string}
-@!c:small_number; {value of |cur_chr|}
-begin @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>;@/
-get_x_token; scan_something_internal(tok_val,false);
-if cur_val_level>=ident_val then begin
- @<Copy the token list@>;
- the_toks:=p;
- end
-else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
- case cur_val_level of
- int_val:print_int(cur_val);
- attr_val:print_int(cur_val);
- dir_val:print_dir(cur_val);
- dimen_val:begin print_scaled(cur_val); print("pt");
- end;
- glue_val: begin print_spec(cur_val,"pt"); delete_glue_ref(cur_val);
- end;
- mu_val: begin print_spec(cur_val,"mu"); delete_glue_ref(cur_val);
- end;
- end; {there are no other cases}
- selector:=old_setting; the_toks:=str_toks(b);
- end;
-exit:end;
-
-function the_scanned_result:str_number;
-var old_setting:0..max_selector; {holds |selector| setting}
-begin
-old_setting:=selector; selector:=new_string;
-if cur_val_level>=ident_val then begin
- if cur_val<>null then begin
- show_token_list(link(cur_val),null,pool_size-pool_ptr);
- the_scanned_result:=make_string;
- end
- else
- the_scanned_result:="";
- end
-else begin
- case cur_val_level of
- int_val:print_int(cur_val);
- attr_val:print_int(cur_val);
- dir_val:print_dir(cur_val);
- dimen_val:begin print_scaled(cur_val); print("pt");
- end;
- glue_val: begin print_spec(cur_val,"pt"); delete_glue_ref(cur_val);
- end;
- mu_val: begin print_spec(cur_val,"mu"); delete_glue_ref(cur_val);
- end;
- end; {there are no other cases}
- the_scanned_result:=make_string;
- end;
-selector:=old_setting;
-end;
-
-@ @<Copy the token list@>=
-begin p:=temp_token_head; link(p):=null;
-if cur_val_level=ident_val then store_new_token(cs_token_flag+cur_val)
-else if cur_val<>null then
- begin r:=link(cur_val); {do not copy the reference count}
- while r<>null do
- begin fast_store_new_token(info(r)); r:=link(r);
- end;
- end;
-end
-
-@ Here's part of the |expand| subroutine that we are now ready to complete:
-
-@p procedure ins_the_toks;
-var junk:pointer;
-begin junk:=the_toks; ins_list(link(temp_token_head));
-end;
-
-@ The primitives \.{\\number}, \.{\\romannumeral}, \.{\\string}, \.{\\meaning},
-\.{\\fontname}, and \.{\\jobname} are defined as follows.
-
-\eTeX\ adds \.{\\eTeXrevision} such that |job_name_code| remains last.
-
-\pdfTeX\ adds \.{\\eTeXrevision}, \.{\\pdftexrevision}, \.{\\pdftexbanner},
-\.{\\pdffontname}, \.{\\pdffontobjnum}, \.{\\pdffontsize}, and \.{\\pdfpageref}
-such that |job_name_code| remains last.
-
-@d number_code=0 {command code for \.{\\number}}
-@d roman_numeral_code=1 {command code for \.{\\romannumeral}}
-@d string_code=2 {command code for \.{\\string}}
-@d meaning_code=3 {command code for \.{\\meaning}}
-@d font_name_code=4 {command code for \.{\\fontname}}
-@d etex_code=5 {command code for \.{\\eTeXVersion}}
-@d omega_code=6 {command code for \.{\\OmegaVersion}}
-@d aleph_code=7 {command code for \.{\\AlephVersion}}
-@d format_name_code=8 {command code for \.{\\AlephVersion}}
-@d pdftex_first_expand_code = 9 {base for \pdfTeX's command codes}
-@d pdftex_revision_code = pdftex_first_expand_code + 0 {command code for \.{\\pdftexrevision}}
-@d pdftex_banner_code = pdftex_first_expand_code + 1 {command code for \.{\\pdftexbanner}}
-@d pdf_font_name_code = pdftex_first_expand_code + 2 {command code for \.{\\pdffontname}}
-@d pdf_font_objnum_code = pdftex_first_expand_code + 3 {command code for \.{\\pdffontobjnum}}
-@d pdf_font_size_code = pdftex_first_expand_code + 4 {command code for \.{\\pdffontsize}}
-@d pdf_page_ref_code = pdftex_first_expand_code + 5 {command code for \.{\\pdfpageref}}
-@d pdf_xform_name_code = pdftex_first_expand_code + 6 {command code for \.{\\pdfxformname}}
-@d left_margin_kern_code = pdftex_first_expand_code + 7 {command code for \.{\\leftmarginkern}}
-@d right_margin_kern_code = pdftex_first_expand_code + 8 {command code for \.{\\rightmarginkern}}
-@d pdf_creation_date_code = pdftex_first_expand_code + 9 {command code for \.{\\pdfcreationdate}}
-@d uniform_deviate_code = pdftex_first_expand_code + 10 {command code for \.{\\uniformdeviate}}
-@d normal_deviate_code = pdftex_first_expand_code + 11 {command code for \.{\\normaldeviate}}
-@d pdf_insert_ht_code = pdftex_first_expand_code + 12 {command code for \.{\\pdfinsertht}}
-@d pdf_ximage_bbox_code = pdftex_first_expand_code + 13 {command code for \.{\\pdfximagebbox}}
-@d lua_code = pdftex_first_expand_code + 14 {command code for \.{\\directlua}}
-@d lua_escape_string_code = pdftex_first_expand_code + 15 {command code for \.{\\luaescapestring}}
-@d pdf_colorstack_init_code = pdftex_first_expand_code + 16 {command code for \.{\\pdfcolorstackinit}}
-@d luatex_revision_code = pdftex_first_expand_code + 17 {command code for \.{\\luatexrevision}}
-@d luatex_date_code = pdftex_first_expand_code + 18 {command code for \.{\\luatexdate}}
-@d math_style_code = pdftex_first_expand_code + 19 {command code for \.{\\mathstyle}}
-@d expanded_code = pdftex_first_expand_code + 20 {command code for \.{\\expanded}}
-@d pdftex_convert_codes = pdftex_first_expand_code + 21 {end of \pdfTeX's command codes}
-@d job_name_code=pdftex_convert_codes {command code for \.{\\jobname}}
-
-
-@<Put each...@>=
-primitive_tex("number",convert,number_code,0);@/
-@!@:number_}{\.{\\number} primitive@>
-primitive_tex("romannumeral",convert,roman_numeral_code,0);@/
-@!@:roman_numeral_}{\.{\\romannumeral} primitive@>
-primitive_tex("string",convert,string_code,0);@/
-@!@:string_}{\.{\\string} primitive@>
-primitive_tex("meaning",convert,meaning_code,0);@/
-@!@:meaning_}{\.{\\meaning} primitive@>
-primitive_etex("eTeXVersion",convert,etex_code,0);@/
-@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
-primitive_omega("OmegaVersion",convert,omega_code,0);@/
-@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
-primitive_aleph("AlephVersion",convert,aleph_code,0);@/
-@!@:aleph_version_}{\.{\\AlephVersion} primitive@>
-primitive_tex("fontname",convert,font_name_code,0);@/
-@!@:font_name_}{\.{\\fontname} primitive@>
-primitive_pdftex("pdftexrevision",convert,pdftex_revision_code,0);@/
-@!@:pdftex_revision_}{\.{\\pdftexrevision} primitive@>
-primitive_luatex("luatexrevision",convert,luatex_revision_code,0);@/
-@!@:luatex_revision_}{\.{\\luatexrevision} primitive@>
-primitive_luatex("luatexdatestamp",convert,luatex_date_code,0);@/
-@!@:luatex_date_}{\.{\\luatexdatestamp} primitive@>
-primitive_pdftex("pdftexbanner",convert,pdftex_banner_code,0);@/
-@!@:pdftex_banner_}{\.{\\pdftexbanner} primitive@>
-primitive_pdftex("pdffontname",convert,pdf_font_name_code,0);@/
-@!@:pdf_font_name_}{\.{\\pdffontname} primitive@>
-primitive_pdftex("pdffontobjnum",convert,pdf_font_objnum_code,0);@/
-@!@:pdf_font_objnum_}{\.{\\pdffontobjnum} primitive@>
-primitive_pdftex("pdffontsize",convert,pdf_font_size_code,0);@/
-@!@:pdf_font_size_}{\.{\\pdffontsize} primitive@>
-primitive_pdftex("pdfpageref",convert,pdf_page_ref_code,0);@/
-@!@:pdf_page_ref_}{\.{\\pdfpageref} primitive@>
-primitive_pdftex("leftmarginkern",convert,left_margin_kern_code,0);@/
-@!@:left_margin_kern_}{\.{\\leftmarginkern} primitive@>
-primitive_pdftex("rightmarginkern",convert,right_margin_kern_code,0);@/
-@!@:right_margin_kern_}{\.{\\rightmarginkern} primitive@>
-primitive_pdftex("pdfxformname",convert,pdf_xform_name_code,0);@/
-@!@:pdf_xform_name_}{\.{\\pdfxformname} primitive@>
-primitive_pdftex("pdfcreationdate",convert,pdf_creation_date_code,0);@/
-@!@:pdf_creation_date_}{\.{\\pdfcreationdate} primitive@>
-primitive_pdftex("pdfuniformdeviate",convert,uniform_deviate_code,0);@/
-@!@:uniform_deviate_}{\.{\\pdfuniformdeviate} primitive@>
-primitive_pdftex("pdfcolorstackinit",convert,pdf_colorstack_init_code,0);@/
-@!@:pdf_colorstack_init_}{\.{\\pdfcolorstackinit} primitive@>
-primitive_pdftex("pdfnormaldeviate",convert,normal_deviate_code,0);@/
-@!@:normal_deviate_}{\.{\\pdfnormaldeviate} primitive@>
-primitive_core("directlua",convert,lua_code,0);@/
-@!@:lua_}{\.{\\directlua} primitive@>
-primitive_luatex("luaescapestring",convert,lua_escape_string_code,0);@/
-@!@:lua_}{\.{\\luaescapestring} primitive@>
-primitive_luatex("mathstyle",convert,math_style_code,0);@/
-@!@:math_style_}{\.{\\mathstyle} primitive@>
-primitive_pdftex("expanded",convert,expanded_code,0);@/
-@!@:expanded_}{\.{\\expanded} primitive@>
-@#
-primitive_tex("jobname",convert,job_name_code,0);@/
-@!@:job_name_}{\.{\\jobname} primitive@>
-primitive_luatex("formatname",convert,format_name_code,0);@/
-@!@:format_name_}{\.{\\formatname} primitive@>
-primitive_pdftex("pdfinsertht",convert,pdf_insert_ht_code,0);@/
-@!@:pdf_insert_ht_}{\.{\\pdfinsertht} primitive@>
-primitive_pdftex("pdfximagebbox",convert,pdf_ximage_bbox_code,0);@/
-@!@:pdf_ximage_bbox_}{\.{\\pdfximagebbox} primitive@>
-
-@ 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
-@d restore_cur_string==if u<>0 then begin decr(str_ptr); u:=0; end
-
-@p procedure conv_toks;
-label exit;
-var old_setting:0..max_selector; {holds |selector| setting}
-p, q: pointer;
-@!c:number_code..job_name_code; {desired type of conversion}
-@!save_scanner_status:small_number; {|scanner_status| upon entry}
-@!save_def_ref: pointer; {|def_ref| upon entry, important if inside `\.{\\message}'}
-@!save_warning_index: pointer;
-@!bool: boolean; {temp boolean}
-@!i: integer; {first temp integer}
-@!j: integer; {second temp integer}
-@!b:pool_pointer; {base of temporary string}
-@!s: str_number; {first temp string}
-@!sn: integer; {lua chunk name}
-@!u: str_number; {third temp string}
-@!junk: pointer;
-begin
-c:=cur_chr;
-u:=0; { will become non-nil if a string is already being built}
-j:=0; i:=0;
-@<Scan the argument for command |c|@>;
-old_setting:=selector; selector:=new_string; b:=pool_ptr;
-@<Print the result of command |c|@>;
-selector:=old_setting; junk:=str_toks(b); ins_list(link(temp_token_head));
-exit:
-end;
-
-@ @<Glob...@>=
-in_lua_escape:boolean;
-
-@ @<Set init...@>=
-in_lua_escape:=false;
-
-@ @<Scan the argument for command |c|@>=
-case c of
-number_code,roman_numeral_code: scan_int;
-string_code, meaning_code: begin save_scanner_status:=scanner_status;
- scanner_status:=normal; get_token; scanner_status:=save_scanner_status;
- end;
-etex_code: do_nothing;
-omega_code: do_nothing;
-aleph_code: do_nothing;
-font_name_code: scan_font_ident;
-pdftex_revision_code: do_nothing;
-luatex_revision_code: do_nothing;
-luatex_date_code: do_nothing;
-pdftex_banner_code: do_nothing;
-pdf_font_name_code, pdf_font_objnum_code, pdf_font_size_code: begin
- scan_font_ident;
- if cur_val = null_font then
- pdf_error("font", "invalid font identifier");
- if c <> pdf_font_size_code then begin
- pdf_check_vf_cur_val;
- if not font_used(cur_val) then
- pdf_init_font_cur_val;
- end;
-end;
-pdf_page_ref_code: begin
- scan_int;
- if cur_val <= 0 then
- pdf_error("pageref", "invalid page number");
-end;
-left_margin_kern_code, right_margin_kern_code: begin
- scan_int;
- if (box(cur_val) = null) or (type(box(cur_val)) <> hlist_node) then
- pdf_error("marginkern", "a non-empty hbox expected")
-end;
-pdf_xform_name_code: begin
- scan_int;
- pdf_check_obj(obj_type_xform, cur_val);
-end;
-pdf_creation_date_code:
- begin
- b := pool_ptr;
- getcreationdate;
- junk := str_toks(b);
- ins_list(link(temp_token_head));
- return;
- end;
-job_name_code: if job_name=0 then open_log_file;
-pdf_colorstack_init_code:
- begin
- bool := scan_keyword('page');
- if scan_keyword('direct') then
- cur_val := direct_always
- else
- if scan_keyword('page') then
- cur_val := direct_page
- else
- cur_val := set_origin;
- save_scanner_status := scanner_status;
- save_warning_index := warning_index;
- save_def_ref := def_ref;
- save_cur_string;
- scan_pdf_ext_toks;
- s := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- def_ref := save_def_ref;
- warning_index := save_warning_index;
- scanner_status := save_scanner_status;
- cur_val := newcolorstack(s, cur_val, bool);
- flush_str(s);
- cur_val_level := int_val;
- if cur_val < 0 then begin
- print_err("Too many color stacks");
-@.Too many color stacks@>
- help2("The number of color stacks is limited to 32768.")@/
- ("I'll use the default color stack 0 here.");
- error;
- cur_val := 0;
- restore_cur_string;
- end;
- end;
-uniform_deviate_code: scan_int;
-normal_deviate_code: do_nothing;
-lua_escape_string_code:
- begin
- u:=0;
- { check if a string is already being built}
- if str_start_macro(str_ptr)<pool_ptr then u:=make_string;
- save_scanner_status := scanner_status;
- save_def_ref := def_ref;
- save_warning_index := warning_index;
- scan_pdf_ext_toks;
- bool := in_lua_escape;
- in_lua_escape:=true;
- s := tokens_to_string(def_ref);
- in_lua_escape:=bool;
- delete_token_ref(def_ref);
- def_ref := save_def_ref;
- warning_index := save_warning_index;
- scanner_status := save_scanner_status;
- junk := lua_str_toks(str_start_macro(s));
- ins_list(link(temp_token_head));
- flush_str(s);
- if u<>0 then begin decr(str_ptr); u:=0; end;
- return;
- end;
-math_style_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));
- def_ref := save_def_ref;
- restore_cur_string;
- return;
- end;
-lua_code:
- begin
- u:=0;
- { Have to check if a string is already being built, because lua code
- may call library functions that may call C functions that
- themselves use the string pool, like e.g. |maketexstring| }
- if str_start_macro(str_ptr)<pool_ptr then u:=make_string;
- save_scanner_status := scanner_status;
- save_def_ref := def_ref;
- save_warning_index := warning_index;
- sn:=0;
- if scan_keyword('name') then begin
- scan_pdf_ext_toks;
- sn := def_ref;
- end;
- @<Parse optional lua state integer, or an instance name to be stored in |sn|@>;
- scan_pdf_ext_toks;
- s := def_ref;
- warning_index := save_warning_index;
- def_ref := save_def_ref;
- scanner_status := save_scanner_status;
- luacstrings:=0;
- luatokencall(s,sn);
- delete_token_ref(s);
- if u<>0 then begin
- if str_ptr=u+1 then
- decr(str_ptr)
- else begin {copy old string to the top location}
- i:=0;
- str_room(length(u));
- while i<length(u) do
- str_pool[pool_ptr+i]:=str_pool[str_start_macro(u)+i];
- end;
- end;
- if luacstrings>0 then
- lua_string_start;
- return;
- end;
-pdf_insert_ht_code: scan_register_num;
-pdf_ximage_bbox_code: begin
- scan_int;
- pdf_check_obj(obj_type_ximage, cur_val);
- i := obj_data_ptr(cur_val);
- scan_int;
- j := cur_val;
- if (j < 1) or (j > 4) then
- pdf_error("pdfximagebbox", "invalid parameter");
- end;
-@<Cases of `Scan the argument for command |c|'@>
-end {there are no other cases}
-
-@ @<Parse optional lua state...@>=
-begin
- @<Get the next non-blank non-relax non-call token@>;
- back_input; { have to push it back, whatever it is }
- if cur_cmd<>left_brace then begin
- scan_register_num;
- if get_lua_name(cur_val) then
- sn:=(cur_val-65536)
- else begin
- i:=tracing_online;
- tracing_online:=1;
- begin_diagnostic;
- print_nl("Warning: support for multiple lua states has been dropped.");
- print_nl(" Please stop using a number after \directlua and \latelua.");
- end_diagnostic(true);
- tracing_online:=i;
- end;
- end;
-end
-
-@ @<Print the result of command |c|@>=
-case c of
-number_code: print_int(cur_val);
-roman_numeral_code: print_roman_int(cur_val);
-string_code:if cur_cs<>0 then sprint_cs(cur_cs)
- else print(cur_chr);
-meaning_code: print_meaning;
-etex_code: print(eTeX_version_string);
-omega_code: print(Omega_version_string);
-aleph_code: print(Aleph_version_string);
-font_name_code: begin
- append_string(font_name(cur_val));
- if font_size(cur_val)<>font_dsize(cur_val) then
- begin print(" at "); print_scaled(font_size(cur_val));
- print("pt");
- end;
- end;
-pdftex_revision_code: print(pdftex_revision);
-luatex_revision_code: print(luatex_revision);
-luatex_date_code: print_int(luatex_date_info);
-pdftex_banner_code: print(pdftex_banner);
-pdf_font_name_code, pdf_font_objnum_code: begin
- set_ff(cur_val);
- if c = pdf_font_name_code then
- print_int(obj_info(pdf_font_num(ff)))
- else
- print_int(pdf_font_num(ff));
-end;
-pdf_font_size_code: begin
- print_scaled(font_size(cur_val));
- print("pt");
-end;
-pdf_page_ref_code: print_int(get_obj(obj_type_page, cur_val, false));
-left_margin_kern_code: begin
- p := list_ptr(box(cur_val));
- if (p <> null) and (not is_char_node(p)) and
- (type(p) = glue_node) and (subtype(p) = left_skip_code + 1) then
- p := vlink(p);
- if (p <> null) and (not is_char_node(p)) and
- (type(p) = margin_kern_node) and (subtype(p) = left_side) then
- print_scaled(width(p))
- else
- print("0");
- print("pt");
-end;
-right_margin_kern_code: begin
- q := list_ptr(box(cur_val));
- p := null;
- if q <> null then begin
- p := prev_rightmost(q, null);
- if (p <> null) and (not is_char_node(p)) and
- (type(p) = glue_node) and (subtype(p) = right_skip_code + 1) then
- p := prev_rightmost(q, p);
- end;
- if (p <> null) and (not is_char_node(p)) and
- (type(p) = margin_kern_node) and (subtype(p) = right_side) then
- print_scaled(width(p))
- else
- print("0");
- print("pt");
-end;
-pdf_xform_name_code: print_int(obj_info(cur_val));
-pdf_colorstack_init_code: print_int(cur_val);
-uniform_deviate_code: print_int(unif_rand(cur_val));
-normal_deviate_code: print_int(norm_rand);
-math_style_code: print_math_style;
-pdf_insert_ht_code: begin
- i := qi(cur_val);
- p := page_ins_head;
- while i >= subtype(vlink(p)) do
- p := vlink(p);
- if subtype(p) = i then
- print_scaled(height(p))
- else
- print("0");
- print("pt");
-end;
-pdf_ximage_bbox_code: begin
- if is_pdf_image(i) then begin
- case j of
- 1: print_scaled(epdf_orig_x(i));
- 2: print_scaled(epdf_orig_y(i));
- 3: print_scaled(epdf_orig_x(i) + epdf_xsize(i));
- 4: print_scaled(epdf_orig_y(i) + epdf_ysize(i));
- endcases;
- end else
- print_scaled(0);
- print("pt");
-end;
-format_name_code: print(format_name);
-job_name_code: print(job_name);
-@/@<Cases of `Print the result of command |c|'@>@/
-end {there are no other cases}
-
-@
-@p function is_convert(c:halfword):boolean;
-begin
- is_convert:=(c=convert);
-end;
-
-function the_convert_string (c:halfword;i:integer):str_number;
-var old_setting:0..max_selector; {saved |selector| setting}
- is_known:boolean;
-begin
- old_setting:=selector;
- selector:=new_string;
- is_known:=true;
- case c of
- number_code: print_int(i);
- roman_numeral_code: print_roman_int(i);
- etex_code: print(eTeX_version_string);
- omega_code: print(Omega_version_string);
- aleph_code: print(Aleph_version_string);
- pdftex_revision_code: print(pdftex_revision);
- luatex_revision_code: print(luatex_revision);
- luatex_date_code: print_int(luatex_date_info);
- pdftex_banner_code: print(pdftex_banner);
- normal_deviate_code: print_int(norm_rand);
- uniform_deviate_code: print_int(unif_rand(i));
- format_name_code: print(format_name);
- job_name_code: print(job_name);
- math_style_code: print_math_style;
- font_name_code: begin
- append_string(font_name(i));
- if font_size(i)<>font_dsize(i) then
- begin print(" at "); print_scaled(font_size(i));
- print("pt");
- end;
- end;
- font_identifier_code: print_font_identifier(i);
- pdf_page_ref_code: print_int(get_obj(obj_type_page, i, false));
- pdf_xform_name_code: print_int(obj_info(i));
- pdf_font_name_code, pdf_font_objnum_code: begin
- set_ff(i);
- if c = pdf_font_name_code then
- print_int(obj_info(pdf_font_num(ff)))
- else
- print_int(pdf_font_num(ff));
- end;
- pdf_font_size_code: begin
- print_scaled(font_size(i));
- print("pt");
- end;
-
-@/@<Cases of `Print the result of command |c|'@>@/
- othercases is_known:=false
- end;
- if is_known then
- the_convert_string := make_string
- else
- the_convert_string := 0;
- selector:=old_setting;
-end;
-
-@ Now we can't postpone the difficulties any longer; we must bravely tackle
-|scan_toks|. This function returns a pointer to the tail of a new token
-list, and it also makes |def_ref| point to the reference count at the
-head of that list.
-
-There are two boolean parameters, |macro_def| and |xpand|. If |macro_def|
-is true, the goal is to create the token list for a macro definition;
-otherwise the goal is to create the token list for some other \TeX\
-primitive: \.{\\mark}, \.{\\output}, \.{\\everypar}, \.{\\lowercase},
-\.{\\uppercase}, \.{\\message}, \.{\\errmessage}, \.{\\write}, or
-\.{\\special}. In the latter cases a left brace must be scanned next; this
-left brace will not be part of the token list, nor will the matching right
-brace that comes at the end. If |xpand| is false, the token list will
-simply be copied from the input using |get_token|. Otherwise all expandable
-tokens will be expanded until unexpandable tokens are left, except that
-the results of expanding `\.{\\the}' are not expanded further.
-If both |macro_def| and |xpand| are true, the expansion applies
-only to the macro body (i.e., to the material following the first
-|left_brace| character).
-
-The value of |cur_cs| when |scan_toks| begins should be the |eqtb|
-address of the control sequence to display in ``runaway'' error
-messages.
-
-@p function scan_toks(@!macro_def,@!xpand:boolean):pointer;
-label found,done,done1,done2;
-var t:halfword; {token representing the highest parameter number}
-@!s:halfword; {saved token}
-@!p:pointer; {tail of the token list being built}
-@!q:pointer; {new node being added to the token list via |store_new_token|}
-@!unbalance:halfword; {number of unmatched left braces}
-@!hash_brace:halfword; {possible `\.{\#\{}' token}
-begin if macro_def then scanner_status:=defining
-@+else scanner_status:=absorbing;
-warning_index:=cur_cs; p:=get_avail; def_ref:=p; token_ref_count(def_ref):=0;
-p:=def_ref; hash_brace:=0; t:=zero_token;
-if macro_def then @<Scan and build the parameter part of the macro definition@>
-else scan_left_brace; {remove the compulsory left brace}
-@<Scan and build the body of the token list; |goto found| when finished@>;
-found: scanner_status:=normal;
-if hash_brace<>0 then store_new_token(hash_brace);
-scan_toks:=p;
-end;
-
-@ @<Scan and build the parameter part...@>=
-begin loop begin get_token; {set |cur_cmd|, |cur_chr|, |cur_tok|}
- if cur_tok<right_brace_limit then goto done1;
- if cur_cmd=mac_param then
- @<If the next character is a parameter number, make |cur_tok|
- a |match| token; but if it is a left brace, store
- `|left_brace|, |end_match|', set |hash_brace|, and |goto done|@>;
- store_new_token(cur_tok);
- end;
-done1: store_new_token(end_match_token);
-if cur_cmd=right_brace then
- @<Express shock at the missing left brace; |goto found|@>;
-done: end
-
-@ @<Express shock...@>=
-begin print_err("Missing { inserted"); incr(align_state);
-@.Missing \{ inserted@>
-help2("Where was the left brace? You said something like `\def\a}',")@/
- ("which I'm going to interpret as `\def\a{}'."); error; goto found;
-end
-
-@ @<If the next character is a parameter number...@>=
-begin s:=match_token+cur_chr; get_token;
-if cur_cmd=left_brace then
- begin hash_brace:=cur_tok;
- store_new_token(cur_tok); store_new_token(end_match_token);
- goto done;
- end;
-if t=zero_token+9 then
- begin print_err("You already have nine parameters");
-@.You already have nine...@>
- help1("I'm going to ignore the # sign you just used."); error;
- end
-else begin incr(t);
- if cur_tok<>t then
- begin print_err("Parameters must be numbered consecutively");
-@.Parameters...consecutively@>
- help2("I've inserted the digit you should have used after the #.")@/
- ("Type `1' to delete what you did use."); back_error;
- end;
- cur_tok:=s;
- end;
-end
-
-@ @<Scan and build the body of the token list; |goto found| when finished@>=
-unbalance:=1;
-loop@+ begin if xpand then @<Expand the next part of the input@>
- else get_token;
- if cur_tok<right_brace_limit then begin
- if cur_cmd<right_brace then incr(unbalance)
- else begin decr(unbalance);
- if unbalance=0 then goto found;
- end;
- end
- else if cur_cmd=mac_param then
- if macro_def then @<Look for parameter number or \.{\#\#}@>;
- store_new_token(cur_tok);
- end
-
-@ Here we insert an entire token list created by |the_toks| without
-expanding it further.
-
-@<Expand the next part of the input@>=
-begin loop begin get_filtered_next;
- if cur_cmd>=call then
- if info(link(cur_chr))=protected_token then
- begin cur_cmd:=relax; cur_chr:=no_expand_flag;
- end;
- if cur_cmd<=max_command then goto done2;
- if cur_cmd<>the then expand
- else begin q:=the_toks;
- if link(temp_token_head)<>null then
- begin link(p):=link(temp_token_head); p:=q;
- end;
- end;
- end;
-done2: x_token
-end
-
-@ @<Look for parameter number...@>=
-begin s:=cur_tok;
-if xpand then get_x_token else get_token;
-if cur_cmd<>mac_param then begin
- 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;
-end
-
-@ Another way to create a token list is via the \.{\\read} command. The
-sixteen files potentially usable for reading appear in the following
-global variables. The value of |read_open[n]| will be |closed| if
-stream number |n| has not been opened or if it has been fully read;
-|just_open| if an \.{\\openin} but not a \.{\\read} has been done;
-and |normal| if it is open and ready to read the next line.
-
-@d closed=2 {not open, or at end of file}
-@d just_open=1 {newly opened, first line not yet read}
-
-@<Glob...@>=
-@!read_file:array[0..15] of alpha_file; {used for \.{\\read}}
-@!read_open:array[0..16] of normal..closed; {state of |read_file[n]|}
-
-@ @<Set init...@>=
-for k:=0 to 16 do begin
- read_open[k]:=closed;
-end;
-
-@ The |read_toks| procedure constructs a token list like that for any
-macro definition, and makes |cur_val| point to it. Parameter |r| points
-to the control sequence that will receive this token list.
-
-@p procedure read_toks(@!n:integer;@!r:pointer;@!j:halfword);
-label done;
-var p:pointer; {tail of the token list}
-@!q:pointer; {new node being added to the token list via |store_new_token|}
-@!s:integer; {saved value of |align_state|}
-@!m:small_number; {stream number}
-begin scanner_status:=defining; warning_index:=r;
-p:=get_avail; def_ref:=p; token_ref_count(def_ref):=0;
-p:=def_ref; {the reference count}
-store_new_token(end_match_token);
-if (n<0)or(n>15) then m:=16@+else m:=n;
-s:=align_state; align_state:=1000000; {disable tab marks, etc.}
-repeat @<Input and store tokens from the next line of the file@>;
-until align_state=1000000;
-cur_val:=def_ref; scanner_status:=normal; align_state:=s;
-end;
-
-@ @<Input and store tokens from the next line of the file@>=
-begin_file_reading; name:=m+1;
-if read_open[m]=closed then @<Input for \.{\\read} from the terminal@>
-else if read_open[m]=just_open then @<Input the first line of |read_file[m]|@>
-else @<Input the next line of |read_file[m]|@>;
-limit:=last;
-if end_line_char_inactive then decr(limit)
-else buffer[limit]:=end_line_char;
-first:=limit+1; loc:=start; state:=new_line;@/
-@<Handle \.{\\readline} and |goto done|@>;@/
-loop@+ begin get_token;
- if cur_tok=0 then goto done;
- {|cur_cmd=cur_chr=0| will occur at the end of the line}
- if align_state<1000000 then {unmatched `\.\}' aborts the line}
- begin repeat get_token; until cur_tok=0;
- align_state:=1000000; goto done;
- end;
- store_new_token(cur_tok);
- end;
-done: end_file_reading
-
-@ Here we input on-line into the |buffer| array, prompting the user explicitly
-if |n>=0|. The value of |n| is set negative so that additional prompts
-will not be given in the case of multi-line input.
-
-@<Input for \.{\\read} from the terminal@>=
-if interaction>nonstop_mode then
- if n<0 then prompt_input("")
- else begin wake_up_terminal;
- print_ln; sprint_cs(r); prompt_input("="); n:=-1;
- end
-else fatal_error("*** (cannot \read from terminal in nonstop modes)")
-@.cannot \\read@>
-
-@ The first line of a file must be treated specially, since |lua_input_ln|
-must be told not to start with |get|.
-@^system dependencies@>
-
-@<Input the first line of |read_file[m]|@>=
-begin if lua_input_ln(read_file[m],(m+1),false) then read_open[m]:=normal
-else begin lua_a_close_in(read_file[m],(m+1)); read_open[m]:=closed;
- end;
-end
-
-@ An empty line is appended at the end of a |read_file|.
-@^empty line at end of file@>
-
-@<Input the next line of |read_file[m]|@>=
-begin if not lua_input_ln(read_file[m],(m+1),true) then
- begin lua_a_close_in(read_file[m],(m+1)); read_open[m]:=closed;
- if align_state<>1000000 then
- begin runaway;
- print_err("File ended within "); print_esc("read");
-@.File ended within \\read@>
- help1("This \read has unbalanced braces.");
- align_state:=1000000; error;
- end;
- end;
-end
-
-@* \[28] Conditional processing.
-We consider now the way \TeX\ handles various kinds of \.{\\if} commands.
-
-@d unless_code=32 {amount added for `\.{\\unless}' prefix}
-@#
-@d if_char_code=0 { `\.{\\if}' }
-@d if_cat_code=1 { `\.{\\ifcat}' }
-@d if_int_code=2 { `\.{\\ifnum}' }
-@d if_dim_code=3 { `\.{\\ifdim}' }
-@d if_odd_code=4 { `\.{\\ifodd}' }
-@d if_vmode_code=5 { `\.{\\ifvmode}' }
-@d if_hmode_code=6 { `\.{\\ifhmode}' }
-@d if_mmode_code=7 { `\.{\\ifmmode}' }
-@d if_inner_code=8 { `\.{\\ifinner}' }
-@d if_void_code=9 { `\.{\\ifvoid}' }
-@d if_hbox_code=10 { `\.{\\ifhbox}' }
-@d if_vbox_code=11 { `\.{\\ifvbox}' }
-@d ifx_code=12 { `\.{\\ifx}' }
-@d if_eof_code=13 { `\.{\\ifeof}' }
-@d if_true_code=14 { `\.{\\iftrue}' }
-@d if_false_code=15 { `\.{\\iffalse}' }
-@d if_case_code=16 { `\.{\\ifcase}' }
-@d if_primitive_code=21 { `\.{\\ifprimitive}' }
-
-@<Put each...@>=
-primitive_tex("if",if_test,if_char_code,0);
-@!@:if_char_}{\.{\\if} primitive@>
-primitive_tex("ifcat",if_test,if_cat_code,0);
-@!@:if_cat_code_}{\.{\\ifcat} primitive@>
-primitive_tex("ifnum",if_test,if_int_code,0);
-@!@:if_int_}{\.{\\ifnum} primitive@>
-primitive_tex("ifdim",if_test,if_dim_code,0);
-@!@:if_dim_}{\.{\\ifdim} primitive@>
-primitive_tex("ifodd",if_test,if_odd_code,0);
-@!@:if_odd_}{\.{\\ifodd} primitive@>
-primitive_tex("ifvmode",if_test,if_vmode_code,0);
-@!@:if_vmode_}{\.{\\ifvmode} primitive@>
-primitive_tex("ifhmode",if_test,if_hmode_code,0);
-@!@:if_hmode_}{\.{\\ifhmode} primitive@>
-primitive_tex("ifmmode",if_test,if_mmode_code,0);
-@!@:if_mmode_}{\.{\\ifmmode} primitive@>
-primitive_tex("ifinner",if_test,if_inner_code,0);
-@!@:if_inner_}{\.{\\ifinner} primitive@>
-primitive_tex("ifvoid",if_test,if_void_code,0);
-@!@:if_void_}{\.{\\ifvoid} primitive@>
-primitive_tex("ifhbox",if_test,if_hbox_code,0);
-@!@:if_hbox_}{\.{\\ifhbox} primitive@>
-primitive_tex("ifvbox",if_test,if_vbox_code,0);
-@!@:if_vbox_}{\.{\\ifvbox} primitive@>
-primitive_tex("ifx",if_test,ifx_code,0);
-@!@:ifx_}{\.{\\ifx} primitive@>
-primitive_tex("ifeof",if_test,if_eof_code,0);
-@!@:if_eof_}{\.{\\ifeof} primitive@>
-primitive_tex("iftrue",if_test,if_true_code,0);
-@!@:if_true_}{\.{\\iftrue} primitive@>
-primitive_tex("iffalse",if_test,if_false_code,0);
-@!@:if_false_}{\.{\\iffalse} primitive@>
-primitive_tex("ifcase",if_test,if_case_code,0);
-@!@:if_case_}{\.{\\ifcase} primitive@>
-primitive_luatex("ifprimitive",if_test,if_primitive_code,0);
-@!@:if_primitive_}{\.{\\ifprimitive} primitive@>
-primitive_pdftex("ifpdfprimitive",if_test,if_primitive_code,0);
-@!@:if_primitive_}{\.{\\ifpdfprimitive} primitive@>
-
-@ 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_limit_subtype(#)==subtype(#+1)
-@d if_limit_type(#)==type(#+1)
-@d if_line_field(#)==vlink(#+1)
-@d if_code=1 {code for \.{\\if...} being evaluated}
-@d fi_code=2 {code for \.{\\fi}}
-@d else_code=3 {code for \.{\\else}}
-@d or_code=4 {code for \.{\\or}}
-
-@<Glob...@>=
-@!cond_ptr:pointer; {top of the condition stack}
-@!if_limit:normal..or_code; {upper bound on |fi_or_else| codes}
-@!cur_if:small_number; {type of conditional being worked on}
-@!if_line:integer; {line where that conditional began}
-
-@ @<Set init...@>=
-cond_ptr:=null; if_limit:=normal; cur_if:=0; if_line:=0;
-
-@ @<Put each...@>=
-primitive_tex("fi",fi_or_else,fi_code,0);
-@!@:fi_}{\.{\\fi} primitive@>
-text(frozen_fi):="fi"; eqtb[frozen_fi]:=eqtb[cur_val];
-primitive_tex("or",fi_or_else,or_code,0);
-@!@:or_}{\.{\\or} primitive@>
-primitive_tex("else",fi_or_else,else_code,0);
-@!@:else_}{\.{\\else} primitive@>
-
-@ When we skip conditional text, we keep track of the line number
-where skipping began, for use in error messages.
-
-@<Glob...@>=
-@!skip_line:integer; {skipping began here}
-
-@ Here is a procedure that ignores text until coming to an \.{\\or},
-\.{\\else}, or \.{\\fi} at level zero of $\.{\\if}\ldots\.{\\fi}$
-nesting. After it has acted, |cur_chr| will indicate the token that
-was found, but |cur_tok| will not be set (because this makes the
-procedure run faster).
-
-@p procedure pass_text;
-label done;
-var l:integer; {level of $\.{\\if}\ldots\.{\\fi}$ nesting}
-@!save_scanner_status:small_number; {|scanner_status| upon entry}
-begin save_scanner_status:=scanner_status; scanner_status:=skipping; l:=0;
-skip_line:=line;
-loop@+ begin get_filtered_next;
- if cur_cmd=fi_or_else then
- begin if l=0 then goto done;
- if cur_chr=fi_code then decr(l);
- end
- else if cur_cmd=if_test then incr(l);
- end;
-done: scanner_status:=save_scanner_status;
-if tracing_ifs>0 then show_cur_cmd_chr;
-end;
-
-@ When we begin to process a new \.{\\if}, we set |if_limit:=if_code|; then
-if\/ \.{\\or} or \.{\\else} or \.{\\fi} occurs before the current \.{\\if}
-condition has been evaluated, \.{\\relax} will be inserted.
-For example, a sequence of commands like `\.{\\ifvoid1\\else...\\fi}'
-would otherwise require something after the `\.1'.
-
-@<Push the condition stack@>=
-begin p:=new_node(if_node,0); vlink(p):=cond_ptr;
-if_limit_type(p):=if_limit;
-if_limit_subtype(p):=cur_if;
-if_line_field(p):=if_line;
-cond_ptr:=p; cur_if:=cur_chr; if_limit:=if_code; if_line:=line;
-end
-
-@ @<Pop the condition stack@>=
-begin if if_stack[in_open]=cond_ptr then if_warning;
- {conditionals possibly not properly nested with files}
-p:=cond_ptr;
-if_line:=if_line_field(p);
-cur_if:=if_limit_subtype(p);
-if_limit:=if_limit_type(p);
-cond_ptr:=vlink(p);
-flush_node(p);
-end
-
-@ Here's a procedure that changes the |if_limit| code corresponding to
-a given value of |cond_ptr|.
-
-@p procedure change_if_limit(@!l:small_number;@!p:pointer);
-label exit;
-var q:pointer;
-begin if p=cond_ptr then if_limit:=l {that's the easy case}
-else begin q:=cond_ptr;
- loop@+ begin if q=null then confusion("if");
-@:this can't happen if}{\quad if@>
- if vlink(q)=p then
- begin if_limit_type(q):=l; return;
- end;
- q:=vlink(q);
- end;
- end;
-exit:end;
-
-@ A condition is started when the |expand| procedure encounters
-an |if_test| command; in that case |expand| reduces to |conditional|,
-which is a recursive procedure.
-@^recursion@>
-
-@p procedure conditional;
-label exit,common_ending;
-var b:boolean; {is the condition true?}
-@!r:"<"..">"; {relation to be evaluated}
-@!m,@!n,@!s:integer; {to be tested against the second operand}
-@!p,@!q:pointer; {for traversing token lists in \.{\\ifx} tests}
-@!save_scanner_status:small_number; {|scanner_status| upon entry}
-@!save_cond_ptr:pointer; {|cond_ptr| corresponding to this conditional}
-@!this_if:small_number; {type of this conditional}
-@!is_unless:boolean; {was this if preceded by `\.{\\unless}' ?}
-begin b:= false; {default is false, just in case}
-if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
-@<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;
-is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/
-@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
-if is_unless then b:=not b;
-if tracing_commands>1 then @<Display the value of |b|@>;
-if b then
- begin change_if_limit(else_code,save_cond_ptr);
- return; {wait for \.{\\else} or \.{\\fi}}
- end;
-@<Skip to \.{\\else} or \.{\\fi}, then |goto common_ending|@>;
-common_ending: if cur_chr=fi_code then @<Pop the condition stack@>
-else if_limit:=fi_code; {wait for \.{\\fi}}
-exit:end;
-
-@ In a construction like `\.{\\if\\iftrue abc\\else d\\fi}', the first
-\.{\\else} that we come to after learning that the \.{\\if} is false is
-not the \.{\\else} we're looking for. Hence the following curious
-logic is needed.
-
-@ @<Skip to \.{\\else} or \.{\\fi}...@>=
-loop@+ begin pass_text;
- if cond_ptr=save_cond_ptr then
- begin if cur_chr<>or_code then goto common_ending;
- print_err("Extra "); print_esc("or");
-@.Extra \\or@>
- help1("I'm ignoring this; it doesn't match any \if.");
- error;
- end
- else if cur_chr=fi_code then @<Pop the condition stack@>;
- end
-
-@ @<Either process \.{\\ifcase} or set |b|...@>=
-case this_if of
-if_char_code, if_cat_code: @<Test if two characters match@>;
-if_int_code, if_dim_code: @<Test relation between integers or dimensions@>;
-if_odd_code: @<Test if an integer is odd@>;
-if_vmode_code: b:=(abs(mode)=vmode);
-if_hmode_code: b:=(abs(mode)=hmode);
-if_mmode_code: b:=(abs(mode)=mmode);
-if_inner_code: b:=(mode<0);
-if_void_code, if_hbox_code, if_vbox_code: @<Test box register status@>;
-ifx_code: @<Test if two tokens match@>;
-if_eof_code: begin scan_four_bit_int; b:=(read_open[cur_val]=closed);
- end;
-if_true_code: b:=true;
-if_false_code: b:=false;
-@/@<Cases for |conditional|@>@/
-if_case_code: @<Select the appropriate case
- and |return| or |goto common_ending|@>;
-if_primitive_code: begin
- save_scanner_status:=scanner_status;
- scanner_status:=normal;
- get_filtered_next;
- scanner_status:=save_scanner_status;
- m := prim_lookup(text(cur_cs));
- b :=((cur_cmd<>undefined_cs) and
- (m<>undefined_primitive) and
- (cur_cmd=get_prim_eq_type(m)) and
- (cur_chr=get_prim_equiv(m)));
- end;
-{there are no other cases, but for -Wall: }
-othercases
- b:=false;
-endcases
-
-@ @<Display the value of |b|@>=
-begin begin_diagnostic;
-if b then print("{true}")@+else print("{false}");
-end_diagnostic(false);
-end
-
-@ Here we use the fact that |"<"|, |"="|, and |">"| are consecutive ASCII
-codes.
-@^ASCII code@>
-
-@<Test relation between integers or dimensions@>=
-begin if this_if=if_int_code then scan_int@+else scan_normal_dimen;
-n:=cur_val; @<Get the next non-blank non-call...@>;
-if (cur_tok>=other_token+"<")and(cur_tok<=other_token+">") then
- r:=cur_tok-other_token
-else begin print_err("Missing = inserted for ");
-@.Missing = inserted@>
- print_cmd_chr(if_test,this_if);
- help1("I was expecting to see `<', `=', or `>'. Didn't.");
- back_error; r:="=";
- end;
-if this_if=if_int_code then scan_int@+else scan_normal_dimen;
-case r of
-"<": b:=(n<cur_val);
-"=": b:=(n=cur_val);
-">": b:=(n>cur_val);
-othercases b:=false; {can't happen}
-end;
-end
-
-@ @<Test if an integer is odd@>=
-begin scan_int; b:=odd(cur_val);
-end
-
-@ @<Test box register status@>=
-begin scan_register_num; p:=box(cur_val);
-if this_if=if_void_code then b:=(p=null)
-else if p=null then b:=false
-else if this_if=if_hbox_code then b:=(type(p)=hlist_node)
-else b:=(type(p)=vlist_node);
-end
-
-@ An active character will be treated as category 13 following
-\.{\\if\\noexpand} or following \.{\\ifcat\\noexpand}.
-
-@d get_x_token_or_active_char==@t@>@;
- begin get_x_token;
- if cur_cmd=relax then if cur_chr=no_expand_flag then if is_active_csname(cur_cs) then
- begin cur_cmd:=active_char;
- cur_chr:=active_csname_value(cur_tok-cs_token_flag);
- end;
- end
-
-@<Test if two characters match@>=
-begin get_x_token_or_active_char;
-if (cur_cmd>active_char)or(cur_chr>biggest_char) then {not a character}
- begin m:=relax; n:=too_big_char;
- end
-else begin m:=cur_cmd; n:=cur_chr;
- end;
-get_x_token_or_active_char;
-if (cur_cmd>active_char)or(cur_chr>biggest_char) then
- begin cur_cmd:=relax; cur_chr:=too_big_char;
- end;
-if this_if=if_char_code then b:=(n=cur_chr)@+else b:=(m=cur_cmd);
-end
-
-@ Note that `\.{\\ifx}' will declare two macros different if one is \\{long}
-or \\{outer} and the other isn't, even though the texts of the macros are
-the same.
-
-We need to reset |scanner_status|, since \.{\\outer} control sequences
-are allowed, but we might be scanning a macro definition or preamble.
-
-@<Test if two tokens match@>=
-begin save_scanner_status:=scanner_status; scanner_status:=normal;
-get_filtered_next; n:=cur_cs; p:=cur_cmd; q:=cur_chr;
-get_filtered_next; if cur_cmd<>p then b:=false
-else if cur_cmd<call then b:=(cur_chr=q)
-else @<Test if two macro texts match@>;
-scanner_status:=save_scanner_status;
-end
-
-@ Note also that `\.{\\ifx}' decides that macros \.{\\a} and \.{\\b} are
-different in examples like this:
-$$\vbox{\halign{\.{#}\hfil&\qquad\.{#}\hfil\cr
- {}\\def\\a\{\\c\}&
- {}\\def\\c\{\}\cr
- {}\\def\\b\{\\d\}&
- {}\\def\\d\{\}\cr}}$$
-
-@<Test if two macro texts match@>=
-begin p:=link(cur_chr); q:=link(equiv(n)); {omit reference counts}
-if p=q then b:=true
-else begin while (p<>null)and(q<>null) do
- if info(p)<>info(q) then p:=null
- else begin p:=link(p); q:=link(q);
- end;
- b:=((p=null)and(q=null));
- end;
-end
-
-@ @<Select the appropriate case and |return| or |goto common_ending|@>=
-begin scan_int; n:=cur_val; {|n| is the number of cases to pass}
-if tracing_commands>1 then
- begin begin_diagnostic; print("{case "); print_int(n); print_char("}");
- end_diagnostic(false);
- end;
-while n<>0 do
- begin pass_text;
- if cond_ptr=save_cond_ptr then
- if cur_chr=or_code then decr(n)
- else goto common_ending
- else if cur_chr=fi_code then @<Pop the condition stack@>;
- end;
-change_if_limit(or_code,save_cond_ptr);
-return; {wait for \.{\\or}, \.{\\else}, or \.{\\fi}}
-end
-
-@ The processing of conditionals is complete except for the following
-code, which is actually part of |expand|. It comes into play when
-\.{\\or}, \.{\\else}, or \.{\\fi} is scanned.
-
-@<Terminate the current conditional and skip to \.{\\fi}@>=
-begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
-if cur_chr>if_limit then
- if if_limit=if_code then insert_relax {condition not yet evaluated}
- else begin print_err("Extra "); print_cmd_chr(fi_or_else,cur_chr);
-@.Extra \\or@>
-@.Extra \\else@>
-@.Extra \\fi@>
- help1("I'm ignoring this; it doesn't match any \if.");
- error;
- end
-else begin while cur_chr<>fi_code do pass_text; {skip to \.{\\fi}}
- @<Pop the condition stack@>;
- end;
-end
-
-@* \[29] File names.
-It's time now to fret about file names. Besides the fact that different
-operating systems treat files in different ways, we must cope with the
-fact that completely different naming conventions are used by different
-groups of people. The following programs show what is required for one
-particular operating system; similar routines for other systems are not
-difficult to devise.
-@^fingers@>
-@^system dependencies@>
-
-\TeX\ assumes that a file name has three parts: the name proper; its
-``extension''; and a ``file area'' where it is found in an external file
-system. The extension of an input file or a write file is assumed to be
-`\.{.tex}' unless otherwise specified; it is `\.{.log}' on the
-transcript file that records each run of \TeX; it is `\.{.tfm}' on the font
-metric files that describe characters in the fonts \TeX\ uses; it is
-`\.{.dvi}' on the output files that specify typesetting information; and it
-is `\.{.fmt}' on the format files written by \.{INITEX} to initialize \TeX.
-The file area can be arbitrary on input files, but files are usually
-output to the user's current area. If an input file cannot be
-found on the specified area, \TeX\ will look for it on a special system
-area; this special area is intended for commonly used input files like
-\.{webmac.tex}.
-
-Simple uses of \TeX\ refer only to file names that have no explicit
-extension or area. For example, a person usually says `\.{\\input} \.{paper}'
-or `\.{\\font\\tenrm} \.= \.{helvetica}' instead of `\.{\\input}
-\.{paper.new}' or `\.{\\font\\tenrm} \.= \.{<csd.knuth>test}'. Simple file
-names are best, because they make the \TeX\ source files portable;
-whenever a file name consists entirely of letters and digits, it should be
-treated in the same way by all implementations of \TeX. However, users
-need the ability to refer to other files in their environment, especially
-when responding to error messages concerning unopenable files; therefore
-we want to let them use the syntax that appears in their favorite
-operating system.
-
-The following procedures don't allow spaces to be part of
-file names; but some users seem to like names that are spaced-out.
-System-dependent changes to allow such things should probably
-be made with reluctance, and only when an entire file name that
-includes spaces is ``quoted'' somehow.
-
-@ Here are the global values that file names will be scanned into.
-
-@<Glob...@>=
-@!cur_name:str_number; {name of file just scanned}
-@!cur_area:str_number; {file area just scanned, or \.{""}}
-@!cur_ext:str_number; {file extension just scanned, or \.{""}}
-
-@ The file names we shall deal with for illustrative purposes have the
-following structure: If the name contains `\.>' or `\.:', the file area
-consists of all characters up to and including the final such character;
-otherwise the file area is null. If the remaining file name contains
-`\..', the file extension consists of all such characters from the first
-remaining `\..' to the end, otherwise the file extension is null.
-@^system dependencies@>
-
-We can scan such file names easily by using two global variables that keep track
-of the occurrences of area and extension delimiters:
-
-@<Glob...@>=
-@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
-@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
-
-@ Input files that can't be found in the user's area may appear in a standard
-system area called |TEX_area|. Font metric files whose areas are not given
-explicitly are assumed to appear in a standard system area called
-|TEX_font_area|. $\Omega$'s compiled translation process files whose areas
-are not given explicitly are assumed to appear in a standard system area
-called |OMEGA_ocp_area|. These system area names will, of course, vary
-from place to place.
-@^system dependencies@>
-
-@d TEX_area=="TeXinputs:"
-@.TeXinputs@>
-@d TEX_font_area=="TeXfonts:"
-@.TeXfonts@>
-@d OMEGA_ocp_area=="OmegaOCPs:"
-@.OmegaOCPs@>
-
-@ Another system-dependent routine is needed to convert three internal
-\TeX\ strings
-into the |nameoffile| value that is used to open files. The present code
-allows both lowercase and uppercase letters in the file name.
-@^system dependencies@>
-
-@d append_to_name(#)==begin c:=#; incr(k);
- if k<=file_name_size then nameoffile[k]:=xchr[c];
- end
-
-@p procedure pack_file_name(@!n,@!a,@!e:str_number);
-var k:integer; {number of positions filled in |nameoffile|}
-@!c: ASCII_code; {character being packed}
-@!j:pool_pointer; {index into |str_pool|}
-begin k:=0;
-for j:=str_start_macro(a) to str_start_macro(a+1)-1 do append_to_name(so(str_pool[j]));
-for j:=str_start_macro(n) to str_start_macro(n+1)-1 do append_to_name(so(str_pool[j]));
-for j:=str_start_macro(e) to str_start_macro(e+1)-1 do append_to_name(so(str_pool[j]));
-if k<=file_name_size then namelength:=k@+else namelength:=file_name_size;
-for k:=namelength+1 to file_name_size do nameoffile[k]:=' ';
-end;
-
-@ A messier routine is also needed, since format file names must be scanned
-before \TeX's string mechanism has been initialized. We shall use the
-global variable |TEX_format_default| to supply the text for default system areas
-and extensions related to format files.
-@^system dependencies@>
-
-@d format_default_length=20 {length of the |TEX_format_default| string}
-@d format_area_length=11 {length of its area part}
-@d format_ext_length=4 {length of its `\.{.fmt}' part}
-@d format_extension=='.fmt' {the extension, as a \.{WEB} constant}
-
-@<Glob...@>=
-@!TEX_format_default:packed array[1..format_default_length] of char;
-
-@ @<Set init...@>=
-TEX_format_default:='TeXformats:plain.fmt';
-@.TeXformats@>
-@.plain@>
-@^system dependencies@>
-
-@ @<Check the ``constant'' values for consistency@>=
-if format_default_length>file_name_size then bad:=31;
-
-@ Here is the messy routine that was just mentioned. It sets |nameoffile|
-from the first |n| characters of |TEX_format_default|, followed by
-|buffer[a..b]|, followed by the last |format_ext_length| characters of
-|TEX_format_default|.
-
-We dare not give error messages here, since \TeX\ calls this routine before
-the |error| routine is ready to roll. Instead, we simply drop excess characters,
-since the error will be detected in another way when a strange file name
-isn't found.
-@^system dependencies@>
-
-@p procedure pack_buffered_name(@!n:integer;@!a,@!b:integer);
-var k:integer; {number of positions filled in |nameoffile|}
-@!c: ASCII_code; {character being packed}
-@!j:integer; {index into |buffer| or |TEX_format_default|}
-begin if n+b-a+1+format_ext_length>file_name_size then
- b:=a+file_name_size-n-1-format_ext_length;
-k:=0;
-for j:=1 to n do append_to_name(TEX_format_default[j]);
-for j:=a to b do append_to_name(buffer[j]);
-for j:=format_default_length-format_ext_length+1 to format_default_length do
- append_to_name(TEX_format_default[j]);
-if k<=file_name_size then namelength:=k@+else namelength:=file_name_size;
-for k:=namelength+1 to file_name_size do nameoffile[k]:=' ';
-end;
-
-@ Here is the only place we use |pack_buffered_name|. This part of the program
-becomes active when a ``virgin'' \TeX\ is trying to get going, just after
-the preliminary initialization, or when the user is substituting another
-format file by typing `\.\&' after the initial `\.{**}' prompt. The buffer
-contains the first line of input in |buffer[loc..(last-1)]|, where
-|loc<last| and |buffer[loc]<>" "|.
-
-@<Declare the function called |open_fmt_file|@>=
-function open_fmt_file:boolean;
-label found,exit;
-var j:0..buf_size; {the first space after the format file name}
-begin j:=loc;
-if buffer[loc]="&" then
- begin incr(loc); j:=loc; buffer[last]:=" ";
- while buffer[j]<>" " do incr(j);
- pack_buffered_name(0,loc,j-1); {try first without the system file area}
- if w_open_in(fmt_file) then goto found;
- pack_buffered_name(format_area_length,loc,j-1);
- {now try the system format file area}
- if w_open_in(fmt_file) then goto found;
- wake_up_terminal;
- wterm_ln('Sorry, I can''t find that format;',' will try PLAIN.');
-@.Sorry, I can't find...@>
- update_terminal;
- end;
- {now pull out all the stops: try for the system \.{plain} file}
-pack_buffered_name(format_default_length-format_ext_length,1,0);
-if not w_open_in(fmt_file) then
- begin wake_up_terminal;
- wterm_ln('I can''t find the PLAIN format file!');
-@.I can't find PLAIN...@>
-@.plain@>
- open_fmt_file:=false; return;
- end;
-found:loc:=j; open_fmt_file:=true;
-exit:end;
-
-@ Operating systems often make it possible to determine the exact name (and
-possible version number) of a file that has been opened. The following routine,
-which simply makes a \TeX\ string from the value of |nameoffile|, should
-ideally be changed to deduce the full name of file~|f|, which is the file
-most recently opened, if it is possible to do this in a \PASCAL\ program.
-@^system dependencies@>
-
-This routine might be called after string memory has overflowed, hence
-we dare not use `|str_room|'.
-
-@d a_make_name_string(#)==make_name_string
-@d b_make_name_string(#)==make_name_string
-@d w_make_name_string(#)==make_name_string
-
-
-@ 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.
-
-@d pack_cur_name==pack_file_name(cur_name,cur_area,cur_ext)
-
-@<Initialize the output...@>=
-job_name:=0; name_in_progress:=false; log_opened:=false;
-
-@ Here's an example of how these conventions are used. Whenever it is time to
-ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
-
-@d ensure_dvi_open==if output_file_name=0 then
- begin if job_name=0 then open_log_file;
- pack_job_name('.dvi');
- while not lua_b_open_out(dvi_file) do
- prompt_file_name('file name for output','.dvi');
- dvi_file:=name_file_pointer ;
- output_file_name:=b_make_name_string(dvi_file);
- end
-
-@<Glob...@>=
-@!dvi_file: byte_file; {the device-independent output goes here}
-@!output_file_name: str_number; {full name of the output file}
-@!log_name:str_number; {full name of the log file}
-
-@ @<Initialize the output...@>=output_file_name:=0;
-
-@ The |open_log_file| routine is used to open the transcript file and to help
-it catch up to what has previously been printed on the terminal.
-
-@p procedure open_log_file;
-var old_setting:0..max_selector; {previous |selector| setting}
-@!k:0..buf_size; {index into |months| and |buffer|}
-@!l:0..buf_size; {end of first input line}
-@!months:packed array [1..36] of char; {abbreviations of month names}
-begin old_setting:=selector;
-if job_name=0 then job_name:="texput";
-@.texput@>
-pack_job_name('.log');
-while not lua_a_open_out(addressof(log_file),0) do @<Try to get a different log file name@>;
-log_file := name_file_pointer;
-log_name:=a_make_name_string(log_file);
-selector:=log_only; log_opened:=true;
-if callback_defined(start_run_callback)=0 then begin
- @<Print the banner line, including the date and time@>;
- input_stack[input_ptr]:=cur_input; {make sure bottom level is in memory}
- print_nl("**");
-@.**@>
- l:=input_stack[0].limit_field; {last position of first line}
- if buffer[l]=end_line_char then decr(l); { TODO: multichar endlinechar}
- for k:=1 to l do print_char(buffer[k]);
- print_ln; {now the transcript file contains the first line of input}
- end;
-flush_loggable_info; {should be done always}
-selector:=old_setting+2; {|log_only| or |term_and_log|}
-end;
-
-@ Sometimes |open_log_file| is called at awkward moments when \TeX\ is
-unable to print error messages or even to |show_context|.
-The |prompt_file_name| routine can result in a |fatal_error|, but the |error|
-routine will not be invoked because |log_opened| will be false.
-
-The normal idea of |batch_mode| is that nothing at all should be written
-on the terminal. However, in the unusual case that
-no log file could be opened, we make an exception and allow
-an explanatory message to be seen.
-
-Incidentally, the program always refers to the log file as a `\.{transcript
-file}', because some systems cannot use the extension `\.{.log}' for
-this file.
-
-@<Try to get a different log file name@>=
-begin selector:=term_only;
-prompt_file_name('transcript file name','.log');
-end
-
-@ @<Print the banner...@>=
-begin wlog(banner);
-slow_print(format_ident); print(" ");
-print_int(day); print_char(" ");
-months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
-for k:=3*month-2 to 3*month do wlog(months[k]);
-print_char(" "); print_int(year); print_char(" ");
-print_two(time div 60); print_char(":"); print_two(time mod 60);
-end
-
-@ Let's turn now to the procedure that is used to initiate file reading
-when an `\.{\\input}' command is being processed.
-
-@p procedure start_input; {\TeX\ will \.{\\input} something}
-label done;
-var temp_str:str_number;
-begin scan_file_name; {set |cur_name| to desired file name}
-{|if cur_ext="" then cur_ext:=".tex";|}
-pack_cur_name;
-loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
- if lua_a_open_in(cur_file,0) then goto done;
- end_file_reading; {remove the level that didn't work}
- prompt_file_name('input file name','.tex');
- end;
-done:
-cur_file := name_file_pointer;
-name:=a_make_name_string(cur_file);
-if job_name=0 then
- begin job_name:=cur_name; open_log_file;
- end; {|open_log_file| doesn't |show_context|, so |limit|
- and |loc| needn't be set to meaningful values yet}
-if tracefilenames then begin
- if term_offset+length(name)>max_print_line-2 then print_ln
- else if (term_offset>0)or(file_offset>0) then print_char(" ");
- print_char("(");
- print_file_name(0,name,0);
-end;
-incr(open_parens);
-update_terminal;
-state:=new_line;
-if name=str_ptr-1 then {we can conserve string pool space now}
- begin flush_string; name:=cur_name;
- end;
-@<Prepare new file {\sl Sync\TeX} information@>;
-@<Read the first line of the new file@>;
-end;
-
-@ Here we have to remember to tell the |lua_input_ln| routine not to
-start with a |get|. If the file is empty, it is considered to
-contain a single blank line.
-@^system dependencies@>
-@^empty line at end of file@>
-
-@<Read the first line...@>=
-begin line:=1;
-if lua_input_ln(cur_file,0,false) then do_nothing;
-firm_up_the_line;
-if end_line_char_inactive then decr(limit)
-else buffer[limit]:=end_line_char;
-first:=limit+1; loc:=start;
-end
-
-@* \[30] Font metric data and OCPS.
-\TeX\ gets its knowledge about fonts from font metric files, also called
-\.{TFM} files; the `\.T' in `\.{TFM}' stands for \TeX,
-but other programs know about them too.
-@:TFM files}{\.{TFM} files@>
-@^font metric files@>
-
-@ When the user defines \.{\\font\\f}, say, \TeX\ assigns an internal number
-to the user's font~\.{\\f}. Adding this number to |font_id_base| gives the
-|eqtb| location of a ``frozen'' control sequence that will always select
-the font.
-
-@<Types...@>=
-@!internal_font_number=integer; {|font| in a |char_node|}
-@!font_index=integer; {index into |font_info|}
-
-@ @<Glob...@>=
-@!font_bytes:integer;
-
-@ \TeX\ always knows at least one font, namely the null font. It has no
-characters, and its seven parameters are all equal to zero.
-
-@<Initialize table...@>=
-create_null_font;
-font_bytes:=0;
-
-@ @<Put each...@>=
-primitive_tex("nullfont",set_font,null_font,0);
-@!@:null_font_}{\.{\\nullfont} primitive@>
-text(frozen_null_font):="nullfont"; eqtb[frozen_null_font]:=eqtb[cur_val];
-
-@ @<The em width for |cur_font|@>=quad(cur_font)
-
-@ @<The x-height for |cur_font|@>=x_height(cur_font)
-
-@ Before we forget about the format of these tables, let's deal with two
-of \TeX's basic scanning routines related to font information.
-
-@<Declare procedures that scan font-related stuff@>=
-procedure scan_font_ident;
-var f:internal_font_number;
-@!m:halfword;
-begin @<Get the next non-blank non-call...@>;
-if (cur_cmd=def_font) or (cur_cmd=letterspace_font) or (cur_cmd=pdf_copy_font) then f:=cur_font
-else if cur_cmd=set_font then begin
- f:=cur_chr;
- set_font_touched(f,1);
- end
-else if cur_cmd=def_family then begin
- m:=cur_chr; scan_math_family_int; f:=fam_fnt(cur_val,m);
- set_font_touched(f,1);
- end
-else begin print_err("Missing font identifier");
-@.Missing font identifier@>
- help2("I was looking for a control sequence whose")@/
- ("current meaning has been defined by \font.");
- back_error; f:=null_font;
- end;
-cur_val:=f;
-end;
-
-@ The following routine is used to implement `\.{\\fontdimen} |n| |f|'.
-The boolean parameter |writing| is set |true| if the calling program
-intends to change the parameter value.
-
-@<Declare procedures that scan font-related stuff@>=
-procedure set_font_dimen;forward;
-procedure get_font_dimen;forward;
-
-@ @p
-procedure set_font_dimen;
-label exit;
-var f:internal_font_number;
-@!n:integer; {the parameter number}
-begin scan_int; n:=cur_val; scan_font_ident; f:=cur_val;
- if n<=0 then
- @<Issue a font parameter error message, and return@>
- else begin
- if n>font_params(f) then begin
- if font_touched(f) then @<Issue a font parameter error message, and return@>
- else @<Increase the number of parameters in the font@>;
- end;
- end;
- scan_optional_equals; scan_normal_dimen;
- set_font_param(f,n,cur_val);
-exit:
-end;
-@#
-procedure get_font_dimen;
-label exit;
-var f:internal_font_number;
-@!n:integer; {the parameter number}
-begin scan_int; n:=cur_val; scan_font_ident; f:=cur_val;
- cur_val:=0; { initialize return value }
- if n<=0 then
- @<Issue a font parameter error message, and return@>
- else begin
- if n>font_params(f) then begin
- if font_touched(f) then @<Issue a font parameter error message, and return@>
- else @<Increase the number of parameters in the font@>;
- end;
- end;
- cur_val:=font_param(f,n);
-exit:
- scanned_result(cur_val)(dimen_val);
-end;
-
-@ @<Issue a font parameter error message, and return@>=
-begin print_err("Font "); print_esc(font_id_text(f));
- print(" has only "); print_int(font_params(f));
- print(" fontdimen parameters");
-@.Font x has only...@>
- help2("To increase the number of font parameters, you must")@/
- ("use \fontdimen immediately after the \font is loaded.");
- error;
- return;
-end
-
-@ @<Increase the number of parameters...@>=
-begin repeat
- set_font_param(f,(font_params(f)+1),0);
-until n=font_params(f);
-end
-
-
-@ When \TeX\ wants to typeset a character that doesn't exist, the
-character node is not created; thus the output routine can assume
-that characters exist when it sees them. The following procedure
-prints a warning message unless the user has suppressed it.
-
-@p procedure char_warning(@!f:internal_font_number;@!c:integer);
-var old_setting: integer; {saved value of |tracing_online|}
- k:0..22; {index to current digit; we assume that $0\L n<16^{22}$}
-begin if tracing_lost_chars>0 then
- begin old_setting:=tracing_online;
- if tracing_lost_chars>1 then tracing_online:=1;
- begin begin_diagnostic;
- print_nl("Missing character: There is no ");
-@.Missing character@>
- print(c); print(" (U+");
- k:=0;
- if c<16 then print_char('0');
- if c<256 then print_char('0');
- if c<4096 then print_char('0');
- repeat dig[k]:=c mod 16; c:=c div 16; incr(k);
- until c=0;
- print_the_digs(k);
- print(") in font ");
- print_font_name(f);
- print_char("!"); end_diagnostic(false);
- end;
- tracing_online:=old_setting;
- end;
-end;
-
-@
-@<Types...@>=
-@!active_index=0..active_mem_size;
-
-@
-@d active_ocp(#)==active_info[#].hh.b0
-@d active_counter(#)==active_info[#].hh.b1
-@d active_lstack_no(#)==active_info[#+1].sc
-
-@<Glob...@>=
-@!active_info:array[active_index] of memory_word;
-@!active_min_ptr:active_index; {first unused word of |active_info|}
-@!active_max_ptr:active_index; {last unused word of |active_info|}
-@!active_real:active_index;
-@!holding:array[active_index] of ocp_list_index;
-
-@
-@<Initialize table...@>=
-active_min_ptr:=0;
-active_real:=0;
-
-@
-@p
-function is_last_ocp(llstack_no:scaled; counter:integer):integer;
-begin
-active_min_ptr:=equiv(ocp_active_min_ptr_base);
-active_max_ptr:=equiv(ocp_active_max_ptr_base);
-active_real:=active_min_ptr;
-while (active_real < active_max_ptr) and
- (active_lstack_no(active_real) < llstack_no) do begin
- active_real:=active_real+2;
- end;
-while (active_real < active_max_ptr) and
- (active_lstack_no(active_real) = llstack_no) and
- (active_counter(active_real) <= counter) do begin
- active_real:=active_real+2;
- end;
-is_last_ocp := (active_real=active_max_ptr);
-end;
-
-procedure print_active_ocps;
-var i:integer;
-begin
-print_nl("Active ocps: [");
-i:=active_min_ptr;
-while i<active_max_ptr do begin
- print("(");
- print_scaled(active_lstack_no(i));
- print(",");
- print_int(active_counter(i));
- print(",");
- print_esc(ocp_id_text(active_ocp(i)));
- print(")");
- if i<>(active_max_ptr-2) then print(",");
- i:=i+2;
- end;
-print("]");
-end;
-
-procedure add_ocp_stack(min_index:integer; min_value:scaled);
-var p:ocp_lstack_index;
- llstack_no:scaled;
- counter:integer;
- m:scaled;
-begin
-m:=min_value; { TH: whatever this is ..}
-p:=ocp_list_lstack(holding[min_index]);
-llstack_no:=ocp_list_lstack_no(holding[min_index]);
-counter:=0;
-while not (is_null_ocp_lstack(p)) do begin
- active_ocp(active_max_ptr):=ocp_lstack_ocp(p);
- active_counter(active_max_ptr):=counter;
- active_lstack_no(active_max_ptr):=llstack_no;
- p:=ocp_lstack_lnext(p);
- active_max_ptr:=active_max_ptr+2;
- incr(counter); {no overflow problem}
- end;
-end;
-
-procedure active_compile;
-var i:integer;
- min_index:integer;
- min_stack_ocp:scaled;
- old_min:scaled;
- max_active:integer;
- stack_value:scaled;
-begin
-active_min_ptr:=active_max_ptr;
-min_stack_ocp:=ocp_maxint;
-max_active:=equiv(ocp_active_number_base)-1;
-min_index:=max_active; {TH I hope ... }
-for i:=max_active downto 0 do begin
- holding[i]:=ocp_list_list[equiv(ocp_active_base+i)];
- stack_value:=ocp_list_lstack_no(holding[i]);
- if stack_value<min_stack_ocp then begin
- min_index:=i;
- min_stack_ocp:=stack_value;
- end;
- end;
-while min_stack_ocp<ocp_maxint do begin
- add_ocp_stack(min_index, min_stack_ocp);
- old_min:=min_stack_ocp;
- min_stack_ocp:=ocp_maxint;
- for i:=max_active downto 0 do begin
- stack_value:=ocp_list_lstack_no(holding[i]);
- while old_min=stack_value do begin
- holding[i]:=ocp_list_lnext(holding[i]);
- stack_value:=ocp_list_lstack_no(holding[i]);
- end;
- if stack_value<min_stack_ocp then begin
- min_index:=i;
- min_stack_ocp:=stack_value;
- end;
- end;
- end;
-end;
-
-@ Here we begin the \.{OCP} file handling.
-
-@<Glob...@>=
-@!ocp_file:byte_file;
-
-@ So that is what \.{OCP} files hold.
-
-When the user defines \.{\\ocp\\f}, say, \TeX\ assigns an internal number
-to the user's ocp~\.{\\f}. Adding this number to |ocp_id_base| gives the
-|eqtb| location of a ``frozen'' control sequence that will always select
-the ocp.
-
-@<Types...@>=
-@!internal_ocp_number=ocp_base..ocp_biggest;
-@!ocp_index=integer;
-
-@ Here now is the array of ocp arrays.
-
-@<Glob...@>=
-@!ocp_ptr:internal_ocp_number; {largest internal ocp number in use}
-@!ocp_buffer:^real_eight_bits; {byte buffer for ocp files}
-@!ocp_size:integer; {total size of the ocp file}
-@!ocp_cur:integer; {index into |ocp_buffer|}
-
-@ @<Set init...@>=
-ocp_buffer:=0; ocp_size:=0; ocp_cur:=0;
-
-@ Besides the arrays just enumerated, we have two directory arrays that
-make it easy to get at the individual entries in |ocp_info|.
-The beginning of the info for the |j|-th state in the |i|-th ocp is at
-location |ocp_info[ocp_state_base[i]+j]| and the |k|-th entry is in
-location |ocp_info[ocp_info[ocp_state_base[i]+j]+k]|.
-(These formulas assume that |min_quarterword| has already been
-added to |i|, |j| and |k|, since $\Omega$ stores its quarterwords that way.)
-
-@d ocp_info_end(#)==#]
-@d ocp_info(#)==ocp_tables[#,ocp_info_end
-@d offset_ocp_file_size=0
-@d offset_ocp_name=1
-@d offset_ocp_area=offset_ocp_name+1
-@d offset_ocp_external=offset_ocp_area+1
-@d offset_ocp_external_arg=offset_ocp_external+1
-@d offset_ocp_input=offset_ocp_external_arg+1
-@d offset_ocp_output=offset_ocp_input+1
-@d offset_ocp_no_tables=offset_ocp_output+1
-@d offset_ocp_no_states=offset_ocp_no_tables+1
-@d offset_ocp_table_base=offset_ocp_no_states+1
-@d offset_ocp_state_base=offset_ocp_table_base+1
-@d offset_ocp_info=offset_ocp_state_base+1
-@d ocp_file_size(#)==ocp_info(#)(offset_ocp_file_size)
-@d ocp_name(#)==ocp_info(#)(offset_ocp_name)
-@d ocp_area(#)==ocp_info(#)(offset_ocp_area)
-@d ocp_external(#)==ocp_info(#)(offset_ocp_external)
-@d ocp_external_arg(#)==ocp_info(#)(offset_ocp_external_arg)
-@d ocp_input(#)==ocp_info(#)(offset_ocp_input)
-@d ocp_output(#)==ocp_info(#)(offset_ocp_output)
-@d ocp_no_tables(#)==ocp_info(#)(offset_ocp_no_tables)
-@d ocp_no_states(#)==ocp_info(#)(offset_ocp_no_states)
-@d ocp_table_base(#)==ocp_info(#)(offset_ocp_table_base)
-@d ocp_state_base(#)==ocp_info(#)(offset_ocp_state_base)
-
-@ $\Omega$ always knows at least one ocp, namely the null ocp.
-It does nothing.
-
-@<Initialize table...@>=
-ocp_ptr:=null_ocp;
-allocate_ocp_table(null_ocp,17);
-ocp_file_size(null_ocp):=17;
-ocp_name(null_ocp):="nullocp"; ocp_area(null_ocp):="";
-ocp_external(null_ocp):=0; ocp_external_arg(null_ocp):=0;
-ocp_input(null_ocp):=1; ocp_output(null_ocp):=1;
-ocp_no_tables(null_ocp):=0;
-ocp_no_states(null_ocp):=1;
-ocp_table_base(f):=offset_ocp_info;
-ocp_state_base(f):=offset_ocp_info;
-ocp_info(null_ocp)(offset_ocp_info) := offset_ocp_info+2; {number of entries}
-ocp_info(null_ocp)(offset_ocp_info+1) := offset_ocp_info+5; {number of entries}
-ocp_info(null_ocp)(offset_ocp_info+2) := 23; {|OTP_LEFT_START|}
-ocp_info(null_ocp)(offset_ocp_info+3) := 3; {|OTP_RIGHT_CHAR|}
-ocp_info(null_ocp)(offset_ocp_info+4) := 36; {|OTP_STOP|}
-
-
-@ @<Put each...@>=
-primitive_omega("nullocp", set_ocp, null_ocp,0);
-text(frozen_null_ocp) := "nullocp";
-eqtb[frozen_null_ocp] := eqtb[cur_val];
-geq_define(ocp_active_number_base, data, 0);
-geq_define(ocp_active_min_ptr_base, data, 0);
-geq_define(ocp_active_max_ptr_base, data, 0);
-
-@ Of course we want to define macros that suppress the detail of how ocp
-information is actually packed, so that we don't have to write things like
-$$\hbox{|ocp_info[k+ocp_info[j+ocp_state_base[i]]]|}$$
-too often. The \.{WEB} definitions here make |ocp_state_entry(i)(j)(k)|
-(|ocp_table_entry(i)(j)(k)|) the |k|-th word in the |j|-th state (table)
-of the |i|-th ocp.
-@^inner loop@>
-
-@d ocp_state_end(#)==#]
-@d ocp_state_one(#)==#*2]+ocp_state_end
-@d ocp_state_entry(#)==ocp_tables[#,ocp_tables[#,ocp_state_base(#)+ocp_state_one
-
-@d ocp_state_no_end(#)==#*2+1]
-@d ocp_state_no(#)==ocp_tables[#,ocp_state_base(#)+ocp_state_no_end
-
-@d ocp_table_end(#)==#]
-@d ocp_table_one(#)==#*2]+ocp_table_end
-@d ocp_table_entry(#)==ocp_tables[#,ocp_tables[#,ocp_table_base(#)+ocp_table_one
-
-@d ocp_table_no_end(#)==#*2+1]
-@d ocp_table_no(#)==ocp_tables[#,ocp_table_base(#)+ocp_table_no_end
-
-@ $\Omega$ checks the information of a \.{OCP} file for validity as the
-file is being read in, so that no further checks will be needed when
-typesetting is going on. The somewhat tedious subroutine that does this
-is called |read_ocp_info|. It has three parameters: the user ocp
-identifier~|u|, and the file name and area strings |nom| and |aire|.
-
-The subroutine opens and closes a global file variable called |ocp_file|.
-It returns the value of the internal ocp number that was just loaded.
-If an error is detected, an error message is issued and no ocp
-information is stored; |null_ocp| is returned in this case.
-
-@d bad_ocp=11 {label for |read_ocp_info|}
-@d ocp_abort(#)==begin print("OCP file error (");
- print(#); print(")"); print_ln; goto bad_ocp end
- {do this when the \.{OCP} data is wrong}
-
-@p function read_ocp_info(@!u:pointer;@!nom,@!aire,@!ext:str_number;
- @!external_ocp:boolean)
- :internal_ocp_number; {input a \.{OCP} file}
-label done,bad_ocp,not_found;
-var
-@!file_opened:boolean; {was |ocp_file| successfully opened?}
-@!k:integer;
-@!res:boolean;
-@!callback_id:integer;
-@!fnam:str_number;
-@!f:internal_ocp_number; {the new ocp's number}
-@!g:internal_ocp_number; {the number to return}
-@!ocpword:integer;
-@!ocpmem_run_ptr:ocp_index;
-@!ocp_length,real_ocp_length:integer; {length of ocp file}
-@!previous_address:ocp_index;
-@!temp_ocp_input:integer;
-@!temp_ocp_output:integer;
-@!temp_ocp_no_tables:integer;
-@!temp_ocp_no_states:integer;
-@!i,new_offset,room_for_tables,room_for_states:integer;
-begin g:=null_ocp; f:=null_ocp;@/
-@<Read and check the ocp data; |ocp_abort| if the \.{OCP} file is
- malformed; if there's no room for this ocp, say so and |goto
- done|; otherwise |incr(ocp_ptr)| and |goto done|@>;
-bad_ocp: @<Report that the ocp won't be loaded@>;
-done:
-ocp_name(f):=nom; ocp_area(f):=aire;
-read_ocp_info:=g;
-end;
-
-@ $\Omega$ does not give precise details about why it
-rejects a particular \.{OCP} file.
-
-@d start_ocp_error_message==print_err("Translation process ");
- sprint_cs(u); print_char("="); print_file_name(nom,aire,"");
-
-@<Report that the ocp won't be loaded@>=
-start_ocp_error_message;
-@.Translation process x=xx not loadable...@>
-if file_opened then print(" not loadable: Bad ocp file")
-else print(" not loadable: ocp file not found");
-help2("I wasn't able to read the data for this ocp,")@/
-("so I will ignore the ocp specification.");
-error
-
-@ @<Read and check the ocp data...@>=
-if external_ocp then
- @<Check |ocp_file| exists@>
-else begin
- @<Open |ocp_file| for input@>;
- @<Read the {\.{OCP}} file@>;
- end;
-
-@ @<Check |ocp_file| exists@>=
-begin
-file_opened:=false;
-pack_file_name(nom,aire,ext);
-b_test_in;
-if namelength=0 then ocp_abort("opening file");
-f :=ocp_ptr+1;
-allocate_ocp_table(f,13);
-ocp_file_size(f):=13;
-for i:=1 to namelength do begin
- append_char(nameoffile[i]);
- end;
-ocp_external(f):=make_string;
-scan_string_argument;
-ocp_external_arg(f):=cur_val;
-ocp_name(f):=""; ocp_area(f):="";
-ocp_state_base(f):=0; ocp_table_base(f):=0;
-ocp_input(f):=1; ocp_output(f):=1;
-ocp_info(f)(offset_ocp_info):=0;
-ocp_ptr:=f; g:=f;
-goto done;
-end
-
-@ @<Open |ocp_file| for input@>=
-file_opened:=false;
-pack_file_name(nom,aire,".ocp");
-if ocp_buffer<>0 then libcfree(ocp_buffer);
-ocp_cur:=0; ocp_buffer:=0; ocp_size:=0;
-callback_id:=callback_defined(find_ocp_file_callback);
-if callback_id>0 then begin
- res := run_callback(callback_id,'S->s',stringcast(nameoffile+1), addressof(fnam));
- if (res)and(fnam<>0)and(length(fnam)>0) then begin
- @<Fixup |nameoffile| after callback@>;
- end;
- end;
-callback_id:=callback_defined(read_ocp_file_callback);
-if callback_id>0 then begin
- res := run_callback(callback_id,'S->bSd',stringcast(nameoffile+1),
- addressof(file_opened), addressof(ocp_buffer),addressof(ocp_size));
- if not res then ocp_abort("callback error");
- if not file_opened then ocp_abort("opening file");
- if not ocp_size then ocp_abort("checking size");
- end
-else begin
- if not ocp_open_in(ocp_file) then ocp_abort("opening file");
- file_opened:=true;
- res := read_ocp_file(ocp_file,addressof(ocp_buffer),addressof(ocp_size));
- b_close(ocp_file);
- if not ocp_size then ocp_abort("checking size");
- if not res then ocp_abort("reading file");
-end
-
-
-@ Note: A malformed \.{OCP} file might be shorter than it claims to be;
-thus |eof(ocp_file)| might be true when |read_ocp_info| refers to
-|ocp_file^| or when it says |get(ocp_file)|. If such circumstances
-cause system error messages, you will have to defeat them somehow,
-for example by defining |ocpget| to be `\ignorespaces|begin get(ocp_file);|
-|if eof(ocp_file) then ocp_abort; end|\unskip'.
-@^system dependencies@>
-
-@d add_to_ocp_info(#)==begin ocp_tables[f,ocpmem_run_ptr]:=#;
- incr(ocpmem_run_ptr);
- end
-@d ocpget==incr(ocp_cur)
-@d ocpbyte==ocp_buffer[ocp_cur]
-@d ocp_read(#)==begin ocpword:=ocpbyte;
- if ocpword>127 then ocp_abort("checking first octet");
- ocpget; ocpword:=ocpword*@'400+ocpbyte;
- ocpget; ocpword:=ocpword*@'400+ocpbyte;
- ocpget; ocpword:=ocpword*@'400+ocpbyte;
- #:=ocpword;
- end
-@d ocp_read_all(#)==begin ocpget; ocp_read(#); end
-@d ocp_read_info==begin ocp_read_all(ocpword);
- add_to_ocp_info(ocpword);
- end
-
-@ @<Read the {\.{OCP}} file@>=
-begin
-f :=ocp_ptr+1;
-ocpmem_run_ptr:=offset_ocp_info;
-ocp_read(ocp_length);
-real_ocp_length:=ocp_length-7;
-ocp_read_all(temp_ocp_input);
-ocp_read_all(temp_ocp_output);
-ocp_read_all(temp_ocp_no_tables);
-ocp_read_all(room_for_tables);
-ocp_read_all(temp_ocp_no_states);
-ocp_read_all(room_for_states);
-if real_ocp_length <>
- (temp_ocp_no_tables + room_for_tables +
- temp_ocp_no_states + room_for_states) then
- ocp_abort("checking size");
-real_ocp_length:=real_ocp_length+12+
- temp_ocp_no_states+temp_ocp_no_tables;
-allocate_ocp_table(f,real_ocp_length);
-ocp_external(f):=0;
-ocp_external_arg(f):=0;
-ocp_file_size(f):=real_ocp_length;
-ocp_input(f):=temp_ocp_input;
-ocp_output(f):=temp_ocp_output;
-ocp_no_tables(f):=temp_ocp_no_tables;
-ocp_no_states(f):=temp_ocp_no_states;
-ocp_table_base(f):=ocpmem_run_ptr;
-if ocp_no_tables(f) <> 0 then begin
- previous_address:=ocpmem_run_ptr+2*(ocp_no_tables(f));
- for i:=1 to ocp_no_tables(f) do begin
- add_to_ocp_info(previous_address);
- ocp_read_all(new_offset);
- add_to_ocp_info(new_offset);
- previous_address:=previous_address+new_offset;
- end
- end;
-if room_for_tables <> 0 then begin
- for i:=1 to room_for_tables do begin
- ocp_read_info;
- end
- end;
-ocp_state_base(f):=ocpmem_run_ptr;
-if ocp_no_states(f) <> 0 then begin
- previous_address:=ocpmem_run_ptr+2*(ocp_no_states(f));
- for i:=1 to ocp_no_states(f) do begin
- add_to_ocp_info(previous_address);
- ocp_read_all(new_offset);
- add_to_ocp_info(new_offset);
- previous_address:=previous_address+new_offset;
- end;
- end;
-if room_for_states <> 0 then begin
- for i:=1 to room_for_states do begin
- ocp_read_info;
- end
- end;
-ocp_ptr:=f; g:=f;
-goto done;
-end
-
-@ Before we forget about the format of these tables, let's deal with
-$\Omega$'s basic scanning routine related to ocp information.
-
-@<Declare procedures that scan ocp-related stuff@>=
-procedure scan_ocp_ident;
-var f:internal_ocp_number;
-begin @<Get the next non-blank non-call...@>;
-if cur_cmd=set_ocp then f:=cur_chr
-else begin print_err("Missing ocp identifier");
-@.Missing ocp identifier@>
- help2("I was looking for a control sequence whose")@/
- ("current meaning has been defined by \ocp.");
- back_error; f:=null_ocp;
- end;
-cur_val:=f;
-end;
-
-
-@ Here we begin the \.{OCP} list handling.
-
-
-@<Types...@>=
-@!internal_ocp_list_number=ocp_list_base..ocp_list_biggest;
-@!ocp_list_index=integer; {index into |ocp_list_info|}
-@!ocp_lstack_index=integer; {index into |ocp_lstack_info|}
-
-@ Here now is the array of ocp arrays.
-@d ocp_list_lnext(#)==ocp_list_info[#].hh.b0
-@d ocp_list_lstack(#)==ocp_list_info[#].hh.b1
-@d ocp_list_lstack_no(#)==ocp_list_info[#+1].sc
-@d ocp_lstack_lnext(#)==ocp_lstack_info[#].hh.b0
-@d ocp_lstack_ocp(#)==ocp_lstack_info[#].hh.b1
-@d make_null_ocp_list==make_ocp_list_node(0,ocp_maxint,0)
-@d is_null_ocp_list(#)==ocp_list_lstack_no(#)=ocp_maxint
-@d make_null_ocp_lstack==0
-@d is_null_ocp_lstack(#)==#=0
-@d add_before_op=1
-@d add_after_op=2
-@d remove_before_op=3
-@d remove_after_op=4
-
-@<Glob...@>=
-@!ocp_list_info:array[ocp_list_index] of memory_word;
- {the big collection of ocp list data}
-@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
-@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
-@!ocp_lstack_info:array[ocp_lstack_index] of memory_word;
- {the big collection of ocp lstack data}
-@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
-@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
-@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
-@!ocp_list_list:array[internal_ocp_list_number] of ocp_list_index;
-
-@
-@<Initialize table...@>=
-ocp_listmem_ptr:=2;
-ocp_list_lstack(0):=0;
-ocp_list_lstack_no(0):=ocp_maxint;
-ocp_list_lnext(0):=0;
-ocp_list_ptr:=null_ocp_list;
-ocp_list_list[null_ocp_list]:=0;
-ocp_lstackmem_ptr:=1;
-
-@ $\Omega$ always knows at least one ocp list, namely the null ocp list.
-
-@ @<Put each...@>=
-primitive_omega("nullocplist", set_ocp_list, null_ocp_list,0);
-text(frozen_null_ocp_list) := "nullocplist";
-eqtb[frozen_null_ocp_list] := eqtb[cur_val];
-
-@ @p function make_ocp_list_node(llstack:ocp_lstack_index;
- llstack_no:scaled;
- llnext:ocp_list_index):ocp_list_index;
-var p:ocp_list_index;
-begin
-p:=ocp_listmem_run_ptr;
-ocp_list_lstack(p):=llstack;
-ocp_list_lstack_no(p):=llstack_no;
-ocp_list_lnext(p):=llnext;
-ocp_listmem_run_ptr:=ocp_listmem_run_ptr+2;
-if ocp_listmem_run_ptr>=ocp_list_size then
- overflow("ocp_list_size",ocp_list_size);
-make_ocp_list_node:=p;
-end;
-
-function make_ocp_lstack_node(locp:internal_ocp_number;
- llnext:ocp_lstack_index) : ocp_lstack_index;
-var p:ocp_lstack_index;
-begin
-p:=ocp_lstackmem_run_ptr;
-ocp_lstack_ocp(p):=locp;
-ocp_lstack_lnext(p):=llnext;
-incr(ocp_lstackmem_run_ptr);
-if ocp_lstackmem_run_ptr>=ocp_stack_size then
- overflow("ocp_stack_size",ocp_stack_size);
-make_ocp_lstack_node:=p;
-end;
-
-function copy_ocp_lstack(llstack:ocp_lstack_index):ocp_lstack_index;
-var result:ocp_lstack_index;
-begin
-if is_null_ocp_lstack(llstack) then
- result:=make_null_ocp_lstack
-else
- result:=make_ocp_lstack_node(ocp_lstack_ocp(llstack),
- copy_ocp_lstack(ocp_lstack_lnext(llstack)));
-copy_ocp_lstack:=result;
-end;
-
-function copy_ocp_list(list:ocp_list_index):ocp_list_index;
-var result:ocp_list_index;
-begin
-if is_null_ocp_list(list) then
- result:=make_null_ocp_list
-else
- result:=make_ocp_list_node(copy_ocp_lstack(ocp_list_lstack(list)),
- ocp_list_lstack_no(list),
- copy_ocp_list(ocp_list_lnext(list)));
-copy_ocp_list:=result;
-end;
-
-function ocp_ensure_lstack(list:ocp_list_index; llstack_no:scaled):
- ocp_list_index;
-var p:ocp_list_index;
- q:ocp_list_index;
-begin
-p:=list;
-if is_null_ocp_list(p) then begin
- ocp_list_lstack_no(p) := llstack_no;
- ocp_list_lnext(p) := make_null_ocp_list;
- end
-else if ocp_list_lstack_no(p) > llstack_no then begin
- ocp_list_lnext(p):=
- make_ocp_list_node(ocp_list_lstack(p),
- ocp_list_lstack_no(p),
- ocp_list_lnext(p));
- ocp_list_lstack(p):=0;
- ocp_list_lstack_no(p):=llstack_no;
- end
-else begin
- q:=ocp_list_lnext(p);
- while (not (is_null_ocp_list(q))) and
- ocp_list_lstack_no(q) <= llstack_no do begin
- p:=q; q:=ocp_list_lnext(q);
- end;
- if ocp_list_lstack_no(p) < llstack_no then begin
- ocp_list_lnext(p) := make_ocp_list_node(0, llstack_no, q);
- p := ocp_list_lnext(p);
- end;
- end;
-ocp_ensure_lstack := p;
-end;
-
-procedure ocp_apply_add(list_entry:ocp_list_index;
- lbefore:boolean;
- locp:internal_ocp_number);
-var p:ocp_lstack_index;
- q:ocp_lstack_index;
-begin
-p := ocp_list_lstack(list_entry);
-if lbefore or (p=0) then begin
- ocp_list_lstack(list_entry) := make_ocp_lstack_node(locp, p);
- end
-else begin
- q:=ocp_lstack_lnext(p);
- while q<>0 do begin
- p:=q; q:=ocp_lstack_lnext(q);
- end;
- ocp_lstack_lnext(p):=make_ocp_lstack_node(locp,0);
- end;
-end;
-
-procedure ocp_apply_remove(list_entry:ocp_list_index;
- lbefore:boolean);
-var p:ocp_lstack_index;
- q:ocp_lstack_index;
- r:ocp_lstack_index;
-begin
-p := ocp_list_lstack(list_entry);
-if p=0 then begin
- print_err("warning: stack entry already empty"); print_ln
- end
-else begin
- q := ocp_lstack_lnext(p);
- if lbefore or (q=0) then
- ocp_list_lstack(list_entry) := q
- else begin
- r:=ocp_lstack_lnext(q);
- while r <> 0 do begin
- p:=q; q:=r; r:=ocp_lstack_lnext(r);
- end;
- ocp_lstack_lnext(p) := 0;
- end
- end;
-end;
-
-procedure scan_scaled; {sets |cur_val| to a scaled value}
-label done, done1, done2, found, not_found, attach_fraction;
-var negative:boolean; {should the answer be negated?}
-@!f:integer; {numerator of a fraction whose denominator is $2^{16}$}
-@!k,@!kk:small_number; {number of digits in a decimal fraction}
-@!p,@!q:pointer; {top of decimal digit stack}
-begin f:=0; arith_error:=false; negative:=false;
-@<Get the next non-blank non-sign...@>;
-back_input;
-if cur_tok=continental_point_token then cur_tok:=point_token;
-if cur_tok<>point_token then scan_int
-else begin radix:=10; cur_val:=0;
- end;
-if cur_tok=continental_point_token then cur_tok:=point_token;
-if (radix=10)and(cur_tok=point_token) then @<Scan decimal fraction@>;
-if cur_val<0 then {in this case |f=0|}
- begin negative := not negative; negate(cur_val);
- end;
-if cur_val>@'40000 then arith_error:=true
-else cur_val := cur_val*unity +f;
-if arith_error or(abs(cur_val)>=@'10000000000) then
-begin print_err("Stack number too large"); error;
-end;
-if negative then negate(cur_val);
-end;
-
-procedure print_ocp_lstack(lstack_entry:ocp_lstack_index);
-var p:ocp_lstack_index;
-begin
-p:=lstack_entry;
-while (p<>0) do begin
- print_esc(ocp_id_text(ocp_lstack_ocp(p)));
- p:=ocp_lstack_lnext(p);
- if (p<>0) then print(",");
- end;
-end;
-
-procedure print_ocp_list(list_entry:ocp_list_index);
-var p:ocp_list_index;
-begin
-print("["); p:=list_entry;
-while not (is_null_ocp_list(p)) do begin
- print("(");
- print_scaled(ocp_list_lstack_no(p));
- print(" : ");
- print_ocp_lstack(ocp_list_lstack(p));
- print(")");
- p:=ocp_list_lnext(p);
- if not (is_null_ocp_list(p)) then print(", ");
- end;
-print("]");
-end;
-
-function scan_ocp_list: ocp_list_index;
-var llstack_no:scaled;
- lop:quarterword;
- lstack_entry:ocp_list_index;
- other_list:ocp_list_index;
- ocp_ident:internal_ocp_number;
- result:ocp_list_index;
-begin
-get_r_token;
-if cur_cmd = set_ocp_list then
- result := copy_ocp_list(ocp_list_list[cur_chr])
-else if cur_cmd <> ocp_list_op then begin
- print_err("Bad ocp list specification");
-@.Bad ocp list specification@>
- help1("I was looking for a ocp list specification.");
- error;
- result := make_null_ocp_list;
- end
-else begin
- lop:=cur_chr;
- scan_scaled; llstack_no:=cur_val;
- if (llstack_no<=0) or (llstack_no>=ocp_maxint) then begin
- print_err("Stack numbers must be between 0 and 4096 (exclusive)");
- error;
- result := make_null_ocp_list;
- end
- else begin
- if lop <= add_after_op then begin
- scan_ocp_ident; ocp_ident:=cur_val;
- end;
- other_list:=scan_ocp_list;
- lstack_entry:=ocp_ensure_lstack(other_list, llstack_no);
- if lop <= add_after_op then
- ocp_apply_add(lstack_entry, (lop=add_before_op), ocp_ident)
- else
- ocp_apply_remove(lstack_entry, (lop=remove_before_op));
- result:=other_list;
- end;
- end;
-scan_ocp_list:=result;
-end;
-
-function read_ocp_list: internal_ocp_list_number;
-var f:internal_ocp_list_number;
- g:internal_ocp_list_number;
-begin
-g:=null_ocp_list;
-f:=ocp_list_ptr+1;
-ocp_listmem_run_ptr:=ocp_listmem_ptr;
-ocp_lstackmem_run_ptr:=ocp_lstackmem_ptr;
-ocp_list_list[f]:=scan_ocp_list;
-ocp_list_ptr:=f;
-ocp_listmem_ptr:=ocp_listmem_run_ptr;
-ocp_lstackmem_ptr:=ocp_lstackmem_run_ptr;
-g:=f;
-read_ocp_list:=g;
-end;
-
-procedure scan_ocp_list_ident;
-var f:internal_ocp_list_number;
-begin @<Get the next non-blank non-call...@>;
-if cur_cmd=set_ocp_list then f:=cur_chr
-else begin print_err("Missing ocp list identifier");
-@.Missing ocp list identifier@>
- help2("I was looking for a control sequence whose")@/
- ("current meaning has been defined by \ocplist.");
- back_error; f:=null_ocp_list;
- end;
-cur_val:=f;
-end;
-
-
-@* \[31] Device-independent file format.
-The most important output produced by a run of \TeX\ is the ``device
-independent'' (\.{DVI}) file that specifies where characters and rules
-are to appear on printed pages. The form of these files was designed by
-David R. Fuchs in 1979. Almost any reasonable typesetting device can be
-@^Fuchs, David Raymond@>
-@:DVI_files}{\.{DVI} files@>
-driven by a program that takes \.{DVI} files as input, and dozens of such
-\.{DVI}-to-whatever programs have been written. Thus, it is possible to
-print the output of \TeX\ on many different kinds of equipment, using \TeX\
-as a device-independent ``front end.''
-
-A \.{DVI} file is a stream of 8-bit bytes, which may be regarded as a
-series of commands in a machine-like language. The first byte of each command
-is the operation code, and this code is followed by zero or more bytes
-that provide parameters to the command. The parameters themselves may consist
-of several consecutive bytes; for example, the `|set_rule|' command has two
-parameters, each of which is four bytes long. Parameters are usually
-regarded as nonnegative integers; but four-byte-long parameters,
-and shorter parameters that denote distances, can be
-either positive or negative. Such parameters are given in two's complement
-notation. For example, a two-byte-long distance parameter has a value between
-$-2^{15}$ and $2^{15}-1$. As in \.{TFM} files, numbers that occupy
-more than one byte position appear in BigEndian order.
-
-A \.{DVI} file consists of a ``preamble,'' followed by a sequence of one
-or more ``pages,'' followed by a ``postamble.'' The preamble is simply a
-|pre| command, with its parameters that define the dimensions used in the
-file; this must come first. Each ``page'' consists of a |bop| command,
-followed by any number of other commands that tell where characters are to
-be placed on a physical page, followed by an |eop| command. The pages
-appear in the order that \TeX\ generated them. If we ignore |nop| commands
-and \\{fnt\_def} commands (which are allowed between any two commands in
-the file), each |eop| command is immediately followed by a |bop| command,
-or by a |post| command; in the latter case, there are no more pages in the
-file, and the remaining bytes form the postamble. Further details about
-the postamble will be explained later.
-
-Some parameters in \.{DVI} commands are ``pointers.'' These are four-byte
-quantities that give the location number of some other byte in the file;
-the first byte is number~0, then comes number~1, and so on. For example,
-one of the parameters of a |bop| command points to the previous |bop|;
-this makes it feasible to read the pages in backwards order, in case the
-results are being directed to a device that stacks its output face up.
-Suppose the preamble of a \.{DVI} file occupies bytes 0 to 99. Now if the
-first page occupies bytes 100 to 999, say, and if the second
-page occupies bytes 1000 to 1999, then the |bop| that starts in byte 1000
-points to 100 and the |bop| that starts in byte 2000 points to 1000. (The
-very first |bop|, i.e., the one starting in byte 100, has a pointer of~$-1$.)
-
-@ The \.{DVI} format is intended to be both compact and easily interpreted
-by a machine. Compactness is achieved by making most of the information
-implicit instead of explicit. When a \.{DVI}-reading program reads the
-commands for a page, it keeps track of several quantities: (a)~The current
-font |f| is an integer; this value is changed only
-by \\{fnt} and \\{fnt\_num} commands. (b)~The current position on the page
-is given by two numbers called the horizontal and vertical coordinates,
-|h| and |v|. Both coordinates are zero at the upper left corner of the page;
-moving to the right corresponds to increasing the horizontal coordinate, and
-moving down corresponds to increasing the vertical coordinate. Thus, the
-coordinates are essentially Cartesian, except that vertical directions are
-flipped; the Cartesian version of |(h,v)| would be |(h,-v)|. (c)~The
-current spacing amounts are given by four numbers |w|, |x|, |y|, and |z|,
-where |w| and~|x| are used for horizontal spacing and where |y| and~|z|
-are used for vertical spacing. (d)~There is a stack containing
-|(h,v,w,x,y,z)| values; the \.{DVI} commands |push| and |pop| are used to
-change the current level of operation. Note that the current font~|f| is
-not pushed and popped; the stack contains only information about
-positioning.
-
-The values of |h|, |v|, |w|, |x|, |y|, and |z| are signed integers having up
-to 32 bits, including the sign. Since they represent physical distances,
-there is a small unit of measurement such that increasing |h| by~1 means
-moving a certain tiny distance to the right. The actual unit of
-measurement is variable, as explained below; \TeX\ sets things up so that
-its \.{DVI} output is in sp units, i.e., scaled points, in agreement with
-all the |scaled| dimensions in \TeX's data structures.
-
-@ Here is a list of all the commands that may appear in a \.{DVI} file. Each
-command is specified by its symbolic name (e.g., |bop|), its opcode byte
-(e.g., 139), and its parameters (if any). The parameters are followed
-by a bracketed number telling how many bytes they occupy; for example,
-`|p[4]|' means that parameter |p| is four bytes long.
-
-\yskip\hang|set_char_0| 0. Typeset character number~0 from font~|f|
-such that the reference point of the character is at |(h,v)|. Then
-increase |h| by the width of that character. Note that a character may
-have zero or negative width, so one cannot be sure that |h| will advance
-after this command; but |h| usually does increase.
-
-\yskip\hang\\{set\_char\_1} through \\{set\_char\_127} (opcodes 1 to 127).
-Do the operations of |set_char_0|; but use the character whose number
-matches the opcode, instead of character~0.
-
-\yskip\hang|set1| 128 |c[1]|. Same as |set_char_0|, except that character
-number~|c| is typeset. \TeX82 uses this command for characters in the
-range |128<=c<256|.
-
-\yskip\hang|@!set2| 129 |c[2]|. Same as |set1|, except that |c|~is two
-bytes long, so it is in the range |0<=c<65536|. \TeX82 never uses this
-command, but it should come in handy for extensions of \TeX\ that deal
-with oriental languages.
-@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
-
-\yskip\hang|@!set3| 130 |c[3]|. Same as |set1|, except that |c|~is three
-bytes long, so it can be as large as $2^{24}-1$. Not even the Chinese
-language has this many characters, but this command might prove useful
-in some yet unforeseen extension.
-
-\yskip\hang|@!set4| 131 |c[4]|. Same as |set1|, except that |c|~is four
-bytes long. Imagine that.
-
-\yskip\hang|set_rule| 132 |a[4]| |b[4]|. Typeset a solid black rectangle
-of height~|a| and width~|b|, with its bottom left corner at |(h,v)|. Then
-set |h:=h+b|. If either |a<=0| or |b<=0|, nothing should be typeset. Note
-that if |b<0|, the value of |h| will decrease even though nothing else happens.
-See below for details about how to typeset rules so that consistency with
-\MF\ is guaranteed.
-
-\yskip\hang|@!put1| 133 |c[1]|. Typeset character number~|c| from font~|f|
-such that the reference point of the character is at |(h,v)|. (The `put'
-commands are exactly like the `set' commands, except that they simply put out a
-character or a rule without moving the reference point afterwards.)
-
-\yskip\hang|@!put2| 134 |c[2]|. Same as |set2|, except that |h| is not changed.
-
-\yskip\hang|@!put3| 135 |c[3]|. Same as |set3|, except that |h| is not changed.
-
-\yskip\hang|@!put4| 136 |c[4]|. Same as |set4|, except that |h| is not changed.
-
-\yskip\hang|put_rule| 137 |a[4]| |b[4]|. Same as |set_rule|, except that
-|h| is not changed.
-
-\yskip\hang|nop| 138. No operation, do nothing. Any number of |nop|'s
-may occur between \.{DVI} commands, but a |nop| cannot be inserted between
-a command and its parameters or between two parameters.
-
-\yskip\hang|bop| 139 $c_0[4]$ $c_1[4]$ $\ldots$ $c_9[4]$ $p[4]$. Beginning
-of a page: Set |(h,v,w,x,y,z):=(0,0,0,0,0,0)| and set the stack empty. Set
-the current font |f| to an undefined value. The ten $c_i$ parameters hold
-the values of \.{\\count0} $\ldots$ \.{\\count9} in \TeX\ at the time
-\.{\\shipout} was invoked for this page; they can be used to identify
-pages, if a user wants to print only part of a \.{DVI} file. The parameter
-|p| points to the previous |bop| in the file; the first
-|bop| has $p=-1$.
-
-\yskip\hang|eop| 140. End of page: Print what you have read since the
-previous |bop|. At this point the stack should be empty. (The \.{DVI}-reading
-programs that drive most output devices will have kept a buffer of the
-material that appears on the page that has just ended. This material is
-largely, but not entirely, in order by |v| coordinate and (for fixed |v|) by
-|h|~coordinate; so it usually needs to be sorted into some order that is
-appropriate for the device in question.)
-
-\yskip\hang|push| 141. Push the current values of |(h,v,w,x,y,z)| onto the
-top of the stack; do not change any of these values. Note that |f| is
-not pushed.
-
-\yskip\hang|pop| 142. Pop the top six values off of the stack and assign
-them respectively to |(h,v,w,x,y,z)|. The number of pops should never
-exceed the number of pushes, since it would be highly embarrassing if the
-stack were empty at the time of a |pop| command.
-
-\yskip\hang|right1| 143 |b[1]|. Set |h:=h+b|, i.e., move right |b| units.
-The parameter is a signed number in two's complement notation, |-128<=b<128|;
-if |b<0|, the reference point moves left.
-
-\yskip\hang|right2| 144 |b[2]|. Same as |right1|, except that |b| is a
-two-byte quantity in the range |-32768<=b<32768|.
-
-\yskip\hang|right3| 145 |b[3]|. Same as |right1|, except that |b| is a
-three-byte quantity in the range |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
-
-\yskip\hang|right4| 146 |b[4]|. Same as |right1|, except that |b| is a
-four-byte quantity in the range |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
-
-\yskip\hang|w0| 147. Set |h:=h+w|; i.e., move right |w| units. With luck,
-this parameterless command will usually suffice, because the same kind of motion
-will occur several times in succession; the following commands explain how
-|w| gets particular values.
-
-\yskip\hang|w1| 148 |b[1]|. Set |w:=b| and |h:=h+b|. The value of |b| is a
-signed quantity in two's complement notation, |-128<=b<128|. This command
-changes the current |w|~spacing and moves right by |b|.
-
-\yskip\hang|@!w2| 149 |b[2]|. Same as |w1|, but |b| is two bytes long,
-|-32768<=b<32768|.
-
-\yskip\hang|@!w3| 150 |b[3]|. Same as |w1|, but |b| is three bytes long,
-|@t$-2^{23}$@><=b<@t$2^{23}$@>|.
-
-\yskip\hang|@!w4| 151 |b[4]|. Same as |w1|, but |b| is four bytes long,
-|@t$-2^{31}$@><=b<@t$2^{31}$@>|.
-
-\yskip\hang|x0| 152. Set |h:=h+x|; i.e., move right |x| units. The `|x|'
-commands are like the `|w|' commands except that they involve |x| instead
-of |w|.
-
-\yskip\hang|x1| 153 |b[1]|. Set |x:=b| and |h:=h+b|. The value of |b| is a
-signed quantity in two's complement notation, |-128<=b<128|. This command
-changes the current |x|~spacing and moves right by |b|.
-
-\yskip\hang|@!x2| 154 |b[2]|. Same as |x1|, but |b| is two bytes long,
-|-32768<=b<32768|.
-
-\yskip\hang|@!x3| 155 |b[3]|. Same as |x1|, but |b| is three bytes long,
-|@t$-2^{23}$@><=b<@t$2^{23}$@>|.
-
-\yskip\hang|@!x4| 156 |b[4]|. Same as |x1|, but |b| is four bytes long,
-|@t$-2^{31}$@><=b<@t$2^{31}$@>|.
-
-\yskip\hang|down1| 157 |a[1]|. Set |v:=v+a|, i.e., move down |a| units.
-The parameter is a signed number in two's complement notation, |-128<=a<128|;
-if |a<0|, the reference point moves up.
-
-\yskip\hang|@!down2| 158 |a[2]|. Same as |down1|, except that |a| is a
-two-byte quantity in the range |-32768<=a<32768|.
-
-\yskip\hang|@!down3| 159 |a[3]|. Same as |down1|, except that |a| is a
-three-byte quantity in the range |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
-
-\yskip\hang|@!down4| 160 |a[4]|. Same as |down1|, except that |a| is a
-four-byte quantity in the range |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
-
-\yskip\hang|y0| 161. Set |v:=v+y|; i.e., move down |y| units. With luck,
-this parameterless command will usually suffice, because the same kind of motion
-will occur several times in succession; the following commands explain how
-|y| gets particular values.
-
-\yskip\hang|y1| 162 |a[1]|. Set |y:=a| and |v:=v+a|. The value of |a| is a
-signed quantity in two's complement notation, |-128<=a<128|. This command
-changes the current |y|~spacing and moves down by |a|.
-
-\yskip\hang|@!y2| 163 |a[2]|. Same as |y1|, but |a| is two bytes long,
-|-32768<=a<32768|.
-
-\yskip\hang|@!y3| 164 |a[3]|. Same as |y1|, but |a| is three bytes long,
-|@t$-2^{23}$@><=a<@t$2^{23}$@>|.
-
-\yskip\hang|@!y4| 165 |a[4]|. Same as |y1|, but |a| is four bytes long,
-|@t$-2^{31}$@><=a<@t$2^{31}$@>|.
-
-\yskip\hang|z0| 166. Set |v:=v+z|; i.e., move down |z| units. The `|z|' commands
-are like the `|y|' commands except that they involve |z| instead of |y|.
-
-\yskip\hang|z1| 167 |a[1]|. Set |z:=a| and |v:=v+a|. The value of |a| is a
-signed quantity in two's complement notation, |-128<=a<128|. This command
-changes the current |z|~spacing and moves down by |a|.
-
-\yskip\hang|@!z2| 168 |a[2]|. Same as |z1|, but |a| is two bytes long,
-|-32768<=a<32768|.
-
-\yskip\hang|@!z3| 169 |a[3]|. Same as |z1|, but |a| is three bytes long,
-|@t$-2^{23}$@><=a<@t$2^{23}$@>|.
-
-\yskip\hang|@!z4| 170 |a[4]|. Same as |z1|, but |a| is four bytes long,
-|@t$-2^{31}$@><=a<@t$2^{31}$@>|.
-
-\yskip\hang|fnt_num_0| 171. Set |f:=0|. Font 0 must previously have been
-defined by a \\{fnt\_def} instruction, as explained below.
-
-\yskip\hang\\{fnt\_num\_1} through \\{fnt\_num\_63} (opcodes 172 to 234). Set
-|f:=1|, \dots, \hbox{|f:=63|}, respectively.
-
-\yskip\hang|fnt1| 235 |k[1]|. Set |f:=k|. \TeX82 uses this command for font
-numbers in the range |64<=k<256|.
-
-\yskip\hang|@!fnt2| 236 |k[2]|. Same as |fnt1|, except that |k|~is two
-bytes long, so it is in the range |0<=k<65536|. \TeX82 never generates this
-command, but large font numbers may prove useful for specifications of
-color or texture, or they may be used for special fonts that have fixed
-numbers in some external coding scheme.
-
-\yskip\hang|@!fnt3| 237 |k[3]|. Same as |fnt1|, except that |k|~is three
-bytes long, so it can be as large as $2^{24}-1$.
-
-\yskip\hang|@!fnt4| 238 |k[4]|. Same as |fnt1|, except that |k|~is four
-bytes long; this is for the really big font numbers (and for the negative ones).
-
-\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
-general; it functions as a $(k+2)$-byte |nop| unless special \.{DVI}-reading
-programs are being used. \TeX82 generates |xxx1| when a short enough
-\.{\\special} appears, setting |k| to the number of bytes being sent. It
-is recommended that |x| be a string having the form of a keyword followed
-by possible parameters relevant to that keyword.
-
-\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
-
-\yskip\hang|@!xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
-
-\yskip\hang|xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be ridiculously
-large. \TeX82 uses |xxx4| when sending a string of length 256 or more.
-
-\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
-Define font |k|, where |0<=k<256|; font definitions will be explained shortly.
-
-\yskip\hang|@!fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
-Define font |k|, where |0<=k<65536|.
-
-\yskip\hang|@!fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
-Define font |k|, where |0<=k<@t$2^{24}$@>|.
-
-\yskip\hang|@!fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
-Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|.
-
-\yskip\hang|pre| 247 |i[1]| |num[4]| |den[4]| |mag[4]| |k[1]| |x[k]|.
-Beginning of the preamble; this must come at the very beginning of the
-file. Parameters |i|, |num|, |den|, |mag|, |k|, and |x| are explained below.
-
-\yskip\hang|post| 248. Beginning of the postamble, see below.
-
-\yskip\hang|post_post| 249. Ending of the postamble, see below.
-
-\yskip\noindent Commands 250--255 are undefined at the present time.
-
-@ @d set_char_0=0 {typeset character 0 and move right}
-@d set1=128 {typeset a character and move right}
-@d set_rule=132 {typeset a rule and move right}
-@d put1==133 {typeset a character without moving}
-@d put_rule=137 {typeset a rule}
-@d nop=138 {no operation}
-@d bop=139 {beginning of page}
-@d eop=140 {ending of page}
-@d push=141 {save the current positions}
-@d pop=142 {restore previous positions}
-@d right1==143 {move right}
-@d right4==146 {move right, 4 bytes}
-@d w0=147 {move right by |w|}
-@d w1=148 {move right and set |w|}
-@d x0=152 {move right by |x|}
-@d x1=153 {move right and set |x|}
-@d down1=157 {move down}
-@d down4=160 {move down, 4 bytes}
-@d y0=161 {move down by |y|}
-@d y1=162 {move down and set |y|}
-@d z0=166 {move down by |z|}
-@d z1=167 {move down and set |z|}
-@d fnt_num_0=171 {set current font to 0}
-@d fnt1=235 {set current font}
-@d xxx1=239 {extension to \.{DVI} primitives}
-@d xxx4=242 {potentially long extension to \.{DVI} primitives}
-@d fnt_def1=243 {define the meaning of a font number}
-@d pre=247 {preamble}
-@d post=248 {postamble beginning}
-@d post_post=249 {postamble ending}
-
-@ The preamble contains basic information about the file as a whole. As
-stated above, there are six parameters:
-$$\hbox{|@!i[1]| |@!num[4]| |@!den[4]| |@!mag[4]| |@!k[1]| |@!x[k]|.}$$
-The |i| byte identifies \.{DVI} format; currently this byte is always set
-to~2. (The value |i=3| is currently used for an extended format that
-allows a mixture of right-to-left and left-to-right typesetting.
-Some day we will set |i=4|, when \.{DVI} format makes another
-incompatible change---perhaps in the year 2048.)
-
-The next two parameters, |num| and |den|, are positive integers that define
-the units of measurement; they are the numerator and denominator of a
-fraction by which all dimensions in the \.{DVI} file could be multiplied
-in order to get lengths in units of $10^{-7}$ meters. Since $\rm 7227{pt} =
-254{cm}$, and since \TeX\ works with scaled points where there are $2^{16}$
-sp in a point, \TeX\ sets
-$|num|/|den|=(254\cdot10^5)/(7227\cdot2^{16})=25400000/473628672$.
-@^sp@>
-
-The |mag| parameter is what \TeX\ calls \.{\\mag}, i.e., 1000 times the
-desired magnification. The actual fraction by which dimensions are
-multiplied is therefore $|mag|\cdot|num|/1000|den|$. Note that if a \TeX\
-source document does not call for any `\.{true}' dimensions, and if you
-change it only by specifying a different \.{\\mag} setting, the \.{DVI}
-file that \TeX\ creates will be completely unchanged except for the value
-of |mag| in the preamble and postamble. (Fancy \.{DVI}-reading programs allow
-users to override the |mag|~setting when a \.{DVI} file is being printed.)
-
-Finally, |k| and |x| allow the \.{DVI} writer to include a comment, which is not
-interpreted further. The length of comment |x| is |k|, where |0<=k<256|.
-
-@d id_byte=2 {identifies the kind of \.{DVI} files described here}
-
-@ Font definitions for a given font number |k| contain further parameters
-$$\hbox{|c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.}$$
-The four-byte value |c| is the check sum that \TeX\ found in the \.{TFM}
-file for this font; |c| should match the check sum of the font found by
-programs that read this \.{DVI} file.
-@^check sum@>
-
-Parameter |s| contains a fixed-point scale factor that is applied to
-the character widths in font |k|; font dimensions in \.{TFM} files and
-other font files are relative to this quantity, which is called the
-``at size'' elsewhere in this documentation. The value of |s| is
-always positive and less than $2^{27}$. It is given in the same units
-as the other \.{DVI} dimensions, i.e., in sp when \TeX82 has made the
-file. Parameter |d| is similar to |s|; it is the ``design size,'' and
-(like~|s|) it is given in \.{DVI} units. Thus, font |k| is to be used
-at $|mag|\cdot s/1000d$ times its normal size.
-
-The remaining part of a font definition gives the external name of the font,
-which is an ASCII string of length |a+l|. The number |a| is the length
-of the ``area'' or directory, and |l| is the length of the font name itself;
-the standard local system font area is supposed to be used when |a=0|.
-The |n| field contains the area in its first |a| bytes.
-
-Font definitions must appear before the first use of a particular font number.
-Once font |k| is defined, it must not be defined again; however, we
-shall see below that font definitions appear in the postamble as well as
-in the pages, so in this sense each font number is defined exactly twice,
-if at all. Like |nop| commands, font definitions can
-appear before the first |bop|, or between an |eop| and a |bop|.
-
-@ Sometimes it is desirable to make horizontal or vertical rules line up
-precisely with certain features in characters of a font. It is possible to
-guarantee the correct matching between \.{DVI} output and the characters
-generated by \MF\ by adhering to the following principles: (1)~The \MF\
-characters should be positioned so that a bottom edge or left edge that is
-supposed to line up with the bottom or left edge of a rule appears at the
-reference point, i.e., in row~0 and column~0 of the \MF\ raster. This
-ensures that the position of the rule will not be rounded differently when
-the pixel size is not a perfect multiple of the units of measurement in
-the \.{DVI} file. (2)~A typeset rule of height $a>0$ and width $b>0$
-should be equivalent to a \MF-generated character having black pixels in
-precisely those raster positions whose \MF\ coordinates satisfy
-|0<=x<@t$\alpha$@>b| and |0<=y<@t$\alpha$@>a|, where $\alpha$ is the number
-of pixels per \.{DVI} unit.
-@:METAFONT}{\MF@>
-@^alignment of rules with characters@>
-@^rules aligning with characters@>
-
-@ The last page in a \.{DVI} file is followed by `|post|'; this command
-introduces the postamble, which summarizes important facts that \TeX\ has
-accumulated about the file, making it possible to print subsets of the data
-with reasonable efficiency. The postamble has the form
-$$\vbox{\halign{\hbox{#\hfil}\cr
- |post| |p[4]| |num[4]| |den[4]| |mag[4]| |l[4]| |u[4]| |s[2]| |t[2]|\cr
- $\langle\,$font definitions$\,\rangle$\cr
- |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
-Here |p| is a pointer to the final |bop| in the file. The next three
-parameters, |num|, |den|, and |mag|, are duplicates of the quantities that
-appeared in the preamble.
-
-Parameters |l| and |u| give respectively the height-plus-depth of the tallest
-page and the width of the widest page, in the same units as other dimensions
-of the file. These numbers might be used by a \.{DVI}-reading program to
-position individual ``pages'' on large sheets of film or paper; however,
-the standard convention for output on normal size paper is to position each
-page so that the upper left-hand corner is exactly one inch from the left
-and the top. Experience has shown that it is unwise to design \.{DVI}-to-printer
-software that attempts cleverly to center the output; a fixed position of
-the upper left corner is easiest for users to understand and to work with.
-Therefore |l| and~|u| are often ignored.
-
-Parameter |s| is the maximum stack depth (i.e., the largest excess of
-|push| commands over |pop| commands) needed to process this file. Then
-comes |t|, the total number of pages (|bop| commands) present.
-
-The postamble continues with font definitions, which are any number of
-\\{fnt\_def} commands as described above, possibly interspersed with |nop|
-commands. Each font number that is used in the \.{DVI} file must be defined
-exactly twice: Once before it is first selected by a \\{fnt} command, and once
-in the postamble.
-
-@ The last part of the postamble, following the |post_post| byte that
-signifies the end of the font definitions, contains |q|, a pointer to the
-|post| command that started the postamble. An identification byte, |i|,
-comes next; this currently equals~2, as in the preamble.
-
-The |i| byte is followed by four or more bytes that are all equal to
-the decimal number 223 (i.e., @'337 in octal). \TeX\ puts out four to seven of
-these trailing bytes, until the total length of the file is a multiple of
-four bytes, since this works out best on machines that pack four bytes per
-word; but any number of 223's is allowed, as long as there are at least four
-of them. In effect, 223 is a sort of signature that is added at the very end.
-@^Fuchs, David Raymond@>
-
-This curious way to finish off a \.{DVI} file makes it feasible for
-\.{DVI}-reading programs to find the postamble first, on most computers,
-even though \TeX\ wants to write the postamble last. Most operating
-systems permit random access to individual words or bytes of a file, so
-the \.{DVI} reader can start at the end and skip backwards over the 223's
-until finding the identification byte. Then it can back up four bytes, read
-|q|, and move to byte |q| of the file. This byte should, of course,
-contain the value 248 (|post|); now the postamble can be read, so the
-\.{DVI} reader can discover all the information needed for typesetting the
-pages. Note that it is also possible to skip through the \.{DVI} file at
-reasonably high speed to locate a particular page, if that proves
-desirable. This saves a lot of time, since \.{DVI} files used in production
-jobs tend to be large.
-
-Unfortunately, however, standard \PASCAL\ does not include the ability to
-@^system dependencies@>
-access a random position in a file, or even to determine the length of a file.
-Almost all systems nowadays provide the necessary capabilities, so \.{DVI}
-format has been designed to work most efficiently with modern operating systems.
-But if \.{DVI} files have to be processed under the restrictions of standard
-\PASCAL, one can simply read them from front to back, since the necessary
-header information is present in the preamble and in the font definitions.
-(The |l| and |u| and |s| and |t| parameters, which appear only in the
-postamble, are ``frills'' that are handy but not absolutely necessary.)
-
-@* \[32] Shipping pages out.
-After considering \TeX's eyes and stomach, we come now to the bowels.
-@^bowels@>
-
-The |ship_out| procedure is given a pointer to a box; its mission is
-to describe that box in \.{DVI} form, outputting a ``page'' to |dvi_file|.
-The \.{DVI} coordinates $(h,v)=(0,0)$ should correspond to the upper left
-corner of the box being shipped.
-
-Since boxes can be inside of boxes inside of boxes, the main work of
-|ship_out| is done by two mutually recursive routines, |hlist_out|
-and |vlist_out|, which traverse the hlists and vlists inside of horizontal
-and vertical boxes.
-
-As individual pages are being processed, we need to accumulate
-information about the entire set of pages, since such statistics must be
-reported in the postamble. The global variables |total_pages|, |max_v|,
-|max_h|, |max_push|, and |last_bop| are used to record this information.
-
-The variable |doing_leaders| is |true| while leaders are being output.
-The variable |dead_cycles| contains the number of times an output routine
-has been initiated since the last |ship_out|.
-
-A few additional global variables are also defined here for use in
-|vlist_out| and |hlist_out|. They could have been local variables, but
-that would waste stack space when boxes are deeply nested, since the
-values of these variables are not needed during recursive calls.
-@^recursion@>
-
-@<Glob...@>=
-@!total_pages:integer; {the number of pages that have been shipped out}
-@!max_v:scaled; {maximum height-plus-depth of pages shipped so far}
-@!max_h:scaled; {maximum width of pages shipped so far}
-@!max_push:integer; {deepest nesting of |push| commands encountered so far}
-@!last_bop:integer; {location of previous |bop| in the \.{DVI} output}
-@!dead_cycles:integer; {recent outputs that didn't ship anything out}
-@!doing_leaders:boolean; {are we inside a leader box?}
-@#
-@!c,@!f:integer; {character and font in current |char_node|}
-@!oval,@!ocmd:integer; {used by |out_cmd| for generating
- |set|, |fnt| and |fnt_def| commands}
-@!rule_ht,@!rule_dp,@!rule_wd:scaled; {size of current rule being output}
-@!g:pointer; {current glue specification}
-@!lq,@!lr:integer; {quantities used in calculations for leaders}
-
-@ @<Set init...@>=
-total_pages:=0; max_v:=0; max_h:=0; max_push:=0; last_bop:=-1;
-doing_leaders:=false; dead_cycles:=0; cur_s:=-1;
-
-@ The \.{DVI} bytes are output to a buffer instead of being written directly
-to the output file. This makes it possible to reduce the overhead of
-subroutine calls, thereby measurably speeding up the computation, since
-output of \.{DVI} bytes is part of \TeX's inner loop. And it has another
-advantage as well, since we can change instructions in the buffer in order to
-make the output more compact. For example, a `|down2|' command can be
-changed to a `|y2|', thereby making a subsequent `|y0|' command possible,
-saving two bytes.
-
-The output buffer is divided into two parts of equal size; the bytes found
-in |dvi_buf[0..half_buf-1]| constitute the first half, and those in
-|dvi_buf[half_buf..dvi_buf_size-1]| constitute the second. The global
-variable |dvi_ptr| points to the position that will receive the next
-output byte. When |dvi_ptr| reaches |dvi_limit|, which is always equal
-to one of the two values |half_buf| or |dvi_buf_size|, the half buffer that
-is about to be invaded next is sent to the output and |dvi_limit| is
-changed to its other value. Thus, there is always at least a half buffer's
-worth of information present, except at the very beginning of the job.
-
-Bytes of the \.{DVI} file are numbered sequentially starting with 0;
-the next byte to be generated will be number |dvi_offset+dvi_ptr|.
-A byte is present in the buffer only if its number is |>=dvi_gone|.
-
-@<Types...@>=
-@!dvi_index=0..dvi_buf_size; {an index into the output buffer}
-
-@ Some systems may find it more efficient to make |dvi_buf| a |packed|
-array, since output of four bytes at once may be facilitated.
-@^system dependencies@>
-
-@<Glob...@>=
-@!dvi_buf:array[dvi_index] of real_eight_bits; {buffer for \.{DVI} output}
-@!half_buf:dvi_index; {half of |dvi_buf_size|}
-@!dvi_limit:dvi_index; {end of the current half buffer}
-@!dvi_ptr:dvi_index; {the next available buffer address}
-@!dvi_offset:integer; {|dvi_buf_size| times the number of times the
- output buffer has been fully emptied}
-@!dvi_gone:integer; {the number of bytes already output to |dvi_file|}
-
-@ Initially the buffer is all in one piece; we will output half of it only
-after it first fills up.
-
-@<Set init...@>=
-half_buf:=dvi_buf_size div 2; dvi_limit:=dvi_buf_size; dvi_ptr:=0;
-dvi_offset:=0; dvi_gone:=0;
-
-@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
-|write_dvi(a,b)|. For best results, this procedure should be optimized to
-run as fast as possible on each particular system, since it is part of
-\TeX's inner loop. It is safe to assume that |a| and |b+1| will both be
-multiples of 4 when |write_dvi(a,b)| is called; therefore it is possible on
-many machines to use efficient methods to pack four bytes per word and to
-output an array of words with one system call.
-@^system dependencies@>
-@^inner loop@>
-@^defecation@>
-
-@p procedure write_dvi(@!a,@!b:dvi_index);
-var k:dvi_index;
-begin for k:=a to b do write(dvi_file,dvi_buf[k]);
-end;
-
-@ To put a byte in the buffer without paying the cost of invoking a procedure
-each time, we use the macro |dvi_out|.
-
-@d dvi_out(#)==@+begin dvi_buf[dvi_ptr]:=#; incr(dvi_ptr);
- if dvi_ptr=dvi_limit then dvi_swap;
- end
-
-@p procedure dvi_swap; {outputs half of the buffer}
-begin if dvi_limit=dvi_buf_size then
- begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
- dvi_offset:=dvi_offset+dvi_buf_size; dvi_ptr:=0;
- end
-else begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
- end;
-dvi_gone:=dvi_gone+half_buf;
-end;
-
-@ Here is how we clean out the buffer when \TeX\ is all through; |dvi_ptr|
-will be a multiple of~4.
-
-@<Empty the last bytes out of |dvi_buf|@>=
-if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
-if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
-
-@ The |dvi_four| procedure outputs four bytes in two's complement notation,
-without risking arithmetic overflow.
-
-@p procedure dvi_four(@!x:integer);
-begin if x>=0 then dvi_out(x div @'100000000)
-else begin x:=x+@'10000000000;
- x:=x+@'10000000000;
- dvi_out((x div @'100000000) + 128);
- end;
-x:=x mod @'100000000; dvi_out(x div @'200000);
-x:=x mod @'200000; dvi_out(x div @'400);
-dvi_out(x mod @'400);
-end;
-
-@ A mild optimization of the output is performed by the |dvi_pop|
-routine, which issues a |pop| unless it is possible to cancel a
-`|push| |pop|' pair. The parameter to |dvi_pop| is the byte address
-following the old |push| that matches the new |pop|.
-
-@p procedure dvi_pop(@!l:integer);
-begin if (l=dvi_offset+dvi_ptr)and(dvi_ptr>0) then decr(dvi_ptr)
-else dvi_out(pop);
-end;
-
-@ Here's a procedure that outputs a font definition. $\Omega$ allows
-more than 256 different fonts per job, so the right font definition
-command must be selected.
-
-@d Incr_Decr(#) == #
-@d Incr(#) == #:=#+Incr_Decr {increase a variable}
-@d Decr(#) == #:=#-Incr_Decr {decrease a variable}
-
-@d dvi_debug_out(#)==begin
-dvi_out(#);
-end
-
-@d out_cmd ==
-begin
-if (oval<@"100)and(oval>=0) then begin
- if (ocmd<>set1)or(oval>127) then begin
- if (ocmd=fnt1)and(oval<64) then Incr(oval)(fnt_num_0) @+ else dvi_debug_out(ocmd);
- end;
- end
-else
- begin if (oval<@"10000)and(oval>=0) then dvi_debug_out(ocmd+1) @+ else @;
- begin if (oval<@"1000000)and(oval>=0) then dvi_debug_out(ocmd+2) @+ else @;
- begin dvi_debug_out(ocmd+3);
- if oval>=0 then dvi_debug_out(oval div @"1000000)
- else begin Incr(oval)(@"40000000); Incr(oval)(@"40000000);
- dvi_debug_out((oval div @"1000000) + 128); oval:=oval mod @"1000000;
- end;
- dvi_debug_out(oval div @"10000); oval:=oval mod @"10000;
- end;
- dvi_debug_out(oval div @"10000); oval:=oval mod @"10000;
- end;
- dvi_debug_out(oval div @"100); oval:=oval mod @"100;
- end;
-dvi_debug_out(oval)
-end
-
-@p procedure dvi_font_def(@!f:internal_font_number);
-var k:pool_pointer; {index into |str_pool|}
-fa:^packed_ASCII_code;
-begin
-oval:=f-font_base-1; ocmd:= fnt_def1; out_cmd;@/
-dvi_out(font_check_0(f));
-dvi_out(font_check_1(f));
-dvi_out(font_check_2(f));
-dvi_out(font_check_3(f));@/
-dvi_four(font_size(f));
-dvi_four(font_dsize(f));@/
-dvi_out(0); { |font_area(f)| is unused }
-dvi_out(strlen(font_name(f)));
-@<Output the font name whose internal number is |f|@>;
-end;
-
-@ @<Output the font name whose internal number is |f|@>=
-fa := get_font_name(f); k := 0;
-while fa[k]<>0 do begin dvi_out(fa[k]); incr(k); end
-
-@ Versions of \TeX\ intended for small computers might well choose to omit
-the ideas in the next few parts of this program, since it is not really
-necessary to optimize the \.{DVI} code by making use of the |w0|, |x0|,
-|y0|, and |z0| commands. Furthermore, the algorithm that we are about to
-describe does not pretend to give an optimum reduction in the length
-of the \.{DVI} code; after all, speed is more important than compactness.
-But the method is surprisingly effective, and it takes comparatively little
-time.
-
-We can best understand the basic idea by first considering a simpler problem
-that has the same essential characteristics. Given a sequence of digits,
-say $3\,1\,4\,1\,5\,9\,2\,6\,5\,3\,5\,8\,9$, we want to assign subscripts
-$d$, $y$, or $z$ to each digit so as to maximize the number of ``$y$-hits''
-and ``$z$-hits''; a $y$-hit is an instance of two appearances of the same
-digit with the subscript $y$, where no $y$'s intervene between the two
-appearances, and a $z$-hit is defined similarly. For example, the sequence
-above could be decorated with subscripts as follows:
-$$3_z\,1_y\,4_d\,1_y\,5_y\,9_d\,2_d\,6_d\,5_y\,3_z\,5_y\,8_d\,9_d.$$
-There are three $y$-hits ($1_y\ldots1_y$ and $5_y\ldots5_y\ldots5_y$) and
-one $z$-hit ($3_z\ldots3_z$); there are no $d$-hits, since the two appearances
-of $9_d$ have $d$'s between them, but we don't count $d$-hits so it doesn't
-matter how many there are. These subscripts are analogous to the \.{DVI}
-commands called \\{down}, $y$, and $z$, and the digits are analogous to
-different amounts of vertical motion; a $y$-hit or $z$-hit corresponds to
-the opportunity to use the one-byte commands |y0| or |z0| in a \.{DVI} file.
-
-\TeX's method of assigning subscripts works like this: Append a new digit,
-say $\delta$, to the right of the sequence. Now look back through the
-sequence until one of the following things happens: (a)~You see
-$\delta_y$ or $\delta_z$, and this was the first time you encountered a
-$y$ or $z$ subscript, respectively. Then assign $y$ or $z$ to the new
-$\delta$; you have scored a hit. (b)~You see $\delta_d$, and no $y$
-subscripts have been encountered so far during this search. Then change
-the previous $\delta_d$ to $\delta_y$ (this corresponds to changing a
-command in the output buffer), and assign $y$ to the new $\delta$; it's
-another hit. (c)~You see $\delta_d$, and a $y$ subscript has been seen
-but not a $z$. Change the previous $\delta_d$ to $\delta_z$ and assign
-$z$ to the new $\delta$. (d)~You encounter both $y$ and $z$ subscripts
-before encountering a suitable $\delta$, or you scan all the way to the
-front of the sequence. Assign $d$ to the new $\delta$; this assignment may
-be changed later.
-
-The subscripts $3_z\,1_y\,4_d\ldots\,$ in the example above were, in fact,
-produced by this procedure, as the reader can verify. (Go ahead and try it.)
-
-@ In order to implement such an idea, \TeX\ maintains a stack of pointers
-to the \\{down}, $y$, and $z$ commands that have been generated for the
-current page. And there is a similar stack for \\{right}, |w|, and |x|
-commands. These stacks are called the down stack and right stack, and their
-top elements are maintained in the variables |down_ptr| and |right_ptr|.
-
-Each entry in these stacks contains four fields: The |width| field is
-the amount of motion down or to the right; the |location| field is the
-byte number of the \.{DVI} command in question (including the appropriate
-|dvi_offset|); the |vlink| field points to the next item below this one
-on the stack; and the |vinfo| field encodes the options for possible change
-in the \.{DVI} command.
-
-@d location(#)==vmem(#+1).int {\.{DVI} byte number for a movement command}
-
-@<Glob...@>=
-@!down_ptr,@!right_ptr:pointer; {heads of the down and right stacks}
-
-@ @<Set init...@>=
-down_ptr:=null; right_ptr:=null;
-
-@ Here is a subroutine that produces a \.{DVI} command for some specified
-downward or rightward motion. It has two parameters: |w| is the amount
-of motion, and |o| is either |down1| or |right1|. We use the fact that
-the command codes have convenient arithmetic properties: |y1-down1=w1-right1|
-and |z1-down1=x1-right1|.
-
-@d dvi_set_end(#)==dvi.h := dvi.h + (#); end
-@d dvi_set(#)==begin synch_dvi_with_pos; oval:=#; ocmd:=set1; out_cmd; dvi_set_end
-@d dvi_put(#)==begin synch_dvi_with_pos; oval:=#; ocmd:=put1; out_cmd; end
-@d dvi_set_rule_end(#)==dvi_four(#); dvi.h := dvi.h + (#); end
-@d dvi_set_rule(#)==begin synch_dvi_with_pos; dvi_out(set_rule); dvi_four(#); dvi_set_rule_end
-@d dvi_put_rule_end(#)==dvi_four(#); end
-@d dvi_put_rule(#)==begin synch_dvi_with_pos; dvi_out(put_rule); dvi_four(#); dvi_put_rule_end
-
-@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
-if false then begin
- q:=new_node(movement_node,0); {new node for the top of the stack}
- width(q):=w; location(q):=dvi_offset+dvi_ptr;
- if o=down1 then
- begin vlink(q):=down_ptr; down_ptr:=q;
- end
- else begin vlink(q):=right_ptr; right_ptr:=q;
- end;
- @<Look at the other stack entries until deciding what sort of \.{DVI} command
- to generate; |goto found| if node |p| is a ``hit''@>;
-end;
-@<Generate a |down| or |right| command for |w| and |return|@>;
-found: @<Generate a |y0| or |z0| command in order to reuse a previous
- appearance of~|w|@>;
-exit:end;
-
-@ The |vinfo| fields in the entries of the down stack or the right stack
-have six possible settings: |y_here| or |z_here| mean that the \.{DVI}
-command refers to |y| or |z|, respectively (or to |w| or |x|, in the
-case of horizontal motion); |yz_OK| means that the \.{DVI} command is
-\\{down} (or \\{right}) but can be changed to either |y| or |z| (or
-to either |w| or |x|); |y_OK| means that it is \\{down} and can be changed
-to |y| but not |z|; |z_OK| is similar; and |d_fixed| means it must stay
-\\{down}.
-
-The four settings |yz_OK|, |y_OK|, |z_OK|, |d_fixed| would not need to
-be distinguished from each other if we were simply solving the
-digit-subscripting problem mentioned above. But in \TeX's case there is
-a complication because of the nested structure of |push| and |pop|
-commands. Suppose we add parentheses to the digit-subscripting problem,
-redefining hits so that $\delta_y\ldots \delta_y$ is a hit if all $y$'s between
-the $\delta$'s are enclosed in properly nested parentheses, and if the
-parenthesis level of the right-hand $\delta_y$ is deeper than or equal to
-that of the left-hand one. Thus, `(' and `)' correspond to `|push|'
-and `|pop|'. Now if we want to assign a subscript to the final 1 in the
-sequence
-$$2_y\,7_d\,1_d\,(\,8_z\,2_y\,8_z\,)\,1$$
-we cannot change the previous $1_d$ to $1_y$, since that would invalidate
-the $2_y\ldots2_y$ hit. But we can change it to $1_z$, scoring a hit
-since the intervening $8_z$'s are enclosed in parentheses.
-
-The program below removes movement nodes that are introduced after a |push|,
-before it outputs the corresponding |pop|.
-
-@d y_here=1 {|vinfo| when the movement entry points to a |y| command}
-@d z_here=2 {|vinfo| when the movement entry points to a |z| command}
-@d yz_OK=3 {|vinfo| corresponding to an unconstrained \\{down} command}
-@d y_OK=4 {|vinfo| corresponding to a \\{down} that can't become a |z|}
-@d z_OK=5 {|vinfo| corresponding to a \\{down} that can't become a |y|}
-@d d_fixed=6 {|vinfo| corresponding to a \\{down} that can't change}
-
-@ When the |movement| procedure gets to the label |found|, the value of
-|vinfo(p)| will be either |y_here| or |z_here|. If it is, say, |y_here|,
-the procedure generates a |y0| command (or a |w0| command), and marks
-all |vinfo| fields between |q| and |p| so that |y| is not OK in that range.
-
-@<Generate a |y0| or |z0| command...@>=
-vinfo(q):=vinfo(p);
-if vinfo(q)=y_here then
- begin dvi_out(o+y0-down1); {|y0| or |w0|}
- while vlink(q)<>p do
- begin q:=vlink(q);
- case vinfo(q) of
- yz_OK: vinfo(q):=z_OK;
- y_OK: vinfo(q):=d_fixed;
- othercases do_nothing
- endcases;
- end;
- end
-else begin dvi_out(o+z0-down1); {|z0| or |x0|}
- while vlink(q)<>p do
- begin q:=vlink(q);
- case vinfo(q) of
- yz_OK: vinfo(q):=y_OK;
- z_OK: vinfo(q):=d_fixed;
- othercases do_nothing
- endcases;
- end;
- end
-
-@ @<Generate a |down| or |right|...@>=
-if abs(w)>=@'40000000 then
- begin dvi_out(o+3); {|down4| or |right4|}
- dvi_four(w); return;
- end;
-if abs(w)>=@'100000 then
- begin dvi_out(o+2); {|down3| or |right3|}
- if w<0 then w:=w+@'100000000;
- dvi_out(w div @'200000); w:=w mod @'200000; goto 2;
- end;
-if abs(w)>=@'200 then
- begin dvi_out(o+1); {|down2| or |right2|}
- if w<0 then w:=w+@'200000;
- goto 2;
- end;
-dvi_out(o); {|down1| or |right1|}
-if w<0 then w:=w+@'400;
-goto 1;
-2: dvi_out(w div @'400);
-1: dvi_out(w mod @'400); return
-
-@ As we search through the stack, we are in one of three states,
-|y_seen|, |z_seen|, or |none_seen|, depending on whether we have
-encountered |y_here| or |z_here| nodes. These states are encoded as
-multiples of 6, so that they can be added to the |info| fields for quick
-decision-making.
-@^inner loop@>
-
-@d none_seen=0 {no |y_here| or |z_here| nodes have been encountered yet}
-@d y_seen=6 {we have seen |y_here| but not |z_here|}
-@d z_seen=12 {we have seen |z_here| but not |y_here|}
-
-@<Look at the other stack entries until deciding...@>=
-p:=vlink(q); mstate:=none_seen;
-while p<>null do
- begin if width(p)=w then @<Consider a node with matching width;
- |goto found| if it's a hit@>
- else case mstate+vinfo(p) of
- none_seen+y_here: mstate:=y_seen;
- none_seen+z_here: mstate:=z_seen;
- y_seen+z_here,z_seen+y_here: goto not_found;
- othercases do_nothing
- endcases;
- p:=vlink(p);
- end;
-not_found:
-
-@ We might find a valid hit in a |y| or |z| byte that is already gone
-from the buffer. But we can't change bytes that are gone forever; ``the
-moving finger writes, $\ldots\,\,$.''
-
-@<Consider a node with matching width...@>=
-case mstate+vinfo(p) of
-none_seen+yz_OK,none_seen+y_OK,z_seen+yz_OK,z_seen+y_OK:@t@>@;@/
- if location(p)<dvi_gone then goto not_found
- else @<Change buffered instruction to |y| or |w| and |goto found|@>;
-none_seen+z_OK,y_seen+yz_OK,y_seen+z_OK:@t@>@;@/
- if location(p)<dvi_gone then goto not_found
- else @<Change buffered instruction to |z| or |x| and |goto found|@>;
-none_seen+y_here,none_seen+z_here,y_seen+z_here,z_seen+y_here: goto found;
-othercases do_nothing
-endcases
-
-@ @<Change buffered instruction to |y| or |w| and |goto found|@>=
-begin k:=location(p)-dvi_offset;
-if k<0 then k:=k+dvi_buf_size;
-dvi_buf[k]:=dvi_buf[k]+y1-down1;
-vinfo(p):=y_here; goto found;
-end
-
-@ @<Change buffered instruction to |z| or |x| and |goto found|@>=
-begin k:=location(p)-dvi_offset;
-if k<0 then k:=k+dvi_buf_size;
-dvi_buf[k]:=dvi_buf[k]+z1-down1;
-vinfo(p):=z_here; goto found;
-end
-
-@ In case you are wondering when all the movement nodes are removed from
-\TeX's memory, the answer is that they are recycled just before
-|hlist_out| and |vlist_out| finish outputting a box. This restores the
-down and right stacks to the state they were in before the box was output,
-except that some |vinfo|'s may have become more restrictive.
-
-@p procedure prune_movements(@!l:integer);
- {delete movement nodes with |location>=l|}
-label done,exit;
-var p:pointer; {node being deleted}
-begin while down_ptr<>null do
- begin if location(down_ptr)<l then goto done;
- p:=down_ptr; down_ptr:=vlink(p); flush_node(p);
- end;
-done: while right_ptr<>null do
- begin if location(right_ptr)<l then return;
- p:=right_ptr; right_ptr:=vlink(p); flush_node(p);
- end;
-exit:end;
-
-@ The actual distances by which we want to move might be computed as the
-sum of several separate movements. For example, there might be several
-glue nodes in succession, or we might want to move right by the width of
-some box plus some amount of glue. More importantly, the baselineskip
-distances are computed in terms of glue together with the depth and
-height of adjacent boxes, and we want the \.{DVI} file to lump these
-three quantities together into a single motion.
-
-Therefore, \TeX\ maintains two pairs of global variables: |dvi.h| and |dvi.v|
-are the |h| and |v| coordinates corresponding to the commands actually
-output to the \.{DVI} file, while |cur.h| and |cur.v| are the coordinates
-corresponding to the current state of the output routines. Coordinate
-changes will accumulate in |cur.h| and |cur.v| without being reflected
-in the output, until such a change becomes necessary or desirable; we
-can call the |movement| procedure whenever we want to make |dvi.h=pos.h|
-or |dvi.v=pos.v|.
-
-The current font reflected in the \.{DVI} output is called |dvi_f|;
-there is no need for a `\\{cur\_f}' variable.
-
-The depth of nesting of |hlist_out| and |vlist_out| is called |cur_s|;
-this is essentially the depth of |push| commands in the \.{DVI} output.
-
-@d synch_h==if pos.h <> dvi.h then begin
- movement(pos.h - dvi.h, right1);
- dvi.h := pos.h;
- end
-
-@d synch_v==if pos.v <> dvi.v then begin
- movement(dvi.v - pos.v, down1);
- dvi.v := pos.v;
- end
-
-@d synch_dvi_with_pos==begin
- synch_h; synch_v;
- end
-
-@d synch_pos_with_cur==case box_direction(dvi_direction) of
- dir_TL_: begin pos.h := box_pos.h + cur.h; pos.v := box_pos.v - cur.v; end;
- dir_TR_: begin pos.h := box_pos.h - cur.h; pos.v := box_pos.v - cur.v; end;
- dir_BL_: begin pos.h := box_pos.h + cur.h; pos.v := box_pos.v + cur.v; end;
- dir_BR_: begin pos.h := box_pos.h - cur.h; pos.v := box_pos.v + cur.v; end;
- dir_LT_: begin pos.h := box_pos.h + cur.v; pos.v := box_pos.v - cur.h; end;
- dir_RT_: begin pos.h := box_pos.h - cur.v; pos.v := box_pos.v - cur.h; end;
- dir_LB_: begin pos.h := box_pos.h + cur.v; pos.v := box_pos.v + cur.h; end;
- dir_RB_: begin pos.h := box_pos.h - cur.v; pos.v := box_pos.v + cur.h; end;
- end
-
-@d synch_dvi_with_cur==begin
- synch_pos_with_cur;
- synch_dvi_with_pos;
-end
-
-@d set_to_zero(#)==begin #.h := 0; #.v := 0; end
-
-@ @p function synch_p_with_c(cur: scaledpos): scaledpos;
-var pos: scaledpos;
-begin
- synch_pos_with_cur;
- synch_p_with_c := pos;
-end;
-
-@ @<Types...@>=
-@!scaledpos = record
- h, v: scaled;
- end;
-
-@ @<Glob...@>=
-@!cur: scaledpos; {\TeX\ position relative to origin of the surrounding box, in box coordinate system}
-@!box_pos: scaledpos; {position of box origin in page coordinates}
-@!pos: scaledpos; {global position on page, in $\rm sp$, from lower left page corner}
-@!dvi: scaledpos; {a \.{DVI} position in page coordinates, in sync with DVI file}
-@!dvi_f:internal_font_number; {the current font}
-@!cur_s:integer; {current depth of output box nesting, initially $-1$}
-
-@ @<Calculate DVI page dimensions and margins@>=
-if page_width > 0 then
- cur_page_size.h := page_width
-else
- case box_direction(dvi_direction) of
- dir_TL_, dir_BL_: cur_page_size.h := width(p) + 2 * page_left_offset;
- dir_TR_, dir_BR_: cur_page_size.h := width(p) + 2 * page_right_offset;
- dir_LT_, dir_LB_: cur_page_size.h := height(p) + depth(p) + 2 * page_left_offset;
- dir_RT_, dir_RB_: cur_page_size.h := height(p) + depth(p) + 2 * page_right_offset;
- end;
-if page_height > 0 then
- cur_page_size.v := page_height
-else
- case box_direction(dvi_direction) of
- dir_TL_, dir_TR_: cur_page_size.v := height(p) + depth(p) + 2 * page_top_offset;
- dir_BL_, dir_BR_: cur_page_size.v := height(p) + depth(p) + 2 * page_bottom_offset;
- dir_LT_, dir_RT_: cur_page_size.v := width(p) + 2 * page_top_offset;
- dir_LB_, dir_RB_: cur_page_size.v := width(p) + 2 * page_bottom_offset;
- end
-
-@ @<Initialize variables as |ship_out| begins@>=
-set_to_zero(dvi); set_to_zero(cur); dvi_f:=null_font;
-@<Calculate DVI page dimensions and margins@>;
-ensure_dvi_open;
-if total_pages=0 then
- begin dvi_out(pre); dvi_out(id_byte); {output the preamble}
-@^preamble of \.{DVI} file@>
- dvi_four(25400000); dvi_four(473628672); {conversion ratio for sp}
- prepare_mag; dvi_four(mag); {magnification factor is frozen}
- old_setting:=selector; selector:=new_string;
- print(" LuaTeX output "); print_int(year); print_char(".");
- print_two(month); print_char("."); print_two(day);
- print_char(":"); print_two(time div 60);
- print_two(time mod 60);
- selector:=old_setting; dvi_out(cur_length);
- for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s]));
- pool_ptr:=str_start_macro(str_ptr); {flush the current string}
- end
-
-@ When |hlist_out| is called, its duty is to output the box represented
-by the |hlist_node| pointed to by |temp_ptr|. The reference point of that
-box has coordinates |(cur.h,cur.v)|.
-
-Similarly, when |vlist_out| is called, its duty is to output the box represented
-by the |vlist_node| pointed to by |temp_ptr|. The reference point of that
-box has coordinates |(cur.h,cur.v)|.
-@^recursion@>
-
-@p procedure@?vlist_out; forward; {|hlist_out| and |vlist_out| are mutually
- recursive}
-
-@ The recursive procedures |hlist_out| and |vlist_out| each have a local variable
-|save_dvi| to hold the value of |dvi| just before
-entering a new level of recursion. In effect, the value of |save_dvi|
-on \TeX's run-time stack corresponds to the values of |h| and |v|
-that a \.{DVI}-reading program will push onto its coordinate stack.
-
-@d move_past=13 {go to this label when advancing past glue or a rule}
-@d fin_rule=14 {go to this label to finish processing a rule}
-@d next_p=15 {go to this label when finished with node |p|}
-
-@p @t\4@>@<Declare procedures needed in |hlist_out|, |vlist_out|@>@t@>@/
-procedure hlist_out; {output an |hlist_node| box}
-label move_past, fin_rule, next_p;
-var base_line: scaled; {the baseline coordinate for this box}
-c_wd,c_ht,c_dp: scaled;
- {the real width, height and depth of the character}
-w: scaled; { temporary value for directional width calculation }
-dir_nest: integer; { for tracking nested direction nodes }
-edge_v: scaled;
-edge_h: scaled;
-effective_horizontal: scaled;
-basepoint_horizontal: scaled;
-basepoint_vertical: scaled;
-save_direction: integer;
-dir_ptr,dir_tmp:pointer;
-@!left_edge: scaled; {the left coordinate for this box}
-@!save_h: scaled; {what |cur.h| should pop to}
-@!save_dvi: scaledpos; {what |dvi| should pop to}
-@!save_box_pos: scaledpos; {what |box_pos| should pop to}
-@!this_box: pointer; {pointer to containing box}
-@!g_order: glue_ord; {applicable order of infinity for glue}
-@!g_sign: normal..shrinking; {selects type of glue}
-@!p,q:pointer; {current position in the hlist}
-@!save_loc:integer; {\.{DVI} byte location upon entry}
-@!leader_box:pointer; {the leader box being replicated}
-@!leader_wd:scaled; {width of leader box being replicated}
-@!lx:scaled; {extra space between leader boxes}
-@!outer_doing_leaders:boolean; {were we doing leaders?}
-@!edge:scaled; {right edge of sub-box or leader space}
-@!glue_temp:real; {glue value before rounding}
-@!cur_glue:real; {glue seen so far}
-@!save_cur_glue:real; { saved version, for direction switch }
-@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
-@!save_cur_g:scaled; { saved version, for direction switch }
-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);
-set_to_zero(cur); box_pos:=pos;
-save_direction:=dvi_direction;
-dvi_direction:=box_dir(this_box);
-@<DIR: Initialize |dir_ptr| for |ship_out|@>;
-incr(cur_s);
-if cur_s>0 then dvi_out(push);
-if cur_s>max_push then max_push:=cur_s;
-save_loc:=dvi_offset+dvi_ptr; base_line:=cur.v; left_edge:=cur.h;
-@<Start hlist {\sl Sync\TeX} information record@>;
-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 {\sl Sync\TeX} information record@>;
-prune_movements(save_loc);
-if cur_s>0 then dvi_pop(save_loc);
-decr(cur_s);
-dvi_direction:=save_direction;
-@<DIR: Reset |dir_ptr|@>;
-end;
-
-@ This is a cacheing attempt
-
-@d charinfo_width(#)==#.ci_wd
-@d charinfo_height(#)==#.ci_ht
-@d charinfo_depth(#)==#.ci_dp
-
-@<Types...@>=
-charinfo_short = packed record@;@/
- @!ci_wd:scaled;
- @!ci_ht:scaled;
- @!ci_dp:scaled;
- end;
-
-@ @<Glob...@>=
-ci:charinfo_short;
-
-@ We ought to give special care to the efficiency of one part of |hlist_out|,
-since it belongs to \TeX's inner loop. When a |char_node| is encountered,
-we save a little time by processing several nodes in succession until
-reaching a non-|char_node|. The program uses the fact that |set_char_0=0|.
-@^inner loop@>
-
-@<Output node |p| for |hlist_out|...@>=
-if is_char_node(p) then
- begin
- repeat
- if x_displace(p)<>0 then cur.h := cur.h + x_displace(p);
- if y_displace(p)<>0 then cur.v := cur.v - y_displace(p);
- synch_pos_with_cur; f:=font(p); c:=character(p);
- ci := char_info_short(f,c);
- if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
- c_ht:=charinfo_height(ci);
- c_dp:=charinfo_depth(ci);
- c_wd:=charinfo_width(ci);
- if (font_natural_dir(f)<>-1) then begin
- case font_direction(dvi_direction) of
- dir__LT,dir__LB: begin
- dvi_set(c)(c_wd);
- end;
- dir__RT,dir__RB: begin
- dvi_put(c);
- end;
- dir__TL,dir__TR,dir__BL,dir__BR: begin
- c_wd := c_ht + c_dp;
- dvi_put(c);
- end;
- dir__LL: begin
- pos_right(c_wd);
- dvi_put(c);
- end;
- dir__RR: begin
- pos_left(c_wd);
- dvi_put(c);
- end;
- dir__LR: begin
- dvi_set(c)(c_wd);
- end;
- dir__RL: begin
- dvi_put(c);
- end;
- dir__TT: begin
- c_wd := c_ht + c_dp;
- pos_down(c_wd);
- dvi_put(c);
- end;
- dir__TB: begin
- c_wd := c_ht + c_dp;
- dvi_put(c);
- end;
- dir__BT: begin
- c_wd := c_ht + c_dp;
- dvi_put(c);
- end;
- dir__BB: begin
- c_wd := c_ht + c_dp;
- pos_up(c_wd);
- dvi_put(c);
- end;
- endcases;
- end else begin
- case font_direction(dvi_direction) of
- dir__LT: begin
- dvi_set(c)(c_wd);
- end;
- dir__LB: begin
- pos_down(c_ht);
- dvi_set(c)(c_wd);
- end;
- dir__RT: begin
- pos_left(c_wd);
- dvi_put(c);
- end;
- dir__RB: begin
- pos_down(c_ht);
- pos_left(c_wd);
- dvi_put(c);
- end;
- dir__TL: begin
- pos_down(c_ht);
- pos_left(c_wd);
- dvi_put(c);
- c_wd := c_ht + c_dp;
- end;
- dir__TR: begin
- pos_down(c_ht);
- dvi_put(c);
- c_wd := c_ht + c_dp;
- end;
- dir__BL: begin
- pos_left(c_wd);
- pos_up(c_dp);
- dvi_put(c);
- c_wd := c_ht + c_dp;
- end;
- dir__BR: begin
- pos_up(c_dp);
- dvi_put(c);
- c_wd := c_ht + c_dp;
- end;
- dir__LL,dir__LR: begin
- pos_down((c_ht - c_dp) div 2);
- dvi_set(c)(c_wd);
- end;
- dir__RL,dir__RR: begin
- pos_left(c_wd);
- pos_down((c_ht - c_dp) div 2);
- dvi_put(c);
- end;
- dir__TT,dir__TB: begin
- pos_down(c_ht);
- pos_left(c_wd div 2);
- dvi_put(c);
- c_wd:=c_ht + c_dp;
- end;
- dir__BT,dir__BB: begin
- pos_up(c_dp);
- pos_left(c_wd div 2);
- dvi_put(c);
- c_wd := c_ht + c_dp;
- end;
- endcases;
- end;
- if x_displace(p)<>0 then cur.h := cur.h - x_displace(p);
- if y_displace(p)<>0 then cur.v := cur.v + y_displace(p);
- cur.h:=cur.h+c_wd;
- p:=vlink(p);
- until not is_char_node(p);
- @<Record current point {\sl Sync\TeX} information@>;
- end
-else @<Output the non-|char_node| |p| for |hlist_out|
- and move to the next node@>
-
-@ @<Change font |dvi_f| to |f|@>=
-begin if not font_used(f) then
- begin dvi_font_def(f); set_font_used(f,true);
- end;
-oval:=f-font_base-1; ocmd:=fnt1; out_cmd;@/
-dvi_f:=f;
-end
-
-@ @<Output the non-|char_node| |p| for |hlist_out|...@>=
-begin case type(p) of
-hlist_node_case,vlist_node_case:@<Output a box in an hlist@>;
-rule_node_case: begin
- if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
- then begin
- rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
- end
- else begin
- rule_ht:=width(p) div 2;
- rule_dp:=width(p) div 2;
- rule_wd:=height(p)+depth(p);
- end;
- goto fin_rule;
- end;
-whatsit_node_case: @<Output the whatsit node |p| in an hlist@>;
-glue_node_case: @<Move right or output leaders@>;
-disc_node_case: if vlink(no_break(p))<>null then if subtype(p)<>select_disc then begin
- vlink(tlink(no_break(p))):=vlink(p);
- q:=vlink(no_break(p));
- vlink(no_break(p)):=null;
- vlink(p):=q;
- end;
-margin_kern_node_case:cur.h:=cur.h+width(p);
-kern_node_case: begin
- @<Record |kern_node| {\sl Sync\TeX} information@>;
- cur.h:=cur.h+width(p);
-end;
-math_node_case: begin
- @<Record |math_node| {\sl Sync\TeX} information@>;
- cur.h:=cur.h+surround(p);
-end;
-othercases do_nothing
-endcases;@/
-goto next_p;
-fin_rule: @<Output a rule in an hlist@>;
-move_past: begin
- cur.h:=cur.h+rule_wd;
- @<Record horizontal |rule_node| or |glue_node| {\sl Sync\TeX} information@>;
-end;
-next_p:p:=vlink(p);
-end
-
-@ @<Output a box in an hlist@>=
-begin
-if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
- then begin
- effective_horizontal:=width(p);
- basepoint_vertical:=0;
- if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=width(p)
- else
- basepoint_horizontal:=0;
- end
-else begin
- effective_horizontal:=height(p)+depth(p);
- if not is_mirrored(box_dir(p)) then
- if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=height(p)
- else
- basepoint_horizontal:=depth(p)
- else
- if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=depth(p)
- else
- basepoint_horizontal:=height(p);
- if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
- basepoint_vertical:= -(width(p) div 2)
- else
- basepoint_vertical:= (width(p) div 2);
- end;
-if not is_mirrored(dvi_direction) then
- basepoint_vertical := basepoint_vertical + shift_amount(p)
- {shift the box `down'}
-else
- basepoint_vertical := basepoint_vertical - shift_amount(p);
- {shift the box `up'}
-if list_ptr(p)=null then begin
- @<Record void list {\sl Sync\TeX} information@>;
- cur.h:=cur.h + effective_horizontal;
- end
-else begin
- temp_ptr:=p; edge:=cur.h; cur.h:=cur.h + basepoint_horizontal;
- edge_v:=cur.v; cur.v:=base_line + basepoint_vertical;
- synch_dvi_with_cur; save_dvi:=dvi;
- save_box_pos:=box_pos;
- if type(p)=vlist_node then vlist_out@+else hlist_out;
- dvi:=save_dvi;
- box_pos:=save_box_pos;
- cur.h:=edge+effective_horizontal; cur.v:=base_line;
- end
-end
-
-@ @<Output a rule in an hlist@>=
-if is_running(rule_ht) then rule_ht:=height(this_box);
-if is_running(rule_dp) then rule_dp:=depth(this_box);
-rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
-if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
- begin cur.v:=base_line+rule_dp; synch_pos_with_cur;
- case box_direction(dvi_direction) of
- dir_TL_: begin
- dvi_set_rule(rule_ht)(rule_wd);
- end;
- dir_BL_: begin
- pos_down(rule_ht);
- dvi_set_rule(rule_ht)(rule_wd);
- end;
- dir_TR_: begin
- pos_left(rule_wd);
- dvi_put_rule(rule_ht)(rule_wd);
- end;
- dir_BR_: begin
- pos_left(rule_wd);
- pos_down(rule_ht);
- dvi_put_rule(rule_ht)(rule_wd);
- end;
- dir_LT_: begin
- pos_down(rule_wd);
- pos_left(rule_ht);
- dvi_set_rule(rule_wd)(rule_ht);
- end;
- dir_RT_: begin
- pos_down(rule_wd);
- dvi_put_rule(rule_wd)(rule_ht);
- end;
- dir_LB_: begin
- pos_left(rule_ht);
- dvi_set_rule(rule_wd)(rule_ht);
- end;
- dir_RB_: begin
- dvi_put_rule(rule_wd)(rule_ht);
- end;
- end;
- cur.v:=base_line;
- end
-
-@ @d billion==float_constant(1000000000)
-@d vet_glue(#)== glue_temp:=#;
- if glue_temp>billion then
- glue_temp:=billion
- else if glue_temp<-billion then
- glue_temp:=-billion
-
-@<Move right or output leaders@>=
-begin g:=glue_ptr(p); rule_wd:=width(g)-cur_g;
-if g_sign<>normal then
- begin if g_sign=stretching then
- begin if stretch_order(g)=g_order then
- begin cur_glue:=cur_glue+stretch(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
-@^real multiplication@>
- cur_g:=round(glue_temp);
- end;
- end
- else if shrink_order(g)=g_order then
- begin cur_glue:=cur_glue-shrink(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
- cur_g:=round(glue_temp);
- end;
- end;
-rule_wd:=rule_wd+cur_g;
-
-if subtype(p)>=a_leaders then
- @<Output leaders in an hlist, |goto fin_rule| if a rule
- or to |next_p| if done@>;
-goto move_past;
-end
-
-@ @<Output leaders in an hlist...@>=
-begin leader_box:=leader_ptr(p);
-if type(leader_box)=rule_node then
- begin rule_ht:=height(leader_box); rule_dp:=depth(leader_box);
- goto fin_rule;
- end;
-if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
- then leader_wd:=width(leader_box)
-else
- leader_wd:=height(leader_box)+depth(leader_box);
-if (leader_wd>0)and(rule_wd>0) then
- begin rule_wd:=rule_wd+10; {compensate for floating-point rounding}
- edge:=cur.h+rule_wd; lx:=0;
- @<Let |cur.h| be the position of the first box, and set |leader_wd+lx|
- to the spacing between corresponding parts of boxes@>;
- while cur.h+leader_wd<=edge do
- @<Output a leader box at |cur.h|,
- then advance |cur.h| by |leader_wd+lx|@>;
- cur.h:=edge-10; goto next_p;
- end;
-end
-
-@ The calculations related to leaders require a bit of care. First, in the
-case of |a_leaders| (aligned leaders), we want to move |cur.h| to
-|left_edge| plus the smallest multiple of |leader_wd| for which the result
-is not less than the current value of |cur.h|; i.e., |cur.h| should become
-$|left_edge|+|leader_wd|\times\lceil
-(|cur.h|-|left_edge|)/|leader_wd|\rceil$. The program here should work in
-all cases even though some implementations of \PASCAL\ give nonstandard
-results for the |div| operation when |cur.h| is less than |left_edge|.
-
-In the case of |c_leaders| (centered leaders), we want to increase |cur.h|
-by half of the excess space not occupied by the leaders; and in the
-case of |x_leaders| (expanded leaders) we increase |cur.h|
-by $1/(q+1)$ of this excess space, where $q$ is the number of times the
-leader box will be replicated. Slight inaccuracies in the division might
-accumulate; half of this rounding error is placed at each end of the leaders.
-
-@<Let |cur.h| be the position of the first box, ...@>=
-if subtype(p)=a_leaders then
- begin save_h:=cur.h;
- cur.h:=left_edge+leader_wd*((cur.h-left_edge)@!div leader_wd);
- if cur.h<save_h then cur.h:=cur.h+leader_wd;
- end
-else begin lq:=rule_wd div leader_wd; {the number of box copies}
- lr:=rule_wd mod leader_wd; {the remaining space}
- if subtype(p)=c_leaders then cur.h:=cur.h+(lr div 2)
- else begin lx:=lr div (lq+1);
- cur.h:=cur.h+((lr-(lq-1)*lx) div 2);
- end;
- end
-
-@ The `\\{synch}' operations here are intended to decrease the number of
-bytes needed to specify horizontal and vertical motion in the \.{DVI} output.
-
-@<Output a leader box at |cur.h|, ...@>=
-begin
-if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
- then begin
- basepoint_vertical:=0;
- if dir_opposite(dir_secondary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=width(leader_box)
- else
- basepoint_horizontal:=0;
- end
-else begin
- if not is_mirrored(box_dir(leader_box)) then
- if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=height(leader_box)
- else
- basepoint_horizontal:=depth(leader_box)
- else
- if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=depth(leader_box)
- else
- basepoint_horizontal:=height(leader_box);
- if dir_eq(dir_secondary[box_dir(leader_box)])(dir_primary[dvi_direction]) then
- basepoint_vertical:= -(width(leader_box) div 2)
- else
- basepoint_vertical:= (width(leader_box) div 2);
- end;
-if not is_mirrored(dvi_direction) then
- basepoint_vertical := basepoint_vertical + shift_amount(leader_box)
- {shift the box `down'}
-else
- basepoint_vertical := basepoint_vertical - shift_amount(leader_box);
- {shift the box `up'}
-temp_ptr:=leader_box;
-edge_h:=cur.h; cur.h:=cur.h + basepoint_horizontal;
-edge_v:=cur.v; cur.v:=base_line + basepoint_vertical;
-synch_dvi_with_cur; save_dvi:=dvi;
-save_box_pos:=box_pos;
-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;
-box_pos:=save_box_pos;
-dvi:=save_dvi;
-cur.h:=edge_h+leader_wd+lx; cur.v:=base_line;
-end
-
-@ The |vlist_out| routine is similar to |hlist_out|, but a bit simpler.
-
-@p procedure vlist_out; {output a |vlist_node| box}
-label move_past, fin_rule, next_p;
-var left_edge: scaled; {the left coordinate for this box}
-@!top_edge: scaled; {the top coordinate for this box}
-@!save_v: scaled; {what |cur.v| should pop to}
-@!save_dvi: scaledpos; {what |dvi| should pop to}
-@!save_box_pos: scaledpos; {what |box_pos| should pop to}
-@!this_box: pointer; {pointer to containing box}
-@!g_order: glue_ord; {applicable order of infinity for glue}
-@!g_sign: normal..shrinking; {selects type of glue}
-@!p:pointer; {current position in the vlist}
-@!save_loc:integer; {\.{DVI} byte location upon entry}
-@!leader_box:pointer; {the leader box being replicated}
-@!leader_ht:scaled; {height of leader box being replicated}
-@!lx:scaled; {extra space between leader boxes}
-@!outer_doing_leaders:boolean; {were we doing leaders?}
-@!edge:scaled; {bottom boundary of leader space}
-@!glue_temp:real; {glue value before rounding}
-@!cur_glue:real; {glue seen so far}
-@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
-@!save_direction: integer;
-@!effective_vertical: scaled;
-@!basepoint_horizontal: scaled;
-@!basepoint_vertical: scaled;
-@!edge_v: scaled;
-begin cur_g:=0; cur_glue:=float_constant(0);
-this_box:=temp_ptr; g_order:=glue_order(this_box);
-g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
-{pdfassert(p<>0);}
-set_to_zero(cur); box_pos:=pos;
-save_direction:=dvi_direction;
-dvi_direction:=box_dir(this_box);
-incr(cur_s);
-if cur_s>0 then dvi_out(push);
-if cur_s>max_push then max_push:=cur_s;
-save_loc:=dvi_offset+dvi_ptr; left_edge:=cur.h;
-@<Start vlist {\sl Sync\TeX} information record@>;
-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|@>;
-@<Finish vlist {\sl Sync\TeX} information record@>;
-prune_movements(save_loc);
-if cur_s>0 then dvi_pop(save_loc);
-decr(cur_s);
-dvi_direction:=save_direction;
-end;
-
-@ @<Output node |p| for |vlist_out|...@>=
-begin if is_char_node(p) then begin print_font_and_char(p); confusion("vlistout"); end
-@:this can't happen vlistout}{\quad vlistout@>
-else @<Output the non-|char_node| |p| for |vlist_out|@>;
-next_p:p:=vlink(p);
-end
-
-@ @<Output the non-|char_node| |p| for |vlist_out|@>=
-begin case type(p) of
-hlist_node_case,vlist_node_case:@<Output a box in a vlist@>;
-rule_node_case: begin
- if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
- then begin
- rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
- end
- else begin
- rule_ht:=width(p) div 2;
- rule_dp:=width(p) div 2;
- rule_wd:=height(p)+depth(p);
- end;
- goto fin_rule;
- end;
-whatsit_node_case: @<Output the whatsit node |p| in a vlist@>;
-glue_node_case: @<Move down or output leaders@>;
-kern_node_case:cur.v:=cur.v+width(p);
-othercases do_nothing
-endcases;@/
-goto next_p;
-fin_rule: @<Output a rule in a vlist, |goto next_p|@>;
-move_past: cur.v:=cur.v+rule_ht;
-end
-
-@ The |synch_v| here allows the \.{DVI} output to use one-byte commands
-for adjusting |v| in most cases, since the baselineskip distance will
-usually be constant.
-
-@<Output a box in a vlist@>=
-begin
-if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
- then begin
- effective_vertical:=height(p)+depth(p);
- if (type(p)=hlist_node) and is_mirrored(box_dir(p)) then
- basepoint_vertical:=depth(p)
- else
- basepoint_vertical:=height(p);
- if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=width(p)
- else
- basepoint_horizontal:=0;
- end
-else begin
- effective_vertical:=width(p);
- if not is_mirrored(box_dir(p)) then
- if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=height(p)
- else
- basepoint_horizontal:=depth(p)
- else
- if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=depth(p)
- else
- basepoint_horizontal:=height(p);
- if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
- basepoint_vertical:=0
- else
- basepoint_vertical:=width(p);
- end;
-basepoint_horizontal := basepoint_horizontal + shift_amount(p);
- {shift the box `right'}
-if list_ptr(p)=null then begin
- cur.v:=cur.v+effective_vertical;
- @<Record void list {\sl Sync\TeX} information@>;
- end
-else begin
- edge_v:=cur.v;
- cur.h:=left_edge + basepoint_horizontal;
- cur.v:=cur.v + basepoint_vertical;
- synch_dvi_with_cur; save_dvi:=dvi;
- save_box_pos:=box_pos;
- temp_ptr:=p;
- if type(p)=vlist_node then vlist_out@+else hlist_out;
- dvi:=save_dvi;
- box_pos:=save_box_pos;
- cur.h:=left_edge; cur.v:=edge_v + effective_vertical;
- end
-end
-
-@ @<Output a rule in a vlist...@>=
-if is_running(rule_wd) then rule_wd:=width(this_box);
-rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
-cur.v:=cur.v+rule_ht;
-if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
- begin synch_pos_with_cur;
- case box_direction(dvi_direction) of
- dir_TL_: begin
- dvi_put_rule(rule_ht)(rule_wd);
- end;
- dir_BL_: begin
- pos_down(rule_ht);
- dvi_put_rule(rule_ht)(rule_wd);
- end;
- dir_TR_: begin
- pos_left(rule_wd);
- dvi_set_rule(rule_ht)(rule_wd);
- end;
- dir_BR_: begin
- pos_down(rule_ht);
- pos_left(rule_wd);
- dvi_set_rule(rule_ht)(rule_wd);
- end;
- dir_LT_: begin
- pos_down(rule_wd);
- pos_left(rule_ht);
- dvi_set_rule(rule_wd)(rule_ht);
- end;
- dir_RT_: begin
- pos_down(rule_wd);
- dvi_put_rule(rule_wd)(rule_ht);
- end;
- dir_LB_: begin
- pos_left(rule_ht);
- dvi_set_rule(rule_wd)(rule_ht);
- end;
- dir_RB_: begin
- dvi_put_rule(rule_wd)(rule_ht);
- end;
- end;
- end;
-goto next_p
-
-@ @<Move down or output leaders@>=
-begin g:=glue_ptr(p); rule_ht:=width(g)-cur_g;
-if g_sign<>normal then
- begin if g_sign=stretching then
- begin if stretch_order(g)=g_order then
- begin cur_glue:=cur_glue+stretch(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
-@^real multiplication@>
- cur_g:=round(glue_temp);
- end;
- end
- else if shrink_order(g)=g_order then
- begin cur_glue:=cur_glue-shrink(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
- cur_g:=round(glue_temp);
- end;
- end;
-rule_ht:=rule_ht+cur_g;
-if subtype(p)>=a_leaders then
- @<Output leaders in a vlist, |goto fin_rule| if a rule
- or to |next_p| if done@>;
-goto move_past;
-end
-
-@ @<Output leaders in a vlist...@>=
-begin leader_box:=leader_ptr(p);
-if type(leader_box)=rule_node then
- begin rule_wd:=width(leader_box); rule_dp:=0;
- goto fin_rule;
- end;
-if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
- then leader_ht:=height(leader_box)+depth(leader_box)
-else
- leader_ht:=width(leader_box);
-if (leader_ht>0)and(rule_ht>0) then
- begin rule_ht:=rule_ht+10; {compensate for floating-point rounding}
- edge:=cur.v+rule_ht; lx:=0;
- @<Let |cur.v| be the position of the first box, and set |leader_ht+lx|
- to the spacing between corresponding parts of boxes@>;
- while cur.v+leader_ht<=edge do
- @<Output a leader box at |cur.v|,
- then advance |cur.v| by |leader_ht+lx|@>;
- cur.v:=edge-10; goto next_p;
- end;
-end
-
-@ @<Let |cur.v| be the position of the first box, ...@>=
-if subtype(p)=a_leaders then
- begin save_v:=cur.v;
- cur.v:=top_edge+leader_ht*((cur.v-top_edge)@!div leader_ht);
- if cur.v<save_v then cur.v:=cur.v+leader_ht;
- end
-else begin lq:=rule_ht div leader_ht; {the number of box copies}
- lr:=rule_ht mod leader_ht; {the remaining space}
- if subtype(p)=c_leaders then cur.v:=cur.v+(lr div 2)
- else begin lx:=lr div (lq+1);
- cur.v:=cur.v+((lr-(lq-1)*lx) div 2);
- end;
- end
-
-@ When we reach this part of the program, |cur.v| indicates the top of a
-leader box, not its baseline.
-
-@<Output a leader box at |cur.v|, ...@>=
-begin
-if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
- then begin
- effective_vertical:=height(leader_box)+depth(leader_box);
- if (type(leader_box)=hlist_node) and is_mirrored(box_dir(leader_box)) then
- basepoint_vertical:=depth(leader_box)
- else
- basepoint_vertical:=height(leader_box);
- if dir_opposite(dir_secondary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=width(leader_box)
- else
- basepoint_horizontal:=0;
- end
-else begin
- effective_vertical:=width(leader_box);
- if not is_mirrored(box_dir(leader_box)) then
- if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=height(leader_box)
- else
- basepoint_horizontal:=depth(leader_box)
- else
- if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=depth(leader_box)
- else
- basepoint_horizontal:=height(leader_box);
- if dir_eq(dir_secondary[box_dir(leader_box)])(dir_primary[dvi_direction]) then
- basepoint_vertical:= width(leader_box)
- else
- basepoint_vertical:= 0;
- end;
-basepoint_horizontal := basepoint_horizontal + shift_amount(leader_box);
- {shift the box `right'}
-temp_ptr:=leader_box;
-cur.h:=left_edge + basepoint_horizontal;
-edge_v:=cur.v ;
-cur.v:=cur.v + basepoint_vertical;
-synch_dvi_with_cur; save_dvi:=dvi;
-save_box_pos:=box_pos;
-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;
-box_pos:=save_box_pos;
-dvi:=save_dvi;
-cur.h:=left_edge; cur.v:=edge_v+leader_ht+lx;
-end
-
-@ The |hlist_out| and |vlist_out| procedures are now complete, so we are
-ready for the |dvi_ship_out| routine that gets them started in the first place.
-
-@p procedure dvi_ship_out(@!p:pointer); {output the box |p|}
-label done;
-var page_loc:integer; {location of the current |bop|}
-@!j,@!k:0..9; {indices to first ten count registers}
-@!s:pool_pointer; {index into |str_pool|}
-@!old_setting:0..max_selector; {saved |selector| setting}
-pre_callback_id:integer;
-post_callback_id:integer;
-ret:boolean;
-begin
-@<Start sheet {\sl Sync\TeX} information record@>;
-pre_callback_id:=callback_defined(start_page_number_callback);
-post_callback_id:=callback_defined(stop_page_number_callback);
-if (tracing_output>0)and(pre_callback_id=0) then
- begin print_nl(""); print_ln;
- print("Completed box being shipped out");
-@.Completed box...@>
- end;
-if pre_callback_id>0 then
- ret:=run_callback(pre_callback_id,'->')
-else if pre_callback_id=0 then begin
- if term_offset>max_print_line-9 then print_ln
- else if (term_offset>0)or(file_offset>0) then print_char(" ");
- print_char("["); j:=9;
- while (count(j)=0)and(j>0) do decr(j);
- for k:=0 to j do
- begin print_int(count(k));
- if k<j then print_char(".");
- end;
- end;
-update_terminal;
-if (tracing_output>0)and(post_callback_id=0) then
- begin print_char("]");
- begin_diagnostic; show_box(p); end_diagnostic(true);
- end;
-@<Ship box |p| out@>;
-if (tracing_output<=0)and(post_callback_id=0) then
- print_char("]");
-dead_cycles:=0;
-update_terminal; {progress report}
-@<Flush the box from memory, showing statistics if requested@>;
-if post_callback_id>0 then
- ret:=run_callback(post_callback_id,'->');
-@<Finish sheet {\sl Sync\TeX} information record@>;
-end;
-
-@ @<Flush the box from memory, showing statistics if requested@>=
-@!stat if (tracing_stats>1)and(pre_callback_id=0) then
- begin print_nl("Memory usage before: ");
-@.Memory usage...@>
- print_int(var_used); print_char("&");
- print_int(dyn_used); print_char(";");
- end;
-tats@/
-flush_node_list(p);
-@!stat if (tracing_stats>1)and(post_callback_id=0) then
- begin print(" after: ");
- print_int(var_used); print_char("&");
- print_int(dyn_used); print_ln;
- end;
-tats
-
-@ @<Ship box |p| out@>=
-if box_dir(p) <> page_direction then
- pdf_warning("\shipout", "\pagedir != \bodydir; \box255 may be placed wrongly on the page.", true, true);
-@<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;
-{Think in upright page/paper coordinates): First preset |pos.h| and |pos.v| to the DVI origin.}
-pos.h := one_true_inch;
-pos.v := cur_page_size.v - one_true_inch;
-box_pos := pos; dvi := pos;
-{Then calculate |cur.h| and |cur.v| within the upright coordinate system
-for the DVI origin depending on the |page_direction|.}
-dvi_direction:=page_direction;
-case box_direction(dvi_direction) of
-dir_TL_,dir_LT_: begin
- cur.h := h_offset;
- cur.v := v_offset;
- end;
-dir_TR_,dir_RT_: begin
- cur.h := cur_page_size.h - page_right_offset - one_true_inch;
- cur.v := v_offset;
- end;
-dir_BL_,dir_LB_: begin
- cur.h := h_offset;
- cur.v := cur_page_size.v - page_bottom_offset - one_true_inch;
- end;
-dir_RB_,dir_BR_: begin
- cur.h := cur_page_size.h - page_right_offset - one_true_inch;
- cur.v := cur_page_size.v - page_bottom_offset - one_true_inch;
- end;
-end;
-{The movement is actually done within the upright page coordinate system.}
-dvi_direction := dir_TL_; {only temporarily for this adjustment}
-synch_pos_with_cur; box_pos := pos; {keep track on page}
-{Then switch to page box coordinate system; do |height(p)| movement.}
-dvi_direction := page_direction;
-cur.h := 0;
-cur.v := height(p);
-synch_pos_with_cur;
-{Now we are at the point on the page where the origin of the page box should go.}
-temp_ptr:=p;
-if type(p)=vlist_node then vlist_out@+else hlist_out;
-dvi_out(eop); incr(total_pages); cur_s:=-1;
-done:
-
-@ Sometimes the user will generate a huge page because other error messages
-are being ignored. Such pages are not output to the \.{dvi} file, since they
-may confuse the printing software.
-
-@<Update the values of |max_h| and |max_v|; but if the page is too large...@>=
-if (height(p)>max_dimen)or@|(depth(p)>max_dimen)or@|
- (height(p)+depth(p)+v_offset>max_dimen)or@|
- (width(p)+h_offset>max_dimen) then
- begin print_err("Huge page cannot be shipped out");
-@.Huge page...@>
- help2("The page just created is more than 18 feet tall or")@/
- ("more than 18 feet wide, so I suspect something went wrong.");
- error;
- if tracing_output<=0 then
- begin begin_diagnostic;
- print_nl("The following box has been deleted:");
-@.The following...deleted@>
- show_box(p);
- end_diagnostic(true);
- end;
- goto done;
- end;
-if height(p)+depth(p)+v_offset>max_v then max_v:=height(p)+depth(p)+v_offset;
-if width(p)+h_offset>max_h then max_h:=width(p)+h_offset
-
-@ At the end of the program, we must finish things off by writing the
-post\-amble. If |total_pages=0|, the \.{DVI} file was never opened.
-If |total_pages>=65536|, the \.{DVI} file will lie. 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 begin
- if callback_id=0 then
- print_nl("No pages of output.")
- else if callback_id>0 then
- res:=run_callback(callback_id,'->');
- end
-@.No pages of output@>
-else begin dvi_out(post); {beginning of the postamble}
- dvi_four(last_bop); last_bop:=dvi_offset+dvi_ptr-5; {|post| location}
- dvi_four(25400000); dvi_four(473628672); {conversion ratio for sp}
- prepare_mag; dvi_four(mag); {magnification factor}
- dvi_four(max_v); dvi_four(max_h);@/
- dvi_out(max_push div 256); dvi_out(max_push mod 256);@/
- dvi_out((total_pages div 256) mod 256); dvi_out(total_pages mod 256);@/
- @<Output the font definitions for all fonts that were used@>;
- dvi_out(post_post); dvi_four(last_bop); dvi_out(id_byte);@/
- k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
- while k>0 do
- begin dvi_out(223); decr(k);
- end;
- @<Empty the last bytes out of |dvi_buf|@>;
- if callback_id=0 then begin
- print_nl("Output written on "); slow_print(output_file_name);
-@.Output written on x@>
- print(" ("); print_int(total_pages); print(" page");
- if total_pages<>1 then print_char("s");
- print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes).");
- end
- else if callback_id>0 then
- res:=run_callback(callback_id,'->');
- b_close(dvi_file);
- end
-
-@ @<Output the font definitions...@>=
-k := max_font_id;
-while k>0 do
- begin if font_used(k) then dvi_font_def(k);
- decr(k);
- end
-
-
-@* \[32a] \pdfTeX\ basic.
-
-Initialize \pdfTeX's parameters to some useful default value.
-Helpful in case one forgets to set them during initex run.
-
-@<Initialize table entries...@>=
-pdf_h_origin := one_inch;
-pdf_v_origin := one_inch;
-pdf_compress_level := 9;
-pdf_objcompresslevel := 0;
-pdf_decimal_digits := 3;
-pdf_image_resolution := 72;
-pdf_minor_version := 4;
-pdf_gamma := 1000;
-pdf_image_gamma := 2200;
-pdf_image_hicolor := 1;
-pdf_image_apply_gamma := 0;
-pdf_px_dimen := one_bp;
-pdf_draftmode := 0;
-
-@ The subroutines define the corresponding macros so we can use them
-in C.
-
-@d flushable(#) == (# = str_ptr - 1)
-
-@d is_valid_char(#) == char_exists(f,#)
-
-@p function get_pdf_compress_level: integer;
-begin
- get_pdf_compress_level := pdf_compress_level;
-end;
-
-function get_nullfont: internal_font_number;
-begin
- get_nullfont := null_font;
-end;
-
-function get_luatexversion: integer;
-begin
- get_luatexversion := luatex_version;
-end;
-
-function get_luatexrevision: str_number;
-begin
- get_luatexrevision := luatex_revision;
-end;
-
-function get_par_shape_ptr: halfword;
-begin
- get_par_shape_ptr := par_shape_ptr;
-end;
-
-function get_escape_char: integer;
-begin
- get_escape_char := escape_char;
-end;
-
-function get_undefined_control_sequence: integer;
-begin
- get_undefined_control_sequence := undefined_control_sequence;
-end;
-
-function get_fontbase: internal_font_number;
-begin
- get_fontbase := font_base;
-end;
-
-function get_nullcs: pointer;
-begin
- get_nullcs := null_cs;
-end;
-
-function get_nullptr: pointer;
-begin
- get_nullptr := null;
-end;
-
-function get_tex_int(code: integer): integer;
-begin
- get_tex_int := int_par(code);
-end;
-
-function get_tex_dimen(code: integer): scaled;
-begin
- get_tex_dimen := dimen_par(code);
-end;
-
-
-function get_x_height(f: internal_font_number): scaled;
-begin
- get_x_height := x_height(f);
-end;
-
-function get_charwidth(f: internal_font_number; c: integer): scaled;
-begin
- if is_valid_char(c) then
- get_charwidth := char_width(f,c)
- else
- get_charwidth := 0;
-end;
-
-function get_charheight(f: internal_font_number; c: integer): scaled;
-begin
- if is_valid_char(c) then
- get_charheight := char_height(f,c)
- else
- get_charheight := 0;
-end;
-
-function get_chardepth(f: internal_font_number; c: integer): scaled;
-begin
- if is_valid_char(c) then
- get_chardepth := char_depth(f,c)
- else
- get_chardepth := 0;
-end;
-
-function get_quad(f: internal_font_number): scaled;
-begin
- get_quad := quad(f);
-end;
-
-function get_slant(f: internal_font_number): scaled;
-begin
- get_slant := slant(f);
-end;
-
-function new_dummy_font: internal_font_number;
-begin
- new_dummy_font := read_font_info(null_cs, "dummy", -1000, -1);
-end;
-
-function get_hash_size: integer;
-begin
- get_hash_size:= hash_size;
-end;
-
-function get_eqtb_size: integer;
-begin
- get_eqtb_size:= eqtb_size;
-end;
-
-function get_hash_base: integer;
-begin
- get_hash_base:= hash_base;
-end;
-
-function get_font_id_base: integer;
-begin
- get_font_id_base:= font_id_base;
-end;
-
-
-function get_cur_font: internal_font_number;
-begin
- get_cur_font:= cur_font;
-end;
-
-procedure set_cur_font (f: internal_font_number);
-var a:small_number;
-begin
- a:=0;
- define(cur_font_loc,data,f);
-end;
-
-function get_current_name: str_number;
-begin
- get_current_name:= name;
-end;
-
-
-@ Helper for debugging purposes
-
-@p procedure short_display_n(@!p, m:integer); {prints highlights of list |p|}
-var i: integer;
-begin
-i := 0;
-font_in_short_display:=null_font;
-if p = null then
- return;
-while p<>null do
- begin if is_char_node(p) then
- begin if p<=max_halfword then
- begin if font(p)<>font_in_short_display then
- begin if not is_valid_font(font(p)) then
- print_char("*")
-@.*\relax@>
- else print_font_identifier(font(p));
- print_char(" "); font_in_short_display:=font(p);
- end;
- print(qo(character(p)));
- end;
- end
- else begin
- if (type(p) = glue_node) or
- (type(p) = disc_node) or
- (type(p) = penalty_node) or
- ((type(p) = kern_node) and (subtype(p) = explicit)) then
- incr(i);
- if i >= m then
- return;
- if (type(p) = disc_node) then begin
- print("|");
- short_display(vlink(pre_break(p)));
- print("|");
- short_display(vlink(post_break(p)));
- print("|");
- end
- else
- @<Print a short indication of the contents of node |p|@>;
- end;
- p:=vlink(p);
- if p = null then
- return;
- end;
- update_terminal;
-end;
-
-@ Sometimes it is neccesary to allocate memory for PDF output that cannot
-be deallocated then, so we use |pdf_mem| for this purpose.
-
-@<Constants...@>=
-@!inf_pdf_mem_size = 10000; {min size of the |pdf_mem| array}
-@!sup_pdf_mem_size = 10000000; {max size of the |pdf_mem| array}
-
-@ @<Glob...@>=
-@!pdf_mem_size: integer;
-@!pdf_mem: ^integer;
-@!pdf_mem_ptr: integer;
-
-@ @<Set init...@>=
-pdf_mem_ptr := 1; {the first word is not used so we can use zero as a value for testing
-whether a pointer to |pdf_mem| is valid}
-pdf_mem_size := inf_pdf_mem_size; {allocated size of |pdf_mem| array}
-
-@ We use |pdf_get_mem| to allocate memory in |pdf_mem|
-
-@p function pdf_get_mem(s: integer): integer; {allocate |s| words in |pdf_mem|}
-var a: integer;
-begin
- if s > sup_pdf_mem_size - pdf_mem_ptr then
- overflow("PDF memory size (pdf_mem_size)", pdf_mem_size);
- if pdf_mem_ptr + s > pdf_mem_size then begin
- a := 0.2 * pdf_mem_size;
- if pdf_mem_ptr + s > pdf_mem_size + a then
- pdf_mem_size := pdf_mem_ptr + s
- else if pdf_mem_size < sup_pdf_mem_size - a then
- pdf_mem_size := pdf_mem_size + a
- else
- pdf_mem_size := sup_pdf_mem_size;
- pdf_mem := xreallocarray(pdf_mem, integer, pdf_mem_size);
- end;
- pdf_get_mem := pdf_mem_ptr;
- pdf_mem_ptr := pdf_mem_ptr + s;
-end;
-
-@* \[32b] \pdfTeX\ output low-level subroutines.
-We use the similiar subroutines to handle the output buffer for
-PDF output. When compress is used, the state of writing to buffer
-is held in |zip_write_state|. We must write the header of PDF
-output file in initialization to ensure that it will be the first
-written bytes.
-
-@<Constants...@>=
-@!pdf_op_buf_size = 16384; {size of the PDF output buffer}
-@!inf_pdf_os_buf_size = 1; {initial value of |pdf_os_buf_size|}
-@!sup_pdf_os_buf_size = 5000000; {arbitrary upper hard limit of |pdf_os_buf_size|}
-@!pdf_os_max_objs = 100; {maximum number of objects in object stream}
-
-@ The following macros are similar as for \.{DVI} buffer handling
-
-@d pdf_offset == (pdf_gone + pdf_ptr) {the file offset of last byte in PDF
-buffer that |pdf_ptr| points to}
-
-@d no_zip == 0 {no \.{ZIP} compression}
-@d zip_writing == 1 {\.{ZIP} compression being used}
-@d zip_finish == 2 {finish \.{ZIP} compression}
-
-@d pdf_quick_out(#) == {output a byte to PDF buffer without checking of
-overflow}
-begin
- pdf_buf[pdf_ptr] := #;
- incr(pdf_ptr);
-end
-
-@d pdf_out(#) == {do the same as |pdf_quick_out| and flush the PDF
-buffer if necessary}
-begin
- pdf_room(1);
- pdf_quick_out(#);
-end
-
-@<Glob...@>=
-@!pdf_file: byte_file; {the PDF output file}
-@!pdf_buf: ^real_eight_bits; {pointer to the PDF output buffer or PDF object stream buffer}
-@!pdf_buf_size: integer; {end of PDF output buffer or PDF object stream buffer}
-@!pdf_ptr: longinteger; {pointer to the first unused byte in the PDF buffer or object stream buffer}
-@!pdf_op_buf: ^real_eight_bits; {the PDF output buffer}
-@!pdf_os_buf: ^real_eight_bits; {the PDF object stream buffer}
-@!pdf_os_buf_size: integer; {current size of the PDF object stream buffer, grows dynamically}
-@!pdf_os_objnum: ^integer; {array of object numbers within object stream}
-@!pdf_os_objoff: ^integer; {array of object offsets within object stream}
-@!pdf_os_objidx: pointer; {pointer into |pdf_os_objnum| and |pdf_os_objoff|}
-@!pdf_os_cntr: integer; {counter for object stream objects}
-@!pdf_op_ptr: integer; {store for PDF buffer |pdf_ptr| while inside object streams}
-@!pdf_os_ptr: integer; {store for object stream |pdf_ptr| while outside object streams}
-@!pdf_os_mode: boolean; {true if producing object stream}
-@!pdf_os_enable: boolean; {true if object streams are globally enabled}
-@!pdf_os_cur_objnum: integer; {number of current object stream object}
-@!pdf_gone: longinteger; {number of bytes that were flushed to output}
-@!pdf_save_offset: longinteger; {to save |pdf_offset|}
-@!zip_write_state: integer; {which state of compression we are in}
-@!fixed_pdf_minor_version: integer; {fixed minor part of the PDF version}
-@!fixed_pdf_minor_version_set: boolean; {flag if the PDF version has been set}
-@!fixed_pdf_objcompresslevel: integer; {fixed level for activating PDF object streams}
-@!fixed_pdfoutput: integer; {fixed output format}
-@!fixed_pdfoutput_set: boolean; {|fixed_pdfoutput| has been set?}
-@!fixed_gamma: integer;
-@!fixed_image_gamma: integer;
-@!fixed_image_hicolor: boolean;
-@!fixed_image_apply_gamma: integer;
-@!fixed_pdf_draftmode: integer; {fixed \\pdfdraftmode}
-@!pdf_page_group_val: integer;
-@!epochseconds: integer;
-@!microseconds: integer;
-@!page_divert_val: integer;
-
-@ @<Set init...@>=
-pdf_gone := 0;
-pdf_os_mode := false;
-pdf_ptr := 0;
-pdf_op_ptr := 0;
-pdf_os_ptr := 0;
-pdf_os_cur_objnum := 0;
-pdf_os_cntr := 0;
-pdf_buf_size := pdf_op_buf_size;
-pdf_os_buf_size := inf_pdf_os_buf_size;
-pdf_buf := pdf_op_buf;
-pdf_seek_write_length := false;
-zip_write_state := no_zip;
-fixed_pdf_minor_version_set := false;
-fixed_pdfoutput_set := false;
-pdf_page_group_val := -1;
-page_divert_val := 0;
-
-@ @p
-function fix_int(val, min, max: integer): integer;
-begin
- if val < min then
- fix_int := min
- else if val > max then
- fix_int := max
- else
- fix_int := val;
-end;
-
-@ This ensures that |pdfminorversion| is set only before any bytes have
-been written to the generated \.{PDF} file. Here also all variables for
-\.{PDF} output are initialized, the \.{PDF} file is opened by |ensure_pdf_open|,
-and the \.{PDF} header is written.
-
-@p procedure check_pdfminorversion;
-begin
- fix_pdfoutput;
- pdfassert(fixed_pdfoutput > 0);
- if not fixed_pdf_minor_version_set then begin
- fixed_pdf_minor_version_set := true;
- @<Initialize variables for \.{PDF} output@>;
- @<Write \.{PDF} header@>;
- end
- else begin
- @<Check that variables for \.{PDF} output are unchanged@>;
- end;
- if fixed_pdf_draftmode <> 0 then begin
- pdf_compress_level := 0; {re-fix it, might have been changed inbetween}
- fixed_pdf_objcompresslevel := 0;
- end;
-end;
-
-@ @<Initialize variables for \.{PDF} output@>=
-prepare_mag;
-if (pdf_minor_version < 0) or (pdf_minor_version > 9) then begin
- print_err("LuaTeX error (illegal pdfminorversion)");
- print_ln;
- help2 ("The pdfminorversion must be between 0 and 9.")@/
- ("I changed this to 4.");
- int_error (pdf_minor_version);
- pdf_minor_version := 4;
-end;
-fixed_pdf_minor_version := pdf_minor_version;
-fixed_decimal_digits := fix_int(pdf_decimal_digits, 0, 4);
-fixed_gamma := fix_int(pdf_gamma, 0, 1000000);
-fixed_image_gamma := fix_int(pdf_image_gamma, 0, 1000000);
-fixed_image_hicolor := fix_int(pdf_image_hicolor, 0, 1);
-fixed_image_apply_gamma := fix_int(pdf_image_apply_gamma, 0, 1);
-fixed_pdf_objcompresslevel := fix_int(pdf_objcompresslevel, 0, 3);
-fixed_pdf_draftmode := fix_int(pdf_draftmode, 0, 1);
-fixed_inclusion_copy_font:= fix_int(pdf_inclusion_copy_font, 0, 1);
-fixed_replace_font := fix_int(pdf_replace_font, 0, 1);
-fixed_pk_resolution := fix_int(pdf_pk_resolution, 72, 8000);
-if (fixed_pdf_minor_version >= 5) and (fixed_pdf_objcompresslevel > 0) then
- pdf_os_enable := true
-else begin
- if fixed_pdf_objcompresslevel > 0 then begin
- pdf_warning("Object streams",
- "\pdfobjcompresslevel > 0 requires \pdfminorversion > 4. Object streams disabled now.", true, true);
- fixed_pdf_objcompresslevel := 0;
- end;
- pdf_os_enable := false;
-end;
-if pdf_pk_resolution = 0 then {if not set from format file or by user}
- pdf_pk_resolution := pk_dpi; {take it from \.{texmf.cnf}}
-pk_scale_factor :=
- divide_scaled(72, fixed_pk_resolution, 5 + fixed_decimal_digits);
-if not callback_defined(read_pk_file_callback) then begin
- if pdf_pk_mode <> null then begin
- kpseinitprog('PDFTEX', fixed_pk_resolution,
- makecstring(tokens_to_string(pdf_pk_mode)), nil);
- flush_string;
- end else
- kpseinitprog('PDFTEX', fixed_pk_resolution, nil, nil);
- if not kpsevarvalue('MKTEXPK') then
- kpsesetprogramenabled (kpsepkformat, 1, kpsesrccmdline);
- end;
-set_job_id(year, month, day, time);
-if (pdf_unique_resname > 0) and (pdf_resname_prefix = 0) then
- pdf_resname_prefix := get_resname_prefix;
-pdf_page_init
-
-@ @<Check that variables for \.{PDF} output are unchanged@>=
-if fixed_pdf_minor_version <> pdf_minor_version then
- pdf_error("setup",
- "\pdfminorversion cannot be changed after data is written to the PDF file");
-if fixed_pdf_draftmode <> pdf_draftmode then
- pdf_error("setup",
- "\pdfdraftmode cannot be changed after data is written to the PDF file");
-
-@ @<Write \.{PDF} header@>=
-ensure_pdf_open;
-pdf_print("%PDF-1.");
-pdf_print_int_ln(fixed_pdf_minor_version);
-pdf_print("%");
-pdf_out(208); {'P' + 128}
-pdf_out(212); {'T' + 128}
-pdf_out(197); {'E' + 128}
-pdf_out(216); {'X' + 128}
-pdf_print_nl;
-
-@ Checks that we have a name for the generated PDF file and that it's open.
-
-@p procedure ensure_pdf_open;
-begin
- if output_file_name <> 0 then
- return;
- if job_name = 0 then
- open_log_file;
- pack_job_name('.pdf');
- if fixed_pdf_draftmode = 0 then
- while not lua_b_open_out(pdf_file) do
- prompt_file_name('file name for output','.pdf');
- pdf_file:=name_file_pointer;
- output_file_name := b_make_name_string(pdf_file);
-end;
-
-@ The PDF buffer is flushed by calling |pdf_flush|, which checks the
-variable |zip_write_state| and will compress the buffer before flushing if
-neccesary. We call |pdf_begin_stream| to begin a stream and |pdf_end_stream|
-to finish it. The stream contents will be compressed if compression is turn on.
-
-@p procedure pdf_flush; {flush out the |pdf_buf|}
-var saved_pdf_gone : longinteger;
-begin
- if not pdf_os_mode then begin
- saved_pdf_gone := pdf_gone;
- case zip_write_state of
- no_zip: if pdf_ptr > 0 then begin
- if fixed_pdf_draftmode = 0 then write_pdf(0, pdf_ptr - 1);
- pdf_gone := pdf_gone + pdf_ptr;
- pdf_last_byte := pdf_buf[pdf_ptr - 1];
- end;
- zip_writing:
- if fixed_pdf_draftmode = 0 then write_zip(false);
- zip_finish: begin
- if fixed_pdf_draftmode = 0 then write_zip(true);
- zip_write_state := no_zip;
- end;
- end;
- pdf_ptr := 0;
- if saved_pdf_gone > pdf_gone then
- pdf_error("file size", "File size exceeds architectural limits (pdf_gone wraps around)");
- end;
-end;
-
-procedure pdf_begin_stream; {begin a stream}
-begin
- pdf_print_ln("/Length ");
- pdf_seek_write_length := true; {fill in length at |pdf_end_stream| call}
- pdf_stream_length_offset := pdf_offset - 11;
- pdf_stream_length := 0;
- pdf_last_byte := 0;
- if pdf_compress_level > 0 then begin
- pdf_print_ln("/Filter /FlateDecode");
- pdf_print_ln(">>");
- pdf_print_ln("stream");
- pdf_flush;
- zip_write_state := zip_writing;
- end
- else begin
- pdf_print_ln(">>");
- pdf_print_ln("stream");
- pdf_save_offset := pdf_offset;
- end;
-end;
-
-procedure pdf_end_stream; {end a stream}
-begin
- if zip_write_state = zip_writing then
- zip_write_state := zip_finish
- else
- pdf_stream_length := pdf_offset - pdf_save_offset;
- pdf_flush;
- if pdf_seek_write_length then
- write_stream_length(pdf_stream_length, pdf_stream_length_offset);
- pdf_seek_write_length := false;
- if pdf_last_byte <> pdf_new_line_char then
- pdf_out(pdf_new_line_char);
- pdf_print_ln("endstream");
- pdf_end_obj;
-end;
-
-@ Basic printing procedures for PDF output are very similiar to \TeX\ basic
-printing ones but the output is going to PDF buffer. Subroutines with
-suffix |_ln| append a new-line character to the PDF output.
-
-@d pdf_new_line_char == 10 {new-line character for UNIX platforms}
-
-@d pdf_print_nl == {output a new-line character to PDF buffer}
-pdf_out(pdf_new_line_char)
-
-@d pdf_print_ln(#) == {print out a string to PDF buffer followed by
-a new-line character}
-begin
- pdf_print(#);
- pdf_print_nl;
-end
-
-@d pdf_print_int_ln(#) == {print out an integer to PDF buffer followed by
-a new-line character}
-begin
- pdf_print_int(#);
- pdf_print_nl;
-end
-
-@<Declare procedures that need to be declared forward for \pdfTeX@>=
-procedure pdf_error(t, p: str_number);
-begin
- normalize_selector;
- print_err("LuaTeX error");
- if t <> 0 then begin
- print(" (");
- print(t);
- print(")");
- end;
- print(": "); print(p);
- succumb;
-end;
-
-procedure pdf_warning(t, p: str_number; prepend_nl, append_nl: boolean);
-begin
- if interaction = error_stop_mode then
- wake_up_terminal;
- if prepend_nl then
- print_ln;
- print("LuaTeX warning");
- if t <> 0 then begin
- print(" (");
- print(t);
- print(")");
- end;
- print(": "); print(p);
- if append_nl then
- print_ln;
- if history=spotless then history:=warning_issued;
-end;
-
-procedure pdf_os_get_os_buf(s: integer); {check that |s| bytes more
-fit into |pdf_os_buf|; increase it if required}
-var a: integer;
-begin
- if s > sup_pdf_os_buf_size - pdf_ptr then
- overflow("PDF object stream buffer", pdf_os_buf_size);
- if pdf_ptr + s > pdf_os_buf_size then begin
- a := 0.2 * pdf_os_buf_size;
- if pdf_ptr + s > pdf_os_buf_size + a then
- pdf_os_buf_size := pdf_ptr + s
- else if pdf_os_buf_size < sup_pdf_os_buf_size - a then
- pdf_os_buf_size := pdf_os_buf_size + a
- else
- pdf_os_buf_size := sup_pdf_os_buf_size;
- pdf_os_buf := xreallocarray(pdf_os_buf, real_eight_bits, pdf_os_buf_size);
- pdf_buf := pdf_os_buf;
- pdf_buf_size := pdf_os_buf_size;
- end;
-end;
-
-procedure pdf_room(n: integer); {make sure that there are at least |n| bytes free in PDF buffer}
-begin
- if pdf_os_mode and (n + pdf_ptr > pdf_buf_size) then
- pdf_os_get_os_buf(n)
- else if not pdf_os_mode and (n > pdf_buf_size) then
- overflow("PDF output buffer", pdf_op_buf_size)
- else if not pdf_os_mode and (n + pdf_ptr > pdf_buf_size) then
- pdf_flush;
-end;
-
-procedure remove_last_space;
-begin
- if (pdf_ptr > 0) and (pdf_buf[pdf_ptr - 1] = 32) then
- decr(pdf_ptr);
-end;
-
-function str_in_str(s, r: str_number; i: integer): boolean;
- {test equality of strings}
-label not_found; {loop exit}
-var j, k: pool_pointer; {running indices}
-begin
- str_in_str := false;
- if length(s) < i + length(r) then
- return;
- j := i + str_start_macro(s);
- k := str_start_macro(r);
- while (j < str_start_macro(s + 1)) and (k < str_start_macro(r + 1)) do begin
- if str_pool[j] <> str_pool[k] then
- return;
- incr(j);
- incr(k);
- end;
- str_in_str := true;
-end;
-
-function tokens_to_string(p: pointer): str_number; {return a string from tokens
-list}
-var old_setting:integer;
-begin
- if selector = new_string then
- pdf_error("tokens", "tokens_to_string() called while selector = new_string");
- old_setting:=selector; selector:=new_string;
- show_token_list(link(p),null,pool_size-pool_ptr);
- selector:=old_setting;
- last_tokens_string := make_string;
- tokens_to_string := last_tokens_string;
-end;
-
-
-@ To print |scaled| value to PDF output we need some subroutines to ensure
-accurary.
-
-@d max_integer == @"7FFFFFFF {$2^{31}-1$}
-@d call_func(#) == begin if # <> 0 then do_nothing end
-
-
-@<Glob...@>=
-@!one_hundred_inch: scaled; {scaled value corresponds to 100in}
-@!one_inch: scaled; {scaled value corresponds to 1in (rounded!)}
-@!one_true_inch: scaled; {scaled value corresponds to 1truein (rounded!)}
-@!one_hundred_bp: scaled; {scaled value corresponds to 100bp}
-@!one_bp: scaled; {scaled value corresponds to 1bp (rounded!)}
-@!ten_pow: array[0..9] of integer; {$10^0..10^9$}
-
-@ @<Set init...@>=
-one_hundred_inch := 7227 * 65536; {exact, 473628672}
-one_inch := (one_hundred_inch + 50) div 100; {rounded to 4736287}
-one_true_inch := one_inch;
-one_hundred_bp := one_hundred_inch div 72; {exact, 6578176}
-one_bp := (one_hundred_bp + 50) div 100; {rounded to 65782}
-ten_pow[0] := 1;
-for i := 1 to 9 do
- ten_pow[i] := 10*ten_pow[i - 1];
-
-@ The function |divide_scaled| divides |s| by |m| using |dd| decimal
-digits of precision. It is defined in C because it is a good candidate
-for optimizations that are not possible in pascal.
-
-@<Declare procedures that need to be declared forward for \pdfTeX@>=
-function round_xn_over_d(@!x:scaled; @!n,@!d:integer):scaled;
-var positive:boolean; {was |x>=0|?}
-@!t,@!u,@!v:nonnegative_integer; {intermediate quantities}
-begin if x>=0 then positive:=true
-else begin negate(x); positive:=false;
- end;
-t:=(x mod @'100000)*n;
-u:=(x div @'100000)*n+(t div @'100000);
-v:=(u mod d)*@'100000 + (t mod @'100000);
-if u div d>=@'100000 then arith_error:=true
-else u:=@'100000*(u div d) + (v div d);
-v := v mod d;
-if 2*v >= d then
- incr(u);
-if positive then
- round_xn_over_d := u
-else
- round_xn_over_d := -u;
-end;
-
-@ @p
-procedure pdf_print_bp(s: scaled); {print scaled as |bp|}
-begin
- pdf_print_real(divide_scaled(s, one_hundred_bp, fixed_decimal_digits + 2),
- fixed_decimal_digits);
-end;
-
-procedure pdf_print_mag_bp(s: scaled); {take |mag| into account}
-begin
- prepare_mag;
- if mag <> 1000 then
- s := round_xn_over_d(s, mag, 1000);
- pdf_print_bp(s);
-end;
-
-@* \[32c] PDF page description.
-
-@<Glob...@>=
-@!fixed_pk_resolution: integer;
-@!fixed_decimal_digits: integer;
-@!fixed_gen_tounicode: integer;
-@!fixed_inclusion_copy_font: integer;
-@!fixed_replace_font: integer;
-@!pk_scale_factor: integer;
-@!pdf_output_option: integer;
-@!pdf_output_value: integer;
-@!pdf_draftmode_option: integer;
-@!pdf_draftmode_value: integer;
-
-@ @p
-procedure pdf_use_font(f: internal_font_number; fontnum: integer);
-{mark |f| as a used font; set |font_used(f)|, |pdf_font_size(f)| and |pdf_font_num(f)|}
-begin
- set_pdf_font_size(f,font_size(f));
- set_font_used(f,true);
- pdfassert((fontnum > 0) or ((fontnum < 0) and (pdf_font_num(-fontnum) > 0)));
- set_pdf_font_num(f,fontnum);
- if pdf_move_chars > 0 then begin
- pdf_warning(0,"Primitive \pdfmovechars is obsolete.",true, true);
- pdf_move_chars := 0; {warn only once}
- end;
-end;
-
-@ To set PDF font we need to find out fonts with the same name, because \TeX\
-can load the same font several times for various sizes. For such fonts we
-define only one font resource. The array |pdf_font_num| holds the object
-number of font resource. A negative value of an entry of |pdf_font_num|
-indicates that the corresponding font shares the font resource with the font
-
-@d pdf_print_resname_prefix ==
-if pdf_resname_prefix <> 0 then
- pdf_print(pdf_resname_prefix)
-
-@p procedure pdf_init_font(f: internal_font_number);
-{create a font object}
-var k, b: internal_font_number;
- i: integer;
-begin
- pdfassert(not font_used(f));
-
- {if |f| is auto expanded then ensure the base font is initialized}
- if pdf_font_auto_expand(f) and (pdf_font_blink(f) <> null_font) then begin
- b := pdf_font_blink(f);
- {TODO: reinstate this check. disabled because wide fonts font have fmentries}
- if false and (not hasfmentry(b)) then
- pdf_error("font expansion", "auto expansion is only possible with scalable fonts");
- if not font_used(b) then
- pdf_init_font(b);
- set_font_map(f,font_map(b));
- end;
-
- {check whether |f| can share the font object with some |k|: we have 2 cases
- here: 1) |f| and |k| have the same tfm name (so they have been loaded at
- different sizes, eg 'cmr10' and 'cmr10 at 11pt'); 2) |f| has been auto
- expanded from |k|}
- if hasfmentry(f) or true then begin
- i := head_tab[obj_type_font];
- while i <> 0 do begin
- k := obj_info(i);
- if font_shareable(f,k) then
- begin
- pdfassert(pdf_font_num(k) <> 0);
- if pdf_font_num(k) < 0 then
- pdf_use_font(f, pdf_font_num(k))
- else
- pdf_use_font(f, -k);
- return;
- end;
- i := obj_link(i);
- end;
- end;
-
- {create a new font object for |f|}
- pdf_create_obj(obj_type_font, f);
- pdf_use_font(f, obj_ptr);
-end;
-
-procedure pdf_init_font_cur_val;
-begin
- pdf_init_font(cur_val);
-end;
-
-function pdf_set_font(f: internal_font_number): internal_font_number;
-{set the actual font on PDF page}
-label found, found1;
-var p: pointer;
- k: internal_font_number;
-begin
- if not font_used(f) then
- pdf_init_font(f);
- set_ff(f); {set |ff| to the tfm number of the font sharing the font object
- with |f|; |ff| is either |f| or some font with the same tfm name
- at different size and/or expansion}
- k := ff;
- p := pdf_font_list;
- while p <> null do begin
- set_ff(info(p));
- if ff = k then
- goto found;
- p := link(p);
- end;
- pdf_append_list(f)(pdf_font_list); {|f| not found in |pdf_font_list|, append it now}
-found:
- pdf_set_font := k;
-end;
-
-@ @p
-procedure literal(s: str_number; literal_mode: integer; warn: boolean);
-var j: pool_pointer; {current character code position}
-begin
- if s>string_offset then begin { needed for |out_save| }
- j:=str_start_macro(s);
- if literal_mode = scan_special then begin
- if not (str_in_str(s, "PDF:", 0) or str_in_str(s, "pdf:", 0)) then begin
- if warn and not (str_in_str(s, "SRC:", 0)
- or str_in_str(s, "src:", 0)
- or (length(s) = 0)) then
- print_nl("Non-PDF special ignored!");
- return;
- end;
- j := j + length("PDF:");
- if str_in_str(s, "direct:", length("PDF:")) then begin
- j := j + length("direct:");
- literal_mode := direct_always; end
- else if str_in_str(s, "page:", length("PDF:")) then begin
- j := j + length("page:");
- literal_mode := direct_page; end
- else
- literal_mode := set_origin;
- end;
- end;
- case literal_mode of
- set_origin: begin
- pdf_goto_pagemode;
- synch_pos_with_cur;
- pdf_set_pos(pos.h, pos.v);
- end;
- direct_page:
- pdf_goto_pagemode;
- direct_always:
- pdf_end_string_nl;
- othercases confusion("literal1")
- endcases;
- if s>string_offset then
- while j<str_start_macro(s+1) do begin
- pdf_out(str_pool[j]);
- incr(j);
- end
- else
- pdf_out(s);
- pdf_print_nl;
-end;
-
-procedure latelua(s: pointer; r: pointer);
-var b: pool_pointer; {current character code position}
-begin
- b := pool_ptr;
- luacall(s,r);
- if b<pool_ptr then begin
- pdf_goto_pagemode;
- while b<pool_ptr do begin
- pdf_out(str_pool[b]);
- incr(b);
- end;
- pdf_print_nl;
- end;
-end;
-
-@* \[32d] The cross-reference table.
-
-The cross-reference table |obj_tab| is an array of |obj_tab_size| of
-|obj_entry|. Each entry contains five integer fields and represents an object
-in PDF file whose object number is the index of this entry in |obj_tab|.
-Objects in |obj_tab| maybe linked into list; objects in such a linked list have
-the same type.
-
-@<Types...@>=
-@!obj_entry = record@;@/
- int0, int1: integer;
- int2: longinteger;
- int3, int4: integer;
-end;
-
-@ The first field contains information representing identifier of this object.
-It is usally a number for most of object types, but it may be a string number
-for named destination or named thread.
-
-The second field of |obj_entry| contains link to the next
-object in |obj_tab| if this object is linked in a list.
-
-The third field holds the byte offset of the object in the output PDF file,
-or its byte offset within an object stream. As long as the object is not
-written, this field is used for flags about the write status of the object;
-then it has a negative value.
-
-The fourth field holds the object number of the object stream, into which
-the object is included.
-
-The last field usually represents the pointer to some auxiliary data
-structure depending on the object type; however it may be used as a counter as
-well.
-
-@d obj_info(#) == obj_tab[#].int0 {information representing identifier of this object}
-@d obj_link(#) == obj_tab[#].int1 {link to the next entry in linked list}
-@d obj_offset(#) == obj_tab[#].int2 {negative (flags), or byte offset for this object in PDF output file, or object stream number for this object}
-@d obj_os_idx(#) == obj_tab[#].int3 {index of this object in object stream}
-@d obj_aux(#) == obj_tab[#].int4 {auxiliary pointer}
-
-@d set_obj_fresh(#) == obj_offset(#) := -2
-@d set_obj_scheduled(#) == if intcast(obj_offset(#)) = -2 then obj_offset(#) := -1
-@d is_obj_scheduled(#) == (intcast(obj_offset(#)) > -2)
-@d is_obj_written(#) == (intcast(obj_offset(#)) > -1)
-
-@# {types of objects}
-@d obj_type_others == 0 {objects which are not linked in any list}
-@d obj_type_page == 1 {index of linked list of Page objects}
-@d obj_type_font == 2 {index of linked list of Fonts objects}
-@d obj_type_outline == 3 {index of linked list of outline objects}
-@d obj_type_dest == 4 {index of linked list of destination objects}
-@d obj_type_obj == 5 {index of linked list of raw objects}
-@d obj_type_xform == 6 {index of linked list of XObject forms}
-@d obj_type_ximage == 7 {index of linked list of XObject image}
-@d obj_type_thread == 8 {index of linked list of num article threads}
-@d head_tab_max == obj_type_thread {max index of |head_tab|}
-
-@# {max number of kids for balanced trees}
-@d name_tree_kids_max == 6 {max number of kids of node of name tree for
-name destinations}
-
-@# {when a whatsit node representing annotation is created, words |1..3| are
-width, height and depth of this annotation; after shipping out words |1..4|
-are rectangle specification of annotation. For whatsit node representing
-destination |pdf_ann_left| and |pdf_ann_top| are used for some types of destinations}
-
-@# {coordinates of destinations/threads/annotations (in whatsit node)}
-@d pdf_ann_left(#) == vmem(# + 2).sc
-@d pdf_ann_top(#) == vmem(# + 3).sc
-@d pdf_ann_right(#) == vmem(# + 4).sc
-@d pdf_ann_bottom(#) == vmem(# + 5).sc
-
-@# {dimension of destinations/threads/annotations (in whatsit node)}
-@d pdf_width(#) == vmem(# + 2).sc
-@d pdf_height(#) == vmem(# + 3).sc
-@d pdf_depth(#) == vmem(# + 4).sc
-
-@# {data structure for \.{\\pdfliteral}}
-@d pdf_literal_data(#) == vlink(#+2) {data}
-@d pdf_literal_mode(#) == type(#+2) {mode of resetting the text matrix
- while writing data to the page stream}
-@d pdf_literal_type(#) == subtype(#+2) {indicates whether data is a |str_number| or
- something else}
-@# {modes of setting the current transformation matrix (CTM)}
-@d set_origin == 0 {end text (ET) if needed, set CTM to current point}
-@d direct_page == 1 {end text (ET) if needed, but don't change the CTM}
-@d direct_always == 2 {don't end text, don't change the CTM}
-@d scan_special == 3 {look into special text}
-
-@# {data structure for \.{\\pdfcolorstack}}
-@d pdf_colorstack_stack(#) == vlink(#+2) {stack number}
-@d pdf_colorstack_cmd(#) == vinfo(#+2) {command: set, push, pop, current}
-@d pdf_colorstack_data(#) == vlink(#+3) {data}
-
-@# {color stack commands}
-@d colorstack_set == 0
-@d colorstack_push == 1
-@d colorstack_data == 1 { last value where data field is set }
-@d colorstack_pop == 2
-@d colorstack_current == 3
-
-@# {data structure for \.{\\pdfsetmatrix}}
-@d pdf_setmatrix_data(#) == vlink(#+2) {data}
-
-@# {data structure for \.{\\pdfsave}}
-
-@# {data structure for \.{\\pdfrestore}}
-
-@# {data structure for \.{\\latelua}}
-@d late_lua_data == write_tokens {data}
-@d late_lua_name(#) == vlink(#+3) {name}
-
-@# {data structure for \.{\\pdfobj} and \.{\\pdfrefobj}}
-@d pdf_obj_objnum(#) == vinfo(# + 2) {number of the raw object}
-@d obj_data_ptr == obj_aux {pointer to |pdf_mem|}
-@d pdfmem_obj_size == 4 {size of memory in |pdf_mem| which |obj_data_ptr| holds}
-@d obj_obj_data(#) == pdf_mem[obj_data_ptr(#) + 0] {object data}
-@d obj_obj_is_stream(#) == pdf_mem[obj_data_ptr(#) + 1] {will this object
- be written as a stream instead of a dictionary?}
-@d obj_obj_stream_attr(#) == pdf_mem[obj_data_ptr(#) + 2] {additional
- object attributes for streams}
-@d obj_obj_is_file(#) == pdf_mem[obj_data_ptr(#) + 3] {data should be
- read from an external file?}
-
-@# {data structure for \.{\\pdfxform} and \.{\\pdfrefxform}}
-@d pdfmem_xform_size == 6 {size of memory in |pdf_mem| which
- |obj_data_ptr| holds}
-
-@d pdf_xform_objnum(#) == vinfo(# + 4) {object number}
-@d obj_xform_width(#) == pdf_mem[obj_data_ptr(#) + 0]
-@d obj_xform_height(#) == pdf_mem[obj_data_ptr(#) + 1]
-@d obj_xform_depth(#) == pdf_mem[obj_data_ptr(#) + 2]
-@d obj_xform_box(#) == pdf_mem[obj_data_ptr(#) + 3] {this field holds
- pointer to the corresponding box}
-@d obj_xform_attr(#) == pdf_mem[obj_data_ptr(#) + 4] {additional xform
- attributes}
-@d obj_xform_resources(#) == pdf_mem[obj_data_ptr(#) + 5] {additional xform
- Resources}
-
-@# {data structure for \.{\\pdfximage} and \.{\\pdfrefximage}}
-@d pdf_ximage_idx(#) == vinfo(# + 5) {image index in array}
-
-@# {data structure of annotations; words 1..4 represent the coordinates of
- the annotation}
-@d obj_annot_ptr == obj_aux {pointer to corresponding whatsit node}
-@d pdf_annot_data(#) == vinfo(# + 6) {raw data of general annotations}
-@d pdf_link_attr(#) == vinfo(# + 6) {attributes of link annotations}
-@d pdf_link_action(#) == vlink(# + 6) {pointer to action structure}
-@d pdf_annot_objnum(#) == vmem(# + 7).int {object number of corresponding object}
-@d pdf_link_objnum(#) == vmem(# + 7).int {object number of corresponding object}
-
-@# {types of actions}
-@d pdf_action_page == 0 {GoTo action}
-@d pdf_action_goto == 1 {GoTo action}
-@d pdf_action_thread == 2 {Thread action}
-@d pdf_action_user == 3 {user-defined action}
-
-@# {data structure of actions}
-@d pdf_action_type(#) == type(#+1) {action type}
-@d pdf_action_named_id(#) == subtype(#+1) {identifier is type of name}
-@d pdf_action_id(#) == vlink(#+1) {destination/thread name identifier}
-@d pdf_action_file(#) == vinfo(# + 2) {file name for external action}
-@d pdf_action_new_window(#) == vlink(# + 2) {open a new window?}
-@d pdf_action_tokens(#) == vinfo(# + 3) {specification of GoTo page or user action}
-@d pdf_action_refcount(#) == vlink(# + 3) {counter of references to this action}
-
-@# {data structure of outlines; it's not able to write out outline entries
-before all outline entries are defined, so memory allocated for outline
-entries can't not be deallocated and will stay in memory. For this reason we
-will store data of outline entries in |pdf_mem| instead of |mem|}
-@d pdfmem_outline_size == 8 {size of memory in |pdf_mem| which
- |obj_outline_ptr| points to}
-@d obj_outline_count == obj_info{count of all opened children}
-@d obj_outline_ptr == obj_aux {pointer to |pdf_mem|}
-@d obj_outline_title(#) == pdf_mem[obj_outline_ptr(#)]
-@d obj_outline_parent(#) == pdf_mem[obj_outline_ptr(#) + 1]
-@d obj_outline_prev(#) == pdf_mem[obj_outline_ptr(#) + 2]
-@d obj_outline_next(#) == pdf_mem[obj_outline_ptr(#) + 3]
-@d obj_outline_first(#) == pdf_mem[obj_outline_ptr(#) + 4]
-@d obj_outline_last(#) == pdf_mem[obj_outline_ptr(#) + 5]
-@d obj_outline_action_objnum(#) == pdf_mem[obj_outline_ptr(#) + 6] {object number of
-action}
-@d obj_outline_attr(#) == pdf_mem[obj_outline_ptr(#) + 7]
-
-@# {types of destinations}
-@d pdf_dest_xyz == 0
-@d pdf_dest_fit == 1
-@d pdf_dest_fith == 2
-@d pdf_dest_fitv == 3
-@d pdf_dest_fitb == 4
-@d pdf_dest_fitbh == 5
-@d pdf_dest_fitbv == 6
-@d pdf_dest_fitr == 7
-
-@# {data structure of destinations}
-@d obj_dest_ptr == obj_aux {pointer to |pdf_dest_node|}
-@d pdf_dest_type(#) == type(# + 6) {type of destination}
-@d pdf_dest_named_id(#) == subtype(# + 6) {is named identifier?}
-@d pdf_dest_id(#) == vlink(# + 6) {destination identifier}
-@d pdf_dest_xyz_zoom(#) == vinfo(# + 7) {zoom factor for |destxyz| destination}
-@d pdf_dest_objnum(#) == vlink(# + 7) {object number of corresponding
-object}
-
-@# {data structure of threads; words 1..4 represent the coordinates of the
- corners}
-@d pdf_thread_named_id(#) == subtype(# + 6) {is a named identifier}
-@d pdf_thread_id(#) == vlink(# + 6) {thread identifier}
-@d pdf_thread_attr(#) == vinfo(# + 7) {attributes of thread}
-@d obj_thread_first == obj_aux {pointer to the first bead}
-
-@# {data structure of beads}
-@d pdfmem_bead_size == 5 {size of memory in |pdf_mem| which
- |obj_bead_ptr| points to}
-@d obj_bead_ptr == obj_aux {pointer to |pdf_mem|}
-@d obj_bead_rect(#) == pdf_mem[obj_bead_ptr(#)]
-@d obj_bead_page(#) == pdf_mem[obj_bead_ptr(#) + 1]
-@d obj_bead_next(#) == pdf_mem[obj_bead_ptr(#) + 2]
-@d obj_bead_prev(#) == pdf_mem[obj_bead_ptr(#) + 3]
-@d obj_bead_attr(#) == pdf_mem[obj_bead_ptr(#) + 4]
-@d obj_bead_data == obj_bead_rect {pointer to the corresponding
-whatsit node; |obj_bead_rect| is needed only when the bead rectangle has
-been written out and after that |obj_bead_data| is not needed any more
-so we can use this field for both}
-
-@<Constants...@>=
-@!inf_obj_tab_size = 1000; {min size of the cross-reference table for PDF output}
-@!sup_obj_tab_size = 8388607; {max size of the cross-reference table for PDF output}
-@!inf_dest_names_size = 1000; {min size of the destination names table for PDF output}
-@!sup_dest_names_size = 131072; {max size of the destination names table for PDF output}
-@!inf_pk_dpi = 72; {min PK pixel density value from \.{texmf.cnf}}
-@!sup_pk_dpi = 8000; {max PK pixel density value from \.{texmf.cnf}}
-@!pdf_objtype_max = head_tab_max;
-
-@ @<Glob...@>=
-@!obj_tab_size:integer;
-@!obj_tab:^obj_entry;
-@!head_tab: array[1..head_tab_max] of integer;
-@!pages_tail: integer;
-@!obj_ptr: integer; {user objects counter}
-@!sys_obj_ptr: integer; {system objects counter, including object streams}
-@!pdf_last_pages: integer; {pointer to most recently generated pages object}
-@!pdf_last_page: integer; {pointer to most recently generated page object}
-@!pdf_last_stream: integer; {pointer to most recently generated stream}
-@!pdf_stream_length: longinteger; {length of most recently generated stream}
-@!pdf_stream_length_offset: longinteger; {file offset of the last stream length}
-@!pdf_seek_write_length: boolean; {flag whether to seek back and write \.{/Length}}
-@!pdf_last_byte: integer; {byte most recently written to PDF file; for \.{endstream} in new line}
-@!pdf_append_list_arg: integer; {for use with |pdf_append_list|}
-@!ff: integer; {for use with |set_ff|}
-@!pdf_box_spec_media: integer;
-@!pdf_box_spec_crop: integer;
-@!pdf_box_spec_bleed: integer;
-@!pdf_box_spec_trim: integer;
-@!pdf_box_spec_art: integer;
-
-@ @<Set init...@>=
-obj_ptr := 0;
-sys_obj_ptr := 0;
-obj_tab_size := inf_obj_tab_size; {allocated size of |obj_tab| array}
-dest_names_size := inf_dest_names_size; {allocated size of |dest_names| array}
-for k := 1 to head_tab_max do
- head_tab[k] := 0;
-pdf_box_spec_media := 1;
-pdf_box_spec_crop := 2;
-pdf_box_spec_bleed := 3;
-pdf_box_spec_trim := 4;
-pdf_box_spec_art := 5;
-
-@ Here we implement subroutines for work with objects and related things.
-Some of them are used in former parts too, so we need to declare them
-forward.
-
-@d pdf_append_list_end(#) == # := append_ptr(#, pdf_append_list_arg); end
-@d pdf_append_list(#) == begin pdf_append_list_arg := #; pdf_append_list_end
-@d set_ff(#) == begin
- if pdf_font_num(#) < 0 then
- ff := -pdf_font_num(#)
- else
- ff := #;
-end
-
-@<Declare procedures that need to be declared forward for \pdfTeX@>=
-procedure append_dest_name(s: str_number; n: integer);
-var a: integer;
-begin
- if pdf_dest_names_ptr = sup_dest_names_size then
- overflow("number of destination names (dest_names_size)", dest_names_size);
- if pdf_dest_names_ptr = dest_names_size then begin
- a := 0.2 * dest_names_size;
- if dest_names_size < sup_dest_names_size - a then
- dest_names_size := dest_names_size + a
- else
- dest_names_size := sup_dest_names_size;
- dest_names := xreallocarray(dest_names, dest_name_entry, dest_names_size);
- end;
- dest_names[pdf_dest_names_ptr].objname := s;
- dest_names[pdf_dest_names_ptr].objnum := n;
- incr(pdf_dest_names_ptr);
-end;
-
-procedure pdf_create_obj(t, i: integer); {create an object with type |t| and
-identifier |i|}
-label done;
-var a, p, q: integer;
-begin
- if sys_obj_ptr = sup_obj_tab_size then
- overflow("indirect objects table size", obj_tab_size);
- if sys_obj_ptr = obj_tab_size then begin
- a := 0.2 * obj_tab_size;
- if obj_tab_size < sup_obj_tab_size - a then
- obj_tab_size := obj_tab_size + a
- else
- obj_tab_size := sup_obj_tab_size;
- obj_tab := xreallocarray(obj_tab, obj_entry, obj_tab_size);
- end;
- incr(sys_obj_ptr);
- obj_ptr := sys_obj_ptr;
- obj_info(obj_ptr) := i;
- set_obj_fresh(obj_ptr);
- obj_aux(obj_ptr) := 0;
- avl_put_obj(obj_ptr, t);
- if t = obj_type_page then begin
- p := head_tab[t];
- {find the right position to insert newly created object}@/
- if (p = 0) or (obj_info(p) < i) then begin
- obj_link(obj_ptr) := p;
- head_tab[t] := obj_ptr;
- end
- else begin
- while p <> 0 do begin
- if obj_info(p) < i then
- goto done;
- q := p;
- p := obj_link(p);
- end;
-done:
- obj_link(q) := obj_ptr;
- obj_link(obj_ptr) := p;
- end;
- end
- else if t <> obj_type_others then begin
- obj_link(obj_ptr) := head_tab[t];
- head_tab[t] := obj_ptr;
- if (t = obj_type_dest) and (i < 0) then
- append_dest_name(-obj_info(obj_ptr), obj_ptr);
- end;
-end;
-
-function pdf_new_objnum: integer; {create a new object and return its number}
-begin
- pdf_create_obj(obj_type_others, 0);
- pdf_new_objnum := obj_ptr;
-end;
-
-procedure pdf_os_switch(pdf_os: boolean); {switch between PDF stream and object stream mode}
-begin
- if pdf_os and pdf_os_enable then begin
- if not pdf_os_mode then begin {back up PDF stream variables}
- pdf_op_ptr := pdf_ptr;
- pdf_ptr := pdf_os_ptr;
- pdf_buf := pdf_os_buf;
- pdf_buf_size := pdf_os_buf_size;
- pdf_os_mode := true; {switch to object stream}
- end;
- end else begin
- if pdf_os_mode then begin {back up object stream variables}
- pdf_os_ptr := pdf_ptr;
- pdf_ptr := pdf_op_ptr;
- pdf_buf := pdf_op_buf;
- pdf_buf_size := pdf_op_buf_size;
- pdf_os_mode := false; {switch to PDF stream}
- end;
- end;
-end;
-
-procedure pdf_os_prepare_obj(i: integer; pdf_os_level: integer); {create new \.{/ObjStm} object
-if required, and set up cross reference info}
-begin
- pdf_os_switch((pdf_os_level > 0) and (fixed_pdf_objcompresslevel >= pdf_os_level));
- if pdf_os_mode then begin
- if pdf_os_cur_objnum = 0 then begin
- pdf_os_cur_objnum := pdf_new_objnum;
- decr(obj_ptr); {object stream is not accessible to user}
- incr(pdf_os_cntr); {only for statistics}
- pdf_os_objidx := 0;
- pdf_ptr := 0; {start fresh object stream}
- end else
- incr(pdf_os_objidx);
- obj_os_idx(i) := pdf_os_objidx;
- obj_offset(i) := pdf_os_cur_objnum;
- pdf_os_objnum[pdf_os_objidx] := i;
- pdf_os_objoff[pdf_os_objidx] := pdf_ptr;
- end else begin
- obj_offset(i) := pdf_offset;
- obj_os_idx(i) := -1; {mark it as not included in object stream}
- end;
-end;
-
-procedure pdf_begin_obj(i: integer; pdf_os_level: integer); {begin a PDF object}
-begin
- check_pdfminorversion;
- pdf_os_prepare_obj(i, pdf_os_level);
- if not pdf_os_mode then begin
- pdf_print_int(i);
- pdf_print_ln(" 0 obj");
- end else if pdf_compress_level = 0 then begin
- pdf_print("% "); {debugging help}
- pdf_print_int(i);
- pdf_print_ln(" 0 obj");
- end;
-end;
-
-procedure pdf_new_obj(t, i: integer; pdf_os: integer); {begin a new PDF object}
-begin
- pdf_create_obj(t, i);
- pdf_begin_obj(obj_ptr, pdf_os);
-end;
-
-procedure pdf_end_obj; {end a PDF object}
-begin
- if pdf_os_mode then begin
- if pdf_os_objidx = pdf_os_max_objs - 1 then
- pdf_os_write_objstream;
- end else
- pdf_print_ln("endobj"); {end a PDF object}
-end;
-
-procedure pdf_begin_dict(i: integer; pdf_os_level: integer); {begin a PDF dictionary object}
-begin
- check_pdfminorversion;
- pdf_os_prepare_obj(i, pdf_os_level);
- if not pdf_os_mode then begin
- pdf_print_int(i);
- pdf_print(" 0 obj ");
- end else if pdf_compress_level = 0 then begin
- pdf_print("% "); {debugging help}
- pdf_print_int(i);
- pdf_print_ln(" 0 obj");
- end;
- pdf_print_ln("<<");
-end;
-
-procedure pdf_new_dict(t, i: integer; pdf_os: integer); {begin a new PDF dictionary object}
-begin
- pdf_create_obj(t, i);
- pdf_begin_dict(obj_ptr, pdf_os);
-end;
-
-procedure pdf_end_dict; {end a PDF dictionary object}
-begin
- if pdf_os_mode then begin
- pdf_print_ln(">>");
- if pdf_os_objidx = pdf_os_max_objs - 1 then
- pdf_os_write_objstream;
- end else
- pdf_print_ln(">> endobj");
-end;
-
-@ Write out an accumulated object stream.
-First the object number and byte offset pairs are generated
-and appended to the ready buffered object stream.
-By this the value of \.{/First} can be calculated.
-Then a new \.{/ObjStm} object is generated, and everything is
-copied to the PDF output buffer, where also compression is done.
-When calling this procedure, |pdf_os_mode| must be |true|.
-
-@<Declare procedures that need to be declared forward for \pdfTeX@>=
-procedure pdf_os_write_objstream;
-var i, j, p, q: pointer;
-begin
- if pdf_os_cur_objnum = 0 then {no object stream started}
- return;
- p := pdf_ptr;
- i := 0;
- j := 0;
- while i <= pdf_os_objidx do begin {assemble object number and byte offset pairs}
- pdf_print_int(pdf_os_objnum[i]);
- pdf_print(" ");
- pdf_print_int(pdf_os_objoff[i]);
- if j = 9 then begin {print out in groups of ten for better readability}
- pdf_out(pdf_new_line_char);
- j := 0;
- end else begin
- pdf_print(" ");
- incr(j);
- end;
- incr(i);
- end;
- pdf_buf[pdf_ptr - 1] := pdf_new_line_char; {no risk of flush, as we are in |pdf_os_mode|}
- q := pdf_ptr;
- pdf_begin_dict(pdf_os_cur_objnum, 0); {switch to PDF stream writing}
- pdf_print_ln("/Type /ObjStm");
- pdf_print("/N ");
- pdf_print_int_ln(pdf_os_objidx + 1);
- pdf_print("/First ");
- pdf_print_int_ln(q - p);
- pdf_begin_stream;
- pdf_room(q - p); {should always fit into the PDF output buffer}
- i := p;
- while i < q do begin {write object number and byte offset pairs}
- pdf_quick_out(pdf_os_buf[i]);
- incr(i);
- end;
- i := 0;
- while i < p do begin
- q := i + pdf_buf_size;
- if q > p then q := p;
- pdf_room(q - i);
- while i < q do begin {write the buffered objects}
- pdf_quick_out(pdf_os_buf[i]);
- incr(i);
- end;
- end;
- pdf_end_stream;
- pdf_os_cur_objnum := 0; {to force object stream generation next time}
-end;
-
-@ @<Declare procedures that need to be declared forward for \pdfTeX@>=
-function append_ptr(p: pointer; i: integer): pointer; {appends a pointer with
-info |i| to the end of linked list with head |p|}
-var q: pointer;
-begin
- append_ptr := p;
- fast_get_avail(q);
- info(q) := i;
- link(q) := null;
- if p = null then begin
- append_ptr := q;
- return;
- end;
- while link(p) <> null do
- p := link(p);
- link(p) := q;
-end;
-
-function pdf_lookup_list(p: pointer; i: integer): pointer; {looks up for pointer
-with info |i| in list |p|}
-begin
- pdf_lookup_list := null;
- while p <> null do begin
- if info(p) = i then begin
- pdf_lookup_list := p;
- return;
- end;
- p := link(p);
- end;
-end;
-
-@ @<Glob...@>=
-@!pdf_image_procset: integer; {collection of image types used in current page/form}
-@!pdf_text_procset: boolean; {mask of used ProcSet's in the current page/form}
-
-@ Subroutines to print out various PDF objects
-
-@p procedure pdf_print_fw_int(n: longinteger; w: integer); {print out an integer with
-fixed width; used for outputting cross-reference table}
-var k: integer; {$0\le k\le23$}
-begin
- k := 0;
- repeat dig[k] := n mod 10; n := n div 10; incr(k);
- until k = w;
- pdf_room(k);
- while k > 0 do begin
- decr(k);
- pdf_quick_out("0" + dig[k]);
- end;
-end;
-
-procedure pdf_out_bytes(n: longinteger; w: integer); {print out an integer as
-a number of bytes; used for outputting \.{/XRef} cross-reference stream}
-var k: integer;
-byte: array[0..7] of integer; {digits in a number being output}
-begin
- k := 0;
- repeat byte[k] := n mod 256; n := n div 256; incr(k);
- until k = w;
- pdf_room(k);
- while k > 0 do begin
- decr(k);
- pdf_quick_out(byte[k]);
- end;
-end;
-
-procedure pdf_int_entry(s: str_number; v: integer); {print out an entry in
-dictionary with integer value to PDF buffer}
-begin
- pdf_out("/");
- pdf_print(s);
- pdf_out(" ");
- pdf_print_int(v);
-end;
-
-procedure pdf_int_entry_ln(s: str_number; v: integer);
-begin
- pdf_int_entry(s, v);
- pdf_print_nl;
-end;
-
-procedure pdf_indirect(s: str_number; o: integer); {print out an indirect
-entry in dictionary}
-begin
- pdf_out("/");
- pdf_print(s);
- pdf_out(" ");
- pdf_print_int(o);
- pdf_print(" 0 R");
-end;
-
-procedure pdf_indirect_ln(s: str_number; o: integer);
-begin
- pdf_indirect(s, o);
- pdf_print_nl;
-end;
-
-procedure pdf_print_str_ln(s: str_number); {print out |s| as string in PDF
-output}
-begin
- pdf_print_str(s);
- pdf_print_nl;
-end;
-
-procedure pdf_str_entry(s, v: str_number); {print out an entry in
-dictionary with string value to PDF buffer}
-begin
- if v = 0 then
- return;
- pdf_out("/");
- pdf_print(s);
- pdf_out(" ");
- pdf_print_str(v);
-end;
-
-procedure pdf_str_entry_ln(s, v: str_number);
-begin
- if v = 0 then
- return;
- pdf_str_entry(s, v);
- pdf_print_nl;
-end;
-
-@* \[32e] Font processing.
-
-As \pdfTeX{} should also act as a back-end driver, it needs to support virtual
-fonts too. Information about virtual fonts can be found in the source of some
-\.{DVI}-related programs.
-
-Whenever we want to write out a character in a font to PDF output, we
-should check whether the used character is a virtual or read character.
-The |has_packet()| C macro checks for this condition.
-
-@ The following code typesets a character to PDF output.
-
-@p
-procedure output_one_char(ffi:internal_font_number;c:integer);
-var c_wd,c_ht,c_dp: scaled; {the real width, height and depth of the character}
-ci: charinfo_short;
-save, save_box_pos: scaledpos;
-save_direction: integer;
-begin
- ci := char_info_short(ffi,c);
- c_ht:=charinfo_height(ci);
- c_dp:=charinfo_depth(ci);
- c_wd:=charinfo_width(ci);
- synch_pos_with_cur;
- case box_direction(dvi_direction) of
- dir_TL_: begin
- case font_direction(dvi_direction) of
- dir__LL, dir__LR: pos_down((c_ht - c_dp) div 2);
- dir__LT: ;
- dir__LB: pos_down(c_ht);
- endcases;
- end;
- dir_TR_: begin
- pos_left(c_wd);
- case font_direction(dvi_direction) of
- dir__RL, dir__RR: pos_down((c_ht - c_dp) div 2);
- dir__RT: ;
- dir__RB: pos_down(c_ht);
- endcases;
- end;
- dir_BL_: begin
- case font_direction(dvi_direction) of
- dir__LL, dir__LR: pos_down((c_ht - c_dp) div 2);
- dir__LT: pos_up(c_dp);
- dir__LB: pos_down(c_ht);
- endcases;
- end;
- dir_BR_: begin
- pos_left(c_wd);
- case font_direction(dvi_direction) of
- dir__RL, dir__RR: pos_down((c_ht - c_dp) div 2);
- dir__RT: pos_up(c_dp);
- dir__RB: pos_down(c_ht);
- endcases;
- end;
- dir_LT_: begin
- pos_down(c_ht);
- case font_direction(dvi_direction) of
- dir__TL: pos_left(c_wd);
- dir__TR: ;
- dir__TB, dir__TT: pos_left(c_wd div 2);
- endcases;
- end;
- dir_RT_: begin
- pos_down(c_ht);
- case font_direction(dvi_direction) of
- dir__TL: pos_left(c_wd);
- dir__TR: ;
- dir__TB, dir__TT: pos_left(c_wd div 2);
- endcases;
- end;
- dir_LB_: begin
- pos_up(c_dp);
- case font_direction(dvi_direction) of
- dir__BL: pos_left(c_wd);
- dir__BR: ;
- dir__BB, dir__BT: pos_left(c_wd div 2);
- endcases;
- end;
- dir_RB_: begin
- pos_up(c_dp);
- case font_direction(dvi_direction) of
- dir__BL: pos_left(c_wd);
- dir__BR: ;
- dir__BB, dir__BT: pos_left(c_wd div 2);
- endcases;
- end;
- endcases;
- if has_packet(ffi,c) then begin
- save := cur;
- save_box_pos := box_pos;
- box_pos := pos;
- save_direction := dvi_direction;
- dvi_direction := dir_TL_; {local virtual font coordinate system}
- set_to_zero(cur);
- do_vf_packet(ffi, c);
- dvi_direction := save_direction;
- box_pos := save_box_pos;
- cur := save;
- end else
- pdf_place_glyph(ffi, c);
- case box_direction(dvi_direction) of
- dir_TL_, dir_TR_, dir_BL_, dir_BR_:
- cur.h := cur.h + c_wd;
- dir_LT_, dir_RT_, dir_LB_, dir_RB_:
- cur.h := cur.h + c_ht + c_dp;
- endcases;
-end;
-
-@ @<Declare procedures that need to be declared forward for \pdfTeX@>=
-procedure pdf_check_vf_cur_val; forward;
-procedure pdf_create_font_obj; forward;
-procedure pdf_init_font_cur_val; forward;
-procedure scan_pdf_ext_toks; forward;
-
-@ Here come some subroutines to deal with expanded fonts for HZ-algorithm.
-
-@d non_existent_path == "///..."
-
-@p
-function get_default_hyphen_char:integer;
-begin
- get_default_hyphen_char:=default_hyphen_char;
-end;
-@#
-function get_default_skew_char:integer;
-begin
- get_default_skew_char:=default_skew_char;
-end;
-@#
-procedure copy_expand_params(k, f: internal_font_number; e: integer);
-{set expansion-related parameters for an expanded font |k|, based on the base
-font |f| and the expansion amount |e|}
-begin
- set_pdf_font_expand_ratio(k,e);
- set_pdf_font_step(k,pdf_font_step(f));
- set_pdf_font_auto_expand(k, pdf_font_auto_expand(f));
- set_pdf_font_blink(k,f);
-end;
-
-function tfm_lookup(s: str_number; fs: scaled): internal_font_number;
-{looks up for a TFM with name |s| loaded at |fs| size; if found then flushes |s|}
-label exit;
-var k: internal_font_number;
-begin
- if fs <> 0 then begin
- for k := 1 to max_font_id do
- if (tex_font_area(k) <> non_existent_path) and
- cmp_font_name(k, s) and
- (font_size(k) = fs) then begin
- flush_str(s);
- tfm_lookup := k;
- return;
- end;
- end
- else begin
- for k := 1 to max_font_id do
- if (tex_font_area(k) <> non_existent_path) and
- cmp_font_name(k, s) then begin
- flush_string; {|font_name|}
- flush_str(s);
- tfm_lookup := k;
- return;
- end else flush_string;
- end;
- tfm_lookup := null_font;
-exit:
-end;
-
-function load_expand_font(f: internal_font_number; e: integer): internal_font_number;
-{loads font |f| expanded by |e| thousandths into font memory; |e| is nonzero
-and is a multiple of |pdf_font_step(f)|}
-label found;
-var s: str_number; {font name}
- k: internal_font_number;
-begin
- s := expand_font_name(f, e);
- k := tfm_lookup(s, font_size(f));
- if k = null_font then begin
- if pdf_font_auto_expand(f) then begin
- k := auto_expand_font(f, e);
- font_id_text(k) := font_id_text(f);
- end
- else
- k := read_font_info(null_cs, s, font_size(f), font_natural_dir(f));
- end;
- copy_expand_params(k, f, e);
- load_expand_font := k;
-end;
-
-function fix_expand_value(f: internal_font_number; e: integer): integer;
-{return the multiple of |pdf_font_step(f)| that is nearest to |e|}
-var step: integer;
- max_expand: integer;
- neg: boolean;
-begin
- fix_expand_value := 0;
- if e = 0 then
- return;
- if e < 0 then begin
- e := -e;
- neg := true;
- max_expand := -pdf_font_expand_ratio(pdf_font_shrink(f));
- end
- else begin
- neg := false;
- max_expand := pdf_font_expand_ratio(pdf_font_stretch(f));
- end;
- if e > max_expand then
- e := max_expand
- else begin
- step := pdf_font_step(f);
- if e mod step > 0 then
- e := step*round_xn_over_d(e, 1, step);
- end;
- if neg then
- e := -e;
- fix_expand_value := e;
-end;
-
-function get_expand_font(f: internal_font_number; e: integer): internal_font_number;
-{look up and create if not found an expanded version of |f|; |f| is an
-expandable font; |e| is nonzero and is a multiple of |pdf_font_step(f)|}
-var k: internal_font_number;
-begin
- k := pdf_font_elink(f);
- while k <> null_font do begin
- if pdf_font_expand_ratio(k) = e then begin
- get_expand_font := k;
- return;
- end;
- k := pdf_font_elink(k);
- end;
- k := load_expand_font(f, e);
- set_pdf_font_elink(k,pdf_font_elink(f));
- set_pdf_font_elink(f,k);
- {|wterm_ln('get_expand_font ', e:1, ': ',f:1, ' became ', k:1);|}
- get_expand_font := k;
-end;
-
-function expand_font(f: internal_font_number; e: integer): internal_font_number;
-{looks up for font |f| expanded by |e| thousandths, |e| is an arbitrary value
-between max stretch and max shrink of |f|; if not found then creates it}
-begin
- expand_font := f;
- if e = 0 then
- return;
- e := fix_expand_value(f, e);
- if e = 0 then
- return;
- if pdf_font_elink(f) = null_font then
- pdf_error("font expansion", "uninitialized pdf_font_elink");
- expand_font := get_expand_font(f, e);
-end;
-
-procedure set_expand_params(f: internal_font_number; auto_expand: boolean;
- stretch_limit, shrink_limit, font_step, expand_ratio: integer);
-{expand a font with given parameters}
-begin
- set_pdf_font_step(f, font_step);
- set_pdf_font_auto_expand(f, auto_expand);
- if stretch_limit > 0 then
- set_pdf_font_stretch(f,get_expand_font(f, stretch_limit));
- if shrink_limit > 0 then
- set_pdf_font_shrink(f, get_expand_font(f, -shrink_limit));
- if expand_ratio <> 0 then
- set_pdf_font_expand_ratio(f,expand_ratio);
-end;
-
-procedure read_expand_font; {read font expansion spec and load expanded font}
-var shrink_limit, stretch_limit, font_step: integer;
- f: internal_font_number;
- auto_expand: boolean;
-begin
- {read font expansion parameters}
- scan_font_ident;
- f := cur_val;
- if f = null_font then
- pdf_error("font expansion", "invalid font identifier");
- if pdf_font_blink(f) <> null_font then
- pdf_error("font expansion", "\pdffontexpand cannot be used this way (the base font has been expanded)");
- scan_optional_equals;
- scan_int;
- stretch_limit := fix_int(cur_val, 0, 1000);
- scan_int;
- shrink_limit := fix_int(cur_val, 0, 500);
- scan_int;
- font_step := fix_int(cur_val, 0, 100);
- if font_step = 0 then
- pdf_error("font expansion", "invalid step");
- stretch_limit := stretch_limit - stretch_limit mod font_step;
- if stretch_limit < 0 then
- stretch_limit := 0;
- shrink_limit := shrink_limit - shrink_limit mod font_step;
- if shrink_limit < 0 then
- shrink_limit := 0;
- if (stretch_limit = 0) and (shrink_limit = 0) then
- pdf_error("font expansion", "invalid limit(s)");
- auto_expand := false;
- if scan_keyword('autoexpand') then begin
- auto_expand := true;
- @<Scan an optional space@>;
- end;
-
- {check if the font can be expanded}
- if (pdf_font_expand_ratio(f) <> 0) then
- pdf_error("font expansion", "this font has been expanded by another font so it cannot be used now");
- if (pdf_font_step(f) <> 0) then
- {this font has been expanded, ensure the expansion parameters are identical}
- begin
- if pdf_font_step(f) <> font_step then
- pdf_error("font expansion", "font has been expanded with different expansion step");
-
- if ((pdf_font_stretch(f) = null_font) and (stretch_limit <> 0)) or
- ((pdf_font_stretch(f) <> null_font) and
- (pdf_font_expand_ratio(pdf_font_stretch(f)) <> stretch_limit)) then
- pdf_error("font expansion", "font has been expanded with different stretch limit");
-
- if ((pdf_font_shrink(f) = null_font) and (shrink_limit <> 0)) or
- ((pdf_font_shrink(f) <> null_font) and
- (-pdf_font_expand_ratio(pdf_font_shrink(f)) <> shrink_limit)) then
- pdf_error("font expansion", "font has been expanded with different shrink limit");
-
- if pdf_font_auto_expand(f) <> auto_expand then
- pdf_error("font expansion", "font has been expanded with different auto expansion value");
- end
- else begin
- if font_used(f) then
- pdf_warning("font expansion", "font should be expanded before its first use",
- true, true);
- set_expand_params(f, auto_expand, stretch_limit, shrink_limit, font_step, 0);
- if font_type(f) = virtual_font_type then
- vf_expand_local_fonts(f);
- end;
-end;
-
-procedure new_letterspaced_font(a: small_number);
-{letter-space a font by creating a virtual font}
-var u:pointer; {user's font identifier}
-@!t:str_number; {name for the frozen font identifier}
-@!f, k:internal_font_number;
-begin
- get_r_token; u:=cur_cs;
- if u>=hash_base then t:=text(u) else t:="FONT";
-@.FONTx@>
- define(u,set_font,null_font); scan_optional_equals; scan_font_ident;
- k := cur_val;
- scan_int;
- f := letter_space_font(u, k, fix_int(cur_val, -1000, 1000));
- equiv(u):=f; eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
-end;
-
-procedure make_font_copy(a: small_number);
-{make a font copy for further use with font expansion}
-var u:pointer; {user's font identifier}
-@!t:str_number; {name for the frozen font identifier}
-@!f, k:internal_font_number;
-begin
- get_r_token; u:=cur_cs;
- if u>=hash_base then t:=text(u) else t:="FONT";
-@.FONTx@>
- define(u,set_font,null_font); scan_optional_equals; scan_font_ident;
- k := cur_val;
- f := copy_font_info(k);
- equiv(u):=f; eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
-end;
-
-
-@ We need to hold information about used characters in each font for partial
-downloading.
-
-@<Types...@>=
-char_map_array = array[0..32] of eight_bits; {move chars in range 0..32}
-fm_entry_ptr = ^integer;
-
-@ @<Glob...@>=
-@!pdf_font_list: pointer; {list of used fonts in current page}
-@!pdf_resname_prefix: str_number; {global prefix of resources name}
-@!last_tokens_string: str_number; {the number of the most recently string
-created by |tokens_to_string|}
-
-@ @<Set init...@>=
-pdf_resname_prefix := 0;
-last_tokens_string := 0;
-
-@ Reading VF files is done in C, using the procedure |do_vf()|
-
-@* \[32f] PDF shipping out.
-To ship out a \TeX\ box to PDF page description we need to implement
-|pdf_hlist_out|, |pdf_vlist_out| and |pdf_ship_out|, which are equivalent to
-the \TeX' original |hlist_out|, |vlist_out| and |ship_out| resp. But first we
-need to declare some procedures needed in |pdf_hlist_out| and |pdf_vlist_out|.
-
-@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure pdf_out_literal(p:pointer);
-var old_setting:0..max_selector; {holds print |selector|}
- s: str_number;
-begin
- if pdf_literal_type(p)=normal then begin
- old_setting:=selector; selector:=new_string;
- show_token_list(link(pdf_literal_data(p)),null,pool_size-pool_ptr);
- selector:=old_setting;
- s := make_string;
- literal(s, pdf_literal_mode(p), false);
- flush_str(s);
- end
- else begin
- pdfassert(pdf_literal_mode(p)<>scan_special);
- case pdf_literal_mode(p) of
- set_origin: begin
- pdf_goto_pagemode;
- synch_pos_with_cur;
- pdf_set_pos(pos.h, pos.v);
- end;
- direct_page:
- pdf_goto_pagemode;
- direct_always:
- pdf_end_string_nl;
- othercases confusion("literal1")
- endcases;
- lua_pdf_literal(pdf_literal_data(p));
- end;
-end;
-
-procedure pdf_out_colorstack(p:pointer);
-var old_setting: 0..max_selector; {holds print |selector|}
- s: str_number;
- cmd: integer;
- stack_no: integer;
- literal_mode: integer;
-begin
- cmd := pdf_colorstack_cmd(p);
- stack_no := pdf_colorstack_stack(p);
- literal_mode := 0;
- if stack_no >= colorstackused then begin
- print_nl("");
- print("Color stack ");
- print_int(stack_no);
- print(" is not initialized for use!");
- print_nl("");
- return;
- end;
- case cmd of
- colorstack_set, colorstack_push: begin
- old_setting:=selector; selector:=new_string;
- show_token_list(link(pdf_colorstack_data(p)),null,pool_size-pool_ptr);
- selector:=old_setting;
- s := make_string;
- if cmd = colorstack_set then
- literal_mode := colorstackset(stack_no, s)
- else
- literal_mode := colorstackpush(stack_no, s);
- if length(s) > 0 then
- literal(s, literal_mode, false);
- flush_str(s);
- return;
- end;
- colorstack_pop: literal_mode := colorstackpop(stack_no);
- colorstack_current: literal_mode := colorstackcurrent(stack_no);
- othercases do_nothing
- endcases;
- if cur_length > 0 then begin
- s := make_string;
- literal(s, literal_mode, false);
- flush_str(s);
- end
-end;
-
-procedure pdf_out_colorstack_startpage;
-var i: integer;
- max: integer;
- start_status: integer;
- literal_mode: integer;
- s: str_number;
-begin
- i := 0;
- max := colorstackused;
- while i < max do begin
- start_status := colorstackskippagestart(i);
- if start_status = 0 then begin
- literal_mode := colorstackcurrent(i);
- if cur_length > 0 then begin
- s := make_string;
- literal(s, literal_mode, false);
- flush_str(s);
- end;
- end;
- incr(i);
- end;
-end;
-
-procedure pdf_out_setmatrix(p:pointer);
-var old_setting:0..max_selector; {holds print |selector|}
- s: str_number;
-begin
- old_setting:=selector; selector:=new_string;
- show_token_list(link(pdf_setmatrix_data(p)),null,pool_size-pool_ptr);
- selector:=old_setting;
- str_room(7);
- str_pool[pool_ptr] := 0; { make C string for pdfsetmatrix }
- synch_pos_with_cur;
- pdfsetmatrix(str_start_macro(str_ptr), pos);
- str_room(7);
- append_char(" ");
- append_char("0");
- append_char(" ");
- append_char("0");
- append_char(" ");
- append_char("c");
- append_char("m");
- s := make_string;
- literal(s, set_origin, false);
- flush_str(s);
-end;
-
-procedure pdf_out_save;
-begin
- synch_pos_with_cur;
- checkpdfsave(pos);
- literal("q", set_origin, false);
-end;
-
-procedure pdf_out_restore;
-begin
- synch_pos_with_cur;
- checkpdfrestore(pos);
- literal("Q", set_origin, false);
-end;
-
-procedure pdf_special(p: pointer);
-var old_setting:0..max_selector; {holds print |selector|}
- s: str_number;
-begin
- old_setting:=selector; selector:=new_string;
- show_token_list(link(write_tokens(p)),null,pool_size-pool_ptr);
- selector:=old_setting;
- s := make_string;
- literal(s, scan_special, true);
- flush_str(s);
-end;
-
-procedure do_late_lua(p: pointer);
-begin
- if not doing_leaders then begin
- expand_late_lua(p);
- latelua(def_ref, late_lua_name(p));
- flush_list(def_ref);
- end;
-end;
-
-procedure pdf_print_toks(p: pointer); {print tokens list |p|}
-var s: str_number;
-begin
- s := tokens_to_string(p);
- if length(s) > 0 then
- pdf_print(s);
- flush_str(s);
-end;
-
-procedure pdf_print_toks_ln(p: pointer); {print tokens list |p|}
-var s: str_number;
-begin
- s := tokens_to_string(p);
- if length(s) > 0 then begin
- pdf_print_ln(s);
- end;
- flush_str(s);
-end;
-
-@ Similiar to |vlist_out|, |pdf_vlist_out| needs to be declared forward
-
-@p procedure@?pdf_vlist_out; forward;
-
-@ The implementation of procedure |pdf_hlist_out| is similiar to |hlist_out|
-
-@p @t\4@>@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>@t@>@/
-
-procedure pdf_hlist_out; {output an |hlist_node| box}
-label move_past, fin_rule, next_p;
-var base_line: scaled; {the baseline coordinate for this box}
-w: scaled; { temporary value for directional width calculation }
-dir_nest: integer; { for tracking nested direction nodes }
-edge_v: scaled;
-edge_h: scaled;
-effective_horizontal: scaled;
-basepoint_horizontal: scaled;
-basepoint_vertical: scaled;
-save_direction: integer;
-dvi_ptr,dir_ptr,dir_tmp:pointer;
-@!left_edge: scaled; {the left coordinate for this box}
-@!save_h: scaled; {what |cur.h| should pop to}
-@!save_box_pos: scaledpos; {what |box_pos| should pop to}
-@!this_box: pointer; {pointer to containing box}
-@!g_order: glue_ord; {applicable order of infinity for glue}
-@!g_sign: normal..shrinking; {selects type of glue}
-@!p,q:pointer; {current position in the hlist}
-@!leader_box:pointer; {the leader box being replicated}
-@!leader_wd:scaled; {width of leader box being replicated}
-@!lx:scaled; {extra space between leader boxes}
-@!outer_doing_leaders:boolean; {were we doing leaders?}
-@!edge:scaled; {right edge of sub-box or leader space}
-@!prev_p:pointer; {one step behind |p|}
-@!glue_temp:real; {glue value before rounding}
-@!cur_glue:real; {glue seen so far}
-@!save_cur_glue:real; { saved version, for direction switch }
-@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
-@!save_cur_g:scaled; { saved version, for direction switch }
-@!i: small_number; {index to scan |pdf_link_stack|}
-begin cur_g:=0; cur_glue:=float_constant(0);
-this_box:=temp_ptr; g_order:=glue_order(this_box);
-g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
-set_to_zero(cur); box_pos:=pos;
-save_direction:=dvi_direction;
-dvi_direction:=box_dir(this_box);
-dvi_ptr:=0; lx:=0;
-@<DIR: Initialize |dir_ptr| for |ship_out|@>;
-incr(cur_s);
-base_line:=cur.v;
-left_edge:=cur.h;
-prev_p:=this_box+list_offset;
-@<Create link annotations for the current hbox if needed@>;
-@<Start hlist {\sl Sync\TeX} information record@>;
-while p<>null do
- @<Output node |p| for |pdf_hlist_out| and move to the next node,
- maintaining the condition |cur.v=base_line|@>;
-@<Finish hlist {\sl Sync\TeX} information record@>;
-decr(cur_s);
-dvi_direction:=save_direction;
-@<DIR: Reset |dir_ptr|@>;
-end;
-
-@ @<Create link annotations for the current hbox if needed@>=
-for i := 1 to pdf_link_stack_ptr do begin
- pdfassert(is_running(pdf_width(pdf_link_stack[i].link_node)));
- if (pdf_link_stack[i].nesting_level = cur_s) then
- append_link(this_box, left_edge, base_line, i);
-end
-
-@
-
-@d pos_right(#) == pos.h := pos.h + (#)
-@d pos_left(#) == pos.h := pos.h - (#)
-@d pos_up(#) == pos.v := pos.v + (#)
-@d pos_down(#) == pos.v := pos.v - (#)
-
-@<Output node |p| for |pdf_hlist_out|...@>=
-begin
-if is_char_node(p) then begin
- repeat
- if x_displace(p)<>0 then cur.h := cur.h + x_displace(p);
- if y_displace(p)<>0 then cur.v := cur.v - y_displace(p);
- output_one_char(font(p), character(p));
- if x_displace(p)<>0 then cur.h := cur.h - x_displace(p);
- if y_displace(p)<>0 then cur.v := cur.v + y_displace(p);
- p:=vlink(p);
- until not is_char_node(p);
- @<Record current point {\sl Sync\TeX} information@>;
-end
-else @<Output the non-|char_node| |p| for |pdf_hlist_out|
- and move to the next node@>;
-end
-
-@ @<Output the non-|char_node| |p| for |pdf_hlist_out|...@>=
-begin case type(p) of
-hlist_node_case,vlist_node_case:@<(\pdfTeX) Output a box in an hlist@>;
-disc_node_case: if vlink(no_break(p))<>null then if subtype(p)<>select_disc then begin
- q:=tail_of_list (vlink(no_break(p))); {TODO, this should be a tlink}
- vlink(q):=vlink(p);
- q:=vlink(no_break(p));
- vlink(no_break(p)):=null;
- vlink(p):=q;
- end;
-rule_node_case: begin
- if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
- then begin
- rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
- end
- else begin
- rule_ht:=width(p) div 2;
- rule_dp:=width(p) div 2;
- rule_wd:=height(p)+depth(p);
- end;
- goto fin_rule;
- end;
-whatsit_node_case: @<Output the whatsit node |p| in |pdf_hlist_out|@>;
-glue_node_case: @<(\pdfTeX) Move right or output leaders@>;
-margin_kern_node_case: cur.h := cur.h + width(p);
-kern_node_case: begin
- @<Record |kern_node| {\sl Sync\TeX} information@>;
- cur.h := cur.h + width(p);
- end;
-math_node_case: begin
- @<Record |math_node| {\sl Sync\TeX} information@>;
- cur.h := cur.h + surround(p);
- end;
-othercases do_nothing
-endcases;@/
-goto next_p;
-fin_rule: @<(\pdfTeX) Output a rule in an hlist@>;
-move_past: begin
- cur.h := cur.h + rule_wd;
- @<Record horizontal |rule_node| or |glue_node| {\sl Sync\TeX} information@>;
- end;
-next_p:prev_p:=p; p:=vlink(p);
-end
-
-@ @<(\pdfTeX) Output a box in an hlist@>=
-begin
-if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
- then begin
- effective_horizontal:=width(p);
- basepoint_vertical:=0;
- if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=width(p)
- else
- basepoint_horizontal:=0;
- end
-else begin
- effective_horizontal:=height(p)+depth(p);
- if not is_mirrored(box_dir(p)) then
- if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=height(p)
- else
- basepoint_horizontal:=depth(p)
- else
- if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=depth(p)
- else
- basepoint_horizontal:=height(p);
- if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
- basepoint_vertical:= -(width(p) div 2)
- else
- basepoint_vertical:= (width(p) div 2);
- end;
-if not is_mirrored(dvi_direction) then
- basepoint_vertical := basepoint_vertical + shift_amount(p)
- {shift the box `down'}
-else
- basepoint_vertical := basepoint_vertical - shift_amount(p);
- {shift the box `up'}
-if list_ptr(p)=null then begin
- @<Record void list {\sl Sync\TeX} information@>;
- cur.h:=cur.h + effective_horizontal;
- end
-else begin
- temp_ptr:=p; edge:=cur.h; cur.h:=cur.h + basepoint_horizontal;
- edge_v:=cur.v; cur.v:=base_line + basepoint_vertical;
- synch_pos_with_cur;
- save_box_pos:=box_pos;
- if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
- box_pos:=save_box_pos;
- cur.h:=edge+effective_horizontal; cur.v:=base_line;
- end
-end
-
-@ @<(\pdfTeX) Output a rule in an hlist@>=
-if is_running(rule_ht) then rule_ht:=height(this_box);
-if is_running(rule_dp) then rule_dp:=depth(this_box);
-if ((rule_ht+rule_dp)>0)and(rule_wd>0) then begin {we don't output empty rules}
- synch_pos_with_cur;
- case box_direction(dvi_direction) of
- dir_TL_: pdf_place_rule(pos.h, pos.v - rule_dp, rule_wd, rule_ht + rule_dp);
- dir_BL_: pdf_place_rule(pos.h, pos.v - rule_ht, rule_wd, rule_ht + rule_dp);
- dir_TR_: pdf_place_rule(pos.h - rule_wd, pos.v - rule_dp, rule_wd, rule_ht + rule_dp);
- dir_BR_: pdf_place_rule(pos.h - rule_wd, pos.v - rule_ht, rule_wd, rule_ht + rule_dp);
- dir_LT_: pdf_place_rule(pos.h - rule_ht, pos.v - rule_wd, rule_ht + rule_dp, rule_wd);
- dir_RT_: pdf_place_rule(pos.h - rule_dp, pos.v - rule_wd, rule_ht + rule_dp, rule_wd);
- dir_LB_: pdf_place_rule(pos.h - rule_ht, pos.v, rule_ht + rule_dp, rule_wd);
- dir_RB_: pdf_place_rule(pos.h - rule_dp, pos.v, rule_ht + rule_dp, rule_wd);
- end;
-end
-
-@ @<(\pdfTeX) Move right or output leaders@>=
-begin g:=glue_ptr(p); rule_wd:=width(g)-cur_g;
-if g_sign<>normal then
- begin if g_sign=stretching then
- begin if stretch_order(g)=g_order then
- begin cur_glue:=cur_glue+stretch(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
-@^real multiplication@>
- cur_g:=round(glue_temp);
- end;
- end
- else if shrink_order(g)=g_order then
- begin cur_glue:=cur_glue-shrink(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
- cur_g:=round(glue_temp);
- end;
- end;
-rule_wd:=rule_wd+cur_g;
-if subtype(p)>=a_leaders then
- @<(\pdfTeX) Output leaders in an hlist, |goto fin_rule| if a rule
- or to |next_p| if done@>;
-goto move_past;
-end
-
-@ @<(\pdfTeX) Output leaders in an hlist...@>=
-begin leader_box:=leader_ptr(p);
-if type(leader_box)=rule_node then
- begin rule_ht:=height(leader_box); rule_dp:=depth(leader_box);
- goto fin_rule;
- end;
-if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
- then leader_wd:=width(leader_box)
-else
- leader_wd:=height(leader_box)+depth(leader_box);
-if (leader_wd>0)and(rule_wd>0) then
- begin rule_wd:=rule_wd+10; {compensate for floating-point rounding}
- edge:=cur.h+rule_wd; lx:=0;
- @<Let |cur.h| be the position of the first box, and set |leader_wd+lx|
- to the spacing between corresponding parts of boxes@>;
- while cur.h+leader_wd<=edge do
- @<(\pdfTeX) Output a leader box at |cur.h|,
- then advance |cur.h| by |leader_wd+lx|@>;
- cur.h:=edge-10; goto next_p;
- end;
-end
-
-@ @<(\pdfTeX) Output a leader box at |cur.h|, ...@>=
-begin
-if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
- then begin
- basepoint_vertical:=0;
- if dir_opposite(dir_secondary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then begin
- basepoint_horizontal:=width(leader_box)
- end
- else
- basepoint_horizontal:=0;
- end
-else begin
- if not is_mirrored(box_dir(leader_box)) then
- if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=height(leader_box)
- else
- basepoint_horizontal:=depth(leader_box)
- else
- if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=depth(leader_box)
- else
- basepoint_horizontal:=height(leader_box);
- if dir_eq(dir_secondary[box_dir(leader_box)])(dir_primary[dvi_direction]) then
- basepoint_vertical:= -(width(leader_box) div 2)
- else
- basepoint_vertical:= (width(leader_box) div 2);
- end;
-if not is_mirrored(dvi_direction) then
- basepoint_vertical := basepoint_vertical + shift_amount(leader_box)
- {shift the box `down'}
-else
- basepoint_vertical := basepoint_vertical - shift_amount(leader_box);
- {shift the box `up'}
-temp_ptr:=leader_box;
-edge_h:=cur.h; cur.h:=cur.h + basepoint_horizontal;
-edge_v:=cur.v; cur.v:=base_line + basepoint_vertical;
-synch_pos_with_cur;
-save_box_pos:=box_pos;
-outer_doing_leaders:=doing_leaders; doing_leaders:=true;
-if type(leader_box)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
-doing_leaders:=outer_doing_leaders;
-box_pos:=save_box_pos;
-cur.h:=edge_h+leader_wd+lx; cur.v:=base_line;
-end
-
-@ The |pdf_vlist_out| routine is similar to |pdf_hlist_out|, but a bit simpler.
-@p procedure pdf_vlist_out; {output a |pdf_vlist_node| box}
-label move_past, fin_rule, next_p;
-var left_edge: scaled; {the left coordinate for this box}
-@!top_edge: scaled; {the top coordinate for this box}
-@!save_v: scaled; {what |cur.v| should pop to}
-@!save_box_pos: scaledpos; {what |box_pos| should pop to}
-@!this_box: pointer; {pointer to containing box}
-@!g_order: glue_ord; {applicable order of infinity for glue}
-@!g_sign: normal..shrinking; {selects type of glue}
-@!p:pointer; {current position in the vlist}
-@!leader_box:pointer; {the leader box being replicated}
-@!leader_ht:scaled; {height of leader box being replicated}
-@!lx:scaled; {extra space between leader boxes}
-@!outer_doing_leaders:boolean; {were we doing leaders?}
-@!edge:scaled; {bottom boundary of leader space}
-@!glue_temp:real; {glue value before rounding}
-@!cur_glue:real; {glue seen so far}
-@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
-@!save_direction: integer;
-@!effective_vertical: scaled;
-@!basepoint_horizontal: scaled;
-@!basepoint_vertical: scaled;
-@!edge_v: scaled;
-begin cur_g:=0; cur_glue:=float_constant(0);
-this_box:=temp_ptr; g_order:=glue_order(this_box);
-g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
-{pdfassert(p<>0);}
-set_to_zero(cur); box_pos:=pos;
-{|writeln(''); writeln('vlist_out: left edge: ', cur.h:1 , '');|}
-save_direction:=dvi_direction;
-dvi_direction:=box_dir(this_box);
-incr(cur_s);
-left_edge:=cur.h;
-@<Start vlist {\sl Sync\TeX} information record@>;
-cur.v:=cur.v-height(this_box); top_edge:=cur.v;
-@<Create thread for the current vbox if needed@>;
-while p<>null do
- @<Output node |p| for |pdf_vlist_out| and move to the next node,
- maintaining the condition |cur.h=left_edge|@>;
-@<Finish vlist {\sl Sync\TeX} information record@>;
-decr(cur_s);
-dvi_direction:=save_direction;
-end;
-
-@ @<Create thread for the current vbox if needed@>=
-if (last_thread <> null) and is_running(pdf_thread_dp) and
- (pdf_thread_level = cur_s) then
- append_thread(this_box, left_edge, top_edge + height(this_box))
-
-@ @<Output node |p| for |pdf_vlist_out|...@>=
-begin if is_char_node(p) then confusion("pdfvlistout")
-@:this can't happen pdfvlistout}{\quad pdfvlistout@>
-else @<Output the non-|char_node| |p| for |pdf_vlist_out|@>;
-next_p:p:=vlink(p);
-end
-
-@ @<Output the non-|char_node| |p| for |pdf_vlist_out|@>=
-begin case type(p) of
-hlist_node_case,vlist_node_case:@<(\pdfTeX) Output a box in a vlist@>;
-rule_node_case: begin
- if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
- then begin
- rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
- end
- else begin
- rule_ht:=width(p) div 2;
- rule_dp:=width(p) div 2;
- rule_wd:=height(p)+depth(p);
- end;
- goto fin_rule;
- end;
-whatsit_node_case: @<Output the whatsit node |p| in |pdf_vlist_out|@>;
-glue_node_case: @<(\pdfTeX) Move down or output leaders@>;
-kern_node_case:cur.v := cur.v + width(p);
-othercases do_nothing
-endcases;@/
-goto next_p;
-fin_rule: @<(\pdfTeX) Output a rule in a vlist, |goto next_p|@>;
-move_past: cur.v := cur.v + rule_ht;
-end
-
-@ TODO: the direct test to switch between |width(p)| and |-width(p)|
-is definately wrong, because it does not nest properly. But at least
-it fixes a very obvious problem that otherwise occured with
-\.{\\pardir TLT} in a document with \.{\\bodydir TRT}, and so it
-will have to do for now.
-
-@<(\pdfTeX) Output a box in a vlist@>=
-begin
-if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
- then begin
- effective_vertical:=height(p)+depth(p);
- if (type(p)=hlist_node) and is_mirrored(box_dir(p)) then
- basepoint_vertical:=depth(p)
- else
- basepoint_vertical:=height(p);
- if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=width(p)
- else
- basepoint_horizontal:=0;
- end
-else begin
- effective_vertical:=width(p);
- if not is_mirrored(box_dir(p)) then
- if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=height(p)
- else
- basepoint_horizontal:=depth(p)
- else
- if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
- basepoint_horizontal:=depth(p)
- else
- basepoint_horizontal:=height(p);
- if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
- basepoint_vertical:=0
- else
- basepoint_vertical:=width(p);
- end;
-basepoint_horizontal := basepoint_horizontal + shift_amount(p);
- {shift the box `right'}
-if list_ptr(p)=null then begin
- cur.v:=cur.v+effective_vertical;
- @<Record void list {\sl Sync\TeX} information@>;
- end
-else begin
- edge_v:=cur.v;
- cur.h:=left_edge + basepoint_horizontal;
- cur.v:=cur.v + basepoint_vertical;
- synch_pos_with_cur;
- save_box_pos:=box_pos;
- temp_ptr:=p;
- if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
- box_pos:=save_box_pos;
- cur.h:=left_edge; cur.v:=edge_v + effective_vertical;
- end
-end
-
-@ @<(\pdfTeX) Output a rule in a vlist...@>=
-if is_running(rule_wd) then rule_wd:=width(this_box);
-rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
-if (rule_ht>0)and(rule_wd>0) then begin {we don't output empty rules}
- synch_pos_with_cur;
- case box_direction(dvi_direction) of
- dir_TL_: pdf_place_rule(pos.h, pos.v - rule_ht, rule_wd, rule_ht);
- dir_BL_: pdf_place_rule(pos.h, pos.v, rule_wd, rule_ht);
- dir_TR_: pdf_place_rule(pos.h - rule_wd, pos.v - rule_ht, rule_wd, rule_ht);
- dir_BR_: pdf_place_rule(pos.h - rule_wd, pos.v, rule_wd, rule_ht);
- dir_LT_: pdf_place_rule(pos.h, pos.v - rule_wd, rule_ht, rule_wd);
- dir_RT_: pdf_place_rule(pos.h - rule_ht, pos.v - rule_wd, rule_ht, rule_wd);
- dir_LB_: pdf_place_rule(pos.h, pos.v, rule_ht, rule_wd);
- dir_RB_: pdf_place_rule(pos.h - rule_ht, pos.v, rule_ht, rule_wd);
- end;
- cur.v := cur.v + rule_ht;
-end;
-goto next_p
-
-@ @<(\pdfTeX) Move down or output leaders@>=
-begin g:=glue_ptr(p); rule_ht:=width(g)-cur_g;
-if g_sign<>normal then
- begin if g_sign=stretching then
- begin if stretch_order(g)=g_order then
- begin cur_glue:=cur_glue+stretch(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
-@^real multiplication@>
- cur_g:=round(glue_temp);
- end;
- end
- else if shrink_order(g)=g_order then
- begin cur_glue:=cur_glue-shrink(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
- cur_g:=round(glue_temp);
- end;
- end;
-rule_ht:=rule_ht+cur_g;
-if subtype(p)>=a_leaders then
- @<(\pdfTeX) Output leaders in a vlist, |goto fin_rule| if a rule
- or to |next_p| if done@>;
-goto move_past;
-end
-
-@ @<(\pdfTeX) Output leaders in a vlist...@>=
-begin leader_box:=leader_ptr(p);
-if type(leader_box)=rule_node then
- begin rule_wd:=width(leader_box); rule_dp:=0;
- goto fin_rule;
- end;
-leader_ht:=height(leader_box)+depth(leader_box);
-if (leader_ht>0)and(rule_ht>0) then
- begin rule_ht:=rule_ht+10; {compensate for floating-point rounding}
- edge:=cur.v+rule_ht; lx:=0;
- @<Let |cur.v| be the position of the first box, and set |leader_ht+lx|
- to the spacing between corresponding parts of boxes@>;
- while cur.v+leader_ht<=edge do
- @<(\pdfTeX) Output a leader box at |cur.v|,
- then advance |cur.v| by |leader_ht+lx|@>;
- cur.v:=edge-10; goto next_p;
- end;
-end
-
-@ @<(\pdfTeX) Output a leader box at |cur.v|, ...@>=
-begin cur.h:=left_edge+shift_amount(leader_box);
-cur.v:=cur.v+height(leader_box); save_v:=cur.v;
-synch_pos_with_cur;
-save_box_pos:=box_pos;
-temp_ptr:=leader_box;
-outer_doing_leaders:=doing_leaders; doing_leaders:=true;
-if type(leader_box)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
-doing_leaders:=outer_doing_leaders;
-box_pos:=save_box_pos;
-cur.h:=left_edge;
-cur.v:=save_v-height(leader_box)+leader_ht+lx;
-end
-
-@ |fix_pdfoutput| freezes |fixed_pdfoutput| as soon as anything has been written
-to the output file, be it \.{PDF} or \.{DVI}.
-
-@p procedure fix_pdfoutput;
-begin
- if not fixed_pdfoutput_set then begin
- fixed_pdfoutput := pdf_output;
- fixed_pdfoutput_set := true;
- end
- else if fixed_pdfoutput <> pdf_output then
- pdf_error("setup",
- "\pdfoutput can only be changed before anything is written to the output");
-end;
-
-@ |pdf_ship_out| is used instead of |ship_out| to shipout a box to PDF
-output. If |shipping_page| is not set then the output will be a Form object,
-otherwise it will be a Page object.
-
-@p procedure pdf_ship_out(p: pointer; shipping_page: boolean); {output the box |p|}
-label done, done1;
-var i,j,k:integer; {general purpose accumulators}
-save_font_list: pointer; {to save |pdf_font_list| during flushing pending forms}
-save_obj_list: pointer; {to save |pdf_obj_list|}
-save_ximage_list: pointer; {to save |pdf_ximage_list|}
-save_xform_list: pointer; {to save |pdf_xform_list|}
-save_image_procset: integer; {to save |pdf_image_procset|}
-save_text_procset: integer; {to save |pdf_text_procset|}
-save_cur_page_size: scaledpos; {to save |cur_page_size| during flushing pending forms}
-form_margin: scaled;
-pdf_last_resources: integer; {pointer to most recently generated Resources object}
-pre_callback_id:integer;
-post_callback_id:integer;
-ret:boolean;
-begin
-@<Start sheet {\sl Sync\TeX} information record@>;
-form_margin := one_bp;
-pre_callback_id:=callback_defined(start_page_number_callback);
-post_callback_id:=callback_defined(stop_page_number_callback);
-if (tracing_output>0)and(pre_callback_id=0) then
- begin print_nl(""); print_ln;
- print("Completed box being shipped out");
-@.Completed box...@>
- end;
-check_pdfminorversion;
-is_shipping_page := shipping_page;
-if shipping_page then begin
- if pre_callback_id>0 then
- ret:=run_callback(pre_callback_id,'->')
- else if pre_callback_id=0 then begin
- if term_offset>max_print_line-9 then print_ln
- else if (term_offset>0)or(file_offset>0) then print_char(" ");
- print_char("["); j:=9;
- while (count(j)=0)and(j>0) do decr(j);
- for k:=0 to j do
- begin print_int(count(k));
- if k<j then print_char(".");
- end;
- end;
- update_terminal;
-end;
-if (tracing_output>0)and(post_callback_id=0)and shipping_page then
- begin print_char("]");
- begin_diagnostic; show_box(p); end_diagnostic(true);
- end;
-@<(\pdfTeX) Ship box |p| out@>;
-if (tracing_output<=0)and(post_callback_id=0) and shipping_page then
- print_char("]");
-dead_cycles:=0;
-update_terminal; {progress report}
-@<Flush the box from memory, showing statistics if requested@>;
-if shipping_page and post_callback_id>0 then
- ret:=run_callback(post_callback_id,'->');
-@<Finish sheet {\sl Sync\TeX} information record@>;
-end;
-
-@ @<(\pdfTeX) Ship box |p| out@>=
-if shipping_page and (box_dir(p) <> page_direction) then
- pdf_warning("\shipout", "\pagedir != \bodydir; \box255 may be placed wrongly on the page.", true, true);
-@<Update the values of |max_h| and |max_v|; but if the page is too large,
- |goto done|@>;
-@<Initialize variables as |pdf_ship_out| begins@>;
-if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
-if shipping_page then
- incr(total_pages);
-cur_s:=-1;
-@<Finish shipping@>;
-done:
-
-@ @<Initialize variables as |pdf_ship_out| begins@>=
-prepare_mag;
-temp_ptr:=p;
-pdf_last_resources := pdf_new_objnum;
-@<Reset resource lists@>;
-dvi_direction:=page_direction;
-@<Calculate PDF page dimensions and margins@>;
-if not shipping_page then begin
- pdf_begin_dict(pdf_cur_form, 0);
- pdf_last_stream := pdf_cur_form;
- @<Write out Form stream header@>;
-end
-else begin
- pdf_last_page := get_obj(obj_type_page, total_pages + 1, 0);
- obj_aux(pdf_last_page) := 1; {mark that this page has been created}
- pdf_new_dict(obj_type_others, 0, 0);
- pdf_last_stream := obj_ptr;
- @<Reset PDF mark lists@>;
-end;
-@<Start stream of page/form contents@>
-
-@ @<Reset resource lists@>=
-pdf_font_list := null;
-pdf_obj_list := null;
-pdf_xform_list := null;
-pdf_ximage_list := null;
-pdf_text_procset := false;
-pdf_image_procset := 0
-
-@ @<Reset PDF mark lists@>=
-pdf_annot_list := null;
-pdf_link_list := null;
-pdf_dest_list := null;
-pdf_bead_list := null;
-last_thread := null
-
-@ @<Calculate PDF page dimensions and margins@>=
-if is_shipping_page then begin
- @<Calculate DVI page dimensions and margins@>;
- {Think in upright page/paper coordinates): First preset |pos.h| and |pos.v| to the DVI origin.}
- pos.h := pdf_h_origin;
- pos.v := cur_page_size.v - pdf_v_origin;
- box_pos := pos;
- {Then calculate |cur.h| and |cur.v| within the upright coordinate system
- for the DVI origin depending on the |page_direction|.}
- dvi_direction:=page_direction;
- case box_direction(dvi_direction) of
- dir_TL_,dir_LT_: begin
- cur.h := h_offset;
- cur.v := v_offset;
- end;
- dir_TR_,dir_RT_: begin
- cur.h := cur_page_size.h - page_right_offset - one_true_inch;
- cur.v := v_offset;
- end;
- dir_BL_,dir_LB_: begin
- cur.h := h_offset;
- cur.v := cur_page_size.v - page_bottom_offset - one_true_inch;
- end;
- dir_RB_,dir_BR_: begin
- cur.h := cur_page_size.h - page_right_offset - one_true_inch;
- cur.v := cur_page_size.v - page_bottom_offset - one_true_inch;
- end;
- end;
- {The movement is actually done within the upright page coordinate system.}
- dvi_direction := dir_TL_; {only temporarily for this adjustment}
- synch_pos_with_cur; box_pos := pos; {keep track on page}
- {Then switch to page box coordinate system; do |height(p)| movement.}
- dvi_direction := page_direction;
- cur.h := 0;
- cur.v := height(p);
- synch_pos_with_cur;
- {Now we are at the point on the page where the origin of the page box should go.}
-end
-else begin
- dvi_direction:=box_dir(p);
- case box_direction(dvi_direction) of
- dir_TL_,dir_TR_,dir_BL_,dir_BR_: begin
- cur_page_size.h := width(p);
- cur_page_size.v := height(p) + depth(p);
- end;
- dir_LT_,dir_RT_,dir_LB_,dir_RB_: begin
- cur_page_size.h := height(p) + depth(p);
- cur_page_size.v := width(p);
- end;
- end;
- case box_direction(dvi_direction) of
- dir_TL_: begin
- pos.h := 0;
- pos.v := depth(p);
- end;
- dir_TR_: begin
- pos.h := width(p);
- pos.v := depth(p);
- end;
- dir_BL_: begin
- pos.h := 0;
- pos.v := height(p);
- end;
- dir_BR_: begin
- pos.h := width(p);
- pos.v := height(p);
- end;
- dir_LT_: begin
- pos.h := height(p);
- pos.v := width(p);
- end;
- dir_RT_: begin
- pos.h := depth(p);
- pos.v := width(p);
- end;
- dir_LB_: begin
- pos.h := height(p);
- pos.v := 0;
- end;
- dir_RB_: begin
- pos.h := depth(p);
- pos.v := 0;
- end;
- end;
-end;
-pdf_page_init;
-
-@ Here we write out the header for Form.
-
-@<Write out Form stream header@>=
-pdf_print_ln("/Type /XObject");
-pdf_print_ln("/Subtype /Form");
-if obj_xform_attr(pdf_cur_form) <> null then begin
- pdf_print_toks_ln(obj_xform_attr(pdf_cur_form));
- delete_toks(obj_xform_attr(pdf_cur_form));
-end;
-pdf_print("/BBox [");
-pdf_print_bp(-form_margin); pdf_print(" ");
-pdf_print_bp(-form_margin); pdf_print(" ");
-pdf_print_bp(cur_page_size.h + form_margin); pdf_out(" ");
-pdf_print_bp(cur_page_size.v + form_margin); pdf_print_ln("]");
-pdf_print_ln("/FormType 1");
-pdf_print_ln("/Matrix [1 0 0 1 0 0]");
-pdf_indirect_ln("Resources", pdf_last_resources)
-
-@ @<Start stream of page/form contents@>=
-pdf_begin_stream;
-if shipping_page then begin
- @<Adjust transformation matrix for the magnification ratio@>;
-end;
-pdfshipoutbegin(shipping_page);
-if shipping_page then
- pdf_out_colorstack_startpage;
-
-
-@ @<Adjust transformation matrix for the magnification ratio@>=
-prepare_mag;
-if mag <> 1000 then begin
- pdf_print_real(mag, 3);
- pdf_print(" 0 0 ");
- pdf_print_real(mag, 3);
- pdf_print_ln(" 0 0 cm");
-end
-
-@ @<Finish shipping@>=
-@<Finish stream of page/form contents@>;
-if shipping_page then begin
- @<Write out page object@>;
-end;
-@<Write out resource lists@>;
-if shipping_page then begin
- @<Write out pending PDF marks@>;
-end;
-@<Write out resources dictionary@>;
-@<Flush resource lists@>;
-if shipping_page then begin
- @<Flush PDF mark lists@>;
-end
-
-@ @<Finish stream of page/form contents@>=
-pdf_goto_pagemode;
-pdfshipoutend(shipping_page);
-pdf_end_stream
-
-@ @<Write out resource lists@>=
-@<Write out pending raw objects@>;
-@<Write out pending forms@>;
-@<Write out pending images@>
-
-@ @<Write out resources dictionary@>=
-pdf_begin_dict(pdf_last_resources, 1);
-@<Print additional resources@>;
-@<Generate font resources@>;
-@<Generate XObject resources@>;
-@<Generate ProcSet@>;
-pdf_end_dict
-
-@ @<Print additional resources@>=
-if shipping_page then begin
- if pdf_page_resources <> null then
- pdf_print_toks_ln(pdf_page_resources);
-end
-else begin
- if obj_xform_resources(pdf_cur_form) <> null then begin
- pdf_print_toks_ln(obj_xform_resources(pdf_cur_form));
- delete_toks(obj_xform_resources(pdf_cur_form));
- end;
-end
-
-@ In the end of shipping out a page we reset all the lists holding objects
-have been created during the page shipping.
-
-@d delete_toks(#) == begin delete_token_ref(#); # := null; end
-
-@<Flush resource lists@>=
-flush_list(pdf_font_list);
-flush_list(pdf_obj_list);
-flush_list(pdf_xform_list);
-flush_list(pdf_ximage_list)
-
-@ @<Flush PDF mark lists@>=
-flush_list(pdf_annot_list);
-flush_list(pdf_link_list);
-flush_list(pdf_dest_list);
-flush_list(pdf_bead_list)
-
-@ @<Generate font resources@>=
-if pdf_font_list <> null then begin
- pdf_print("/Font << ");
- k := pdf_font_list;
- while k <> null do begin
- pdf_print("/F");
- set_ff(info(k));
- pdf_print_int(ff);
- pdf_print_resname_prefix;
- pdf_out(" ");
- pdf_print_int(pdf_font_num(ff));
- pdf_print(" 0 R ");
- k := link(k);
- end;
- pdf_print_ln(">>");
- pdf_text_procset := true;
-end
-
-@ @<Generate XObject resources@>=
-if (pdf_xform_list <> null) or (pdf_ximage_list <> null) then begin
- pdf_print("/XObject << ");
- k := pdf_xform_list;
- while k <> null do begin
- pdf_print("/Fm");
- pdf_print_int(obj_info(info(k)));
- pdf_print_resname_prefix;
- pdf_out(" ");
- pdf_print_int(info(k));
- pdf_print(" 0 R ");
- k := link(k);
- end;
- k := pdf_ximage_list;
- while k <> null do begin
- pdf_print("/Im");
- pdf_print_int(image_index(obj_data_ptr(info(k))));
- pdf_print_resname_prefix;
- pdf_out(" ");
- pdf_print_int(info(k));
- pdf_print(" 0 R ");
- update_image_procset(obj_data_ptr(info(k)));
- k := link(k);
- end;
- pdf_print_ln(">>");
-end
-
-@ @<Generate ProcSet@>=
-pdf_print("/ProcSet [ /PDF");
-if pdf_text_procset then
- pdf_print(" /Text");
-if check_image_b(pdf_image_procset) then
- pdf_print(" /ImageB");
-if check_image_c(pdf_image_procset) then
- pdf_print(" /ImageC");
-if check_image_i(pdf_image_procset) then
- pdf_print(" /ImageI");
-pdf_print_ln(" ]")
-
-@ @<Write out page object@>=
-pdf_begin_dict(pdf_last_page, 1);
-pdf_last_pages := pdf_do_page_divert(pdf_last_page, page_divert_val);
-pdf_print_ln("/Type /Page");
-pdf_indirect_ln("Contents", pdf_last_stream);
-pdf_indirect_ln("Resources", pdf_last_resources);
-pdf_print("/MediaBox [0 0 ");
-pdf_print_mag_bp(cur_page_size.h); pdf_out(" ");
-pdf_print_mag_bp(cur_page_size.v);
-pdf_print_ln("]");
-if pdf_page_attr <> null then
- pdf_print_toks_ln(pdf_page_attr);
-pdf_indirect_ln("Parent", pdf_last_pages);
-if pdf_page_group_val > 0 then begin
- pdf_print("/Group ");
- pdf_print_int(pdf_page_group_val);
- pdf_print_ln(" 0 R");
- pdf_page_group_val := -1;
-end;
-@<Generate array of annotations or beads in page@>;
-pdf_end_dict
-
-@ @<Generate array of annotations or beads in page@>=
-if (pdf_annot_list <> null) or (pdf_link_list <> null) then begin
- pdf_print("/Annots [ ");
- k := pdf_annot_list;
- while k <> null do begin
- pdf_print_int(info(k));
- pdf_print(" 0 R ");
- k := link(k);
- end;
- k := pdf_link_list;
- while k <> null do begin
- pdf_print_int(info(k));
- pdf_print(" 0 R ");
- k := link(k);
- end;
- pdf_print_ln("]");
-end;
-if pdf_bead_list <> null then begin
- k := pdf_bead_list;
- pdf_print("/B [ ");
- while k <> null do begin
- pdf_print_int(info(k));
- pdf_print(" 0 R ");
- k := link(k);
- end;
- pdf_print_ln("]");
-end
-
-@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure pdf_write_obj(n: integer); {write a raw PDF object}
-var s: str_number;
- f: byte_file;
- data_size:integer; {total size of the data file}
- data_cur:integer; {index into |data_buffer|}
- data_buffer:^real_eight_bits; {byte buffer for data files}
- file_opened:boolean;
- k:integer;
- res:boolean;
- fnam: str_number;
- callback_id:integer;
-begin
- s := tokens_to_string(obj_obj_data(n));
- delete_toks(obj_obj_data(n));
- if obj_obj_is_stream(n) > 0 then begin
- pdf_begin_dict(n, 0);
- if obj_obj_stream_attr(n) <> null then begin
- pdf_print_toks_ln(obj_obj_stream_attr(n));
- delete_toks(obj_obj_stream_attr(n));
- end;
- pdf_begin_stream;
- end
- else
- pdf_begin_obj(n, 1);
- if obj_obj_is_file(n) > 0 then begin
- data_size:=0; data_cur:=0; data_buffer:=0;
- pack_file_name(s,"","");
- callback_id:=callback_defined(find_data_file_callback);
- if callback_id>0 then begin
- res := run_callback(callback_id,'S->s',stringcast(nameoffile+1),addressof(fnam));
- if (res)and(fnam<>0)and(length(fnam)>0) then begin
- @<Fixup |nameoffile| after callback@>;
- end;
- end;
- callback_id:=callback_defined(read_data_file_callback);
- if callback_id>0 then begin
- file_opened := false;
- res := run_callback(callback_id,'S->bSd',stringcast(nameoffile+1),
- addressof(file_opened), addressof(data_buffer),addressof(data_size));
- if not file_opened then pdf_error("ext5", "cannot open file for embedding");
- end
- else begin
- if not tex_b_open_in(f) then
- pdf_error("ext5", "cannot open file for embedding");
- res := read_data_file(f,addressof(data_buffer),addressof(data_size));
- b_close(f);
- end;
- if not data_size then pdf_error("ext5", "empty file for embedding");
- if not res then pdf_error("ext5", "error reading file for embedding");
- print("<<");
- print(s);
- while data_cur<data_size do begin
- pdf_out(data_buffer[data_cur]);
- incr(data_cur);
- end;
- if data_buffer<>0 then libcfree(data_buffer);
- print(">>");
- end
- else if obj_obj_is_stream(n) > 0 then
- pdf_print(s)
- else
- pdf_print_ln(s);
- if obj_obj_is_stream(n) > 0 then
- pdf_end_stream
- else
- pdf_end_obj;
- flush_str(s);
-end;
-
-@ @<Write out pending raw objects@>=
-if pdf_obj_list <> null then begin
- k := pdf_obj_list;
- while k <> null do begin
- if not is_obj_written(info(k)) then
- pdf_write_obj(info(k));
- k := link(k);
- end;
-end
-
-@ When flushing pending forms we need to save and restore resource lists
-(|pdf_font_list|, |pdf_obj_list|, |pdf_xform_list| and |pdf_ximage_list|),
-which are also used by page shipping.
-Saving and restoring |cur_page_size| is needed for proper
-writing out pending PDF marks.
-
-@<Write out pending forms@>=
-if pdf_xform_list <> null then begin
- k := pdf_xform_list;
- while k <> null do begin
- if not is_obj_written(info(k)) then begin
- pdf_cur_form := info(k);
- @<Save resource lists@>;
- @<Reset resource lists@>;
- save_cur_page_size := cur_page_size;
- pdf_ship_out(obj_xform_box(pdf_cur_form), false);
- cur_page_size := save_cur_page_size;
- @<Restore resource lists@>;
- end;
- k := link(k);
- end;
-end
-
-@ @<Save resource lists@>=
-save_font_list := pdf_font_list;
-save_obj_list := pdf_obj_list;
-save_xform_list := pdf_xform_list;
-save_ximage_list := pdf_ximage_list;
-save_text_procset := pdf_text_procset;
-save_image_procset := pdf_image_procset
-
-@ @<Restore resource lists@>=
-pdf_font_list := save_font_list;
-pdf_obj_list := save_obj_list;
-pdf_xform_list := save_xform_list;
-pdf_ximage_list := save_ximage_list;
-pdf_text_procset := save_text_procset;
-pdf_image_procset := save_image_procset
-
-@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure pdf_write_image(n: integer); {write an image}
-begin
- pdf_begin_dict(n, 0);
- if fixed_pdf_draftmode = 0 then write_image(obj_data_ptr(n));
-end;
-
-@ @<Write out pending images@>=
-if pdf_ximage_list <> null then begin
- k := pdf_ximage_list;
- while k <> null do begin
- if not is_obj_written(info(k)) then
- pdf_write_image(info(k));
- k := link(k);
- end;
-end
-
-@ @<Write out pending PDF marks@>=
-@<Write out PDF annotations@>;
-@<Write out PDF link annotations@>;
-@<Write out PDF mark destinations@>;
-@<Write out PDF bead rectangle specifications@>
-
-@ @<Write out PDF annotations@>=
-if pdf_annot_list <> null then begin
- k := pdf_annot_list;
- while k <> null do begin
- i := obj_annot_ptr(info(k)); {|i| points to |pdf_annot_node|}
- pdf_begin_dict(info(k), 1);
- pdf_print_ln("/Type /Annot");
- pdf_print_toks_ln(pdf_annot_data(i));
- pdf_rectangle(i);
- pdf_end_dict;
- k := link(k);
- end;
-end
-
-@ @<Write out PDF link annotations@>=
-if pdf_link_list <> null then begin
-k := pdf_link_list;
-while k <> null do begin
- i := obj_annot_ptr(info(k));
- pdf_begin_dict(info(k), 1);
- pdf_print_ln("/Type /Annot");
- if pdf_action_type(pdf_link_action(i)) <> pdf_action_user then
- pdf_print_ln("/Subtype /Link");
- if pdf_link_attr(i) <> null then
- pdf_print_toks_ln(pdf_link_attr(i));
- pdf_rectangle(i);
- if pdf_action_type(pdf_link_action(i)) <> pdf_action_user then
- pdf_print("/A ");
- write_action(pdf_link_action(i));
- pdf_end_dict;
- k := link(k);
- end;
- @<Flush |pdf_start_link_node|'s created by |append_link|@>;
-end
-
-@ @<Flush |pdf_start_link_node|'s created by |append_link|@>=
-k := pdf_link_list;
-while k <> null do begin
- i := obj_annot_ptr(info(k));
- {nodes with |subtype = pdf_link_data_node| were created by |append_link| and
- must be flushed here, as they are not linked in any list}
- if subtype(i) = pdf_link_data_node then
- flush_node(i);
- k := link(k);
-end
-
-@ @<Write out PDF mark destinations@>=
-if pdf_dest_list <> null then begin
- k := pdf_dest_list;
- while k <> null do begin
- if is_obj_written(info(k)) then
- pdf_error("ext5",
- "destination has been already written (this shouldn't happen)")
- else begin
- i := obj_dest_ptr(info(k));
- if pdf_dest_named_id(i) > 0 then begin
- pdf_begin_dict(info(k), 1);
- pdf_print("/D ");
- end
- else
- pdf_begin_obj(info(k), 1);
- pdf_out("["); pdf_print_int(pdf_last_page); pdf_print(" 0 R ");
- case pdf_dest_type(i) of
- pdf_dest_xyz: begin
- pdf_print("/XYZ ");
- pdf_print_mag_bp(pdf_ann_left(i)); pdf_out(" ");
- pdf_print_mag_bp(pdf_ann_top(i)); pdf_out(" ");
- if pdf_dest_xyz_zoom(i) = null then
- pdf_print("null")
- else begin
- pdf_print_int(pdf_dest_xyz_zoom(i) div 1000);
- pdf_out(".");
- pdf_print_int((pdf_dest_xyz_zoom(i) mod 1000));
- end;
- end;
- pdf_dest_fit:
- pdf_print("/Fit");
- pdf_dest_fith: begin
- pdf_print("/FitH ");
- pdf_print_mag_bp(pdf_ann_top(i));
- end;
- pdf_dest_fitv: begin
- pdf_print("/FitV ");
- pdf_print_mag_bp(pdf_ann_left(i));
- end;
- pdf_dest_fitb:
- pdf_print("/FitB");
- pdf_dest_fitbh: begin
- pdf_print("/FitBH ");
- pdf_print_mag_bp(pdf_ann_top(i));
- end;
- pdf_dest_fitbv: begin
- pdf_print("/FitBV ");
- pdf_print_mag_bp(pdf_ann_left(i));
- end;
- pdf_dest_fitr: begin
- pdf_print("/FitR ");
- pdf_print_rect_spec(i);
- end;
- othercases pdf_error("ext5", "unknown dest type");
- endcases;
- pdf_print_ln("]");
- if pdf_dest_named_id(i) > 0 then
- pdf_end_dict
- else
- pdf_end_obj;
- end;
- k := link(k);
- end;
-end
-
-@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure pdf_print_rect_spec(r: pointer); {prints a rect spec}
-begin
- pdf_print_mag_bp(pdf_ann_left(r));
- pdf_out(" ");
- pdf_print_mag_bp(pdf_ann_bottom(r));
- pdf_out(" ");
- pdf_print_mag_bp(pdf_ann_right(r));
- pdf_out(" ");
- pdf_print_mag_bp(pdf_ann_top(r));
-end;
-
-procedure pdf_rectangle(r:pointer); {output a rectangle specification to PDF file}
-begin
- prepare_mag;
- pdf_print("/Rect [");
- pdf_print_rect_spec(r);
- pdf_print_ln("]");
-end;
-
-@ @<Write out PDF bead rectangle specifications@>=
-if pdf_bead_list <> null then begin
- k := pdf_bead_list;
- while k <> null do begin
- pdf_new_obj(obj_type_others, 0, 1);
- pdf_out("[");
- i := obj_bead_data(info(k)); {pointer to a whatsit or whatsit-like node}
- pdf_print_rect_spec(i);
- if subtype(i) = pdf_thread_data_node then {thanh says it mis be destroyed here}
- flush_node(i);
- pdf_print_ln("]");
- obj_bead_rect(info(k)) := obj_ptr; {rewrite |obj_bead_data|}
- pdf_end_obj;
- k := link(k);
- end;
-end
-
-@ In the end we must flush PDF objects that cannot be written out
-immediately after shipping out pages.
-
-@ @<Output outlines@>=
-if pdf_first_outline <> 0 then begin
- pdf_new_dict(obj_type_others, 0, 1);
- outlines := obj_ptr;
- l := pdf_first_outline; k := 0;
- repeat
- incr(k);
- a := open_subentries(l);
- if obj_outline_count(l) > 0 then
- k := k + a;
- obj_outline_parent(l) := obj_ptr;
- l := obj_outline_next(l);
- until l = 0;
- pdf_print_ln("/Type /Outlines");
- pdf_indirect_ln("First", pdf_first_outline);
- pdf_indirect_ln("Last", pdf_last_outline);
- pdf_int_entry_ln("Count", k);
- pdf_end_dict;
- @<Output PDF outline entries@>;
-end
-else
- outlines := 0
-
-@ @<Output PDF outline entries@>=
-k := head_tab[obj_type_outline];
-while k <> 0 do begin
- if obj_outline_parent(k) = pdf_parent_outline then begin
- if obj_outline_prev(k) = 0 then
- pdf_first_outline := k;
- if obj_outline_next(k) = 0 then
- pdf_last_outline := k;
- end;
- pdf_begin_dict(k, 1);
- pdf_indirect_ln("Title", obj_outline_title(k));
- pdf_indirect_ln("A", obj_outline_action_objnum(k));
- if obj_outline_parent(k) <> 0 then
- pdf_indirect_ln("Parent", obj_outline_parent(k));
- if obj_outline_prev(k) <> 0 then
- pdf_indirect_ln("Prev", obj_outline_prev(k));
- if obj_outline_next(k) <> 0 then
- pdf_indirect_ln("Next", obj_outline_next(k));
- if obj_outline_first(k) <> 0 then
- pdf_indirect_ln("First", obj_outline_first(k));
- if obj_outline_last(k) <> 0 then
- pdf_indirect_ln("Last", obj_outline_last(k));
- if obj_outline_count(k) <> 0 then
- pdf_int_entry_ln("Count", obj_outline_count(k));
- if obj_outline_attr(k) <> 0 then begin
- pdf_print_toks_ln(obj_outline_attr(k));
- delete_toks(obj_outline_attr(k));
- end;
- pdf_end_dict;
- k := obj_link(k);
-end
-
-@ @<Output article threads@>=
-if head_tab[obj_type_thread] <> 0 then begin
- pdf_new_obj(obj_type_others, 0, 1);
- threads := obj_ptr;
- pdf_out("[");
- k := head_tab[obj_type_thread];
- while k <> 0 do begin
- pdf_print_int(k);
- pdf_print(" 0 R ");
- k := obj_link(k);
- end;
- remove_last_space;
- pdf_print_ln("]");
- pdf_end_obj;
- k := head_tab[obj_type_thread];
- while k <> 0 do begin
- out_thread(k);
- k := obj_link(k);
- end;
-end
-else
- threads := 0
-
-@ Now we are ready to declare our new procedure |ship_out|. It will call
-|pdf_ship_out| if the integer parameter |pdf_output| is positive; otherwise it
-will call |dvi_ship_out|, which is the \TeX\ original |ship_out|.
-
-@p procedure ship_out(p:pointer); {output the box |p|}
-begin
- fix_pdfoutput;
- if pdf_output > 0 then
- pdf_ship_out(p, true)
- else
- dvi_ship_out(p);
-end;
-
-@ Finishing the PDF output file.
-
-The following procedures sort the table of destination names
-@p function str_less_str(s1, s2: str_number): boolean; {compare two strings}
-var c1, c2: pool_pointer;
- l, i: integer;
-begin
- c1 := str_start_macro(s1);
- c2 := str_start_macro(s2);
- if length(s1) < length(s2) then
- l := length(s1)
- else
- l := length(s2);
- i := 0;
- while (i < l) and (str_pool[c1 + i] = str_pool[c2 + i]) do
- incr(i);
- if ((i < l) and (str_pool[c1 + i] < str_pool[c2 + i])) or
- ((i = l) and (length(s1) < length(s2))) then
- str_less_str := true
- else
- str_less_str := false;
-end;
-
-procedure sort_dest_names(l, r: integer); {sorts |dest_names| by names}
-var i, j: integer;
- s: str_number;
- e: dest_name_entry;
-begin
- i := l;
- j := r;
- s := dest_names[(l + r) div 2].objname;
- repeat
- while str_less_str(dest_names[i].objname, s) do
- incr(i);
- while str_less_str(s, dest_names[j].objname) do
- decr(j);
- if i <= j then begin
- e := dest_names[i];
- dest_names[i] := dest_names[j];
- dest_names[j] := e;
- incr(i);
- decr(j);
- end;
- until i > j;
- if l < j then
- sort_dest_names(l, j);
- if i < r then
- sort_dest_names(i, r);
-end;
-
-@ Now the finish of PDF output file. At this moment all Page objects
-are already written completely to PDF output file.
-
-@<Finish the PDF file@>=
-if total_pages=0 then begin
- if callback_id=0 then
- print_nl("No pages of output.")
- else if callback_id>0 then
- res:=run_callback(callback_id,'->');
- @.No pages of output@>
- if pdf_gone > 0 then
- garbage_warning;
-end
-else begin
- if fixed_pdf_draftmode = 0 then begin
- pdf_flush; {to make sure that the output file name has been already created}
- flush_jbig2_page0_objects; {flush page 0 objects from JBIG2 images, if any}
- @<Check for non-existing pages@>;
- @<Check for non-existing destinations@>;
- @<Output fonts definition@>;
- pdf_last_pages := output_pages_tree;
- @<Output outlines@>;
- @<Output name tree@>;
- @<Output article threads@>;
- @<Output the catalog object@>;
- pdf_print_info; {last candidate for object stream}
- if pdf_os_enable then begin
- pdf_os_switch(true);
- pdf_os_write_objstream;
- pdf_flush;
- pdf_os_switch(false);
- @<Output the cross-reference stream dictionary@>;
- pdf_flush;
- end else begin
- @<Output the |obj_tab|@>;
- end;
- @<Output the trailer@>;
- pdf_flush;
- if callback_id=0 then begin
- print_nl("Output written on "); print_file_name(0, output_file_name, 0);
- @.Output written on x@>
- print(" ("); print_int(total_pages); print(" page");
- if total_pages<>1 then print_char("s");
- print(", "); print_int(pdf_offset); print(" bytes).");
- end
- else if callback_id>0 then
- res:=run_callback(callback_id,'->');
- end;
- libpdffinish;
- if fixed_pdf_draftmode = 0 then b_close(pdf_file)
- else pdf_warning(0, "\pdfdraftmode enabled, not changing output pdf", true, true)
-end
-
-@ Destinations that have been referenced but don't exists have
-|obj_dest_ptr=null|. Leaving them undefined might cause troubles for
-PDF browsers, so we need to fix them.
-
-@p procedure pdf_fix_dest(k: integer);
-begin
- if obj_dest_ptr(k) <> null then
- return;
- pdf_warning("dest", "", false, false);
- if obj_info(k) < 0 then begin
- print("name{");
- print(-obj_info(k));
- print("}");
- end
- else begin
- print("num");
- print_int(obj_info(k));
- end;
- print(" has been referenced but does not exist, replaced by a fixed one");
- print_ln; print_ln;
- pdf_begin_obj(k, 1);
- pdf_out("[");
- pdf_print_int(head_tab[obj_type_page]);
- pdf_print_ln(" 0 R /Fit]");
- pdf_end_obj;
-end;
-
-@ @<Check for non-existing destinations@>=
-k := head_tab[obj_type_dest];
-while k <> 0 do begin
- pdf_fix_dest(k);
- k := obj_link(k);
-end
-
-@ @<Check for non-existing pages@>=
-k := head_tab[obj_type_page];
-while obj_aux(k) = 0 do begin
- pdf_warning("dest", "Page ", false, false);
- print_int(obj_info(k));
- print(" has been referenced but does not exist!");
- print_ln; print_ln;
- k := obj_link(k);
-end;
-head_tab[obj_type_page] := k
-
-@ @<Output fonts definition@>=
-for k := 1 to max_font_id do
- if font_used(k) and (pdf_font_num(k) < 0) then begin
- i := -pdf_font_num(k);
- pdfassert(pdf_font_num(i) > 0);
- for j := font_bc(k) to font_ec(k) do
- if pdf_char_marked(k, j) then
- pdf_mark_char(i, j);
- if (pdf_font_attr(i) = 0) and (pdf_font_attr(k) <> 0) then
- set_pdf_font_attr(i, pdf_font_attr(k))
- else if (pdf_font_attr(k) = 0) and (pdf_font_attr(i) <> 0) then
- set_pdf_font_attr(k,pdf_font_attr(i))
- else if (pdf_font_attr(i) <> 0) and (pdf_font_attr(k) <> 0) and
- not str_eq_str(pdf_font_attr(i), pdf_font_attr(k)) then begin
- pdf_warning("\pdffontattr", "fonts ", false, false);
- print_font_identifier(i);
- print(" and ");
- print_font_identifier(k);
- print(" have conflicting attributes; I will ignore the attributes assigned to ");
- print_font_identifier(i);
- print_ln; print_ln;
- end;
- end;
-fixed_gen_tounicode := pdf_gen_tounicode;
-k := head_tab[obj_type_font];
-while k <> 0 do begin
- f := obj_info(k);
- pdfassert(pdf_font_num(f) > 0);
- do_pdf_font(k, f);
- k := obj_link(k);
-end;
-write_fontstuff
-
-@ @p
-procedure print_pdf_pages_attr;
-begin
- if pdf_pages_attr <> null then
- pdf_print_toks_ln(pdf_pages_attr);
-end;
-
-@ The name tree is very similiar to Pages tree so its construction should be
-certain from Pages tree construction. For intermediate node |obj_info| will be
-the first name and |obj_link| will be the last name in \.{\\Limits} array.
-Note that |pdf_dest_names_ptr| will be less than |obj_ptr|, so we test if
-|k < pdf_dest_names_ptr| then |k| is index of leaf in |dest_names|; else
-|k| will be index in |obj_tab| of some intermediate node.
-
-@<Output name tree@>=
-if pdf_dest_names_ptr = 0 then begin
- dests := 0;
- goto done1;
-end;
-sort_dest_names(0, pdf_dest_names_ptr - 1);
-names_head := 0;
-names_tail := 0;
-k := 0; {index of current child of |l|; if |k < pdf_dest_names_ptr|
- then this is pointer to |dest_names| array;
- otherwise it is the pointer to |obj_tab| (object number)}
-is_names := true; {flag whether Names or Kids}
-b := 0;
-repeat
- repeat
- pdf_create_obj(obj_type_others, 0); {create a new node}
- l := obj_ptr;
- if b = 0 then
- b := l; {first in this level}
- if names_head = 0 then begin
- names_head := l;
- names_tail := l;
- end else begin
- obj_link(names_tail) := l;
- names_tail := l;
- end;
- obj_link(names_tail) := 0;
- @<Output the current node in this level@>;
- until b = 0;
- if k = l then begin
- dests := l;
- goto done1;
- end;
-until false;
-done1:
-if (dests <> 0) or (pdf_names_toks <> null) then begin
- pdf_new_dict(obj_type_others, 0, 1);
- if (dests <> 0) then
- pdf_indirect_ln("Dests", dests);
- if pdf_names_toks <> null then begin
- pdf_print_toks_ln(pdf_names_toks);
- delete_toks(pdf_names_toks);
- end;
- pdf_end_dict;
- names_tree := obj_ptr;
-end
-else
- names_tree := 0
-
-@ @<Output the current node in this level@>=
-pdf_begin_dict(l, 1);
-j := 0;
-if is_names then begin
- obj_info(l) := dest_names[k].objname;
- pdf_print("/Names [");
- repeat
- pdf_print_str(dest_names[k].objname);
- pdf_out(" ");
- pdf_print_int(dest_names[k].objnum);
- pdf_print(" 0 R ");
- incr(j);
- incr(k);
- until (j = name_tree_kids_max) or (k = pdf_dest_names_ptr);
- remove_last_space;
- pdf_print_ln("]");
- obj_aux(l) := dest_names[k - 1].objname;
- if k = pdf_dest_names_ptr then begin
- is_names := false;
- k := names_head;
- b := 0;
- end;
-end
-else begin
- obj_info(l) := obj_info(k);
- pdf_print("/Kids [");
- repeat
- pdf_print_int(k);
- pdf_print(" 0 R ");
- incr(j);
- obj_aux(l) := obj_aux(k);
- k := obj_link(k);
- until (j = name_tree_kids_max) or (k = b) or (obj_link(k) = 0);
- remove_last_space;
- pdf_print_ln("]");
- if k = b then
- b := 0;
-end;
-pdf_print("/Limits [");
-pdf_print_str(obj_info(l));
-pdf_out(" ");
-pdf_print_str(obj_aux(l));
-pdf_print_ln("]");
-pdf_end_dict;
-
-@ @<Output the catalog object@>=
-pdf_new_dict(obj_type_others, 0, 1);
-root := obj_ptr;
-pdf_print_ln("/Type /Catalog");
-pdf_indirect_ln("Pages", pdf_last_pages);
-if threads <> 0 then
- pdf_indirect_ln("Threads", threads);
-if outlines <> 0 then
- pdf_indirect_ln("Outlines", outlines);
-if names_tree <> 0 then
- pdf_indirect_ln("Names", names_tree);
-if pdf_catalog_toks <> null then begin
- pdf_print_toks_ln(pdf_catalog_toks);
- delete_toks(pdf_catalog_toks);
-end;
-if pdf_catalog_openaction <> 0 then
- pdf_indirect_ln("OpenAction", pdf_catalog_openaction);
-pdf_end_dict
-
-@ If the same keys in a dictionary are given several times, then it is not
-defined which value is choosen by an application. Therefore the keys
-|/Producer| and |/Creator| are only set if the token list
-|pdf_info_toks| converted to a string does not contain these key strings.
-
-@p function substr_of_str(s, t: str_number):boolean;
-label continue,exit;
-var j, k, kk: pool_pointer; {running indices}
-begin
- k:=str_start_macro(t);
- while (k < str_start_macro(t+1) - length(s)) do begin
- j:=str_start_macro(s);
- kk:=k;
- while (j < str_start_macro(s+1)) do begin
- if str_pool[j] <> str_pool[kk] then
- goto continue;
- incr(j);
- incr(kk);
- end;
- substr_of_str:=true;
- return;
- continue: incr(k);
- end;
- substr_of_str:=false;
-end;
-
-procedure pdf_print_info; {print info object}
-var s: str_number;
- creator_given, producer_given, creationdate_given, moddate_given, trapped_given: boolean;
-begin
- s:="";
- pdf_new_dict(obj_type_others, 0, 3); {keep Info readable unless explicitely forced}
- creator_given:=false;
- producer_given:=false;
- creationdate_given:=false;
- moddate_given:=false;
- trapped_given:=false;
- if pdf_info_toks <> null then begin
- s:=tokens_to_string(pdf_info_toks);
- creator_given:=substr_of_str("/Creator", s);
- producer_given:=substr_of_str("/Producer", s);
- creationdate_given:=substr_of_str("/CreationDate", s);
- moddate_given:=substr_of_str("/ModDate", s);
- trapped_given:=substr_of_str("/Trapped", s);
- end;
- if not producer_given then begin
- @<Print the Producer key@>;
- end;
- if pdf_info_toks <> null then begin
- if length(s) > 0 then begin
- pdf_print_ln(s);
- end;
- flush_str(s);
- delete_toks(pdf_info_toks);
- end;
- if not creator_given then
- pdf_str_entry_ln("Creator", "TeX");
- if not creationdate_given then begin
- @<Print the CreationDate key@>;
- end;
- if not moddate_given then begin
- @<Print the ModDate key@>;
- end;
- if not trapped_given then begin
- pdf_print_ln("/Trapped /False");
- end;
- pdf_str_entry_ln("PTEX.Fullbanner", pdftex_banner);
- pdf_end_dict;
-end;
-
-@ @<Print the Producer key@>=
-pdf_print("/Producer (LuaTeX-");
-pdf_print_int(luatex_version div 100);
-pdf_out(".");
-pdf_print_int(luatex_version mod 100);
-pdf_out(".");
-pdf_print(luatex_revision);
-pdf_print_ln(")")
-
-@ @<Print the CreationDate key@>=
-print_creation_date;
-
-@ @<Print the ModDate key@>=
-print_mod_date;
-
-@ @<Glob...@>=
-@!pdftex_banner: str_number; {the complete banner}
-
-@ @<Build a linked list of free objects@>=
-l := 0;
-set_obj_fresh(l); {null object at begin of list of free objects}
-for k := 1 to sys_obj_ptr do
- if not is_obj_written(k) then begin
- obj_link(l) := k;
- l := k;
- end;
-obj_link(l) := 0
-
-@ @<Output the |obj_tab|@>=
-@<Build a linked list of free objects@>;
-pdf_save_offset := pdf_offset;
-pdf_print_ln("xref");
-pdf_print("0 "); pdf_print_int_ln(obj_ptr + 1);
-pdf_print_fw_int(obj_link(0), 10);
-pdf_print_ln(" 65535 f ");
-for k := 1 to obj_ptr do begin
- if not is_obj_written(k) then begin
- pdf_print_fw_int(obj_link(k), 10);
- pdf_print_ln(" 00000 f ");
- end
- else begin
- pdf_print_fw_int(obj_offset(k), 10);
- pdf_print_ln(" 00000 n ");
- end;
-end
-
-@ @<Output the cross-reference stream dictionary@>=
-pdf_new_dict(obj_type_others, 0, 0);
-if ((obj_offset(sys_obj_ptr)/256) > 16777215) then
- xref_offset_width := 5
-else if obj_offset(sys_obj_ptr) > 16777215 then
- xref_offset_width := 4
-else if obj_offset(sys_obj_ptr) > 65535 then
- xref_offset_width := 3
-else
- xref_offset_width := 2;
-@<Build a linked list of free objects@>;
-pdf_print_ln("/Type /XRef");
-pdf_print("/Index [0 ");
-pdf_print_int(obj_ptr);
-pdf_print_ln("]");
-pdf_int_entry_ln("Size", obj_ptr);
-pdf_print("/W [1 ");
-pdf_print_int(xref_offset_width);
-pdf_print_ln(" 1]");
-pdf_indirect_ln("Root", root);
-pdf_indirect_ln("Info", obj_ptr - 1);
-if pdf_trailer_toks <> null then begin
- pdf_print_toks_ln(pdf_trailer_toks);
- delete_toks(pdf_trailer_toks);
-end;
-print_ID(output_file_name);
-pdf_print_nl;
-pdf_begin_stream;
-for k := 0 to sys_obj_ptr do begin
- if not is_obj_written(k) then begin {a free object}
- pdf_out(0);
- pdf_out_bytes(obj_link(k), xref_offset_width);
- pdf_out(255);
- end else begin
- if obj_os_idx(k) = -1 then begin {object not in object stream}
- pdf_out(1);
- pdf_out_bytes(obj_offset(k), xref_offset_width);
- pdf_out(0);
- end else begin {object in object stream}
- pdf_out(2);
- pdf_out_bytes(obj_offset(k), xref_offset_width);
- pdf_out(obj_os_idx(k));
- end;
- end;
-end;
-pdf_end_stream;
-
-@ @<Output the trailer@>=
-if not pdf_os_enable then begin
- pdf_print_ln("trailer");
- pdf_print("<< ");
- pdf_int_entry_ln("Size", sys_obj_ptr + 1);
- pdf_indirect_ln("Root", root);
- pdf_indirect_ln("Info", sys_obj_ptr);
- if pdf_trailer_toks <> null then begin
- pdf_print_toks_ln(pdf_trailer_toks);
- delete_toks(pdf_trailer_toks);
- end;
- print_ID(output_file_name);
- pdf_print_ln(" >>");
-end;
-pdf_print_ln("startxref");
-if pdf_os_enable then
- pdf_print_int_ln(obj_offset(sys_obj_ptr))
-else
- pdf_print_int_ln(pdf_save_offset);
-pdf_print_ln("%%EOF")
-
-@* \[33] Packaging.
-We're essentially done with the parts of \TeX\ that are concerned with
-the input (|get_next|) and the output (|ship_out|). So it's time to
-get heavily into the remaining part, which does the real work of typesetting.
-
-After lists are constructed, \TeX\ wraps them up and puts them into boxes.
-Two major subroutines are given the responsibility for this task: |hpack|
-applies to horizontal lists (hlists) and |vpack| applies to vertical lists
-(vlists). The main duty of |hpack| and |vpack| is to compute the dimensions
-of the resulting boxes, and to adjust the glue if one of those dimensions
-is pre-specified. The computed sizes normally enclose all of the material
-inside the new box; but some items may stick out if negative glue is used,
-if the box is overfull, or if a \.{\\vbox} includes other boxes that have
-been shifted left.
-
-The subroutine call |hpack(p,w,m)| returns a pointer to an |hlist_node|
-for a box containing the hlist that starts at |p|. Parameter |w| specifies
-a width; and parameter |m| is either `|exactly|' or `|additional|'. Thus,
-|hpack(p,w,exactly)| produces a box whose width is exactly |w|, while
-|hpack(p,w,additional)| yields a box whose width is the natural width plus
-|w|. It is convenient to define a macro called `|natural|' to cover the
-most common case, so that we can say |hpack(p,natural)| to get a box that
-has the natural width of list |p|.
-
-Similarly, |vpack(p,w,m)| returns a pointer to a |vlist_node| for a
-box containing the vlist that starts at |p|. In this case |w| represents
-a height instead of a width; the parameter |m| is interpreted as in |hpack|.
-
-@d exactly=0 {a box dimension is pre-specified}
-@d additional=1 {a box dimension is increased from the natural one}
-@d natural==0,additional {shorthand for parameters to |hpack| and |vpack|}
-
-@<Glob...@>=
-pack_direction:integer;
-spec_direction:integer;
-
-@ The parameters to |hpack| and |vpack| correspond to \TeX's primitives
-like `\.{\\hbox} \.{to} \.{300pt}', `\.{\\hbox} \.{spread} \.{10pt}'; note
-that `\.{\\hbox}' with no dimension following it is equivalent to
-`\.{\\hbox} \.{spread} \.{0pt}'. The |scan_spec| subroutine scans such
-constructions in the user's input, including the mandatory left brace that
-follows them, and it puts the specification onto |save_stack| so that the
-desired box can later be obtained by executing the following code:
-$$\vbox{\halign{#\hfil\cr
-|save_ptr:=save_ptr-2;|\cr
-|hpack(p,saved(1),saved(0)).|\cr}}$$
-Special care is necessary to ensure that the special |save_stack| codes
-are placed just below the new group code, because scanning can change
-|save_stack| when \.{\\csname} appears.
-
-@p procedure scan_spec(@!c:group_code;@!three_codes:boolean);
- {scans a box specification and left brace}
-label found, continue;
-var @!s:integer; {temporarily saved value}
-i:integer; v:integer;
-@!spec_code:exactly..additional;
-attr_list:halfword;
-begin s:=0;
-if attr_list_cache=cache_disabled then update_attribute_cache;
-attr_list:=attr_list_cache;
-if three_codes then begin
- s:=saved(0);
-continue:
- if scan_keyword('attr') then begin
- scan_register_num; i:=cur_val;
- scan_optional_equals;
- scan_int; v:=cur_val;
- if (attr_list<>null) and (attr_list=attr_list_cache) then begin
- attr_list:=copy_attribute_list(attr_list_cache);
- add_node_attr_ref(attr_list); {will be used once}
- end;
- attr_list:=do_set_attribute(attr_list,i,v);
- goto continue;
- end;
- if scan_keyword('dir') then begin
- scan_direction; spec_direction:=cur_val;
- goto continue;
- end;
- if attr_list=attr_list_cache then begin add_node_attr_ref(attr_list); end;
- end;
-if scan_keyword('to') then spec_code:=exactly
-@.to@>
-else if scan_keyword('spread') then spec_code:=additional
-@.spread@>
-else begin spec_code:=additional; cur_val:=0;
- goto found;
- end;
-scan_normal_dimen;
-found: if three_codes then begin
- saved(0):=s;
- saved(1):=spec_code;
- saved(2):=cur_val;
- saved(3):=spec_direction;
- @<DIR: Adjust |text_dir_ptr| for |scan_spec|@>;
- saved(5):=attr_list;
- save_ptr:=save_ptr+6;
- new_save_level(c); scan_left_brace;
- eq_word_define(dir_base+body_direction_code,spec_direction);
- eq_word_define(dir_base+par_direction_code,spec_direction);
- eq_word_define(dir_base+text_direction_code,spec_direction);
- eq_word_define(int_base+level_local_dir_code,cur_level);
- end
- else begin
- saved(0):=spec_code;
- saved(1):=cur_val;
- save_ptr:=save_ptr+2;
- new_save_level(c); scan_left_brace;
- end;
-spec_direction:=-1;
-end;
-
-@ To figure out the glue setting, |hpack| and |vpack| determine how much
-stretchability and shrinkability are present, considering all four orders
-of infinity. The highest order of infinity that has a nonzero coefficient
-is then used as if no other orders were present.
-
-For example, suppose that the given list contains six glue nodes with
-the respective stretchabilities 3pt, 8fill, 5fil, 6pt, $-3$fil, $-8$fill.
-Then the total is essentially 2fil; and if a total additional space of 6pt
-is to be achieved by stretching, the actual amounts of stretch will be
-0pt, 0pt, 15pt, 0pt, $-9$pt, and 0pt, since only `fil' glue will be
-considered. (The `fill' glue is therefore not really stretching infinitely
-with respect to `fil'; nobody would actually want that to happen.)
-
-The arrays |total_stretch| and |total_shrink| are used to determine how much
-glue of each kind is present. A global variable |last_badness| is used
-to implement \.{\\badness}.
-
-@<Glob...@>=
-@!total_stretch, @!total_shrink: array[glue_ord] of scaled;
- {glue found by |hpack| or |vpack|}
-@!last_badness:integer; {badness of the most recently packaged box}
-
-@ If the global variable |adjust_tail| is non-null, the |hpack| routine
-also removes all occurrences of |ins_node|, |mark_node|, and |adjust_node|
-items and appends the resulting material onto the list that ends at
-location |adjust_tail|.
-
-@< Glob...@>=
-@!adjust_tail:pointer; {tail of adjustment list}
-
-@ @<Set init...@>=adjust_tail:=null; last_badness:=0;
-
-@ @<Glob...@>=
-@!font_expand_ratio: integer; {current expansion ratio}
-@!last_leftmost_char: pointer;
-@!last_rightmost_char: pointer;
-
-@ @<Glob...@>=
-next_char_p:pointer; {pointer to the next char of an implicit kern}
-prev_char_p:pointer; {pointer to the previous char of an implicit kern}
-
-@ This procedure is called repeatedly from inside the line break algorithm.
-
-@p procedure set_prev_char_p(p:pointer);
-begin prev_char_p:=p;
-end;
-
-@ Here is |hpack|, which is place where we do font substituting when
-font expansion is being used. We define some constants used when calling
-|hpack| to deal with font expansion.
-
-@d cal_expand_ratio == 2 {calculate amount for font expansion after breaking
- paragraph into lines}
-@d subst_ex_font == 3 {substitute fonts}
-
-@d substituted = 3 {|subtype| of kern nodes that should be substituted}
-
-@p function char_stretch(p:halfword): scaled;
-var k: internal_font_number;
- dw: scaled;
- ef: integer;
- f: internal_font_number;
- c: integer;
-begin
- f := font(p);
- c := character(p);
- char_stretch := 0;
- k := pdf_font_stretch(f);
- ef := get_ef_code(f, c);
- if (k <> null_font) and (ef > 0) then begin
- dw := char_width(k,c) - char_width(f,c);
- if dw > 0 then
- char_stretch := round_xn_over_d(dw, ef, 1000);
- end;
-end;
-
-function char_shrink(p:halfword): scaled;
-var k: internal_font_number;
- dw: scaled;
- ef: integer;
- f: internal_font_number;
- c: integer;
-begin
- f := font(p);
- c := character(p);
- char_shrink := 0;
- k := pdf_font_shrink(f);
- ef := get_ef_code(f, c);
- if (k <> null_font) and (ef > 0) then begin
- dw := char_width(f,c) - char_width(k,c);
- if dw > 0 then
- char_shrink := round_xn_over_d(dw, ef, 1000);
- end;
-end;
-
-function kern_stretch(p: pointer): scaled;
-var l, r: pointer;
- d: scaled;
-begin
- kern_stretch := 0;
- if (prev_char_p = null) or (vlink(prev_char_p) <> p) or (vlink(p) = null)
- then
- return;
- l := prev_char_p;
- r := vlink(p);
- if not (is_char_node(l) and is_char_node(r) and
- (font(l) = font(r)) and
- (pdf_font_stretch(font(l)) <> null_font))
- then
- return;
- d := get_kern(pdf_font_stretch(font(l)), character(l), character(r));
- kern_stretch := round_xn_over_d(d - width(p),
- get_ef_code(font(l), character(l)), 1000);
-end;
-
-function kern_shrink(p: pointer): scaled;
-var l, r: pointer;
- d: scaled;
-begin
- kern_shrink := 0;
- if (prev_char_p = null) or (vlink(prev_char_p) <> p) or (vlink(p) = null)
- then
- return;
- l := prev_char_p;
- r := vlink(p);
- if not (is_char_node(l) and is_char_node(r) and
- (font(l) = font(r)) and
- (pdf_font_shrink(font(l)) <> null_font))
- then
- return;
- d := get_kern(pdf_font_shrink(font(l)), character(l), character(r));
- kern_shrink := round_xn_over_d(width(p) - d,
- get_ef_code(font(l), character(l)), 1000);
-end;
-
-procedure do_subst_font(p: pointer; ex_ratio: integer);
-var f, k: internal_font_number;
- r: pointer;
- ef: integer;
-begin
- if not is_char_node(p) and (type(p) = disc_node) then begin
- r := vlink(pre_break(p));
- while r <> null do begin
- if is_char_node(r) then
- do_subst_font(r, ex_ratio);
- r := vlink(r);
- end;
- r := vlink(post_break(p));
- while r <> null do begin
- if is_char_node(r) then
- do_subst_font(r, ex_ratio);
- r := vlink(r);
- end;
- r := vlink(no_break(p));
- while r <> null do begin
- if is_char_node(r) then
- do_subst_font(r, ex_ratio);
- r := vlink(r);
- end;
- return;
- end;
- if is_char_node(p) then
- r := p
- else begin
- {|short_display_n(p, 5);|}
- pdf_error("font expansion", "invalid node type");
- return;
- end;
- f := font(r);
- ef := get_ef_code(f, character(r));
- if ef = 0 then
- return;
- if (pdf_font_expand_ratio(f)=0) and
- (pdf_font_stretch(f) <> null_font) and
- (ex_ratio > 0) then
- k := expand_font(f, ext_xn_over_d(ex_ratio*ef,
- pdf_font_expand_ratio(pdf_font_stretch(f)),
- 1000000))
- else if (pdf_font_expand_ratio(f)=0) and
- (pdf_font_shrink(f) <> null_font) and (ex_ratio < 0) then
- k := expand_font(f, ext_xn_over_d(ex_ratio*ef,
- -pdf_font_expand_ratio(pdf_font_shrink(f)),
- 1000000))
- else
- k := f;
- if k <> f then begin
- font(r) := k;
- if not is_char_node(p) then begin
- r := lig_ptr(p);
- while r <> null do begin
- font(r) := k;
- r := vlink(r);
- end;
- end;
- end;
-end;
-
-function char_pw(p: pointer; side: small_number): scaled;
-var f: internal_font_number;
- c: integer;
-begin
- char_pw := 0;
- if side = left_side then
- last_leftmost_char := null
- else
- last_rightmost_char := null;
- if p = null then
- return;
- if not is_char_node(p) then
- return;
- f := font(p);
- if side = left_side then begin
- c := get_lp_code(f, character(p));
- last_leftmost_char := p;
- end
- else begin
- c := get_rp_code(f, character(p));
- last_rightmost_char := p;
- end;
- if c = 0 then
- return;
- char_pw :=
- round_xn_over_d(quad(f), c, 1000);
-end;
-
-function new_margin_kern(w: scaled; p: pointer; side: small_number): pointer;
-var k,q: pointer;
-begin
- k := new_node(margin_kern_node,side);
- width(k) := w;
- if p = null then
- pdf_error("margin kerning", "invalid pointer to marginal char node");
- q := new_char(font(p), character(p)); margin_char(k):=q;
- new_margin_kern := k;
-end;
-
-function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
-label reswitch,common_ending,exit;
-var r:pointer; {the box node that will be returned}
-@!q:pointer; {trails behind |p|}
-@!h,@!d,@!x:scaled; {height, depth, and natural width}
-@!s:scaled; {shift amount}
-@!g:pointer; {points to a glue specification}
-@!o:glue_ord; {order of infinity}
-@!f:internal_font_number; {the font in a |char_node|}
-@!dir_tmp,dir_ptr:pointer; {for managing the direction stack}
-@!hpack_dir:integer; {the current direction}
-@!disc_level:integer;
-pack_interrupt:array[0..255] of halfword;
-font_stretch: scaled;
-font_shrink: scaled;
-k: scaled;
-begin last_badness:=0; r:=new_node(hlist_node,min_quarterword);
-if pack_direction=-1 then
- box_dir(r):=text_direction
-else begin
- box_dir(r):=pack_direction; pack_direction:=-1;
- end;
-hpack_dir:=box_dir(r);
-dir_ptr:=null;
-push_dir(hpack_dir);
-q:=r+list_offset; vlink(q):=p;@/
-if m = cal_expand_ratio then begin
- prev_char_p := null;
- font_stretch := 0;
- font_shrink := 0;
- font_expand_ratio := 0;
-end;
-h:=0; @<Clear dimensions to zero@>;
-disc_level:=0;
-reswitch:
-while (p<>null)or(disc_level>0) do begin
- if p=null then begin
- decr(disc_level);
- p:=pack_interrupt[disc_level];
- goto reswitch;
- end;
- @<Examine node |p| in the hlist, taking account of its effect
- on the dimensions of the new box, or moving it to the adjustment list;
- then advance |p| to the next node@>;
- end;
-if adjust_tail<>null then vlink(adjust_tail):=null;
-if pre_adjust_tail<>null then vlink(pre_adjust_tail):=null;
-height(r):=h; depth(r):=d;@/
-@<Determine the value of |width(r)| and the appropriate glue setting;
- then |return| or |goto common_ending|@>;
-common_ending: @<Finish issuing a diagnostic message
- for an overfull or underfull hbox@>;
-exit:
-if (m = cal_expand_ratio) and (font_expand_ratio <> 0) then begin
- font_expand_ratio := fix_int(font_expand_ratio, -1000, 1000);
- q := list_ptr(r);
- list_ptr(r):=null; flush_node(r);
- r:=hpack(q, w, subst_ex_font);
-end;
-while dir_ptr<>null do pop_dir_node;
-hpack:=r;
-end;
-
-function filtered_hpack(@!p:pointer;@!qt:pointer;@!w:scaled;@!m:small_number;@!grp:integer):pointer;
-var q:pointer;
-begin
- new_hyphenation(p,qt);
- call_func(new_ligkern(p,qt)); {don't care about the tail in this case}
- q:=vlink(p);
- q:=lua_hpack_filter(q,w,m,grp);
- filtered_hpack:=hpack(q,w,m);
-end;
-
-@ @<Clear dimensions to zero@>=
-d:=0; x:=0;
-total_stretch[normal]:=0; total_shrink[normal]:=0;
-total_stretch[sfi]:=0; total_shrink[sfi]:=0;
-total_stretch[fil]:=0; total_shrink[fil]:=0;
-total_stretch[fill]:=0; total_shrink[fill]:=0;
-total_stretch[filll]:=0; total_shrink[filll]:=0
-
-@ @<Examine node |p| in the hlist, taking account of its effect...@>=
-@^inner loop@>
-begin while is_char_node(p) do
- @<Incorporate character dimensions into the dimensions of
- the hbox that will contain~it, then move to the next node@>;
-if p<>null then
- begin case type(p) of
- hlist_node_case,vlist_node_case,rule_node_case,unset_node_case:
- @<Incorporate box dimensions into the dimensions of
- the hbox that will contain~it@>;
- ins_node_case,mark_node_case,adjust_node_case: begin if adjust_tail<>null then
- @<Transfer node |p| to the adjustment list@>; end;
- whatsit_node_case:@<Incorporate a whatsit node into an hbox@>;
- glue_node_case:@<Incorporate glue into the horizontal totals@>;
- margin_kern_node_case: begin
- if m = cal_expand_ratio then begin
- f := font(margin_char(p));
- do_subst_font(margin_char(p), 1000);
- if f <> font(margin_char(p)) then
- font_stretch := font_stretch - width(p) -
- char_pw(margin_char(p), subtype(p));
- font(margin_char(p)) := f;
- do_subst_font(margin_char(p), -1000);
- if f <> font(margin_char(p)) then
- font_shrink := font_shrink - width(p) -
- char_pw(margin_char(p), subtype(p));
- font(margin_char(p)) := f;
- end
- else if m = subst_ex_font then begin
- do_subst_font(margin_char(p), font_expand_ratio);
- width(p) := -char_pw(margin_char(p), subtype(p));
- end;
- x := x + width(p);
- end;
- kern_node_case: begin
- if subtype(p) = normal then begin
- if m = cal_expand_ratio then begin
- font_stretch := font_stretch + kern_stretch(p);
- font_shrink := font_shrink + kern_shrink(p);
- end
- else if m = subst_ex_font then begin
- if font_expand_ratio > 0 then
- k := kern_stretch(p)
- else if font_expand_ratio < 0 then
- k := kern_shrink(p)
- else
- pdfassert(0);
- if k <> 0 then
- width(p) := get_kern(font(prev_char_p),
- character(prev_char_p),
- character(vlink(p)))
- end;
- end;
- x := x + width(p);
- end;
- math_node_case: x:=x+surround(p);
- disc_node_case:
- begin
- if m = subst_ex_font then do_subst_font(p, font_expand_ratio);
- if (subtype(p)<>select_disc)and(vlink(no_break(p))<>null) then begin
- pack_interrupt[disc_level]:=vlink(p);
- incr(disc_level);
- p:=no_break(p);
- end;
- end;
- othercases do_nothing
- endcases;@/
- p:=vlink(p);
- end;
-end
-
-
-@ The code here implicitly uses the fact that running dimensions are
-indicated by |null_flag|, which will be ignored in the calculations
-because it is a highly negative number.
-
-@<Incorporate box dimensions into the dimensions of the hbox...@>=
-begin
-if (type(p)=hlist_node) or (type(p)=vlist_node) then begin
- if dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[hpack_dir]) then begin
- x:=x+height(p)+depth(p);
- s:=shift_amount(p);
- if (width(p) div 2)-s>h then h:=(width(p) div 2)-s;
- if (width(p) div 2)+s>d then d:=(width(p) div 2)+s;
- end
- else if (type(p)=hlist_node) and is_mirrored(hpack_dir) then begin
- x:=x+width(p);
- s:=shift_amount(p);
- if depth(p)-s>h then h:=depth(p)-s;
- if height(p)+s>d then d:=height(p)+s;
- end
- else begin
- x:=x+width(p);
- s:=shift_amount(p);
- if height(p)-s>h then h:=height(p)-s;
- if depth(p)+s>d then d:=depth(p)+s;
- end
- end
-else begin
- x:=x+width(p);
- if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
- if height(p)-s>h then h:=height(p)-s;
- if depth(p)+s>d then d:=depth(p)+s;
- end;
-end
-
-@ The following code is part of \TeX's inner loop; i.e., adding another
-character of text to the user's input will cause each of these instructions
-to be exercised one more time.
-@^inner loop@>
-
-@d add_char_stretch_end(#) == char_stretch(#)
-@d add_char_stretch(#) == # := # + add_char_stretch_end
-
-@d add_char_shrink_end(#) == char_shrink(#)
-@d add_char_shrink(#) == # := # + add_char_shrink_end
-
-@<Incorporate character dimensions into the dimensions of the hbox...@>=
-begin
-if m >= cal_expand_ratio then begin
- prev_char_p := p;
- case m of
- cal_expand_ratio: begin
- add_char_stretch(font_stretch)(p);
- add_char_shrink(font_shrink)(p);
- end;
- subst_ex_font:
- do_subst_font(p, font_expand_ratio);
- endcases;
-end;
-f:=font(p);
-if is_rotated(hpack_dir) then begin
- x:=x+glyph_height(p)+glyph_depth(p);@/
- s:=glyph_width(p) div 2;@+if s>h then h:=s;@+if s>d then d:=s;
- end
-else if dir_opposite(dir_tertiary[hpack_dir])(dir_tertiary[box_dir(r)])
- then begin
- x:=x+glyph_width(p);@/
- s:=glyph_depth(p);@+if s>h then h:=s;
- s:=glyph_height(p);@+if s>d then d:=s;
- end
-else begin
- x:=x+glyph_width(p);@/
- s:=glyph_height(p);@+if s>h then h:=s;
- s:=glyph_depth(p);@+if s>d then d:=s;
- end;
-p:=vlink(p);
-end
-
-@ Although node |q| is not necessarily the immediate predecessor of node |p|,
-it always points to some node in the list preceding |p|. Thus, we can delete
-nodes by moving |q| when necessary. The algorithm takes linear time, and the
-extra computation does not intrude on the inner loop unless it is necessary
-to make a deletion.
-@^inner loop@>
-
-@<Glob...@>=
-@!pre_adjust_tail: pointer;
-
-@ @<Set init...@>=
-pre_adjust_tail := null;
-
-@ Materials in \.{\\vadjust} used with \.{pre} keyword will be appended to
-|pre_adjust_tail| instead of |adjust_tail|.
-
-@d update_adjust_list(#) == begin
- vlink(#) := adjust_ptr(p);
- while vlink(#) <> null do
- # := vlink(#);
-end
-
-@<Transfer node |p| to the adjustment list@>=
-begin while vlink(q)<>p do q:=vlink(q);
- if type(p) = adjust_node then begin
- if adjust_pre(p) <> 0 then
- update_adjust_list(pre_adjust_tail)
- else
- update_adjust_list(adjust_tail);
- p := vlink(p);
- adjust_ptr(vlink(q)):=null; flush_node(vlink(q));
- end
-else begin vlink(adjust_tail):=p; adjust_tail:=p; p:=vlink(p);
- end;
-vlink(q):=p; p:=q;
-end
-
-@ @<Incorporate glue into the horizontal totals@>=
-begin g:=glue_ptr(p); x:=x+width(g);@/
-o:=stretch_order(g); total_stretch[o]:=total_stretch[o]+stretch(g);
-o:=shrink_order(g); total_shrink[o]:=total_shrink[o]+shrink(g);
-if subtype(p)>=a_leaders then
- begin g:=leader_ptr(p);
- if height(g)>h then h:=height(g);
- if depth(g)>d then d:=depth(g);
- end;
-end
-
-@ When we get to the present part of the program, |x| is the natural width
-of the box being packaged.
-
-@<Determine the value of |width(r)| and the appropriate glue setting...@>=
-if m=additional then w:=x+w;
-width(r):=w; x:=w-x; {now |x| is the excess to be made up}
-if x=0 then
- begin glue_sign(r):=normal; glue_order(r):=normal;
- set_glue_ratio_zero(glue_set(r));
- return;
- end
-else if x>0 then @<Determine horizontal glue stretch setting, then |return|
- or \hbox{|goto common_ending|}@>
-else @<Determine horizontal glue shrink setting, then |return|
- or \hbox{|goto common_ending|}@>
-
-@ If |hpack| is called with |m=cal_expand_ratio| we calculate
-|font_expand_ratio| and return without checking for overfull or underfull box.
-
-@<Determine horizontal glue stretch setting...@>=
-begin @<Determine the stretch order@>;
-if (m = cal_expand_ratio) and (o = normal) and (font_stretch > 0) then begin
- font_expand_ratio := divide_scaled_n(x, font_stretch, 1000.0);
- return;
-end;
-glue_order(r):=o; glue_sign(r):=stretching;
-if total_stretch[o]<>0 then glue_set(r):=unfloat(x/total_stretch[o])
-@^real division@>
-else begin glue_sign(r):=normal;
- set_glue_ratio_zero(glue_set(r)); {there's nothing to stretch}
- end;
-if o=normal then if list_ptr(r)<>null then
- @<Report an underfull hbox and |goto common_ending|, if this box
- is sufficiently bad@>;
-return;
-end
-
-@ @<Determine the stretch order@>=
-if total_stretch[filll]<>0 then o:=filll
-else if total_stretch[fill]<>0 then o:=fill
-else if total_stretch[fil]<>0 then o:=fil
-else if total_stretch[sfi]<>0 then o:=sfi
-else o:=normal
-
-@ @<Report an underfull hbox and |goto common_ending|, if...@>=
-begin last_badness:=badness(x,total_stretch[normal]);
-if last_badness>hbadness then
- begin print_ln;
- if last_badness>100 then print_nl("Underfull")@+else print_nl("Loose");
- print(" \hbox (badness "); print_int(last_badness);
-@.Underfull \\hbox...@>
-@.Loose \\hbox...@>
- goto common_ending;
- end;
-end
-
-@ In order to provide a decent indication of where an overfull or underfull
-box originated, we use a global variable |pack_begin_line| that is
-set nonzero only when |hpack| is being called by the paragraph builder
-or the alignment finishing routine.
-
-@<Glob...@>=
-@!pack_begin_line:integer; {source file line where the current paragraph
- or alignment began; a negative value denotes alignment}
-
-@ @<Set init...@>=
-pack_begin_line:=0;
-
-@ @<Finish issuing a diagnostic message for an overfull or underfull hbox@>=
-if output_active then print(") has occurred while \output is active")
-else begin if pack_begin_line<>0 then
- begin if pack_begin_line>0 then print(") in paragraph at lines ")
- else print(") in alignment at lines ");
- print_int(abs(pack_begin_line));
- print("--");
- end
- else print(") detected at line ");
- print_int(line);
- end;
-print_ln;@/
-font_in_short_display:=null_font; short_display(list_ptr(r)); print_ln;@/
-begin_diagnostic; show_box(r); end_diagnostic(true)
-
-@ @<Determine horizontal glue shrink setting...@>=
-begin @<Determine the shrink order@>;
-if (m = cal_expand_ratio) and (o = normal) and (font_shrink > 0) then begin
- font_expand_ratio := divide_scaled_n(x, font_shrink, 1000.0);
- return;
-end;
-glue_order(r):=o; glue_sign(r):=shrinking;
-if total_shrink[o]<>0 then glue_set(r):=unfloat((-x)/total_shrink[o])
-@^real division@>
-else begin glue_sign(r):=normal;
- set_glue_ratio_zero(glue_set(r)); {there's nothing to shrink}
- end;
-if (total_shrink[o]<-x)and(o=normal)and(list_ptr(r)<>null) then
- begin last_badness:=1000000;
- set_glue_ratio_one(glue_set(r)); {use the maximum shrinkage}
- @<Report an overfull hbox and |goto common_ending|, if this box
- is sufficiently bad@>;
- end
-else if o=normal then if list_ptr(r)<>null then
- @<Report a tight hbox and |goto common_ending|, if this box
- is sufficiently bad@>;
-return;
-end
-
-@ @<Determine the shrink order@>=
-if total_shrink[filll]<>0 then o:=filll
-else if total_shrink[fill]<>0 then o:=fill
-else if total_shrink[fil]<>0 then o:=fil
-else if total_shrink[sfi]<>0 then o:=sfi
-else o:=normal
-
-@ @<Report an overfull hbox and |goto common_ending|, if...@>=
-if (-x-total_shrink[normal]>hfuzz)or(hbadness<100) then
- begin if (overfull_rule>0)and(-x-total_shrink[normal]>hfuzz) then
- begin while vlink(q)<>null do q:=vlink(q);
- vlink(q):=new_rule; rule_dir(vlink(q)):=box_dir(r);
- width(vlink(q)):=overfull_rule;
- end;
- print_ln; print_nl("Overfull \hbox (");
-@.Overfull \\hbox...@>
- print_scaled(-x-total_shrink[normal]); print("pt too wide");
- goto common_ending;
- end
-
-@ @<Report a tight hbox and |goto common_ending|, if...@>=
-begin last_badness:=badness(-x,total_shrink[normal]);
-if last_badness>hbadness then
- begin print_ln; print_nl("Tight \hbox (badness "); print_int(last_badness);
-@.Tight \\hbox...@>
- goto common_ending;
- end;
-end
-
-@ The |vpack| subroutine is actually a special case of a slightly more
-general routine called |vpackage|, which has four parameters. The fourth
-parameter, which is |max_dimen| in the case of |vpack|, specifies the
-maximum depth of the page box that is constructed. The depth is first
-computed by the normal rules; if it exceeds this limit, the reference
-point is simply moved down until the limiting depth is attained.
-
-@d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth}
-
-@p function vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled):
- pointer;
-label common_ending, exit;
-var r:pointer; {the box node that will be returned}
-@!w,@!d,@!x:scaled; {width, depth, and natural height}
-@!s:scaled; {shift amount}
-@!g:pointer; {points to a glue specification}
-@!o:glue_ord; {order of infinity}
-begin last_badness:=0;
-{pdfassert(p<>0);}
-r:=new_node(vlist_node,0);
-if pack_direction=-1 then
- box_dir(r):=body_direction
-else begin
- box_dir(r):=pack_direction; pack_direction:=-1;
- end;
-subtype(r):=min_quarterword; shift_amount(r):=0;
-list_ptr(r):=p;@/
-w:=0; @<Clear dimensions to zero@>;
-while p<>null do @<Examine node |p| in the vlist, taking account of its effect
- on the dimensions of the new box; then advance |p| to the next node@>;
-width(r):=w;
-if d>l then
- begin x:=x+d-l; depth(r):=l;
- end
-else depth(r):=d;
-@<Determine the value of |height(r)| and the appropriate glue setting;
- then |return| or |goto common_ending|@>;
-common_ending: @<Finish issuing a diagnostic message
- for an overfull or underfull vbox@>;
-exit: vpackage:=r;
-end;
-
-function filtered_vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled;@!grp:integer):pointer;
-var q:pointer;
-begin
- q:=p;
- q:=lua_vpack_filter(q,h,m,l,grp);
- filtered_vpackage:=vpackage(q,h,m,l);
-end;
-
-@ @<Examine node |p| in the vlist, taking account of its effect...@>=
-begin if is_char_node(p) then confusion("vpack")
-@:this can't happen vpack}{\quad vpack@>
-else case type(p) of
- hlist_node_case,vlist_node_case,rule_node_case,unset_node_case:
- @<Incorporate box dimensions into the dimensions of
- the vbox that will contain~it@>;
- whatsit_node_case:@<Incorporate a whatsit node into a vbox@>;
- glue_node_case: @<Incorporate glue into the vertical totals@>;
- kern_node_case: begin x:=x+d+width(p); d:=0;
- end;
- othercases do_nothing
- endcases;
-p:=vlink(p);
-end
-
-@ @<Incorporate box dimensions into the dimensions of the vbox...@>=
-begin
-if (type(p)=hlist_node) or (type(p)=vlist_node) then begin
- if dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[box_dir(r)]) then begin
- x:=x+d+(width(p) div 2); d:=width(p) div 2;
- s:=shift_amount(p);
- if depth(p)+height(p)+s>w then w:=depth(p)+height(p)+s;
- end
- else if (type(p)=hlist_node) and is_mirrored(box_dir(p)) then begin
- x:=x+d+depth(p); d:=height(p);
- s:=shift_amount(p);
- if width(p)+s>w then w:=width(p)+s;
- end
- else begin
- x:=x+d+height(p); d:=depth(p);
- s:=shift_amount(p);
- if width(p)+s>w then w:=width(p)+s;
- end
- end
-else
- begin x:=x+d+height(p); d:=depth(p);
- if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
- if width(p)+s>w then w:=width(p)+s;
- end;
-end
-
-@ @<Incorporate glue into the vertical totals@>=
-begin x:=x+d; d:=0;@/
-g:=glue_ptr(p); x:=x+width(g);@/
-o:=stretch_order(g); total_stretch[o]:=total_stretch[o]+stretch(g);
-o:=shrink_order(g); total_shrink[o]:=total_shrink[o]+shrink(g);
-if subtype(p)>=a_leaders then
- begin g:=leader_ptr(p);
- if width(g)>w then w:=width(g);
- end;
-end
-
-@ When we get to the present part of the program, |x| is the natural height
-of the box being packaged.
-
-@<Determine the value of |height(r)| and the appropriate glue setting...@>=
-if m=additional then h:=x+h;
-height(r):=h; x:=h-x; {now |x| is the excess to be made up}
-if x=0 then
- begin glue_sign(r):=normal; glue_order(r):=normal;
- set_glue_ratio_zero(glue_set(r));
- return;
- end
-else if x>0 then @<Determine vertical glue stretch setting, then |return|
- or \hbox{|goto common_ending|}@>
-else @<Determine vertical glue shrink setting, then |return|
- or \hbox{|goto common_ending|}@>
-
-@ @<Determine vertical glue stretch setting...@>=
-begin @<Determine the stretch order@>;
-glue_order(r):=o; glue_sign(r):=stretching;
-if total_stretch[o]<>0 then glue_set(r):=unfloat(x/total_stretch[o])
-@^real division@>
-else begin glue_sign(r):=normal;
- set_glue_ratio_zero(glue_set(r)); {there's nothing to stretch}
- end;
-if o=normal then if list_ptr(r)<>null then
- @<Report an underfull vbox and |goto common_ending|, if this box
- is sufficiently bad@>;
-return;
-end
-
-@ @<Report an underfull vbox and |goto common_ending|, if...@>=
-begin last_badness:=badness(x,total_stretch[normal]);
-if last_badness>vbadness then
- begin print_ln;
- if last_badness>100 then print_nl("Underfull")@+else print_nl("Loose");
- print(" \vbox (badness "); print_int(last_badness);
-@.Underfull \\vbox...@>
-@.Loose \\vbox...@>
- goto common_ending;
- end;
-end
-
-@ @<Finish issuing a diagnostic message for an overfull or underfull vbox@>=
-if output_active then print(") has occurred while \output is active")
-else begin if pack_begin_line<>0 then {it's actually negative}
- begin print(") in alignment at lines ");
- print_int(abs(pack_begin_line));
- print("--");
- end
- else print(") detected at line ");
- print_int(line);
- print_ln;@/
- end;
-begin_diagnostic; show_box(r); end_diagnostic(true)
-
-@ @<Determine vertical glue shrink setting...@>=
-begin @<Determine the shrink order@>;
-glue_order(r):=o; glue_sign(r):=shrinking;
-if total_shrink[o]<>0 then glue_set(r):=unfloat((-x)/total_shrink[o])
-@^real division@>
-else begin glue_sign(r):=normal;
- set_glue_ratio_zero(glue_set(r)); {there's nothing to shrink}
- end;
-if (total_shrink[o]<-x)and(o=normal)and(list_ptr(r)<>null) then
- begin last_badness:=1000000;
- set_glue_ratio_one(glue_set(r)); {use the maximum shrinkage}
- @<Report an overfull vbox and |goto common_ending|, if this box
- is sufficiently bad@>;
- end
-else if o=normal then if list_ptr(r)<>null then
- @<Report a tight vbox and |goto common_ending|, if this box
- is sufficiently bad@>;
-return;
-end
-
-@ @<Report an overfull vbox and |goto common_ending|, if...@>=
-if (-x-total_shrink[normal]>vfuzz)or(vbadness<100) then
- begin print_ln; print_nl("Overfull \vbox (");
-@.Overfull \\vbox...@>
- print_scaled(-x-total_shrink[normal]); print("pt too high");
- goto common_ending;
- end
-
-@ @<Report a tight vbox and |goto common_ending|, if...@>=
-begin last_badness:=badness(-x,total_shrink[normal]);
-if last_badness>vbadness then
- begin print_ln; print_nl("Tight \vbox (badness "); print_int(last_badness);
-@.Tight \\vbox...@>
- goto common_ending;
- end;
-end
-
-@ When a box is being appended to the current vertical list, the
-baselineskip calculation is handled by the |append_to_vlist| routine.
-
-@p procedure append_to_vlist(@!b:pointer);
-var d:scaled; {deficiency of space between baselines}
-@!p:pointer; {a new glue node}
-begin if prev_depth>pdf_ignored_dimen then
- begin
- if (type(b)=hlist_node) and is_mirrored(box_dir(b)) then
- d:=width(baseline_skip)-prev_depth-depth(b)
- else
- d:=width(baseline_skip)-prev_depth-height(b);
- if d<line_skip_limit then p:=new_param_glue(line_skip_code)
- else begin p:=new_skip_param(baseline_skip_code);
- width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
- end;
- vlink(tail):=p; tail:=p;
- end;
-vlink(tail):=b; tail:=b;
-if (type(b)=hlist_node) and is_mirrored(box_dir(b)) then
- prev_depth:=height(b)
-else
- prev_depth:=depth(b);
-end;
-
-@* \[34] Data structures for math mode.
-
-Is done in C.
-
-@* \[35] Subroutines for math mode.
-
-Is one in C.
-
-@* \[36] Typesetting math formulas.
-
-Is done in C.
-
-@* \[37] Alignment.
-It's sort of a miracle whenever \.{\\halign} and \.{\\valign} work, because
-they cut across so many of the control structures of \TeX.
-
-Therefore the
-present page is probably not the best place for a beginner to start reading
-this program; it is better to master everything else first.
-
-Let us focus our thoughts on an example of what the input might be, in order
-to get some idea about how the alignment miracle happens. The example doesn't
-do anything useful, but it is sufficiently general to indicate all of the
-special cases that must be dealt with; please do not be disturbed by its
-apparent complexity and meaninglessness.
-$$\vbox{\halign{\.{#}\hfil\cr
-{}\\tabskip 2pt plus 3pt\cr
-{}\\halign to 300pt\{u1\#v1\&\cr
-\hskip 50pt\\tabskip 1pt plus 1fil u2\#v2\&\cr
-\hskip 50pt u3\#v3\\cr\cr
-\hskip 25pt a1\&\\omit a2\&\\vrule\\cr\cr
-\hskip 25pt \\noalign\{\\vskip 3pt\}\cr
-\hskip 25pt b1\\span b2\\cr\cr
-\hskip 25pt \\omit\&c2\\span\\omit\\cr\}\cr}}$$
-Here's what happens:
-
-\yskip
-(0) When `\.{\\halign to 300pt\{}' is scanned, the |scan_spec| routine
-places the 300pt dimension onto the |save_stack|, and an |align_group|
-code is placed above it. This will make it possible to complete the alignment
-when the matching `\.\}' is found.
-
-(1) The preamble is scanned next. Macros in the preamble are not expanded,
-@^preamble@>
-except as part of a tabskip specification. For example, if \.{u2} had been
-a macro in the preamble above, it would have been expanded, since \TeX\
-must look for `\.{minus...}' as part of the tabskip glue. A ``preamble list''
-is constructed based on the user's preamble; in our case it contains the
-following seven items:
-$$\vbox{\halign{\.{#}\hfil\qquad&(#)\hfil\cr
-{}\\glue 2pt plus 3pt&the tabskip preceding column 1\cr
-{}\\alignrecord, width $-\infty$&preamble info for column 1\cr
-{}\\glue 2pt plus 3pt&the tabskip between columns 1 and 2\cr
-{}\\alignrecord, width $-\infty$&preamble info for column 2\cr
-{}\\glue 1pt plus 1fil&the tabskip between columns 2 and 3\cr
-{}\\alignrecord, width $-\infty$&preamble info for column 3\cr
-{}\\glue 1pt plus 1fil&the tabskip following column 3\cr}}$$
-These ``alignrecord'' entries have the same size as an |unset_node|,
-since they will later be converted into such nodes. These alignrecord
-nodes have no |depth| field; this is split into |u_part| and |v_part|,
-and they point to token lists for the templates of the alignment. For
-example, the |u_part| field in the first alignrecord points to the
-token list `\.{u1}', i.e., the template preceding the `\.\#' for
-column~1. Furthermore, They have a |span_ptr| instead of a |node_attr|
-field, and these |span_ptr| fields are initially set to the value
-|end_span|, for reasons explained below.
-
-(2) \TeX\ now looks at what follows the \.{\\cr} that ended the preamble.
-It is not `\.{\\noalign}' or `\.{\\omit}', so this input is put back to
-be read again, and the template `\.{u1}' is fed to the scanner. Just
-before reading `\.{u1}', \TeX\ goes into restricted horizontal mode.
-Just after reading `\.{u1}', \TeX\ will see `\.{a1}', and then (when the
-{\.\&} is sensed) \TeX\ will see `\.{v1}'. Then \TeX\ scans an |endv|
-token, indicating the end of a column. At this point an |unset_node| is
-created, containing the contents of the current hlist (i.e., `\.{u1a1v1}').
-The natural width of this unset node replaces the |width| field of the
-alignrecord for column~1; in general, the alignrecords will record the
-maximum natural width that has occurred so far in a given column.
-
-(3) Since `\.{\\omit}' follows the `\.\&', the templates for column~2
-are now bypassed. Again \TeX\ goes into restricted horizontal mode and
-makes an |unset_node| from the resulting hlist; but this time the
-hlist contains simply `\.{a2}'. The natural width of the new unset box
-is remembered in the |width| field of the alignrecord for column~2.
-
-(4) A third |unset_node| is created for column 3, using essentially the
-mechanism that worked for column~1; this unset box contains `\.{u3\\vrule
-v3}'. The vertical rule in this case has running dimensions that will later
-extend to the height and depth of the whole first row, since each |unset_node|
-in a row will eventually inherit the height and depth of its enclosing box.
-
-(5) The first row has now ended; it is made into a single unset box
-comprising the following seven items:
-$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
-{}\\glue 2pt plus 3pt\cr
-{}\\unsetbox for 1 column: u1a1v1\cr
-{}\\glue 2pt plus 3pt\cr
-{}\\unsetbox for 1 column: a2\cr
-{}\\glue 1pt plus 1fil\cr
-{}\\unsetbox for 1 column: u3\\vrule v3\cr
-{}\\glue 1pt plus 1fil\cr}}$$
-The width of this unset row is unimportant, but it has the correct height
-and depth, so the correct baselineskip glue will be computed as the row
-is inserted into a vertical list.
-
-(6) Since `\.{\\noalign}' follows the current \.{\\cr}, \TeX\ appends
-additional material (in this case \.{\\vskip 3pt}) to the vertical list.
-While processing this material, \TeX\ will be in internal vertical
-mode, and |no_align_group| will be on |save_stack|.
-
-(7) The next row produces an unset box that looks like this:
-$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
-{}\\glue 2pt plus 3pt\cr
-{}\\unsetbox for 2 columns: u1b1v1u2b2v2\cr
-{}\\glue 1pt plus 1fil\cr
-{}\\unsetbox for 1 column: {\rm(empty)}\cr
-{}\\glue 1pt plus 1fil\cr}}$$
-The natural width of the unset box that spans columns 1~and~2 is stored
-in a ``span node,'' which we will explain later; the |span_ptr| field of the
-alignrecord for column~1 now points to the new span node, and the |span_ptr|
-of the span node points to |end_span|.
-
-(8) The final row produces the unset box
-$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
-{}\\glue 2pt plus 3pt\cr
-{}\\unsetbox for 1 column: {\rm(empty)}\cr
-{}\\glue 2pt plus 3pt\cr
-{}\\unsetbox for 2 columns: u2c2v2\cr
-{}\\glue 1pt plus 1fil\cr}}$$
-A new span node is attached to the alignrecord for column 2.
-
-(9) The last step is to compute the true column widths and to change all the
-unset boxes to hboxes, appending the whole works to the vertical list that
-encloses the \.{\\halign}. The rules for deciding on the final widths of
-each unset column box will be explained below.
-
-\yskip\noindent
-Note that as \.{\\halign} is being processed, we fearlessly give up control
-to the rest of \TeX. At critical junctures, an alignment routine is
-called upon to step in and do some little action, but most of the time
-these routines just lurk in the background. It's something like
-post-hypnotic suggestion.
-
-@ We have mentioned that alignrecords contain no |height| or |depth| fields.
-Their |glue_sign| and |glue_order| are pre-empted as well, since it
-is necessary to store information about what to do when a template ends.
-This information is called the |extra_info| field.
-
-@d u_part(#)==vlink(#+depth_offset) {pointer to \<u_j> token list}
-@d v_part(#)==vinfo(#+depth_offset) {pointer to \<v_j> token list}
-@d span_ptr(#)==vinfo(#+1) {column spanning list}
-@d extra_info(#)==vinfo(#+list_offset) {info to remember during template}
-
-@ Alignments can occur within alignments, so a small stack is used to access
-the alignrecord information. At each level we have a |preamble| pointer,
-indicating the beginning of the preamble list; a |cur_align| pointer,
-indicating the current position in the preamble list; a |cur_span| pointer,
-indicating the value of |cur_align| at the beginning of a sequence of
-spanned columns; a |cur_loop| pointer, indicating the tabskip glue before
-an alignrecord that should be copied next if the current list is extended;
-and the |align_state| variable, which indicates the nesting of braces so
-that \.{\\cr} and \.{\\span} and tab marks are properly intercepted.
-There also are pointers |cur_head| and |cur_tail| to the head and tail
-of a list of adjustments being moved out from horizontal mode to
-vertical~mode, and alike |cur_pre_head| and |cur_pre_tail| for pre-adjust
-lists.
-
-The current values of these nine quantities appear in global variables;
-when they have to be pushed down, they are stored in 6-word nodes, and
-|align_ptr| points to the topmost such node.
-
-@d preamble==vlink(align_head) {the current preamble list}
-
-@<Glob...@>=
-@!cur_align:pointer; {current position in preamble list}
-@!cur_span:pointer; {start of currently spanned columns in preamble list}
-@!cur_loop:pointer; {place to copy when extending a periodic preamble}
-@!align_ptr:pointer; {most recently pushed-down alignment stack node}
-@!cur_head,@!cur_tail:pointer; {adjustment list pointers}
-@!cur_pre_head,@!cur_pre_tail:pointer; {pre-adjustment list pointers}
-
-@ The |align_state| and |preamble| variables are initialized elsewhere.
-
-@<Set init...@>=
-align_ptr:=null; cur_align:=null; cur_span:=null; cur_loop:=null;
-cur_head:=null; cur_tail:=null;
-cur_pre_head:=null; cur_pre_tail:=null;
-
-@ Alignment stack maintenance is handled by a pair of trivial routines
-called |push_alignment| and |pop_alignment|.
-
-@p procedure push_alignment;
-var p:pointer; {the new alignment stack node}
-begin p:=new_node(align_stack_node,0);
-vinfo(p+1):=align_ptr; vlink(p+1):=cur_align;
-vinfo(p+2):=preamble; vlink(p+2):=cur_span;
-vinfo(p+3):=cur_loop; vlink(p+3):=align_state;
-vinfo(p+4):=cur_head; vlink(p+4):=cur_tail;
-vinfo(p+5):=cur_pre_head; vlink(p+5):=cur_pre_tail;
-align_ptr:=p;
-cur_head:=new_node(temp_node,0);
-end;
-@#
-procedure pop_alignment;
-var p:pointer; {the top alignment stack node}
-begin flush_node(cur_head);
-p:=align_ptr;
-cur_pre_tail:=vlink(p+5); cur_pre_head:=vinfo(p+5);
-cur_tail :=vlink(p+4); cur_head :=vinfo(p+4);
-align_state :=vlink(p+3); cur_loop :=vinfo(p+3);
-cur_span :=vlink(p+2); preamble :=vinfo(p+2);
-cur_align :=vlink(p+1); align_ptr :=vinfo(p+1);
-flush_node(p);
-end;
-
-@ \TeX\ has eight procedures that govern alignments: |init_align| and
-|fin_align| are used at the very beginning and the very end; |init_row| and
-|fin_row| are used at the beginning and end of individual rows; |init_span|
-is used at the beginning of a sequence of spanned columns (possibly involving
-only one column); |init_col| and |fin_col| are used at the beginning and
-end of individual columns; and |align_peek| is used after \.{\\cr} to see
-whether the next item is \.{\\noalign}.
-
-We shall consider these routines in the order they are first used during
-the course of a complete \.{\\halign}, namely |init_align|, |align_peek|,
-|init_row|, |init_span|, |init_col|, |fin_col|, |fin_row|, |fin_align|.
-
-@ When \.{\\halign} or \.{\\valign} has been scanned in an appropriate
-mode, \TeX\ calls |init_align|, whose task is to get everything off to a
-good start. This mostly involves scanning the preamble and putting its
-information into the preamble list.
-@^preamble@>
-
-@p @t\4@>@<Declare the procedure called |get_preamble_token|@>@t@>@/
-procedure@?align_peek; forward;@t\2@>@/
-procedure@?normal_paragraph; forward;@t\2@>@/
-procedure init_align;
-label done, done1, done2, continue;
-var save_cs_ptr:pointer; {|warning_index| value for error messages}
-@!p,r:pointer; {for short-term temporary use}
-begin save_cs_ptr:=cur_cs; {\.{\\halign} or \.{\\valign}, usually}
-push_alignment; align_state:=-1000000; {enter a new alignment level}
-@<Check for improper alignment in displayed math@>;
-push_nest; {enter a new semantic level}
-@<Change current mode to |-vmode| for \.{\\halign}, |-hmode| for \.{\\valign}@>;
-scan_spec(align_group,false);@/
-@<Scan the preamble and record it in the |preamble| list@>;
-new_save_level(align_group);
-if every_cr<>null then begin_token_list(every_cr,every_cr_text);
-align_peek; {look for \.{\\noalign} or \.{\\omit}}
-end;
-
-@ In vertical modes, |prev_depth| already has the correct value. But
-if we are in |mmode| (displayed formula mode), we reach out to the
-enclosing vertical mode for the |prev_depth| value that produces the
-correct baseline calculations.
-
-@<Change current mode...@>=
-if mode=mmode then
- begin mode:=-vmode; prev_depth:=nest[nest_ptr-2].aux_field.sc;
- end
-else if mode>0 then negate(mode)
-
-@ When \.{\\halign} is used as a displayed formula, there should be
-no other pieces of mlists present.
-
-@<Check for improper alignment in displayed math@>=
-if (mode=mmode)and((tail<>head)or(incompleat_noad<>null)) then
- begin print_err("Improper "); print_esc("halign"); print(" inside $$'s");
-@.Improper \\halign...@>
- help3("Displays can use special alignments (like \eqalignno)")@/
- ("only if nothing but the alignment itself is between $$'s.")@/
- ("So I've deleted the formulas that preceded this alignment.");
- error; flush_math;
- end
-
-@ @<Scan the preamble and record it in the |preamble| list@>=
-preamble:=null; cur_align:=align_head; cur_loop:=null; scanner_status:=aligning;
-warning_index:=save_cs_ptr; align_state:=-1000000;
- {at this point, |cur_cmd=left_brace|}
-loop@+ begin @<Append the current tabskip glue to the preamble list@>;
- if cur_cmd=car_ret then goto done; {\.{\\cr} ends the preamble}
- @<Scan preamble text until |cur_cmd| is |tab_mark| or |car_ret|,
- looking for changes in the tabskip glue; append an
- alignrecord to the preamble list@>;
- end;
-done: scanner_status:=normal
-
-@ @<Append the current tabskip glue to the preamble list@>=
-r:=new_param_glue(tab_skip_code); vlink(cur_align):=r;
-cur_align:=vlink(cur_align)
-
-@ @<Scan preamble text until |cur_cmd| is |tab_mark| or |car_ret|...@>=
-@<Scan the template \<u_j>, putting the resulting token list in |hold_token_head|@>;
-r:=new_node(align_record_node,0); vlink(cur_align):=r;
-cur_align:=vlink(cur_align); {a new alignrecord}
-span_ptr(cur_align):=end_span; width(cur_align):=null_flag;
-u_part(cur_align):=link(hold_token_head);
-@<Scan the template \<v_j>, putting the resulting token list in |hold_token_head|@>;
-v_part(cur_align):=link(hold_token_head)
-
-@ We enter `\.{\\span}' into |eqtb| with |tab_mark| as its command code,
-and with |span_code| as the command modifier. This makes \TeX\ interpret it
-essentially the same as an alignment delimiter like `\.\&', yet it is
-recognizably different when we need to distinguish it from a normal delimiter.
-It also turns out to be useful to give a special |cr_code| to `\.{\\cr}',
-and an even larger |cr_cr_code| to `\.{\\crcr}'.
-
-The end of a template is represented by two ``frozen'' control sequences
-called \.{\\endtemplate}. The first has the command code |end_template|, which
-is |>outer_call|, so it will not easily disappear in the presence of errors.
-The |get_x_token| routine converts the first into the second, which has |endv|
-as its command code.
-
-@d span_code=special_char {distinct from any character}
-@d cr_code=span_code+1 {distinct from |span_code| and from any character}
-@d cr_cr_code=cr_code+1 {this distinguishes \.{\\crcr} from \.{\\cr}}
-@d end_template_token==cs_token_flag+frozen_end_template
-
-@<Put each of \TeX's primitives into the hash table@>=
-primitive_tex("span",tab_mark,span_code,span_code);@/
-@!@:span_}{\.{\\span} primitive@>
-primitive_tex("cr",car_ret,cr_code,cr_code);
-@!@:cr_}{\.{\\cr} primitive@>
-text(frozen_cr):="cr"; eqtb[frozen_cr]:=eqtb[cur_val];@/
-primitive_tex("crcr",car_ret,cr_cr_code,cr_code);
-@!@:cr_cr_}{\.{\\crcr} primitive@>
-text(frozen_end_template):="endtemplate"; text(frozen_endv):="endtemplate";
-eq_type(frozen_endv):=endv; equiv(frozen_endv):=null_list;
-eq_level(frozen_endv):=level_one;@/
-eqtb[frozen_end_template]:=eqtb[frozen_endv];
-eq_type(frozen_end_template):=end_template;
-
-@ The preamble is copied directly, except that \.{\\tabskip} causes a change
-to the tabskip glue, thereby possibly expanding macros that immediately
-follow it. An appearance of \.{\\span} also causes such an expansion.
-
-Note that if the preamble contains `\.{\\global\\tabskip}', the `\.{\\global}'
-token survives in the preamble and the `\.{\\tabskip}' defines new
-tabskip glue (locally).
-
-@<Declare the procedure called |get_preamble_token|@>=
-procedure get_preamble_token;
-label restart;
-begin restart: get_token;
-while (cur_chr=span_code)and(cur_cmd=tab_mark) do
- begin get_token; {this token will be expanded once}
- if cur_cmd>max_command then
- begin expand; get_token;
- end;
- end;
-if cur_cmd=endv then
- fatal_error("(interwoven alignment preambles are not allowed)");
-@.interwoven alignment preambles...@>
-if (cur_cmd=assign_glue)and(cur_chr=glue_base+tab_skip_code) then
- begin scan_optional_equals; scan_glue(glue_val);
- if global_defs>0 then geq_define(glue_base+tab_skip_code,glue_ref,cur_val)
- else eq_define(glue_base+tab_skip_code,glue_ref,cur_val);
- goto restart;
- end;
-end;
-
-@ Spaces are eliminated from the beginning of a template.
-
-@<Scan the template \<u_j>...@>=
-p:=hold_token_head; link(p):=null;
-loop@+ begin get_preamble_token;
- if cur_cmd=mac_param then goto done1;
- if (cur_cmd<=car_ret)and(cur_cmd>=tab_mark)and(align_state=-1000000) then
- if (p=hold_token_head)and(cur_loop=null)and(cur_cmd=tab_mark)
- then cur_loop:=cur_align
- else begin print_err("Missing # inserted in alignment preamble");
-@.Missing \# inserted...@>
- help3("There should be exactly one # between &'s, when an")@/
- ("\halign or \valign is being set up. In this case you had")@/
- ("none, so I've put one in; maybe that will work.");
- back_error; goto done1;
- end
- else if (cur_cmd<>spacer)or(p<>hold_token_head) then
- begin r:=get_avail; link(p):=r; p:=link(p); info(p):=cur_tok;
- end;
- end;
-done1:
-
-@ @<Scan the template \<v_j>...@>=
-p:=hold_token_head; link(p):=null;
-loop@+ begin continue: get_preamble_token;
- if (cur_cmd<=car_ret)and(cur_cmd>=tab_mark)and(align_state=-1000000) then
- goto done2;
- if cur_cmd=mac_param then
- begin print_err("Only one # is allowed per tab");
-@.Only one \# is allowed...@>
- help3("There should be exactly one # between &'s, when an")@/
- ("\halign or \valign is being set up. In this case you had")@/
- ("more than one, so I'm ignoring all but the first.");
- error; goto continue;
- end;
- r:=get_avail; link(p):=r; p:=link(p); info(p):=cur_tok;
- end;
-done2: r:=get_avail; link(p):=r; p:=link(p);
-info(p):=end_template_token {put \.{\\endtemplate} at the end}
-
-@ The tricky part about alignments is getting the templates into the
-scanner at the right time, and recovering control when a row or column
-is finished.
-
-We usually begin a row after each \.{\\cr} has been sensed, unless that
-\.{\\cr} is followed by \.{\\noalign} or by the right brace that terminates
-the alignment. The |align_peek| routine is used to look ahead and do
-the right thing; it either gets a new row started, or gets a \.{\\noalign}
-started, or finishes off the alignment.
-
-@<Declare the procedure called |align_peek|@>=
-procedure align_peek;
-label restart;
-begin restart: align_state:=1000000;
-repeat get_x_or_protected;
-until cur_cmd<>spacer;
-if cur_cmd=no_align then
- begin scan_left_brace; new_save_level(no_align_group);
- if mode=-vmode then normal_paragraph;
- end
-else if cur_cmd=right_brace then fin_align
-else if (cur_cmd=car_ret)and(cur_chr=cr_cr_code) then
- goto restart {ignore \.{\\crcr}}
-else begin init_row; {start a new row}
- init_col; {start a new column and replace what we peeked at}
- end;
-end;
-
-@ To start a row (i.e., a `row' that rhymes with `dough' but not with `bough'),
-we enter a new semantic level, copy the first tabskip glue, and change
-from internal vertical mode to restricted horizontal mode or vice versa.
-The |space_factor| and |prev_depth| are not used on this semantic level,
-but we clear them to zero just to be tidy.
-
-@p @t\4@>@<Declare the procedure called |init_span|@>@t@>@/
-procedure init_row;
-begin push_nest; mode:=(-hmode-vmode)-mode;
-if mode=-hmode then space_factor:=0 @+else prev_depth:=0;
-tail_append(new_glue(glue_ptr(preamble)));
-subtype(tail):=tab_skip_code+1;@/
-cur_align:=vlink(preamble); cur_tail:=cur_head; cur_pre_tail:=cur_pre_head;
-init_span(cur_align);
-end;
-
-@ The parameter to |init_span| is a pointer to the alignrecord where the
-next column or group of columns will begin. A new semantic level is
-entered, so that the columns will generate a list for subsequent packaging.
-
-@<Declare the procedure called |init_span|@>=
-procedure init_span(@!p:pointer);
-begin push_nest;
-if mode=-hmode then space_factor:=1000
-else begin prev_depth:=pdf_ignored_dimen; normal_paragraph;
- end;
-cur_span:=p;
-end;
-
-@ When a column begins, we assume that |cur_cmd| is either |omit| or else
-the current token should be put back into the input until the \<u_j>
-template has been scanned. (Note that |cur_cmd| might be |tab_mark| or
-|car_ret|.) We also assume that |align_state| is approximately 1000000 at
-this time. We remain in the same mode, and start the template if it is
-called for.
-
-@p procedure init_col;
-begin extra_info(cur_align):=cur_cmd;
-if cur_cmd=omit then align_state:=0
-else begin back_input; begin_token_list(u_part(cur_align),u_template);
- end; {now |align_state=1000000|}
-end;
-
-@ The scanner sets |align_state| to zero when the \<u_j> template ends. When
-a subsequent \.{\\cr} or \.{\\span} or tab mark occurs with |align_state=0|,
-the scanner activates the following code, which fires up the \<v_j> template.
-We need to remember the |cur_chr|, which is either |cr_cr_code|, |cr_code|,
-|span_code|, or a character code, depending on how the column text has ended.
-
-This part of the program had better not be activated when the preamble
-to another alignment is being scanned, or when no alignment preamble is active.
-
-@p procedure insert_vj_template;
-begin if (scanner_status=aligning) or (cur_align=null) then
- fatal_error("(interwoven alignment preambles are not allowed)");
-@.interwoven alignment preambles...@>
-cur_cmd:=extra_info(cur_align); extra_info(cur_align):=cur_chr;
-if cur_cmd=omit then begin_token_list(omit_template,v_template)
-else begin_token_list(v_part(cur_align),v_template);
-align_state:=1000000;
-end;
-
-@ The token list |omit_template| just referred to is a constant token
-list that contains the special control sequence \.{\\endtemplate} only.
-
-@<Initialize the special...@>=
-info(omit_template):=end_template_token; {|link(omit_template)=null|}
-
-@ When the |endv| command at the end of a \<v_j> template comes through the
-scanner, things really start to happen; and it is the |fin_col| routine
-that makes them happen. This routine returns |true| if a row as well as a
-column has been finished.
-
-@p function fin_col:boolean;
-label exit;
-var p:pointer; {the alignrecord after the current one}
-@!q,@!r:pointer; {temporary pointers for list manipulation}
-@!s:pointer; {a new span node}
-@!u:pointer; {a new unset box}
-@!w:scaled; {natural width}
-@!o:glue_ord; {order of infinity}
-@!n:halfword; {span counter}
-begin if cur_align=null then confusion("endv");
-q:=vlink(cur_align);@+if q=null then confusion("endv");
-@:this can't happen endv}{\quad endv@>
-if align_state<500000 then
- fatal_error("(interwoven alignment preambles are not allowed)");
-@.interwoven alignment preambles...@>
-p:=vlink(q);
-@<If the preamble list has been traversed, check that the row has ended@>;
-if extra_info(cur_align)<>span_code then
- begin unsave; new_save_level(align_group);@/
- @<Package an unset box for the current column and record its width@>;
- @<Copy the tabskip glue between columns@>;
- if extra_info(cur_align)>=cr_code then
- begin fin_col:=true; return;
- end;
- init_span(p);
- end;
-align_state:=1000000;
-repeat get_x_or_protected;
-until cur_cmd<>spacer;
-cur_align:=p;
-init_col; fin_col:=false;
-exit: end;
-
-@ @<If the preamble list has been traversed, check that the row has ended@>=
-if (p=null)and(extra_info(cur_align)<cr_code) then begin
- 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;
-end
-
-@ @<Lengthen the preamble...@>=
-begin r:=new_node(align_record_node,0); vlink(q):=r; p:=vlink(q); {a new alignrecord}
-span_ptr(p):=end_span; width(p):=null_flag; cur_loop:=vlink(cur_loop);
-@<Copy the templates from node |cur_loop| into node |p|@>;
-cur_loop:=vlink(cur_loop);
-r:=new_glue(glue_ptr(cur_loop)); vlink(p):=r;
-end
-
-@ @<Copy the templates from node |cur_loop| into node |p|@>=
-q:=hold_token_head; r:=u_part(cur_loop);
-while r<>null do
- begin s:=get_avail; link(q):=s; q:=link(q); info(q):=info(r); r:=link(r);
- end;
-link(q):=null; u_part(p):=link(hold_token_head);
-q:=hold_token_head; r:=v_part(cur_loop);
-while r<>null do
- begin s:=get_avail; link(q):=s; q:=link(q); info(q):=info(r); r:=link(r);
- end;
-link(q):=null; v_part(p):=link(hold_token_head)
-
-@ @<Copy the tabskip glue...@>=
-tail_append(new_glue(glue_ptr(vlink(cur_align))));
-subtype(tail):=tab_skip_code+1
-
-@ @<Package an unset...@>=
-begin if mode=-hmode then
- begin adjust_tail:=cur_tail; pre_adjust_tail:=cur_pre_tail;
- u:=filtered_hpack(head,tail,natural,align_set_group); w:=width(u);
- cur_tail:=adjust_tail; adjust_tail:=null;
- cur_pre_tail:=pre_adjust_tail; pre_adjust_tail:=null;
- end
-else begin u:=filtered_vpackage(vlink(head),natural,0,align_set_group); w:=height(u);
- end;
-n:=min_quarterword; {this represents a span count of 1}
-if cur_span<>cur_align then @<Update width entry for spanned columns@>
-else if w>width(cur_align) then width(cur_align):=w;
-type(u):=unset_node; span_count(u):=n;@/
-@<Determine the stretch order@>;
-glue_order(u):=o; glue_stretch(u):=total_stretch[o];@/
-@<Determine the shrink order@>;
-glue_sign(u):=o; glue_shrink(u):=total_shrink[o];@/
-pop_nest; vlink(tail):=u; tail:=u;
-end
-
-@ A span node is a 3-word record containing |width|, |span_span|, and
-|span_ptr| fields. The |span_span| field indicates the number of
-spanned columns; the |span_ptr| field points to a span node for the same
-starting column, having a greater extent of spanning, or to
-|end_span|, which has the largest possible |span_span| field; the |width|
-field holds the largest natural width corresponding to a particular
-set of spanned columns.
-
-A list of the maximum widths so far, for spanned columns starting at a
-given column, begins with the |span_ptr| field of the alignrecord for
-that column. The code has to make sure that there is room for
-|span_ptr| in both the alignrecord and the span nodes, which is why
-|span_ptr| replaces |node_attr|.
-@^data structure assumptions@>
-
-The |new_span_node| function is defined in |texnodes.c|.
-
-@d span_span(#)==vlink(#+1) {that is normally |alink| }
-
-@<Initialize the special list heads...@>=
-span_span(end_span):=max_quarterword+1; span_ptr(end_span):=null;
-
-@ @<Update width entry for spanned columns@>=
-begin q:=cur_span;
-repeat incr(n); q:=vlink(vlink(q));
-until q=cur_align;
-if n>max_quarterword then confusion("too many spans"); {this can happen, but won't}
-@^system dependencies@>
-@:this can't happen too many spans}{\quad too many spans@>
-q:=cur_span;
-while span_span(span_ptr(q))<n do begin
- q:=span_ptr(q);
- end;
-if span_span(span_ptr(q))>n then begin
- s:=new_span_node(span_ptr(q),n,w);
- span_ptr(q):=s;
- end
-else if width(span_ptr(q))<w then width(span_ptr(q)):=w;
-end
-
-@ At the end of a row, we append an unset box to the current vlist (for
-\.{\\halign}) or the current hlist (for \.{\\valign}). This unset box
-contains the unset boxes for the columns, separated by the tabskip glue.
-Everything will be set later.
-
-@p procedure fin_row;
-var p:pointer; {the new unset box}
-begin if mode=-hmode then
- begin p:=filtered_hpack(head,tail,natural,fin_row_group);
- pop_nest;
- if cur_pre_head <> cur_pre_tail then
- append_list(cur_pre_head)(cur_pre_tail);
- append_to_vlist(p);
- if cur_head <> cur_tail then
- append_list(cur_head)(cur_tail);
- end
-else begin p:=filtered_vpackage(vlink(head),natural,max_depth,fin_row_group);
- pop_nest; vlink(tail):=p; tail:=p; space_factor:=1000;
- end;
-type(p):=unset_node; glue_stretch(p):=0;
-if every_cr<>null then begin_token_list(every_cr,every_cr_text);
-align_peek;
-end; {note that |glue_shrink(p)=0| since |glue_shrink==shift_amount|}
-
-@ Finally, we will reach the end of the alignment, and we can breathe a
-sigh of relief that memory hasn't overflowed. All the unset boxes will now be
-set so that the columns line up, taking due account of spanned columns.
-
-@p procedure@?do_assignments; forward;@t\2@>@/
-procedure@?resume_after_display; forward;@t\2@>@/
-procedure@?build_page; forward;@t\2@>@/
-procedure fin_align;
-var @!p,@!q,@!r,@!s,@!u,@!v,@!rr: pointer; {registers for the list operations}
-@!t,@!w:scaled; {width of column}
-@!o:scaled; {shift offset for unset boxes}
-@!n:halfword; {matching span amount}
-@!rule_save:scaled; {temporary storage for |overfull_rule|}
-@!aux_save:memory_word; {temporary storage for |aux|}
-begin if cur_group<>align_group then confusion("align1");
-@:this can't happen align}{\quad align@>
-unsave; {that |align_group| was for individual entries}
-if cur_group<>align_group then confusion("align0");
-unsave; {that |align_group| was for the whole alignment}
-if nest[nest_ptr-1].mode_field=mmode then o:=display_indent
- else o:=0;
-@<Go through the preamble list, determining the column widths and
- changing the alignrecords to dummy unset boxes@>;
-@<Package the preamble list, to determine the actual tabskip glue amounts,
- and let |p| point to this prototype box@>;
-@<Set the glue in all the unset boxes of the current list@>;
-flush_node_list(p); pop_alignment;
-@<Insert the \(c)current list into its environment@>;
-end;@/
-@t\4@>@<Declare the procedure called |align_peek|@>
-
-@ It's time now to dismantle the preamble list and to compute the column
-widths. Let $w_{ij}$ be the maximum of the natural widths of all entries
-that span columns $i$ through $j$, inclusive. The alignrecord for column~$i$
-contains $w_{ii}$ in its |width| field, and there is also a linked list of
-the nonzero $w_{ij}$ for increasing $j$, accessible via the |info| field;
-these span nodes contain the value $j-i+|min_quarterword|$ in their
-|link| fields. The values of $w_{ii}$ were initialized to |null_flag|, which
-we regard as $-\infty$.
-
-The final column widths are defined by the formula
-$$w_j=\max_{1\L i\L j}\biggl( w_{ij}-\sum_{i\L k<j}(t_k+w_k)\biggr),$$
-where $t_k$ is the natural width of the tabskip glue between columns
-$k$ and~$k+1$. However, if $w_{ij}=-\infty$ for all |i| in the range
-|1<=i<=j| (i.e., if every entry that involved column~|j| also involved
-column~|j+1|), we let $w_j=0$, and we zero out the tabskip glue after
-column~|j|.
-
-\TeX\ computes these values by using the following scheme: First $w_1=w_{11}$.
-Then replace $w_{2j}$ by $\max(w_{2j},w_{1j}-t_1-w_1)$, for all $j>1$.
-Then $w_2=w_{22}$. Then replace $w_{3j}$ by $\max(w_{3j},w_{2j}-t_2-w_2)$
-for all $j>2$; and so on. If any $w_j$ turns out to be $-\infty$, its
-value is changed to zero and so is the next tabskip.
-
-@<Go through the preamble list,...@>=
-q:=vlink(preamble);
-repeat flush_list(u_part(q)); flush_list(v_part(q));
-p:=vlink(vlink(q));
-if width(q)=null_flag then
- @<Nullify |width(q)| and the tabskip glue following this column@>;
-if span_ptr(q)<>end_span then
- @<Merge the widths in the span nodes of |q| with those of |p|,
- destroying the span nodes of |q|@>;
-type(q):=unset_node; span_count(q):=min_quarterword; height(q):=0;
-depth(q):=0; glue_order(q):=normal; glue_sign(q):=normal;
-glue_stretch(q):=0; glue_shrink(q):=0; q:=p;
-until q=null
-
-@ @<Nullify |width(q)| and the tabskip glue following this column@>=
-begin width(q):=0; r:=vlink(q); s:=glue_ptr(r);
-if s<>zero_glue then
- begin add_glue_ref(zero_glue); delete_glue_ref(s);
- glue_ptr(r):=zero_glue;
- end;
-end
-
-@ Merging of two span-node lists is a typical exercise in the manipulation of
-linearly linked data structures. The essential invariant in the following
-|repeat| loop is that we want to dispense with node |r|, in |q|'s list,
-and |u| is its successor; all nodes of |p|'s list up to and including |s|
-have been processed, and the successor of |s| matches |r| or precedes |r|
-or follows |r|, according as |link(r)=n| or |link(r)>n| or |link(r)<n|.
-
-@<Merge the widths...@>=
-begin t:=width(q)+width(glue_ptr(vlink(q)));
-r:=span_ptr(q); s:=end_span; span_ptr(s):=p; n:=min_quarterword+1;
-repeat width(r):=width(r)-t; u:=span_ptr(r);
-while span_span(r)>n do
- begin s:=span_ptr(s); n:=span_span(span_ptr(s))+1;
- end;
-if span_span(r)<n then
- begin span_ptr(r):=span_ptr(s); span_ptr(s):=r; decr(span_span(r)); s:=r;
- end
-else begin if width(r)>width(span_ptr(s)) then width(span_ptr(s)):=width(r);
- flush_node(r);
- end;
-r:=u;
-until r=end_span;
-end
-
-@ Now the preamble list has been converted to a list of alternating unset
-boxes and tabskip glue, where the box widths are equal to the final
-column sizes. In case of \.{\\valign}, we change the widths to heights,
-so that a correct error message will be produced if the alignment is
-overfull or underfull.
-
-@<Package the preamble list...@>=
-save_ptr:=save_ptr-2; pack_begin_line:=-mode_line;
-if mode=-vmode then
- begin rule_save:=overfull_rule;
- overfull_rule:=0; {prevent rule from being packaged}
- p:=hpack(preamble,saved(1),saved(0));
- overfull_rule:=rule_save;
- end
-else begin q:=vlink(preamble);
- repeat height(q):=width(q); width(q):=0; q:=vlink(vlink(q));
- until q=null;
- p:=filtered_vpackage(preamble,saved(1),saved(0),max_depth,preamble_group);
- q:=vlink(preamble);
- repeat width(q):=height(q); height(q):=0; q:=vlink(vlink(q));
- until q=null;
- end;
-pack_begin_line:=0
-
-@ @<Set the glue in all the unset...@>=
-q:=vlink(head); s:=head;
-while q<>null do
- begin if not is_char_node(q) then begin
- 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@>;
- end;
- s:=q; q:=vlink(q);
- end
-
-@ @<Make the running dimensions in rule |q| extend...@>=
-begin if is_running(width(q)) then width(q):=width(p);
-if is_running(height(q)) then height(q):=height(p);
-if is_running(depth(q)) then depth(q):=depth(p);
-if o<>0 then
- begin r:=vlink(q); vlink(q):=null; q:=hpack(q,natural);
- shift_amount(q):=o; vlink(q):=r; vlink(s):=q;
- end;
-end
-
-@ The unset box |q| represents a row that contains one or more unset boxes,
-depending on how soon \.{\\cr} occurred in that row.
-
-@<Set the unset box |q| and the unset boxes in it@>=
-begin if mode=-vmode then
- begin type(q):=hlist_node; width(q):=width(p);
- end
-else begin type(q):=vlist_node; height(q):=height(p);
- end;
-glue_order(q):=glue_order(p); glue_sign(q):=glue_sign(p);
-glue_set(q):=glue_set(p); shift_amount(q):=o;
-r:=vlink(list_ptr(q)); s:=vlink(list_ptr(p));
-repeat @<Set the glue in node |r| and change it from an unset node@>;
-r:=vlink(vlink(r)); s:=vlink(vlink(s));
-until r=null;
-end
-
-@ A box made from spanned columns will be followed by tabskip glue nodes and
-by empty boxes as if there were no spanning. This permits perfect alignment
-of subsequent entries, and it prevents values that depend on floating point
-arithmetic from entering into the dimensions of any boxes.
-
-@<Set the glue in node |r|...@>=
-n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
-while n>min_quarterword do
- begin decr(n);
- @<Append tabskip glue and an empty box to list |u|,
- and update |s| and |t| as the prototype nodes are passed@>;
- end;
-if mode=-vmode then
- @<Make the unset node |r| into an |hlist_node| of width |w|,
- setting the glue as if the width were |t|@>
-else @<Make the unset node |r| into a |vlist_node| of height |w|,
- setting the glue as if the height were |t|@>;
-shift_amount(r):=0;
-if u<>hold_head then {append blank boxes to account for spanned nodes}
- begin vlink(u):=vlink(r); vlink(r):=vlink(hold_head); r:=u;
- end
-
-@ @<Append tabskip glue and an empty box to list |u|...@>=
-s:=vlink(s); v:=glue_ptr(s); vlink(u):=new_glue(v); u:=vlink(u);
-subtype(u):=tab_skip_code+1; t:=t+width(v);
-if glue_sign(p)=stretching then
- begin if stretch_order(v)=glue_order(p) then
- t:=t+round(float(glue_set(p))*stretch(v));
-@^real multiplication@>
- end
-else if glue_sign(p)=shrinking then
- begin if shrink_order(v)=glue_order(p) then
- t:=t-round(float(glue_set(p))*shrink(v));
- end;
-s:=vlink(s); rr:=new_null_box; vlink(u):=rr; u:=vlink(u); t:=t+width(s);
-if mode=-vmode then width(u):=width(s)@+else
- begin type(u):=vlist_node; height(u):=width(s);
- end
-
-@ @<Make the unset node |r| into an |hlist_node| of width |w|...@>=
-begin height(r):=height(q); depth(r):=depth(q);
-if t=width(r) then
- begin glue_sign(r):=normal; glue_order(r):=normal;
- set_glue_ratio_zero(glue_set(r));
- end
-else if t>width(r) then
- begin glue_sign(r):=stretching;
- if glue_stretch(r)=0 then set_glue_ratio_zero(glue_set(r))
- else glue_set(r):=unfloat((t-width(r))/glue_stretch(r));
-@^real division@>
- end
-else begin glue_order(r):=glue_sign(r); glue_sign(r):=shrinking;
- if glue_shrink(r)=0 then set_glue_ratio_zero(glue_set(r))
- else if (glue_order(r)=normal)and(width(r)-t>glue_shrink(r)) then
- set_glue_ratio_one(glue_set(r))
- else glue_set(r):=unfloat((width(r)-t)/glue_shrink(r));
- end;
-width(r):=w; type(r):=hlist_node;
-end
-
-@ @<Make the unset node |r| into a |vlist_node| of height |w|...@>=
-begin width(r):=width(q);
-if t=height(r) then
- begin glue_sign(r):=normal; glue_order(r):=normal;
- set_glue_ratio_zero(glue_set(r));
- end
-else if t>height(r) then
- begin glue_sign(r):=stretching;
- if glue_stretch(r)=0 then set_glue_ratio_zero(glue_set(r))
- else glue_set(r):=unfloat((t-height(r))/glue_stretch(r));
-@^real division@>
- end
-else begin glue_order(r):=glue_sign(r); glue_sign(r):=shrinking;
- if glue_shrink(r)=0 then set_glue_ratio_zero(glue_set(r))
- else if (glue_order(r)=normal)and(height(r)-t>glue_shrink(r)) then
- set_glue_ratio_one(glue_set(r))
- else glue_set(r):=unfloat((height(r)-t)/glue_shrink(r));
- end;
-height(r):=w; type(r):=vlist_node;
-end
-
-@ We now have a completed alignment, in the list that starts at |head|
-and ends at |tail|. This list will be merged with the one that encloses
-it. (In case the enclosing mode is |mmode|, for displayed formulas,
-we will need to insert glue before and after the display; that part of the
-program will be deferred until we're more familiar with such operations.)
-
-@<Insert the \(c)current list into its environment@>=
-aux_save:=aux; p:=vlink(head); q:=tail; pop_nest;
-if mode=mmode then finish_display_alignment(p,q,aux_save)
-else begin aux:=aux_save; vlink(tail):=p;
- if p<>null then tail:=q;
- if mode=vmode then begin check_filter('alignment'); build_page; end;
- end
-
-@* \[38] Breaking paragraphs into lines.
-We come now to what is probably the most interesting algorithm of \TeX:
-the mechanism for choosing the ``best possible'' breakpoints that yield
-the individual lines of a paragraph. \TeX's line-breaking algorithm takes
-a given horizontal list and converts it to a sequence of boxes that are
-appended to the current vertical list. In the course of doing this, it
-creates a special data structure containing three kinds of records that are
-not used elsewhere in \TeX. Such nodes are created while a paragraph is
-being processed, and they are destroyed afterwards; thus, the other parts
-of \TeX\ do not need to know anything about how line-breaking is done.
-
-The method used here is based on an approach devised by Michael F. Plass and
-@^Plass, Michael Frederick@>
-@^Knuth, Donald Ervin@>
-the author in 1977, subsequently generalized and improved by the same two
-people in 1980. A detailed discussion appears in {\sl SOFTWARE---Practice
-\AM\ Experience \bf11} (1981), 1119--1184, where it is shown that the
-line-breaking problem can be regarded as a special case of the problem of
-computing the shortest path in an acyclic network. The cited paper includes
-numerous examples and describes the history of line breaking as it has been
-practiced by printers through the ages. The present implementation adds two
-new ideas to the algorithm of 1980: Memory space requirements are considerably
-reduced by using smaller records for inactive nodes than for active ones,
-and arithmetic overflow is avoided by using ``delta distances'' instead of
-keeping track of the total distance from the beginning of the paragraph to the
-current point.
-
-@ The |line_break| procedure should be invoked only in horizontal mode; it
-leaves that mode and places its output into the current vlist of the
-enclosing vertical mode (or internal vertical mode).
-There is one explicit parameter: |d| is true for partial paragraphs
-preceding display math mode; in this case the amount of additional
-penalty inserted before the final line is |display_widow_penalty|
-instead of |widow_penalty|.
-
-There are also a number of implicit parameters: The hlist to be broken
-starts at |vlink(head)|, and it is nonempty. The value of |prev_graf| in the
-enclosing semantic level tells where the paragraph should begin in the
-sequence of line numbers, in case hanging indentation or \.{\\parshape}
-are in use; |prev_graf| is zero unless this paragraph is being continued
-after a displayed formula. Other implicit parameters, such as the
-|par_shape_ptr| and various penalties to use for hyphenation, etc., appear
-in |eqtb|.
-
-After |line_break| has acted, it will have updated the current vlist and the
-value of |prev_graf|. Furthermore, the global variable |just_box| will
-point to the final box created by |line_break|, so that the width of this
-line can be ascertained when it is necessary to decide whether to use
-|above_display_skip| or |above_display_short_skip| before a displayed formula.
-
-@<Glob...@>=
-@!just_box:pointer; {the |hlist_node| for the last line of the new paragraph}
-@!paragraph_dir:integer; {main direction of paragraph}
-@!line_break_dir:integer; {current direction within paragraph}
-@!line_break_context:integer; {the surrounding state for |line_break| calls}
-@!break_c_htdp:quarterword; {height-depth entry in |char_info|}
-@!temp_no_whatsits:integer; {used when closing group}
-@!temp_no_dirs:integer; {used when closing group}
-@!temporary_dir:integer;
-@!dir_ptr,@!dir_tmp,@!dir_rover:pointer;
-
-@ @<Set init...@>=
-temp_no_whatsits:=0; temp_no_dirs:=0; temporary_dir:=0;
-dir_ptr:=null; dir_tmp:=null; dir_rover:=null;
-line_break_context := bottom_level;
-
-@ In it's complete form, |line_break| is a rather lengthy
-procedure---sort of a small world unto itself---we must build it up
-little by little. Below you see only the general outline.
-
-The main task performed here is to move the list from |head| to
-|temp_head| and go into the enclosing semantic level. We also append
-the \.{\\parfillskip} glue to the end of the paragraph, removing a
-space (or other glue node) if it was there, since spaces usually
-precede blank lines and instances of `\.{\$\$}'. The |par_fill_skip|
-is preceded by an infinite penalty, so it will never be considered as
-a potential breakpoint.
-
-That code assumes that a |glue_node| and a |penalty_node| occupy the
-same number of |mem|~words.
-@^data structure assumptions@>
-
-Most other processing is delegated to external functions.
-
-@p procedure line_break(@!d:boolean);
-var final_par_glue:pointer;
-start_of_par:pointer;
-callback_id:integer;
-begin pack_begin_line:=mode_line; {this is for over/underfull box messages}
-vlink(temp_head):=vlink(head);
-new_hyphenation(temp_head, tail);
-if (not is_char_node(vlink(head))) and ((type(vlink(head))=whatsit_node)
- and (subtype(vlink(head))=local_par_node)) then
- paragraph_dir:=local_par_dir(vlink(head))
-else
- paragraph_dir:=0;
-line_break_dir:=paragraph_dir;
-tail:=new_ligkern(temp_head,tail);
-if is_char_node(tail) then new_tail_append(new_penalty(inf_penalty))
-else if type(tail)<>glue_node then new_tail_append(new_penalty(inf_penalty))
-else begin
- type(tail):=penalty_node;
- delete_glue_ref(glue_ptr(tail));
- if leader_ptr(tail)<>null then
- flush_node_list(leader_ptr(tail));
- penalty(tail):=inf_penalty;
- end;
-final_par_glue:=new_param_glue(par_fill_skip_code);
-couple_nodes(tail,final_par_glue);
-lua_node_filter(pre_linebreak_filter_callback,
- line_break_context,temp_head,addressof(tail));
-last_line_fill:=vlink(tail);
-pop_nest;
-start_of_par:=tail;
-callback_id:=callback_defined(linebreak_filter_callback);
-if callback_id>0 then begin
- callback_id := lua_linebreak_callback(d, temp_head, addressof(tail));
- if callback_id>0 then begin
- just_box := tail;
- if just_box<>null then
- while vlink(just_box)<>null do
- just_box := vlink(just_box);
- if (just_box=null)or(type(just_box) <> hlist_node) then begin
- help3("A linebreaking routine should return a non-empty list of nodes")
- ("and the last one of those has to be a \\hbox.")
- ("Sorry, I cannot recover from this.");
- print_err("Invalid linebreak_filter");
- succumb;
- end
- end
- else begin
- if tracing_paragraphs>0 then begin
- begin_diagnostic;
- print_nl("Lua linebreak_filter failed, reverting to default on line "); print_int(line);
- end_diagnostic(true);
- end;
- end;
-end;
-if callback_id=0 then begin
- ext_do_line_break(d,pretolerance,tracing_paragraphs,tolerance,emergency_stretch,
- looseness,hyphen_penalty,ex_hyphen_penalty,
- pdf_adjust_spacing, par_shape_ptr, adj_demerits,
- pdf_protrude_chars, line_penalty, last_line_fit,
- double_hyphen_demerits, final_hyphen_demerits,
- hang_indent, hsize, hang_after, left_skip, right_skip,
- pdf_each_line_height,pdf_each_line_depth,
- pdf_first_line_height, pdf_last_line_depth,
- inter_line_penalties_ptr, inter_line_penalty,
- club_penalty, club_penalties_ptr,
- display_widow_penalties_ptr,widow_penalties_ptr,
- display_widow_penalty, widow_penalty,
- broken_penalty, final_par_glue, pdf_ignored_dimen);
-end;
-lua_node_filter(post_linebreak_filter_callback,
- line_break_context,start_of_par,addressof(tail));
-pack_begin_line:=0;
-end;
-@#
-@t\4@>@<Declare \eTeX\ procedures for use by |main_control|@>
-
-@ It is possible that the user wants to interfere at some point.
-
-The choice between |check_head_filter| and |check_contrib_filter| is not
-quite clear to me yet, but it seems that the latter is the better choice.
-
-@d check_filter(#)==if not output_active then lua_node_filter_s(buildpage_filter_callback,#)
-
-@* \[39] Breaking paragraphs into lines, continued.
-
-Hyphenation and line breaking are now all handled in C. Only the
-section heads are kept here.
-
-@* \[40] Pre-hyphenation.
-
-@* \[41] Post-hyphenation.
-
-@* \[42] Hyphenation.
-
-@ When \TeX\ has scanned `\.{\\hyphenation}', it calls on a procedure named
-|new_hyph_exceptions| to do the right thing.
-
-@p procedure new_hyph_exceptions; {enters new exceptions}
-var p:halfword; {just to catch the return value of |scan_toks|}
-begin p:=scan_toks(false,true);
-load_tex_hyphenation(language,def_ref);
-flush_list(def_ref);
-end;
-
-@ Similarly, when \TeX\ has scanned `\.{\\patterns}', it calls on a
-procedure named |new_patterns|.
-
-@p procedure new_patterns; {initializes the hyphenation pattern data}
-var p:halfword; {just to catch the return value of |scan_toks|}
-begin p:=scan_toks(false,true);
-load_tex_patterns(language,def_ref);
-flush_list(def_ref);
-end;
-
-@ `\.{\\prehyphenchar}', sets the |pre_break| character, and
-`\.{\\posthyphenchar}' the |post_break| character. Their respective
-defaults are ascii hyphen ("-") and zero (nul).
-
-@p procedure new_pre_hyphen_char;
-begin scan_optional_equals; scan_int;
- set_pre_hyphen_char(language,cur_val);
-end;
-@#
-procedure new_post_hyphen_char;
-begin scan_optional_equals; scan_int;
- set_post_hyphen_char(language,cur_val);
-end;
-
-@ `\.{\\preexhyphenchar}', sets the |pre_break| character, and
-`\.{\\postexhyphenchar}' the |post_break| character. Their
-defaults are both zero (nul).
-
-@p procedure new_pre_exhyphen_char;
-begin scan_optional_equals; scan_int;
- set_pre_exhyphen_char(language,cur_val);
-end;
-@#
-procedure new_post_exhyphen_char;
-begin scan_optional_equals; scan_int;
- set_post_exhyphen_char(language,cur_val);
-end;
-
-
-@* \[43] Initializing the hyphenation tables.
-
-None of the trie-related stuff is applicable any more in luatex.
-
-@* \[44] Breaking vertical lists into pages.
-The |vsplit| procedure, which implements \TeX's \.{\\vsplit} operation,
-is considerably simpler than |line_break| because it doesn't have to
-worry about hyphenation, and because its mission is to discover a single
-break instead of an optimum sequence of breakpoints. But before we get
-into the details of |vsplit|, we need to consider a few more basic things.
-
-@ A subroutine called |prune_page_top| takes a pointer to a vlist and
-returns a pointer to a modified vlist in which all glue, kern, and penalty nodes
-have been deleted before the first box or rule node. However, the first
-box or rule is actually preceded by a newly created glue node designed so that
-the topmost baseline will be at distance |split_top_skip| from the top,
-whenever this is possible without backspacing.
-
-When the second argument |s| is |false| the deleted nodes are destroyed,
-otherwise they are collected in a list starting at |split_disc|.
-
-@d discard_or_move = 60
-@p function prune_page_top(@!p:pointer;@!s:boolean):pointer;
-var prev_p:pointer; {lags one step behind |p|}
-@!q,@!r:pointer; {temporary variables for list manipulation}
-begin prev_p:=temp_head; vlink(temp_head):=p; r:=null;
-while p<>null do
- case type(p) of
- hlist_node_case,vlist_node_case,rule_node_case:@<Insert glue for |split_top_skip|
- and set~|p:=null|@>;
- whatsit_node_case,mark_node_case,ins_node_case: begin
- prev_p:=p; p:=vlink(prev_p);
- end;
- glue_node_case,kern_node_case,penalty_node_case: begin
- q:=p; p:=vlink(q); vlink(q):=null;
- vlink(prev_p):=p;
- if s then
- begin if split_disc=null then split_disc:=q else vlink(r):=q;
- r:=q;
- end
- else flush_node_list(q);
- end;
- othercases confusion("pruning")
-@:this can't happen pruning}{\quad pruning@>
- endcases;
-prune_page_top:=vlink(temp_head);
-end;
-
-@ @<Insert glue for |split_top_skip|...@>=
-begin q:=new_skip_param(split_top_skip_code); vlink(prev_p):=q; vlink(q):=p;
- {now |temp_ptr=glue_ptr(q)|}
-if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
-else width(temp_ptr):=0;
-p:=null;
-end
-
-@ The next subroutine finds the best place to break a given vertical list
-so as to obtain a box of height~|h|, with maximum depth~|d|.
-A pointer to the beginning of the vertical list is given,
-and a pointer to the optimum breakpoint is returned. The list is effectively
-followed by a forced break, i.e., a penalty node with the |eject_penalty|;
-if the best break occurs at this artificial node, the value |null| is returned.
-
-@<Glob...@>=
-@!active_height:array[1..9] of scaled;
- {distance from first active node to~|cur_p|}
-
-@ An array of six |scaled| distances is used to keep track of the height
-from the beginning of the list to the current place, just as in |line_break|.
-In fact, we use one of the same arrays, only changing its name to reflect
-its new significance.
-
-@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6);#(7)
-
-@d cur_height==active_height[1] {the natural height}
-@d set_height_zero(#)==active_height[#]:=0 {initialize the height to zero}
-@#
-@d update_heights=90 {go here to record glue in the |active_height| table}
-@d awful_bad=@'7777777777 { more than a billion demerits }
-
-@p function vert_break(@!p:pointer; @!h,@!d:scaled):pointer;
- {finds optimum page break}
-label done,not_found,update_heights;
-var prev_p:pointer; {if |p| is a glue node, |type(prev_p)| determines
- whether |p| is a legal breakpoint}
-@!q,@!r:pointer; {glue specifications}
-@!pi:integer; {penalty value}
-@!b:integer; {badness at a trial breakpoint}
-@!least_cost:integer; {the smallest badness plus penalties found so far}
-@!best_place:pointer; {the most recent break that leads to |least_cost|}
-@!prev_dp:scaled; {depth of previous box in the list}
-@!t:small_number; {|type| of the node following a kern}
-begin prev_p:=p; {an initial glue node is not a legal breakpoint}
-least_cost:=awful_bad; do_all_six(set_height_zero); prev_dp:=0;
-best_place:=null; pi:=0;
-loop@+ begin @<If node |p| is a legal breakpoint, check if this break is
- the best known, and |goto done| if |p| is null or
- if the page-so-far is already too full to accept more stuff@>;
- prev_p:=p; p:=vlink(prev_p);
- end;
-done: vert_break:=best_place;
-end;
-
-@ A global variable |best_height_plus_depth| will be set to the natural size
-of the box that corresponds to the optimum breakpoint found by |vert_break|.
-(This value is used by the insertion-splitting algorithm of the page builder.)
-
-@<Glob...@>=
-@!best_height_plus_depth:scaled; {height of the best box, without stretching or
- shrinking}
-
-@ A subtle point to be noted here is that the maximum depth~|d| might be
-negative, so |cur_height| and |prev_dp| might need to be corrected even
-after a glue or kern node.
-
-@<If node |p| is a legal breakpoint, check...@>=
-if p=null then pi:=eject_penalty
-else @<Use node |p| to update the current height and depth measurements;
- if this node is not a legal breakpoint, |goto not_found|
- or |update_heights|,
- otherwise set |pi| to the associated penalty at the break@>;
-@<Check if node |p| is a new champion breakpoint; then \(go)|goto done|
- if |p| is a forced break or if the page-so-far is already too full@>;
-if (type(p)<glue_node)or(type(p)>kern_node) then goto not_found;
-update_heights: @<Update the current height and depth measurements with
- respect to a glue or kern node~|p|@>;
-not_found: if prev_dp>d then
- begin cur_height:=cur_height+prev_dp-d;
- prev_dp:=d;
- end;
-
-@ @<Use node |p| to update the current height and depth measurements...@>=
-case type(p) of
-hlist_node_case,vlist_node_case,rule_node_case: begin@t@>@;@/
- cur_height:=cur_height+prev_dp+height(p); prev_dp:=depth(p);
- goto not_found;
- end;
-whatsit_node_case:@<Process whatsit |p| in |vert_break| loop, |goto not_found|@>;
-glue_node_case: if precedes_break(prev_p) then pi:=0
- else goto update_heights;
-kern_node_case: begin if vlink(p)=null then t:=penalty_node
- else t:=type(vlink(p));
- if t=glue_node then pi:=0@+else goto update_heights;
- end;
-penalty_node_case: pi:=penalty(p);
-mark_node_case,ins_node_case: 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 begin
- if pi<=eject_penalty then b:=pi
- else if b<inf_bad then b:=b+pi
- else b:=deplorable;
- end;
- if b<=least_cost then
- begin best_place:=p; least_cost:=b;
- best_height_plus_depth:=cur_height+prev_dp;
- end;
- if (b=awful_bad)or(pi<=eject_penalty) then goto done;
- end
-
-@ @<Compute the badness, |b|, using |awful_bad| if the box is too full@>=
-if cur_height<h then
- if (active_height[3]<>0) or (active_height[4]<>0) or
- (active_height[5]<>0) or (active_height[6]<>0) then b:=0
- else b:=badness(h-cur_height,active_height[2])
-else if cur_height-h>active_height[7] then b:=awful_bad
-else b:=badness(cur_height-h,active_height[7])
-
-@ Vertical lists that are subject to the |vert_break| procedure should not
-contain infinite shrinkability, since that would permit any amount of
-information to ``fit'' on one page.
-
-@<Update the current height and depth measurements with...@>=
-if type(p)=kern_node then q:=p
-else begin q:=glue_ptr(p);
- active_height[2+stretch_order(q)]:=@|
- active_height[2+stretch_order(q)]+stretch(q);@/
- active_height[7]:=active_height[7]+shrink(q);
- if (shrink_order(q)<>normal)and(shrink(q)<>0) then
- begin@t@>@;@/
- print_err("Infinite glue shrinkage found in box being split");@/
-@.Infinite glue shrinkage...@>
- help4("The box you are \vsplitting contains some infinitely")@/
- ("shrinkable glue, e.g., `\vss' or `\vskip 0pt minus 1fil'.")@/
- ("Such glue doesn't belong there; but you can safely proceed,")@/
- ("since the offensive shrinkability has been made finite.");
- error; r:=new_spec(q); shrink_order(r):=normal; delete_glue_ref(q);
- glue_ptr(p):=r; q:=r;
- end;
- end;
-cur_height:=cur_height+prev_dp+width(q); prev_dp:=0
-
-@ Now we are ready to consider |vsplit| itself. Most of
-its work is accomplished by the two subroutines that we have just considered.
-
-Given the number of a vlist box |n|, and given a desired page height |h|,
-the |vsplit| function finds the best initial segment of the vlist and
-returns a box for a page of height~|h|. The remainder of the vlist, if
-any, replaces the original box, after removing glue and penalties and
-adjusting for |split_top_skip|. Mark nodes in the split-off box are used to
-set the values of |split_first_mark| and |split_bot_mark|; we use the
-fact that |split_first_mark(x)=null| if and only if |split_bot_mark(x)=null|.
-
-The original box becomes ``void'' if and only if it has been entirely
-extracted. The extracted box is ``void'' if and only if the original
-box was void (or if it was, erroneously, an hlist box).
-
-@p function vsplit(@!n:halfword; @!h:scaled):pointer;
- {extracts a page of height |h| from box |n|}
-label exit,done;
-var v:pointer; {the box to be split}
-vdir:integer; {the direction of the box to be split}
-p:pointer; {runs through the vlist}
-q:pointer; {points to where the break occurs}
-i:halfword; {for traversing marks lists}
-begin v:=box(n); vdir:=box_dir(v);
-flush_node_list(split_disc); split_disc:=null;
-for i:=0 to biggest_used_mark do begin
- delete_split_first_mark(i);
- delete_split_bot_mark(i);
-end;
-@<Dispense with trivial cases of void or bad boxes@>;
-q:=vert_break(list_ptr(v),h,split_max_depth);
-@<Look at all the marks in nodes before the break, and set the final
- link to |null| at the break@>;
-q:=prune_page_top(q,saving_vdiscards>0);
-p:=list_ptr(v); list_ptr(v):=null; flush_node(v);
-pack_direction:=vdir;
-if q=null then box(n):=null {the |eq_level| of the box stays the same}
-else box(n):=filtered_vpackage(q,0,additional,max_depth,split_keep_group);
-vsplit:=filtered_vpackage(p,h,exactly,split_max_depth,split_off_group);
-exit: end;
-
-@ @<Dispense with trivial cases of void or bad boxes@>=
-if v=null then
- begin vsplit:=null; return;
- end;
-if type(v)<>vlist_node then
- begin print_err(""); print_esc("vsplit"); print(" needs a ");
- print_esc("vbox");
-@:vsplit_}{\.{\\vsplit needs a \\vbox}@>
- help2("The box you are trying to split is an \hbox.")@/
- ("I can't split such a box, so I'll leave it alone.");
- error; vsplit:=null; return;
- end
-
-@ It's possible that the box begins with a penalty node that is the
-``best'' break, so we must be careful to handle this special case correctly.
-
-@<Look at all the marks...@>=
-p:=list_ptr(v);
-if p=q then list_ptr(v):=null
-else loop@+begin if type(p)=mark_node then begin
- if split_first_mark(mark_class(p))=null then
- begin split_first_mark(mark_class(p)):=mark_ptr(p);
- split_bot_mark(mark_class(p)):=split_first_mark(mark_class(p));
- token_ref_count(split_first_mark(mark_class(p))):=@|
- token_ref_count(split_first_mark(mark_class(p)))+2;
- end
- else begin delete_token_ref(split_bot_mark(mark_class(p)));
- split_bot_mark(mark_class(p)):=mark_ptr(p);
- add_token_ref(split_bot_mark(mark_class(p)));
- end;
- end;
- if vlink(p)=q then
- begin vlink(p):=null; goto done;
- end;
- p:=vlink(p);
- end;
-done:
-
-@* \[45] The page builder.
-When \TeX\ appends new material to its main vlist in vertical mode, it uses
-a method something like |vsplit| to decide where a page ends, except that
-the calculations are done ``on line'' as new items come in.
-The main complication in this process is that insertions must be put
-into their boxes and removed from the vlist, in a more-or-less optimum manner.
-
-We shall use the term ``current page'' for that part of the main vlist that
-is being considered as a candidate for being broken off and sent to the
-user's output routine. The current page starts at |vlink(page_head)|, and
-it ends at |page_tail|. We have |page_head=page_tail| if this list is empty.
-@^current page@>
-
-Utter chaos would reign if the user kept changing page specifications
-while a page is being constructed, so the page builder keeps the pertinent
-specifications frozen as soon as the page receives its first box or
-insertion. The global variable |page_contents| is |empty| when the
-current page contains only mark nodes and content-less whatsit nodes; it
-is |inserts_only| if the page contains only insertion nodes in addition to
-marks and whatsits. Glue nodes, kern nodes, and penalty nodes are
-discarded until a box or rule node appears, at which time |page_contents|
-changes to |box_there|. As soon as |page_contents| becomes non-|empty|,
-the current |vsize| and |max_depth| are squirreled away into |page_goal|
-and |page_max_depth|; the latter values will be used until the page has
-been forwarded to the user's output routine. The \.{\\topskip} adjustment
-is made when |page_contents| changes to |box_there|.
-
-Although |page_goal| starts out equal to |vsize|, it is decreased by the
-scaled natural height-plus-depth of the insertions considered so far, and by
-the \.{\\skip} corrections for those insertions. Therefore it represents
-the size into which the non-inserted material should fit, assuming that
-all insertions in the current page have been made.
-
-The global variables |best_page_break| and |least_page_cost| correspond
-respectively to the local variables |best_place| and |least_cost| in the
-|vert_break| routine that we have already studied; i.e., they record the
-location and value of the best place currently known for breaking the
-current page. The value of |page_goal| at the time of the best break is
-stored in |best_size|.
-
-@d inserts_only=1
- {|page_contents| when an insert node has been contributed, but no boxes}
-@d box_there=2 {|page_contents| when a box or rule has been contributed}
-
-@<Glob...@>=
-@!page_tail:pointer; {the final node on the current page}
-@!page_contents:empty..box_there; {what is on the current page so far?}
-@!page_max_depth:scaled; {maximum box depth on page being built}
-@!best_page_break:pointer; {break here to get the best page known so far}
-@!least_page_cost:integer; {the score for this currently best page}
-@!best_size:scaled; {its |page_goal|}
-
-@ The page builder has another data structure to keep track of insertions.
-This is a list of four-word nodes, starting and ending at |page_ins_head|.
-That is, the first element of the list is node |r@t$_1$@>=vlink(page_ins_head)|;
-node $r_j$ is followed by |r@t$_{j+1}$@>=vlink(r@t$_j$@>)|; and if there are
-|n| items we have |r@t$_{n+1}$@>=page_ins_head|. The |subtype| field of
-each node in this list refers to an insertion number; for example, `\.{\\insert
-250}' would correspond to a node whose |subtype| is |qi(250)|
-(the same as the |subtype| field of the relevant |ins_node|). These |subtype|
-fields are in increasing order, and |subtype(page_ins_head)=65535|, so
-|page_ins_head| serves as a convenient sentinel
-at the end of the list. A record is present for each insertion number that
-appears in the current page.
-
-The |type| field in these nodes distinguishes two possibilities that
-might occur as we look ahead before deciding on the optimum page break.
-If |type(r)=inserting_node|, then |height(r)| contains the total of the
-height-plus-depth dimensions of the box and all its inserts seen so far.
-If |type(r)=split_up_node|, then no more insertions will be made into this box,
-because at least one previous insertion was too big to fit on the current
-page; |broken_ptr(r)| points to the node where that insertion will be
-split, if \TeX\ decides to split it, |broken_ins(r)| points to the
-insertion node that was tentatively split, and |height(r)| includes also the
-natural height plus depth of the part that would be split off.
-
-In both cases, |last_ins_ptr(r)| points to the last |ins_node|
-encountered for box |qo(subtype(r))| that would be at least partially
-inserted on the next page; and |best_ins_ptr(r)| points to the last
-such |ins_node| that should actually be inserted, to get the page with
-minimum badness among all page breaks considered so far. We have
-|best_ins_ptr(r)=null| if and only if no insertion for this box should
-be made to produce this optimum page.
-
-The data structure definitions here use the fact that the |@!height| field
-appears in the fourth word of a box node.
-@^data structure assumptions@>
-
-@d broken_ptr(#)==vlink(#+2)
- {an insertion for this class will break here if anywhere}
-@d broken_ins(#)==vinfo(#+2) {this insertion might break at |broken_ptr|}
-@d last_ins_ptr(#)==vlink(#+3) {the most recent insertion for this |subtype|}
-@d best_ins_ptr(#)==vinfo(#+3) {the optimum most recent insertion}
-
-@<Initialize the special list heads...@>=
-subtype(page_ins_head):=65535;
-type(page_ins_head):=split_up_node; vlink(page_ins_head):=page_ins_head;
-
-@ An array |page_so_far| records the heights and depths of everything
-on the current page. This array contains six |scaled| numbers, like the
-similar arrays already considered in |line_break| and |vert_break|; and it
-also contains |page_goal| and |page_depth|, since these values are
-all accessible to the user via |set_page_dimen| commands. The
-value of |page_so_far[1]| is also called |page_total|. The stretch
-and shrink components of the \.{\\skip} corrections for each insertion are
-included in |page_so_far|, but the natural space components of these
-corrections are not, since they have been subtracted from |page_goal|.
-
-The variable |page_depth| records the depth of the current page; it has been
-adjusted so that it is at most |page_max_depth|. The variable
-|last_glue| points to the glue specification of the most recent node
-contributed from the contribution list, if this was a glue node; otherwise
-|last_glue=max_halfword|. (If the contribution list is nonempty,
-however, the value of |last_glue| is not necessarily accurate.)
-The variables |last_penalty|, |last_kern|, and |last_node_type|
-are similar. And
-finally, |insert_penalties| holds the sum of the penalties associated with
-all split and floating insertions.
-
-@d page_goal==page_so_far[0] {desired height of information on page being built}
-@d page_total==page_so_far[1] {height of the current page}
-@d page_shrink==page_so_far[6] {shrinkability of the current page}
-@d page_depth==page_so_far[7] {depth of the current page}
-
-@<Glob...@>=
-@!page_so_far:array [0..7] of scaled; {height and glue of the current page}
-@!last_glue:pointer; {used to implement \.{\\lastskip}}
-@!last_penalty:integer; {used to implement \.{\\lastpenalty}}
-@!last_kern:scaled; {used to implement \.{\\lastkern}}
-@!last_node_type:integer; {used to implement \.{\\lastnodetype}}
-@!insert_penalties:integer; {sum of the penalties for held-over insertions}
-
-@ @<Put each...@>=
-primitive_tex("pagegoal",set_page_dimen,0,0);
-@!@:page_goal_}{\.{\\pagegoal} primitive@>
-primitive_tex("pagetotal",set_page_dimen,1,0);
-@!@:page_total_}{\.{\\pagetotal} primitive@>
-primitive_tex("pagestretch",set_page_dimen,2,0);
-@!@:page_stretch_}{\.{\\pagestretch} primitive@>
-primitive_tex("pagefilstretch",set_page_dimen,3,0);
-@!@:page_fil_stretch_}{\.{\\pagefilstretch} primitive@>
-primitive_tex("pagefillstretch",set_page_dimen,4,0);
-@!@:page_fill_stretch_}{\.{\\pagefillstretch} primitive@>
-primitive_tex("pagefilllstretch",set_page_dimen,5,0);
-@!@:page_filll_stretch_}{\.{\\pagefilllstretch} primitive@>
-primitive_tex("pageshrink",set_page_dimen,6,0);
-@!@:page_shrink_}{\.{\\pageshrink} primitive@>
-primitive_tex("pagedepth",set_page_dimen,7,0);
-@!@:page_depth_}{\.{\\pagedepth} primitive@>
-
-@ @d print_plus_end(#)==print(#);@+end
-@d print_plus(#)==if page_so_far[#]<>0 then
- begin print(" plus "); print_scaled(page_so_far[#]); print_plus_end
-
-@p procedure print_totals;
-begin print_scaled(page_total);
-print_plus(2)("");
-print_plus(3)("fil");
-print_plus(4)("fill");
-print_plus(5)("filll");
-if page_shrink<>0 then
- begin print(" minus "); print_scaled(page_shrink);
- end;
-end;
-
-@ @<Show the status of the current page@>=
-if page_head<>page_tail then
- begin print_nl("### current page:");
- if output_active then print(" (held over for next output)");
-@.held over for next output@>
- show_box(vlink(page_head));
- if page_contents>empty then
- begin print_nl("total height "); print_totals;
-@:total_height}{\.{total height}@>
- print_nl(" goal height "); print_scaled(page_goal);
-@.goal height@>
- r:=vlink(page_ins_head);
- while r<>page_ins_head do
- begin print_ln; print_esc("insert"); t:=qo(subtype(r));
- print_int(t); print(" adds ");
- 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_node then
- begin q:=page_head; t:=0;
- repeat q:=vlink(q);
- if (type(q)=ins_node)and(subtype(q)=subtype(r)) then incr(t);
- until q=broken_ins(r);
- print(", #"); print_int(t); print(" might split");
- end;
- r:=vlink(r);
- end;
- end;
- end
-
-@ Here is a procedure that is called when the |page_contents| is changing
-from |empty| to |inserts_only| or |box_there|.
-
-@d set_page_so_far_zero(#)==page_so_far[#]:=0
-
-@p procedure freeze_page_specs(@!s:small_number);
-begin page_contents:=s;
-page_goal:=vsize; page_max_depth:=max_depth;
-page_depth:=0; do_all_six(set_page_so_far_zero);
-least_page_cost:=awful_bad;
-@!stat if tracing_pages>0 then
- begin begin_diagnostic;
- print_nl("%% goal height="); print_scaled(page_goal);
-@.goal height@>
- print(", max depth="); print_scaled(page_max_depth);
- end_diagnostic(false);
- end;@;@+tats@;@/
-end;
-
-@ Pages are built by appending nodes to the current list in \TeX's
-vertical mode, which is at the outermost level of the semantic nest. This
-vlist is split into two parts; the ``current page'' that we have been
-talking so much about already, and the ``contribution list'' that receives
-new nodes as they are created. The current page contains everything that
-the page builder has accounted for in its data structures, as described
-above, while the contribution list contains other things that have been
-generated by other parts of \TeX\ but have not yet been
-seen by the page builder.
-The contribution list starts at |vlink(contrib_head)|, and it ends at the
-current node in \TeX's vertical mode.
-
-When \TeX\ has appended new material in vertical mode, it calls the procedure
-|build_page|, which tries to catch up by moving nodes from the contribution
-list to the current page. This procedure will succeed in its goal of
-emptying the contribution list, unless a page break is discovered, i.e.,
-unless the current page has grown to the point where the optimum next
-page break has been determined. In the latter case, the nodes after the
-optimum break will go back onto the contribution list, and control will
-effectively pass to the user's output routine.
-
-We make |type(page_head)=glue_node|, so that an initial glue node on
-the current page will not be considered a valid breakpoint.
-
-@<Initialize the special list...@>=
-type(page_head):=glue_node; subtype(page_head):=normal;
-
-@ The global variable |output_active| is true during the time the
-user's output routine is driving \TeX.
-
-@<Glob...@>=
-@!output_active:boolean; {are we in the midst of an output routine?}
-
-@ @<Set init...@>=
-output_active:=false; insert_penalties:=0;
-
-@ The page builder is ready to start a fresh page if we initialize
-the following state variables. (However, the page insertion list is initialized
-elsewhere.)
-
-@<Start a new current page@>=
-page_contents:=empty; page_tail:=page_head; vlink(page_head):=null;@/
-last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
-last_node_type:=-1;
-page_depth:=0; page_max_depth:=0
-
-@ At certain times box \.{\\outputbox} is supposed to be void (i.e., |null|),
-or an insertion box is supposed to be ready to accept a vertical list.
-If not, an error message is printed, and the following subroutine
-flushes the unwanted contents, reporting them to the user.
-
-@p procedure box_error(@!n:eight_bits);
-begin error; begin_diagnostic;
-print_nl("The following box has been deleted:");
-@.The following...deleted@>
-show_box(box(n)); end_diagnostic(true);
-flush_node_list(box(n)); box(n):=null;
-end;
-
-@ The following procedure guarantees that a given box register
-does not contain an \.{\\hbox}.
-
-@p procedure ensure_vbox(@!n:eight_bits);
-var p:pointer; {the box register contents}
-begin p:=box(n);
-if p<>null then if type(p)=hlist_node then
- begin print_err("Insertions can only be added to a vbox");
-@.Insertions can only...@>
- help3("Tut tut: You're trying to \insert into a")@/
- ("\box register that now contains an \hbox.")@/
- ("Proceed, and I'll discard its present contents.");
- box_error(n);
- end;
-end;
-
-@ \TeX\ is not always in vertical mode at the time |build_page|
-is called; the current mode reflects what \TeX\ should return to, after
-the contribution list has been emptied. A call on |build_page| should
-be immediately followed by `|goto big_switch|', which is \TeX's central
-control point.
-
-@d contribute=80 {go here to link a node into the current page}
-
-@p @t\4@>@<Declare the procedure called |fire_up|@>@;@/
-procedure build_page; {append contributions to the current page}
-label exit,done,done1,continue,contribute,update_heights;
-var p:pointer; {the node being appended}
-@!q,@!r:pointer; {nodes being examined}
-@!b,@!c:integer; {badness and cost of current page}
-@!pi:integer; {penalty to be added to the badness}
-@!n:min_quarterword..255; {insertion box number}
-@!delta,@!h,@!w:scaled; {sizes used for insertion calculations}
-begin pi:=0;
-if (vlink(contrib_head)=null)or output_active then return;
-repeat continue: p:=vlink(contrib_head);@/
-@<Update the values of |last_glue|, |last_penalty|, and |last_kern|@>;
-@<Move node |p| to the current page; if it is time for a page break,
- put the nodes following the break back onto the contribution list,
- and |return| to the user's output routine if there is one@>;
-until vlink(contrib_head)=null;
-@<Make the contribution list empty by setting its tail to |contrib_head|@>;
-exit:end;
-
-@ @d contrib_tail==nest[0].tail_field {tail of the contribution list}
-
-@<Make the contribution list empty...@>=
-if nest_ptr=0 then tail:=contrib_head {vertical mode}
-else contrib_tail:=contrib_head {other modes}
-
-@ @<Update the values of |last_glue|...@>=
-if last_glue<>max_halfword then delete_glue_ref(last_glue);
-last_penalty:=0; last_kern:=0;
-last_node_type:=type(p)+1;
-if type(p)=glue_node then
- begin last_glue:=glue_ptr(p); add_glue_ref(last_glue);
- end
-else begin last_glue:=max_halfword;
- if type(p)=penalty_node then last_penalty:=penalty(p)
- else if type(p)=kern_node then last_kern:=width(p);
- end
-
-@ The code here is an example of a many-way switch into routines that
-merge together in different places. Some people call this unstructured
-programming, but the author doesn't see much wrong with it, as long as
-@^Knuth, Donald Ervin@>
-the various labels have a well-understood meaning.
-
-@<Move node |p| to the current page; ...@>=
-@<If the current page is empty and node |p| is to be deleted, |goto done1|;
- otherwise use node |p| to update the state of the current page;
- if this node is an insertion, |goto contribute|; otherwise if this node
- is not a legal breakpoint, |goto contribute| or |update_heights|;
- otherwise set |pi| to the penalty associated with this breakpoint@>;
-@<Check if node |p| is a new champion breakpoint; then \(if)if it is time for
- a page break, prepare for output, and either fire up the user's
- output routine and |return| or ship out the page and |goto done|@>;
-if (type(p)<glue_node)or(type(p)>kern_node) then goto contribute;
-update_heights:@<Update the current page measurements with respect to the
- glue or kern specified by node~|p|@>;
-contribute: @<Make sure that |page_max_depth| is not exceeded@>;
-@<Link node |p| into the current page and |goto done|@>;
-done1:@<Recycle node |p|@>;
-done:
-
-@ @<Link node |p| into the current page and |goto done|@>=
-vlink(page_tail):=p; page_tail:=p;
-vlink(contrib_head):=vlink(p); vlink(p):=null; goto done
-
-@ @<Recycle node |p|@>=
-vlink(contrib_head):=vlink(p); vlink(p):=null;
-if saving_vdiscards>0 then
- begin if page_disc=null then page_disc:=p@+else vlink(tail_page_disc):=p;
- tail_page_disc:=p;
- end
-else flush_node_list(p)
-
-@ The title of this section is already so long, it seems best to avoid
-making it more accurate but still longer, by mentioning the fact that a
-kern node at the end of the contribution list will not be contributed until
-we know its successor.
-
-@<If the current page is empty...@>=
-case type(p) of
-hlist_node_case,vlist_node_case,rule_node_case: 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_case: @<Prepare to move whatsit |p| to the current page,
- then |goto contribute|@>;
-glue_node_case: if page_contents<box_there then goto done1
- else if precedes_break(page_tail) then pi:=0
- else goto update_heights;
-kern_node_case: if page_contents<box_there then goto done1
- else if vlink(p)=null then return
- else if type(vlink(p))=glue_node then pi:=0
- else goto update_heights;
-penalty_node_case: if page_contents<box_there then goto done1@+else pi:=penalty(p);
-mark_node_case: goto contribute;
-ins_node_case: @<Append an insertion to the current page and |goto contribute|@>;
-othercases confusion("page")
-@:this can't happen page}{\quad page@>
-endcases
-
-@ @<Initialize the current page, insert the \.{\\topskip} glue...@>=
-begin if page_contents=empty then freeze_page_specs(box_there)
-else page_contents:=box_there;
-q:=new_skip_param(top_skip_code); {now |temp_ptr=glue_ptr(q)|}
-if (type(p)=hlist_node) and is_mirrored(body_direction) then begin
- if width(temp_ptr)>depth(p) then width(temp_ptr):=width(temp_ptr)-depth(p)
- else width(temp_ptr):=0;
- end
-else begin
- if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
- else width(temp_ptr):=0;
- end;
-vlink(q):=p; vlink(contrib_head):=q; goto continue;
-end
-
-@ @<Prepare to move a box or rule node to the current page...@>=
-begin
-if (type(p)=hlist_node) and is_mirrored(body_direction) then begin
- page_total:=page_total+page_depth+depth(p);
- page_depth:=height(p);
- end
-else begin
- page_total:=page_total+page_depth+height(p);
- page_depth:=depth(p);
- end;
-goto contribute;
-end
-
-@ @<Make sure that |page_max_depth| is not exceeded@>=
-if page_depth>page_max_depth then
- begin page_total:=@|
- page_total+page_depth-page_max_depth;@/
- page_depth:=page_max_depth;
- end;
-
-@ @<Update the current page measurements with respect to the glue...@>=
-if type(p)=kern_node then q:=p
-else begin q:=glue_ptr(p);
-if stretch_order(q)>1 then
- page_so_far[1+stretch_order(q)]:=@|
- page_so_far[1+stretch_order(q)]+stretch(q)@/
-else
- page_so_far[2+stretch_order(q)]:=@|
- page_so_far[2+stretch_order(q)]+stretch(q);@/
- page_shrink:=page_shrink+shrink(q);
- if (shrink_order(q)<>normal)and(shrink(q)<>0) then
- begin@t@>@;@/
- print_err("Infinite glue shrinkage found on current page");@/
-@.Infinite glue shrinkage...@>
- help4("The page about to be output contains some infinitely")@/
- ("shrinkable glue, e.g., `\vss' or `\vskip 0pt minus 1fil'.")@/
- ("Such glue doesn't belong there; but you can safely proceed,")@/
- ("since the offensive shrinkability has been made finite.");
- error;
- r:=new_spec(q); shrink_order(r):=normal; delete_glue_ref(q);
- glue_ptr(p):=r; q:=r;
- end;
- end;
-page_total:=page_total+page_depth+width(q); page_depth:=0
-
-@ @<Check if node |p| is a new champion breakpoint; then \(if)...@>=
-if pi<inf_penalty then
- begin @<Compute the badness, |b|, of the current page,
- using |awful_bad| if the box is too full@>;
- if b<awful_bad then
- if pi<=eject_penalty then c:=pi
- else if b<inf_bad then c:=b+pi+insert_penalties
- else c:=deplorable
- else c:=b;
- if insert_penalties>=10000 then c:=awful_bad;
- @!stat if tracing_pages>0 then @<Display the page break cost@>;@+tats@;@/
- if c<=least_page_cost then
- begin best_page_break:=p; best_size:=page_goal;
- least_page_cost:=c;
- r:=vlink(page_ins_head);
- while r<>page_ins_head do
- begin best_ins_ptr(r):=last_ins_ptr(r);
- r:=vlink(r);
- end;
- end;
- if (c=awful_bad)or(pi<=eject_penalty) then
- begin fire_up(p); {output the current page at the best place}
- if output_active then return; {user's output routine will act}
- goto done; {the page has been shipped out by default output routine}
- end;
- end
-
-@ @<Display the page break cost@>=
-begin begin_diagnostic; print_nl("%");
-print(" t="); print_totals;@/
-print(" g="); print_scaled(page_goal);@/
-print(" b=");
-if b=awful_bad then print_char("*")@+else print_int(b);
-@.*\relax@>
-print(" p="); print_int(pi);
-print(" c=");
-if c=awful_bad then print_char("*")@+else print_int(c);
-if c<=least_page_cost then print_char("#");
-end_diagnostic(false);
-end
-
-@ @<Compute the badness, |b|, of the current page...@>=
-if page_total<page_goal then
- if (page_so_far[3]<>0) or (page_so_far[4]<>0) or@|
- (page_so_far[5]<>0) then b:=0
- else b:=badness(page_goal-page_total,page_so_far[2])
-else if page_total-page_goal>page_shrink then b:=awful_bad
-else b:=badness(page_total-page_goal,page_shrink)
-
-@ @<Append an insertion to the current page and |goto contribute|@>=
-begin if page_contents=empty then freeze_page_specs(inserts_only);
-n:=subtype(p); r:=page_ins_head;
-while n>=subtype(vlink(r)) do r:=vlink(r);
-n:=qo(n);
-if subtype(r)<>qi(n) then
- @<Create a page insertion node with |subtype(r)=qi(n)|, and
- include the glue correction for box |n| in the
- current page state@>;
-if type(r)=split_up_node then insert_penalties:=insert_penalties+float_cost(p)
-else begin last_ins_ptr(r):=p;
- delta:=page_goal-page_total-page_depth+page_shrink;
- {this much room is left if we shrink the maximum}
- if count(n)=1000 then h:=height(p)
- else h:=x_over_n(height(p),1000)*count(n); {this much room is needed}
- if ((h<=0)or(h<=delta))and(height(p)+height(r)<=dimen(n)) then
- begin page_goal:=page_goal-h; height(r):=height(r)+height(p);
- end
- else @<Find the best way to split the insertion, and change
- |type(r)| to |split_up_node|@>;
- end;
-goto contribute;
-end
-
-@ We take note of the value of \.{\\skip} |n| and the height plus depth
-of \.{\\box}~|n| only when the first \.{\\insert}~|n| node is
-encountered for a new page. A user who changes the contents of \.{\\box}~|n|
-after that first \.{\\insert}~|n| had better be either extremely careful
-or extremely lucky, or both.
-
-@<Create a page insertion node...@>=
-begin q:=new_node(inserting_node,n); vlink(q):=vlink(r); vlink(r):=q; r:=q;
-ensure_vbox(n);
-if box(n)=null then height(r):=0
-else height(r):=height(box(n))+depth(box(n));
-best_ins_ptr(r):=null;@/
-q:=skip(n);
-if count(n)=1000 then h:=height(r)
-else h:=x_over_n(height(r),1000)*count(n);
-page_goal:=page_goal-h-width(q);@/
-if stretch_order(q)>1 then
- page_so_far[1+stretch_order(q)]:=@|page_so_far[1+stretch_order(q)]+stretch(q)@/
-else
- page_so_far[2+stretch_order(q)]:=@|page_so_far[2+stretch_order(q)]+stretch(q);@/
-page_shrink:=page_shrink+shrink(q);
-if (shrink_order(q)<>normal)and(shrink(q)<>0) then
- begin print_err("Infinite glue shrinkage inserted from "); print_esc("skip");
-@.Infinite glue shrinkage...@>
- print_int(n);
- help3("The correction glue for page breaking with insertions")@/
- ("must have finite shrinkability. But you may proceed,")@/
- ("since the offensive shrinkability has been made finite.");
- error;
- end;
-end
-
-@ Here is the code that will split a long footnote between pages, in an
-emergency. The current situation deserves to be recapitulated: Node |p|
-is an insertion into box |n|; the insertion will not fit, in its entirety,
-either because it would make the total contents of box |n| greater than
-\.{\\dimen} |n|, or because it would make the incremental amount of growth
-|h| greater than the available space |delta|, or both. (This amount |h| has
-been weighted by the insertion scaling factor, i.e., by \.{\\count} |n|
-over 1000.) Now we will choose the best way to break the vlist of the
-insertion, using the same criteria as in the \.{\\vsplit} operation.
-
-@<Find the best way to split the insertion...@>=
-begin if count(n)<=0 then w:=max_dimen
-else begin w:=page_goal-page_total-page_depth;
- if count(n)<>1000 then w:=x_over_n(w,count(n))*1000;
- end;
-if w>dimen(n)-height(r) then w:=dimen(n)-height(r);
-q:=vert_break(ins_ptr(p),w,depth(p));
-height(r):=height(r)+best_height_plus_depth;
-@!stat if tracing_pages>0 then @<Display the insertion split cost@>;@+tats@;@/
-if count(n)<>1000 then
- best_height_plus_depth:=x_over_n(best_height_plus_depth,1000)*count(n);
-page_goal:=page_goal-best_height_plus_depth;
-type(r):=split_up_node; broken_ptr(r):=q; broken_ins(r):=p;
-if q=null then insert_penalties:=insert_penalties+eject_penalty
-else if type(q)=penalty_node then insert_penalties:=insert_penalties+penalty(q);
-end
-
-@ @<Display the insertion split cost@>=
-begin begin_diagnostic; print_nl("% split"); print_int(n);
-@.split@>
-print(" to "); print_scaled(w);
-print_char(","); print_scaled(best_height_plus_depth);@/
-print(" p=");
-if q=null then print_int(eject_penalty)
-else if type(q)=penalty_node then print_int(penalty(q))
-else print_char("0");
-end_diagnostic(false);
-end
-
-@ When the page builder has looked at as much material as could appear before
-the next page break, it makes its decision. The break that gave minimum
-badness will be used to put a completed ``page'' into box \.{\\outputbox}, with insertions
-appended to their other boxes.
-
-We also set the values of |top_mark|, |first_mark|, and |bot_mark|. The
-program uses the fact that |bot_mark(x)<>null| implies |first_mark(x)<>null|;
-it also knows that |bot_mark(x)=null| implies |top_mark(x)=first_mark(x)=null|.
-
-The |fire_up| subroutine prepares to output the current page at the best
-place; then it fires up the user's output routine, if there is one,
-or it simply ships out the page. There is one parameter, |c|, which represents
-the node that was being contributed to the page when the decision to
-force an output was made.
-
-@<Declare the procedure called |fire_up|@>=
-procedure fire_up(@!c:pointer);
-label exit;
-var p,@!q,@!r,@!s:pointer; {nodes being examined and/or changed}
-@!prev_p:pointer; {predecessor of |p|}
-@!n:min_quarterword..255; {insertion box number}
-@!wait:boolean; {should the present insertion be held over?}
-@!save_vbadness:integer; {saved value of |vbadness|}
-@!save_vfuzz: scaled; {saved value of |vfuzz|}
-@!save_split_top_skip: pointer; {saved value of |split_top_skip|}
-@!i: halfword; { for looping through the marks}
-begin @<Set the value of |output_penalty|@>;
-for i:=0 to biggest_used_mark do begin
- if bot_mark(i)<>null then
- begin if top_mark(i)<>null then delete_token_ref(top_mark(i));
- top_mark(i):=bot_mark(i); add_token_ref(top_mark(i));
- delete_first_mark(i);
- end;
- end;
-@<Put the \(o)optimal current page into box |output_box|, update |first_mark| and
- |bot_mark|, append insertions to their boxes, and put the
- remaining nodes back on the contribution list@>;
-for i:=0 to biggest_used_mark do begin
- if (top_mark(i)<>null)and(first_mark(i)=null) then
- begin first_mark(i):=top_mark(i); add_token_ref(top_mark(i));
- end;
- end;
-if output_routine<>null then begin
- 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|@>;
- end;
-@<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 ...@>=
-if c=best_page_break then best_page_break:=null; {|c| not yet linked in}
-@<Ensure that box |output_box| is empty before output@>;
-insert_penalties:=0; {this will count the number of insertions held over}
-save_split_top_skip:=split_top_skip;
-if holding_inserts<=0 then
- @<Prepare all the boxes involved in insertions to act as queues@>;
-q:=hold_head; vlink(q):=null; prev_p:=page_head; p:=vlink(prev_p);
-while p<>best_page_break do
- begin if type(p)=ins_node then
- begin if holding_inserts<=0 then
- @<Either insert the material specified by node |p| into the
- appropriate box, or hold it for the next page;
- also delete node |p| from the current page@>;
- end
- else if type(p)=mark_node then @<Update the values of
- |first_mark| and |bot_mark|@>;
- prev_p:=p; p:=vlink(prev_p);
- end;
-split_top_skip:=save_split_top_skip;
-@<Break the current page at node |p|, put it in box~|output_box|,
- and put the remaining nodes on the contribution list@>;
-@<Delete \(t)the page-insertion nodes@>
-
-@ @<Ensure that box |output_box| is empty before output@>=
-if box(output_box)<>null then
- begin print_err(""); print_esc("box"); print_int(output_box); print(" is not void");
-@:box\\outputbox}{\.{\\box\\outputbox is not void}@>
- help2("You shouldn't use \box\outputbox except in \output routines.")@/
- ("Proceed, and I'll discard its present contents.");
- box_error(output_box);
- end
-
-@ @<Update the values of |first_mark| and |bot_mark|@>=
-begin if first_mark(mark_class(p))=null then
- begin first_mark(mark_class(p)):=mark_ptr(p);
- add_token_ref(first_mark(mark_class(p)));
- end;
-if bot_mark(mark_class(p))<>null then delete_token_ref(bot_mark(mark_class(p)));
-bot_mark(mark_class(p)):=mark_ptr(p); add_token_ref(bot_mark(mark_class(p)));
-end;
-
-@ When the following code is executed, the current page runs from node
-|vlink(page_head)| to node |prev_p|, and the nodes from |p| to |page_tail|
-are to be placed back at the front of the contribution list. Furthermore
-the heldover insertions appear in a list from |vlink(hold_head)| to |q|; we
-will put them into the current page list for safekeeping while the user's
-output routine is active. We might have |q=hold_head|; and |p=null| if
-and only if |prev_p=page_tail|. Error messages are suppressed within
-|vpackage|, since the box might appear to be overfull or underfull simply
-because the stretch and shrink from the \.{\\skip} registers for inserts
-are not actually present in the box.
-
-@<Break the current page at node |p|, put it...@>=
-if p<>null then
- begin if vlink(contrib_head)=null then begin
- if nest_ptr=0 then tail:=page_tail
- else contrib_tail:=page_tail;
- end;
- vlink(page_tail):=vlink(contrib_head);
- vlink(contrib_head):=p;
- vlink(prev_p):=null;
- end;
-save_vbadness:=vbadness; vbadness:=inf_bad;
-save_vfuzz:=vfuzz; vfuzz:=max_dimen; {inhibit error messages}
-pack_direction:=body_direction;
-box(output_box):=filtered_vpackage(vlink(page_head),best_size,exactly,page_max_depth,output_group);
-vbadness:=save_vbadness; vfuzz:=save_vfuzz;
-if last_glue<>max_halfword then delete_glue_ref(last_glue);
-@<Start a new current page@>; {this sets |last_glue:=max_halfword|}
-if q<>hold_head then
- begin vlink(page_head):=vlink(hold_head); page_tail:=q;
- end
-
-@ If many insertions are supposed to go into the same box, we want to know
-the position of the last node in that box, so that we don't need to waste time
-when linking further information into it. The |last_ins_ptr| fields of the
-page insertion nodes are therefore used for this purpose during the
-packaging phase.
-
-@<Prepare all the boxes involved in insertions to act as queues@>=
-begin r:=vlink(page_ins_head);
-while r<>page_ins_head do
- begin if best_ins_ptr(r)<>null then
- begin n:=qo(subtype(r)); ensure_vbox(n);
- if box(n)=null then box(n):=new_null_box;
- p:=box(n)+list_offset;
- while vlink(p)<>null do p:=vlink(p);
- last_ins_ptr(r):=p;
- end;
- r:=vlink(r);
- end;
-end
-
-@ @<Delete \(t)the page-insertion nodes@>=
-r:=vlink(page_ins_head);
-while r<>page_ins_head do
- begin q:=vlink(r); flush_node(r); r:=q;
- end;
-vlink(page_ins_head):=page_ins_head
-
-@ We will set |best_ins_ptr:=null| and package the box corresponding to
-insertion node~|r|, just after making the final insertion into that box.
-If this final insertion is `|split_up_node|', the remainder after splitting
-and pruning (if any) will be carried over to the next page.
-
-@<Either insert the material specified by node |p| into...@>=
-begin r:=vlink(page_ins_head);
-while subtype(r)<>subtype(p) do r:=vlink(r);
-if best_ins_ptr(r)=null then wait:=true
-else begin wait:=false; s:=last_ins_ptr(r); vlink(s):=ins_ptr(p);
- if best_ins_ptr(r)=p then
- @<Wrap up the box specified by node |r|, splitting node |p| if
- called for; set |wait:=true| if node |p| holds a remainder after
- splitting@>
- else begin while vlink(s)<>null do s:=vlink(s);
- last_ins_ptr(r):=s;
- end;
- end;
-@<Either append the insertion node |p| after node |q|, and remove it
- from the current page, or delete |node(p)|@>;
-end
-
-@ @<Wrap up the box specified by node |r|, splitting node |p| if...@>=
-begin if type(r)=split_up_node then
- if (broken_ins(r)=p)and(broken_ptr(r)<>null) then
- begin while vlink(s)<>broken_ptr(r) do s:=vlink(s);
- vlink(s):=null;
- split_top_skip:=split_top_ptr(p);
- ins_ptr(p):=prune_page_top(broken_ptr(r),false);
- if ins_ptr(p)<>null then
- begin temp_ptr:=vpack(ins_ptr(p),natural);
- height(p):=height(temp_ptr)+depth(temp_ptr);
- list_ptr(temp_ptr):=null; flush_node(temp_ptr); wait:=true;
- end;
- end;
-best_ins_ptr(r):=null;
-n:=qo(subtype(r));
-temp_ptr:=list_ptr(box(n));
-list_ptr(box(n)):=null; flush_node(box(n));
-pack_direction:=body_direction;
-box(n):=vpack(temp_ptr,natural);
-end
-
-@ @<Either append the insertion node |p|...@>=
-vlink(prev_p):=vlink(p); vlink(p):=null;
-if wait then
- begin vlink(q):=p; q:=p; incr(insert_penalties);
- end
-else begin ins_ptr(p):=null; flush_node(p);
- end;
-p:=prev_p
-
-@ The list of heldover insertions, running from |vlink(page_head)| to
-|page_tail|, must be moved to the contribution list when the user has
-specified no output routine.
-
-@<Perform the default output routine@>=
-begin if vlink(page_head)<>null then
- begin if vlink(contrib_head)=null then
- if nest_ptr=0 then tail:=page_tail@+else contrib_tail:=page_tail
- else vlink(page_tail):=vlink(contrib_head);
- vlink(contrib_head):=vlink(page_head);
- vlink(page_head):=null; page_tail:=page_head;
- end;
-flush_node_list(page_disc); page_disc:=null;
-ship_out(box(output_box)); box(output_box):=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 \box\outputbox 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:=pdf_ignored_dimen; 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 |output_box| is empty after output@>;
-if tail<>head then {current list goes after heldover insertions}
- begin vlink(page_tail):=vlink(head);
- page_tail:=tail;
- end;
-if vlink(page_head)<>null then {and both go before heldover contributions}
- begin if vlink(contrib_head)=null then contrib_tail:=page_tail;
- vlink(page_tail):=vlink(contrib_head);
- vlink(contrib_head):=vlink(page_head);
- vlink(page_head):=null; page_tail:=page_head;
- end;
-flush_node_list(page_disc); page_disc:=null;
-pop_nest; check_filter('after_output'); 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 |output_box| is empty after output@>=
-if box(output_box)<>null then
- begin print_err("Output routine didn't use all of ");
- print_esc("box"); print_int(output_box);
-@.Output routine didn't use...@>
- help3("Your \output commands should empty \box\outputbox,")@/
- ("e.g., by saying `\shipout\box\outputbox'.")@/
- ("Proceed; I'll discard its present contents.");
- box_error(output_box);
- end
-
-@* \[46] The chief executive.
-We come now to the |main_control| routine, which contains the master
-switch that causes all the various pieces of \TeX\ to do their things,
-in the right order.
-
-In a sense, this is the grand climax of the program: It applies all the
-tools that we have worked so hard to construct. In another sense, this is
-the messiest part of the program: It necessarily refers to other pieces
-of code all over the place, so that a person can't fully understand what is
-going on without paging back and forth to be reminded of conventions that
-are defined elsewhere. We are now at the hub of the web, the central nervous
-system that touches most of the other parts and ties them together.
-@^brain@>
-
-The structure of |main_control| itself is quite simple. There's a label
-called |big_switch|, at which point the next token of input is fetched
-using |get_x_token|. Then the program branches at high speed into one of
-about 100 possible directions, based on the value of the current
-mode and the newly fetched command code; the sum |abs(mode)+cur_cmd|
-indicates what to do next. For example, the case `|vmode+letter|' arises
-when a letter occurs in vertical mode (or internal vertical mode); this
-case leads to instructions that initialize a new paragraph and enter
-horizontal mode.
-
-The big |case| statement that contains this multiway switch has been labeled
-|reswitch|, so that the program can |goto reswitch| when the next token
-has already been fetched. Most of the cases are quite short; they call
-an ``action procedure'' that does the work for that case, and then they
-either |goto reswitch| or they ``fall through'' to the end of the |case|
-statement, which returns control back to |big_switch|. Thus, |main_control|
-is not an extremely large procedure, in spite of the multiplicity of things
-it must do; it is small enough to be handled by \PASCAL\ compilers that put
-severe restrictions on procedure size.
-@!@^action procedure@>
-
-One case is singled out for special treatment, because it accounts for most
-of \TeX's activities in typical applications. The process of reading simple
-text and converting it into |char_node| records, while looking for ligatures
-and kerns, is part of \TeX's ``inner loop''; the whole program runs
-efficiently when its inner loop is fast, so this part has been written
-with particular care.
-
-@ We shall concentrate first on the inner loop of |main_control|, deferring
-consideration of the other cases until later.
-@^inner loop@>
-
-@d big_switch=60 {go here to branch on the next token of input}
-
-@p @t\4@>@<Declare action procedures for use by |main_control|@>@;
-@t\4@>@<Declare the procedure called |handle_right_brace|@>@;
-procedure main_control; {governs \TeX's activities}
-label big_switch,reswitch,continue,exit;
-var@!t,k:integer; {general-purpose temporary variables}
-p:pointer; {for whatsit nodes and testing whether an auto kern should be inserted}
-chr_stack:integer; { to temporarily save an |cur_chr| to be appended }
-mval:mathcodeval; { to build up an argument to |set_math_char| }
-begin t:=0; {for -Wall}
-chr_stack:=-1;
-if every_job<>null then begin_token_list(every_job,every_job_text);
-big_switch: get_x_token;@/
-reswitch: @<Give diagnostic information, if requested@>;
-case abs(mode)+cur_cmd of
-hmode+letter,hmode+other_char,hmode+char_given,hmode+char_num: begin
- if abs(mode)+cur_cmd=hmode+char_num then begin
- scan_char_num; cur_chr:=cur_val;
- end;
- if is_last_ocp(current_ocp_lstack,current_ocp_no) then begin
- @<Append character |cur_chr| and the following characters (if~any)
- to the current hlist in the current font; |goto reswitch| when
- a non-character has been fetched@>;
- end
- else begin
- @<Create a buffer with character |cur_chr| and the following
- characters (if~any) and then apply the current active OCP filter
- to this buffer@>;
- end;
- end;
-hmode+no_boundary: begin @<Append a |cancel_boundary_node| @>;
- end;
-hmode+char_ghost: begin t:=cur_chr; get_x_token;
- if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
- (cur_cmd=char_num) then begin
- p:=new_glyph(cur_font,cur_chr);
- if t=0 then begin set_is_leftghost(p); end
- else begin set_is_rightghost(p); end;
- tail_append(p);
- end;
- end;
-hmode+spacer,hmode+ex_space,mmode+ex_space:
-if (abs(mode)+cur_cmd=hmode+spacer) and
- (not (space_factor = 1000)) then
- app_space
-else begin
- @<Append a normal inter-word space to the current list@>;
- end;
-@t\4@>@<Cases of |main_control| that are not part of the inner loop@>@;
-end; {of the big |case| statement}
-goto big_switch;
-exit:end;
-
-@ When a new token has just been fetched at |big_switch|, we have an
-ideal place to monitor \TeX's activity.
-@^debugging@>
-
-@<Give diagnostic information, if requested@>=
-if interrupt<>0 then if OK_to_interrupt then
- begin back_input; check_interrupt; goto big_switch;
- end;
-if tracing_commands>0 then show_cur_cmd_chr
-
-@ The following part of the program was first written in a structured
-manner, according to the philosophy that ``premature optimization is
-the root of all evil.'' Then it was rearranged into pieces of
-spaghetti so that the most common actions could proceed with little or
-no redundancy. And finally, it is replaced by a completely standalone
-loop over the node list: luatex does not have a |main+loop| at all.
-@^inner loop@>
-
-@<Glob...@>=
-@!main_p:pointer; {temporary register for list manipulation}
-@!main_s:integer; {space factor value}
-
-@ We leave the |space_factor| unchanged if |sf_code(cur_chr)=0|; otherwise we
-set it equal to |sf_code(cur_chr)|, except that it should never change
-from a value less than 1000 to a value exceeding 1000. The most common
-case is |sf_code(cur_chr)=1000|, so we want that case to be fast.
-
-@d adjust_space_factor==@t@>@;@/
- main_s:=get_sf_code(cur_chr);
- if main_s=1000 then space_factor:=1000
- else if main_s<1000 then
- begin if main_s>0 then space_factor:=main_s;
- end
- else if space_factor<1000 then space_factor:=1000
- else space_factor:=main_s
-
-@<Append character |cur_chr|...@>=
-continue: adjust_space_factor;@/
-chr_stack:=cur_chr;
-tail_append(new_char(cur_font,chr_stack));
-get_x_token;
-if (cur_cmd=letter)or(cur_cmd=other_char)or
- (cur_cmd=char_given)or(cur_cmd=char_num) then begin
- if cur_cmd=char_num then begin
- scan_char_num; cur_chr:=cur_val;
- end;
- if (chr_stack=ex_hyphen_char)and(cur_chr<>ex_hyphen_char)and(mode>0) then begin
- tail:=compound_word_break(tail,cur_lang);
- subtype(tail):=automatic_disc;
- end;
- goto continue;
- end
-else begin
- if (chr_stack=ex_hyphen_char) and (mode>0) then begin
- tail:=compound_word_break(tail,cur_lang);
- subtype(tail):=automatic_disc;
- end;
- chr_stack:=-1;
- goto reswitch;
- end
-
-@ The occurrence of blank spaces is almost part of \TeX's inner loop,
-@^inner loop@>
-since we usually encounter about one space for every five non-blank characters.
-Therefore |main_control| gives second-highest priority to ordinary spaces.
-
-When a glue parameter like \.{\\spaceskip} is set to `\.{0pt}', we will
-see to it later that the corresponding glue specification is precisely
-|zero_glue|, not merely a pointer to some specification that happens
-to be full of zeroes. Therefore it is simple to test whether a glue parameter
-is zero or~not.
-
-@<Append a normal inter-word space...@>=
-if space_skip=zero_glue then
- begin @<Find the glue specification, |main_p|, for
- text spaces in the current font@>;
- temp_ptr:=new_glue(main_p);
- end
-else temp_ptr:=new_param_glue(space_skip_code);
-vlink(tail):=temp_ptr; tail:=temp_ptr
-
-
-@ From Knuth: ``Having |font_glue| allocated for each text font saves
-both time and memory.'' That may be true, but it also punches through
-the API wall for fonts, so I removed that -- Taco. But a bit of caching
-is very welcome, which is why I need to have the next two globals:
-
-@<Glob...@>=
-space_spec_font:internal_font_number;
-space_spec_cache:halfword;
-
-@ @<Set init...@>=
-space_spec_font:=0;
-space_spec_cache:=zero_glue;
-
-@ @<Find the glue specification...@>=
-begin
-if cur_font<>space_spec_font then begin
- if space_spec_cache<>zero_glue then
- delete_glue_ref(space_spec_cache);
- space_spec_cache:=new_spec(zero_glue);
- width(space_spec_cache):=space(cur_font);
- stretch(space_spec_cache):=space_stretch(cur_font);
- shrink(space_spec_cache):=space_shrink(cur_font);
- space_spec_font:=cur_font;
- end;
-main_p:=space_spec_cache;
-end
-
-@ @<Declare act...@>=
-procedure app_space; {handle spaces when |space_factor<>1000|}
-var@!q:pointer; {glue node}
-begin if (space_factor>=2000)and(xspace_skip<>zero_glue) then
- q:=new_param_glue(xspace_skip_code)
-else begin if space_skip<>zero_glue then
- main_p:=new_spec(space_skip)
- else begin
- main_p:=new_spec(zero_glue);
- width(main_p):=space(cur_font);
- stretch(main_p):=space_stretch(cur_font);
- shrink(main_p):=space_shrink(cur_font);
- end;
- @<Modify the glue specification in |main_p| according to the space factor@>;
- q:=new_glue(main_p); glue_ref_count(main_p):=null;
- end;
-vlink(tail):=q; tail:=q;
-end;
-
-@ @<Modify the glue specification in |main_p| according to the space factor@>=
-if space_factor>=2000 then width(main_p):=width(main_p)+extra_space(cur_font);
-stretch(main_p):=xn_over_d(stretch(main_p),space_factor,1000);
-shrink(main_p):=xn_over_d(shrink(main_p),1000,space_factor)
-
-@ Whew---that covers the main loop. We can now proceed at a leisurely
-pace through the other combinations of possibilities.
-
-@d any_mode(#)==vmode+#,hmode+#,mmode+# {for mode-independent commands}
-
-@<Cases of |main_control| that are not part of the inner loop@>=
-any_mode(relax),vmode+spacer,mmode+spacer,mmode+no_boundary:do_nothing;
-any_mode(ignore_spaces): begin
- if cur_chr = 0 then begin
- @<Get the next non-blank non-call...@>;
- goto reswitch;
- end
- else begin
- t:=scanner_status;
- scanner_status:=normal;
- get_filtered_next;
- scanner_status:=t;
- cur_cs := prim_lookup(text(cur_cs));
- if cur_cs<>undefined_primitive then begin
- cur_cmd := get_prim_eq_type(cur_cs);
- cur_chr := get_prim_equiv(cur_cs);
- cur_tok := (cur_cmd*string_offset)+cur_chr;
- goto reswitch;
- end;
- end;
- end;
-vmode+stop: if its_all_over then return; {this is the only way out}
-@t\4@>@<Math cases in non-math modes@>;
-@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(super_sub_script), 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
-
-@ @<Math cases in non-math modes@>=
-vmode+math_char_num, vmode+math_given, vmode+omath_given, vmode+xmath_given: begin
- back_input; new_graf(true);
- end;
-hmode+math_char_num: begin
- if cur_chr=0 then
- mval := scan_mathchar(tex_mathcode)
- else if cur_chr=1 then
- mval := scan_mathchar(aleph_mathcode)
- else if cur_chr=2 then
- mval := scan_mathchar(xetex_mathcode)
- else
- mval := scan_mathchar(xetexnum_mathcode);
- math_char_in_text(mval);
- end;
-hmode+math_given: begin
- mval := mathchar_from_integer(cur_chr,tex_mathcode);
- math_char_in_text(mval);
- end;
-hmode+omath_given: begin
- mval := mathchar_from_integer(cur_chr,aleph_mathcode);
- math_char_in_text(mval);
- end;
-hmode+xmath_given: begin
- mval := mathchar_from_integer(cur_chr,xetex_mathcode);
- math_char_in_text(mval);
- end
-
-
-
-@ @<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_tex("end",stop,0,0);@/
-@!@:end_}{\.{\\end} primitive@>
-primitive_tex("dump",stop,1,0);@/
-@!@:dump_}{\.{\\dump} primitive@>
-
-@ 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));@/
- check_filter('end'); 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:=pdf_ignored_dimen|.
-
-@<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:=pdf_ignored_dimen
- 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_tex("hskip",hskip,skip_code,0);@/
-@!@:hskip_}{\.{\\hskip} primitive@>
-primitive_tex("hfil",hskip,fil_code,0);
-@!@:hfil_}{\.{\\hfil} primitive@>
-primitive_tex("hfill",hskip,fill_code,0);@/
-@!@:hfill_}{\.{\\hfill} primitive@>
-primitive_tex("hss",hskip,ss_code,0);
-@!@:hss_}{\.{\\hss} primitive@>
-primitive_tex("hfilneg",hskip,fil_neg_code,0);@/
-@!@:hfil_neg_}{\.{\\hfilneg} primitive@>
-primitive_tex("vskip",vskip,skip_code,0);@/
-@!@:vskip_}{\.{\\vskip} primitive@>
-primitive_tex("vfil",vskip,fil_code,0);
-@!@:vfil_}{\.{\\vfil} primitive@>
-primitive_tex("vfill",vskip,fill_code,0);@/
-@!@:vfill_}{\.{\\vfill} primitive@>
-primitive_tex("vss",vskip,ss_code,0);
-@!@:vss_}{\.{\\vss} primitive@>
-primitive_tex("vfilneg",vskip,fil_neg_code,0);@/
-@!@:vfil_neg_}{\.{\\vfilneg} primitive@>
-primitive_tex("mskip",mskip,mskip_code,0);@/
-@!@:mskip_}{\.{\\mskip} primitive@>
-primitive_tex("kern",kern,explicit,0);
-@!@:kern_}{\.{\\kern} primitive@>
-primitive_tex("mkern",mkern,mu_glue,0);@/
-@!@:mkern_}{\.{\\mkern} primitive@>
-
-@ All the work relating to glue creation has been relegated to the
-following subroutine. It does not call |build_page|, because it is
-used in at least one place where that would be a mistake.
-
-@<Declare action...@>=
-procedure append_glue;
-var s:small_number; {modifier of skip command}
-begin s:=cur_chr;
-case s of
-fil_code: cur_val:=fil_glue;
-fill_code: cur_val:=fill_glue;
-ss_code: cur_val:=ss_glue;
-fil_neg_code: cur_val:=fil_neg_glue;
-skip_code: scan_glue(glue_val);
-mskip_code: scan_glue(mu_val);
-end; {now |cur_val| points to the glue specification}
-tail_append(new_glue(cur_val));
-if s>=skip_code then
- begin decr(glue_ref_count(cur_val));
- if s>skip_code then subtype(tail):=mu_glue;
- end;
-end;
-
-@ @<Declare act...@>=
-procedure append_kern;
-var s:quarterword; {|subtype| of the kern node}
-begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
-tail_append(new_kern(cur_val)); subtype(tail):=s;
-end;
-
-@ Many of the actions related to box-making are triggered by the appearance
-of braces in the input. For example, when the user says `\.{\\hbox}
-\.{to} \.{100pt\{$\langle\,\hbox{hlist}\,\rangle$\}}' in vertical mode,
-the information about the box size (100pt, |exactly|) is put onto |save_stack|
-with a level boundary word just above it, and |cur_group:=adjusted_hbox_group|;
-\TeX\ enters restricted horizontal mode to process the hlist. The right
-brace eventually causes |save_stack| to be restored to its former state,
-at which time the information about the box size (100pt, |exactly|) is
-available once again; a box is packaged and we leave restricted horizontal
-mode, appending the new box to the current list of the enclosing mode
-(in this case to the current list of vertical mode), followed by any
-vertical adjustments that were removed from the box by |hpack|.
-
-The next few sections of the program are therefore concerned with the
-treatment of left and right curly braces.
-
-@ If a left brace occurs in the middle of a page or paragraph, it simply
-introduces a new level of grouping, and the matching right brace will not have
-such a drastic effect. Such grouping affects neither the mode nor the
-current list.
-
-@<Cases of |main_control| that build...@>=
-non_math(left_brace): begin
- new_save_level(simple_group);
- eq_word_define(int_base+no_local_whatsits_code,0);
- eq_word_define(int_base+no_local_dirs_code,0);
- end;
-any_mode(begin_group): begin
- new_save_level(semi_simple_group);
- eq_word_define(int_base+no_local_whatsits_code,0);
- eq_word_define(int_base+no_local_dirs_code,0);
- end;
-any_mode(end_group):
- if cur_group=semi_simple_group then begin
- temp_no_whatsits:=no_local_whatsits;
- temp_no_dirs:=no_local_dirs;
- temporary_dir:=text_direction;
- if dir_level(text_dir_ptr)=cur_level then
- @<DIR: Remove from |text_dir_ptr|@>;
- unsave;
- if abs(mode)=hmode then begin
- if temp_no_dirs<>0 then begin
- @<DIR: Add local dir node@>;
- dir_dir(tail):=temporary_dir-64;
- end;
- if temp_no_whatsits<>0 then
- @<LOCAL: Add local paragraph node@>;
- end
- end
- else off_save;
-
-@ We have to deal with errors in which braces and such things are not
-properly nested. Sometimes the user makes an error of commission by
-inserting an extra symbol, but sometimes the user makes an error of omission.
-\TeX\ can't always tell one from the other, so it makes a guess and tries
-to avoid getting into a loop.
-
-The |off_save| routine is called when the current group code is wrong. It tries
-to insert something into the user's input that will help clean off
-the top level.
-
-@<Declare act...@>=
-procedure off_save;
-var p,q:pointer; {inserted token}
-begin if cur_group=bottom_level then
- @<Drop current token and complain that it was unmatched@>
-else begin back_input; p:=get_avail; link(temp_token_head):=p;
- print_err("Missing ");
- @<Prepare to insert a token that matches |cur_group|,
- and print what it is@>;
- print(" inserted"); ins_list(link(temp_token_head));
- help5("I've inserted something that you may have forgotten.")@/
- ("(See the <inserted text> above.)")@/
- ("With luck, this will get me unwedged. But if you")@/
- ("really didn't forget anything, try typing `2' now; then")@/
- ("my insertion and my current dilemma will both disappear.");
- error;
- end;
-end;
-
-@ At this point, |link(temp_token_head)=p|, a pointer to an empty one-word node.
-
-@<Prepare to insert a token that matches |cur_group|...@>=
-case cur_group of
-semi_simple_group: begin info(p):=cs_token_flag+frozen_end_group;
- print_esc("endgroup");
-@.Missing \\endgroup inserted@>
- end;
-math_shift_group: begin info(p):=math_shift_token+"$"; print_char("$");
-@.Missing \$ inserted@>
- end;
-math_left_group: begin info(p):=cs_token_flag+frozen_right; q:=get_avail; link(p):=q;
- p:=link(p); info(p):=other_token+"."; print_esc("right.");
-@.Missing \\right\hbox{.} inserted@>
-@^null delimiter@>
- end;
-othercases begin info(p):=right_brace_token+"}"; print_char("}");
-@.Missing \} inserted@>
- end
-endcases
-
-@ @<Drop current token and complain that it was unmatched@>=
-begin print_err("Extra "); print_cmd_chr(cur_cmd,cur_chr);
-@.Extra x@>
-help1("Things are pretty mixed up, but I think the worst is over.");@/
-error;
-end
-
-@ The routine for a |right_brace| character branches into many subcases,
-since a variety of things may happen, depending on |cur_group|. Some
-types of groups are not supposed to be ended by a right brace; error
-messages are given in hopes of pinpointing the problem. Most branches
-of this routine will be filled in later, when we are ready to understand
-them; meanwhile, we must prepare ourselves to deal with such errors.
-
-@<Cases of |main_control| that build...@>=
-any_mode(right_brace): handle_right_brace;
-
-@ @<Declare the procedure called |handle_right_brace|@>=
-procedure handle_right_brace;
-var p,@!q:pointer; {for short-term use}
-@!d:scaled; {holds |split_max_depth| in |insert_group|}
-@!f:integer; {holds |floating_penalty| in |insert_group|}
-begin p:=null;
-case cur_group of
-simple_group: begin
- temp_no_whatsits:=no_local_whatsits;
- temp_no_dirs:=no_local_dirs;
- temporary_dir:=text_direction;
- if dir_level(text_dir_ptr)=cur_level then
- @<DIR: Remove from |text_dir_ptr|@>;
- unsave;
- if abs(mode)=hmode then begin
- if temp_no_dirs<>0 then begin
- @<DIR: Add local dir node@>;
- dir_dir(tail):=temporary_dir-64;
- end;
- if temp_no_whatsits<>0 then
- @<LOCAL: Add local paragraph node@>;
- end
- end;
-bottom_level: begin print_err("Too many }'s");
-@.Too many \}'s@>
- help2("You've closed more groups than you opened.")@/
- ("Such booboos are generally harmless, so keep going."); error;
- end;
-semi_simple_group,math_shift_group,math_left_group: extra_right_brace;
-@t\4@>@<Cases of |handle_right_brace| where a |right_brace| triggers
- a delayed action@>@;
-othercases confusion("rightbrace")
-@:this can't happen rightbrace}{\quad rightbrace@>
-endcases;
-end;
-
-@ @<Declare act...@>=
-procedure extra_right_brace;
-begin print_err("Extra }, or forgotten ");
-@.Extra \}, or forgotten x@>
-case cur_group of
-semi_simple_group: print_esc("endgroup");
-math_shift_group: print_char("$");
-math_left_group: print_esc("right");
-end;@/
-help5("I've deleted a group-closing symbol because it seems to be")@/
-("spurious, as in `$x}$'. But perhaps the } is legitimate and")@/
-("you forgot something else, as in `\hbox{$x}'. In such cases")@/
-("the way to recover is to insert both the forgotten and the")@/
-("deleted material, e.g., by typing `I$}'."); error;
-incr(align_state);
-end;
-
-@ Here is where we clear the parameters that are supposed to revert to their
-default values after every paragraph and when internal vertical mode is entered.
-
-@<Declare act...@>=
-procedure normal_paragraph;
-begin if looseness<>0 then eq_word_define(int_base+looseness_code,0);
-if hang_indent<>0 then eq_word_define(dimen_base+hang_indent_code,0);
-if hang_after<>1 then eq_word_define(int_base+hang_after_code,1);
-if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
-if inter_line_penalties_ptr<>null then
- eq_define(inter_line_penalties_loc,shape_ref,null);
-end;
-
-@ Now let's turn to the question of how \.{\\hbox} is treated. We actually
-need to consider also a slightly larger context, since constructions like
-`\.{\\setbox3=}\penalty0\.{\\hbox...}' and
-`\.{\\leaders}\penalty0\.{\\hbox...}' and
-`\.{\\lower3.8pt\\hbox...}'
-are supposed to invoke quite
-different actions after the box has been packaged. Conversely,
-constructions like `\.{\\setbox3=}' can be followed by a variety of
-different kinds of boxes, and we would like to encode such things in an
-efficient way.
-
-In other words, there are two problems: To represent the context of a box,
-and to represent its type.
-
-The first problem is solved by putting a ``context code'' on the |save_stack|,
-just below the two entries that give the dimensions produced by |scan_spec|.
-The context code is either a (signed) shift amount, or it is a large
-integer |>=box_flag|, where |box_flag=@t$2^{30}$@>|. Codes |box_flag| through
-|box_flag+biggest_reg| represent `\.{\\setbox0}' through
-`\.{\\setbox}|biggest_reg|'; codes |box_flag+biggest_reg+1| through
-|box_flag+2*biggest_reg| represent `\.{\\global\\setbox0}'
-through `\.{\\global\\setbox}|biggest_reg|'; code |box_flag+2*number_regs|
-represents `\.{\\shipout}'; and codes |box_flag+2*number_regs+1|
-through |box_flag+2*number_regs+3| represent `\.{\\leaders}', `\.{\\cleaders}',
-and `\.{\\xleaders}'.
-
-The second problem is solved by giving the command code |make_box| to all
-control sequences that produce a box, and by using the following |chr_code|
-values to distinguish between them: |box_code|, |copy_code|, |last_box_code|,
-|vsplit_code|, |vtop_code|, |vtop_code+vmode|, and |vtop_code+hmode|,
-where the latter two are used denote \.{\\vbox} and \.{\\hbox}, respectively.
-
-@d box_flag==@'10000000000 {context code for `\.{\\setbox0}'}
-@d global_box_flag==(box_flag+number_regs) {context code for `\.{\\global\\setbox0}'}
-@d max_global_box_flag==(global_box_flag+number_regs)
-@d ship_out_flag==(max_global_box_flag+1) {context code for `\.{\\shipout}'}
-@d leader_flag==ship_out_flag+1 {context code for `\.{\\leaders}'}
-@d box_code=0 {|chr_code| for `\.{\\box}'}
-@d copy_code=1 {|chr_code| for `\.{\\copy}'}
-@d last_box_code=2 {|chr_code| for `\.{\\lastbox}'}
-@d vsplit_code=3 {|chr_code| for `\.{\\vsplit}'}
-@d vtop_code=4 {|chr_code| for `\.{\\vtop}'}
-
-@<Put each...@>=
-primitive_tex("moveleft",hmove,1,0);
-@!@:move_left_}{\.{\\moveleft} primitive@>
-primitive_tex("moveright",hmove,0,0);@/
-@!@:move_right_}{\.{\\moveright} primitive@>
-primitive_tex("raise",vmove,1,0);
-@!@:raise_}{\.{\\raise} primitive@>
-primitive_tex("lower",vmove,0,0);
-@!@:lower_}{\.{\\lower} primitive@>
-@#
-primitive_tex("box",make_box,box_code,0);
-@!@:box_}{\.{\\box} primitive@>
-primitive_tex("copy",make_box,copy_code,0);
-@!@:copy_}{\.{\\copy} primitive@>
-primitive_tex("lastbox",make_box,last_box_code,0);
-@!@:last_box_}{\.{\\lastbox} primitive@>
-primitive_tex("vsplit",make_box,vsplit_code,0);
-@!@:vsplit_}{\.{\\vsplit} primitive@>
-primitive_tex("vtop",make_box,vtop_code,0);@/
-@!@:vtop_}{\.{\\vtop} primitive@>
-primitive_tex("vbox",make_box,vtop_code+vmode,0);
-@!@:vbox_}{\.{\\vbox} primitive@>
-primitive_tex("hbox",make_box,vtop_code+hmode,0);@/
-@!@:hbox_}{\.{\\hbox} primitive@>
-primitive_tex("shipout",leader_ship,a_leaders-1,0); {|ship_out_flag=leader_flag-1|}
-@!@:ship_out_}{\.{\\shipout} primitive@>
-primitive_tex("leaders",leader_ship,a_leaders,0);
-@!@:leaders_}{\.{\\leaders} primitive@>
-primitive_tex("cleaders",leader_ship,c_leaders,0);
-@!@:c_leaders_}{\.{\\cleaders} primitive@>
-primitive_tex("xleaders",leader_ship,x_leaders,0);
-@!@:x_leaders_}{\.{\\xleaders} primitive@>;
-primitive_aleph("boxdir",assign_box_dir,0,0);
-@!@:box_dir}{\.{\\boxdir} primitive@>
-
-@ Constructions that require a box are started by calling |scan_box| with
-a specified context code. The |scan_box| routine verifies
-that a |make_box| command comes next and then it calls |begin_box|.
-
-@<Cases of |main_control| that build...@>=
-vmode+hmove,hmode+vmove,mmode+vmove: begin t:=cur_chr;
- scan_normal_dimen;
- if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
- end;
-any_mode(leader_ship): scan_box(leader_flag-a_leaders+cur_chr);
-any_mode(make_box): begin_box(0);
-any_mode(assign_box_dir): begin scan_register_num;
- cur_box:=box(cur_val);
- scan_optional_equals; scan_direction;
- if cur_box<>null then box_dir(cur_box):=cur_val;
- end;
-
-@ The global variable |cur_box| will point to a newly-made box. If the box
-is void, we will have |cur_box=null|. Otherwise we will have
-|type(cur_box)=hlist_node| or |vlist_node| or |rule_node|; the |rule_node|
-case can occur only with leaders.
-
-@<Glob...@>=
-@!cur_box:pointer; {box to be placed into its context}
-
-@ The |box_end| procedure does the right thing with |cur_box|, if
-|box_context| represents the context as explained above.
-
-@<Declare act...@>=
-procedure box_end(@!box_context:integer);
-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 begin
- if box_context>ship_out_flag then @<Append a new leader node that
- uses |cur_box|@>
- else ship_out(cur_box);
- end;
-end;
-
-@ The global variable |adjust_tail| will be non-null if and only if the
-current box might include adjustments that should be appended to the
-current vertical list.
-
-@<Append box |cur_box| to the current...@>=
-begin if cur_box<>null then
- begin shift_amount(cur_box):=box_context;
- if abs(mode)=vmode then
- begin
- if pre_adjust_tail <> null then begin
- if pre_adjust_head <> pre_adjust_tail then
- append_list(pre_adjust_head)(pre_adjust_tail);
- pre_adjust_tail := null;
- end;
- append_to_vlist(cur_box);
- if adjust_tail <> null then begin
- if adjust_head <> adjust_tail then
- append_list(adjust_head)(adjust_tail);
- adjust_tail := null;
- end;
- if mode>0 then begin check_filter('box'); build_page; end;
- end
- else begin if abs(mode)=hmode then space_factor:=1000
- else cur_box:=new_sub_box(cur_box);
- vlink(tail):=cur_box; tail:=cur_box;
- end;
- end;
-end
-
-@ @<Store \(c)|cur_box| in a box register@>=
-if box_context<global_box_flag then
- eq_define(box_base+box_context-box_flag,box_ref,cur_box)
-else geq_define(box_base+box_context-global_box_flag,box_ref,cur_box)
-
-@ @<Append a new leader node ...@>=
-begin @<Get the next non-blank non-relax...@>;
-if ((cur_cmd=hskip)and(abs(mode)<>vmode))or@|
- ((cur_cmd=vskip)and(abs(mode)=vmode)) then
- begin append_glue; subtype(tail):=box_context-(leader_flag-a_leaders);
- leader_ptr(tail):=cur_box;
- end
-else begin print_err("Leaders not followed by proper glue");
-@.Leaders not followed by...@>
- help3("You should say `\leaders <box or rule><hskip or vskip>'.")@/
- ("I found the <box or rule>, but there's no suitable")@/
- ("<hskip or vskip>, so I'm ignoring these leaders."); back_error;
- flush_node_list(cur_box);
- end;
-end
-
-@ Now that we can see what eventually happens to boxes, we can consider
-the first steps in their creation. The |begin_box| routine is called when
-|box_context| is a context specification, |cur_chr| specifies the type of
-box desired, and |cur_cmd=make_box|.
-
-@<Declare act...@>=
-procedure begin_box(@!box_context:integer);
-label exit, done;
-var @!p,@!q:pointer; {run through the current list}
-@!k:halfword; {0 or |vmode| or |hmode|}
-@!n:eight_bits; {a box number}
-begin case cur_chr of
-box_code: begin scan_register_num; cur_box:=box(cur_val);
- box(cur_val):=null; {the box becomes void, at the same level}
- end;
-copy_code: begin scan_register_num; cur_box:=copy_node_list(box(cur_val));
- end;
-last_box_code: @<If the current list ends with a box node, delete it from
- the list and make |cur_box| point to it; otherwise set |cur_box:=null|@>;
-vsplit_code: @<Split off part of a vertical box, make |cur_box| point to it@>;
-othercases @<Initiate the construction of an hbox or vbox, then |return|@>
-endcases;@/
-box_end(box_context); {in simple cases, we use the box immediately}
-exit:end;
-
-@ Note that the condition |not is_char_node(tail)| implies that |head<>tail|,
-since |head| is a one-word node.
-
-@<If the current list ends with a box node, delete it...@>=
-begin cur_box:=null;
-if abs(mode)=mmode then
- begin you_cant; help1("Sorry; this \lastbox will be void."); error;
- end
-else if (mode=vmode)and(head=tail) then
- begin you_cant;
- help2("Sorry...I usually can't take things from the current page.")@/
- ("This \lastbox will therefore be void."); error;
- end
-else begin if not is_char_node(tail) then
- if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
- @<Remove the last box, unless it's part of a discretionary@>;
- end;
-end
-
-@ @<Remove the last box...@>=
-begin q:=head;
-repeat p:=q;
-if not is_char_node(q) then if type(q)=disc_node then
- begin
- if p=tail then goto done;
- end;
-q:=vlink(p);
-until q=tail;
-cur_box:=tail; shift_amount(cur_box):=0;
-tail:=p; vlink(p):=null;
-done:end
-
-@ Here we deal with things like `\.{\\vsplit 13 to 100pt}'.
-
-@<Split off part of a vertical box, make |cur_box| point to it@>=
-begin scan_register_num; n:=cur_val;
-if not scan_keyword('to') then
-@.to@>
- begin print_err("Missing `to' inserted");
-@.Missing `to' inserted@>
- help2("I'm working on `\vsplit<box number> to <dimen>';")@/
- ("will look for the <dimen> next."); error;
- end;
-scan_normal_dimen;
-cur_box:=vsplit(n,cur_val);
-end
-
-@ Here is where we enter restricted horizontal mode or internal vertical
-mode, in order to make a box.
-
-@<Initiate the construction of an hbox or vbox, then |return|@>=
-begin k:=cur_chr-vtop_code; saved(0):=box_context;
-case abs(mode) of
-vmode: spec_direction:=body_direction;
-hmode: spec_direction:=text_direction;
-mmode: spec_direction:=math_direction;
-end;
-if k=hmode then
- if (box_context<box_flag)and(abs(mode)=vmode) then
- scan_spec(adjusted_hbox_group,true)
- else scan_spec(hbox_group,true)
-else begin if k=vmode then scan_spec(vbox_group,true)
- else begin scan_spec(vtop_group,true); k:=vmode;
- end;
- normal_paragraph;
- end;
-push_nest; mode:=-k;
-if k=vmode then
- begin prev_depth:=pdf_ignored_dimen;
- if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
- end
-else begin space_factor:=1000;
- if every_hbox<>null then begin_token_list(every_hbox,every_hbox_text);
- end;
-return;
-end
-
-@ @<Declare act...@>=
-procedure scan_box(@!box_context:integer);
- {the next input should specify a box or perhaps a rule}
-begin @<Get the next non-blank non-relax...@>;
-if cur_cmd=make_box then begin_box(box_context)
-else if (box_context>=leader_flag)and((cur_cmd=hrule)or(cur_cmd=vrule)) then
- begin cur_box:=scan_rule_spec; box_end(box_context);
- end
-else begin@t@>@;@/
- print_err("A <box> was supposed to be here");@/
-@.A <box> was supposed to...@>
- help3("I was expecting to see \hbox or \vbox or \copy or \box or")@/
- ("something like that. So you might find something missing in")@/
- ("your output. But keep trying; you can fix this later."); back_error;
- end;
-end;
-
-@ When the right brace occurs at the end of an \.{\\hbox} or \.{\\vbox} or
-\.{\\vtop} construction, the |package| routine comes into action. We might
-also have to finish a paragraph that hasn't ended.
-
-@<Cases of |handle...@>=
-hbox_group: package(0);
-adjusted_hbox_group: begin adjust_tail:=adjust_head;
- pre_adjust_tail:=pre_adjust_head; package(0);
- end;
-vbox_group: begin line_break_context:=vbox_group; end_graf; package(0);
- end;
-vtop_group: begin line_break_context:=vtop_group; end_graf; package(vtop_code);
- end;
-
-@ @<Declare action...@>=
-procedure package(@!c:small_number);
-var h:scaled; {height of box}
-@!p:pointer; {first node in a box}
-@!d:scaled; {max depth}
-@!grp:integer;
-begin grp:=cur_group;
-d:=box_max_depth; unsave; save_ptr:=save_ptr-6;
-pack_direction:=saved(3);
-if mode=-hmode then cur_box:=filtered_hpack(head,tail,saved(2),saved(1),grp)
-else begin cur_box:=filtered_vpackage(vlink(head),saved(2),saved(1),d,grp);
- if c=vtop_code then @<Readjust the height and depth of |cur_box|,
- for \.{\\vtop}@>;
- end;
-if saved(4)<>null then
- @<DIR: Adjust back |text_dir_ptr| for |scan_spec|@>;
-replace_attribute_list(cur_box, saved(5));
-pop_nest; box_end(saved(0));
-end;
-
-@ The height of a `\.{\\vtop}' box is inherited from the first item on its list,
-if that item is an |hlist_node|, |vlist_node|, or |rule_node|; otherwise
-the \.{\\vtop} height is zero.
-
-
-@<Readjust the height...@>=
-begin h:=0; p:=list_ptr(cur_box);
-if p<>null then if type(p)<=rule_node then h:=height(p);
-depth(cur_box):=depth(cur_box)-h+height(cur_box); height(cur_box):=h;
-end
-
-@ Here is a really small patch to add a new primitive called
-\.{\\quitvmode}. In vertical modes, it is identical to \.{\\indent},
-but in horizontal and math modes it is really a no-op (as opposed to
-\.{\\indent}, which executes the |indent_in_hmode| procedure).
-
-A paragraph begins when horizontal-mode material occurs in vertical mode,
-or when the paragraph is explicitly started by `\.{\\quitvmode}',
-`\.{\\indent}' or `\.{\\noindent}'.
-
-@<Put each...@>=
-primitive_tex("indent",start_par,1,0);
-@!@:indent_}{\.{\\indent} primitive@>
-primitive_tex("noindent",start_par,0,0);
-@!@:no_indent_}{\.{\\noindent} primitive@>
-primitive_pdftex("quitvmode",start_par,2,0);
-@!@:quit_vmode_}{\.{\\quitvmode} primitive@>
-
-@ @<Cases of |main_control| that build...@>=
-vmode+start_par: new_graf(cur_chr>0);
-vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
- vmode+char_ghost,
- vmode+math_shift,vmode+math_shift_cs,vmode+un_hbox,vmode+vrule,
- vmode+accent,vmode+discretionary,vmode+hskip,vmode+valign,
- vmode+ex_space,vmode+no_boundary:@t@>@;@/
- begin back_input; new_graf(true);
- end;
-
-@ @<Declare act...@>=
-procedure new_graf(@!indented:boolean);
-var p,q,dir_graf_tmp:pointer;
-begin prev_graf:=0;
-if (mode=vmode)or(head<>tail) then begin
- tail_append(new_param_glue(par_skip_code));
- end;
-push_nest; mode:=hmode; space_factor:=1000;
-@<LOCAL: Add local paragraph node@>;
-if indented then begin
- p:=new_null_box; box_dir(p):=par_direction;
- width(p):=par_indent;@+
- tail_append(p);
- end;
-q:=tail;
-dir_rover:=text_dir_ptr;
-while dir_rover<>null do
- begin
- if (vlink(dir_rover)<>null) or (dir_dir(dir_rover)<>par_direction) then
- begin
- dir_graf_tmp:=new_dir(dir_dir(dir_rover));
- vlink(dir_graf_tmp):=vlink(q); vlink(q):=dir_graf_tmp;
- end;
- dir_rover:=vlink(dir_rover);
- end;
-q:=head;
-while vlink(q)<>null do q:=vlink(q);
-tail:=q;
-if every_par<>null then begin_token_list(every_par,every_par_text);
-if nest_ptr=1 then begin
- check_filter('new_graf'); build_page; {put |par_skip| glue on current page}
- end;
-end;
-
-@ @<Cases of |main_control| that build...@>=
-hmode+start_par,mmode+start_par: if cur_chr<>2 then indent_in_hmode;
-
-@ @<Declare act...@>=
-procedure indent_in_hmode;
-var p: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 p:=new_sub_box(p);
- tail_append(p);
- end;
-end;
-
-@ A paragraph ends when a |par_end| command is sensed, or when we are in
-horizontal mode when reaching the right brace of vertical-mode routines
-like \.{\\vbox}, \.{\\insert}, or \.{\\output}.
-
-@<Cases of |main_control| that build...@>=
-vmode+par_end: begin normal_paragraph;
- if mode>0 then begin check_filter('vmode_par'); build_page; end;
- end;
-hmode+par_end: begin if align_state<0 then off_save; {this tries to
- recover from an alignment that didn't end properly}
- if (mode>0) and (nest[(nest_ptr-1)].mode_field=vmode) then
- line_break_context:=bottom_level;
- end_graf; {this takes us to the enclosing mode, if |mode>0|}
- if mode=vmode then begin check_filter('hmode_par'); build_page; end;
- end;
-hmode+stop,hmode+vskip,hmode+hrule,hmode+un_vbox,hmode+halign: head_for_vmode;
-
-@ @<Declare act...@>=
-procedure head_for_vmode;
-begin if mode<0 then
- if cur_cmd<>hrule then off_save
- else begin print_err("You can't use `");
- print_esc("hrule"); print("' here except with leaders");
-@.You can't use \\hrule...@>
- help2("To put a horizontal rule in an hbox or an alignment,")@/
- ("you should use \leaders or \hrulefill (see The TeXbook).");
- error;
- end
-else begin back_input; cur_tok:=par_token; back_input; token_type:=inserted;
- end;
-end;
-
-@ TODO (BUG?): |dir_save| would have been set by |line_break| by means
-of |post_line_break|, but this is not done right now, as it introduces
-pretty heavy memory leaks. This means the current code is probably
-wrong in some way that relates to in-paragraph displays.
-
-@<Declare act...@>=
-procedure end_graf;
-begin if mode=hmode then
- begin if (head=tail) or (vlink(head)=tail) then pop_nest
- {null paragraphs are ignored, all contain a |local_paragraph| node}
- else line_break(false);
- if dir_save<>null then
- begin flush_node_list(dir_save); dir_save:=null;
- end;
- normal_paragraph;
- error_count:=0;
- end;
-end;
-
-@ Insertion and adjustment and mark nodes are constructed by the following
-pieces of the program.
-
-@<Cases of |main_control| that build...@>=
-any_mode(insert),hmode+vadjust,mmode+vadjust: begin_insert_or_adjust;
-any_mode(mark): handle_mark;
-
-@ @<Forbidden...@>=
-vmode+vadjust,
-
-@ @<Declare act...@>=
-procedure begin_insert_or_adjust;
-begin if cur_cmd=vadjust then cur_val:=output_box
-else begin scan_register_num;
- if cur_val=output_box then
- begin print_err("You can't "); print_esc("insert"); print_int(output_box);
-@.You can't \\insert\\outputbox@>
- help1("I'm changing to \insert0; box \outputbox 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:=pdf_ignored_dimen;
-end;
-
-@ @<Cases of |handle...@>=
-insert_group: begin
- line_break_context:=insert_group;
- end_graf; q:=split_top_skip; add_glue_ref(q);
- d:=split_max_depth; f:=floating_penalty; unsave; save_ptr := save_ptr - 2;
- {now |saved(0)| is the insertion number, or |output_box| for |vadjust|}
- p:=vpack(vlink(head),natural); pop_nest;
- if saved(0)<>output_box then
- begin tail_append(new_node(ins_node,saved(0)));
- height(tail):=height(p)+depth(p); ins_ptr(tail):=list_ptr(p);
- split_top_ptr(tail):=q; depth(tail):=d; float_cost(tail):=f;
- end
- else begin tail_append(new_node(adjust_node,saved(1))); {the |subtype| is used for |adjust_pre|}
- adjust_ptr(tail):=list_ptr(p); delete_glue_ref(q);
- end;
- list_ptr(p):=null; flush_node(p);
- if nest_ptr=0 then begin check_filter('insert'); build_page; end;
- end;
-output_group: @<Resume the page builder...@>;
-
-@ I've renamed the |make_mark| procedure to this, because if the
-current chr code is 1, then the actual command was \.{\\clearmarks},
-which does not generate a mark node but instead destroys the current
-mark tokenlists.
-
-@<Declare act...@>=
-procedure handle_mark;
-var p:pointer; {new node}
-@!c:halfword; {the mark class}
-begin if cur_chr=clear_marks_code then begin
- scan_mark_num; c:=cur_val;
- delete_top_mark(c); delete_bot_mark(c); delete_first_mark(c);
- delete_split_first_mark(c); delete_split_bot_mark(c);
- end
-else begin
-if cur_chr=0 then c:=0
-else begin scan_mark_num; c:=cur_val;
- if c > biggest_used_mark then biggest_used_mark := c;
- end;
-p:=scan_toks(false,true);
-p:=new_node(mark_node,0); {the |subtype| is not used}
-mark_class(p):=c;
-mark_ptr(p):=def_ref; vlink(tail):=p; tail:=p;
-end;
-end;
-
-@ Penalty nodes get into a list via the |break_penalty| command.
-@^penalties@>
-
-@<Cases of |main_control| that build...@>=
-any_mode(break_penalty): append_penalty;
-
-@ @<Declare action...@>=
-procedure append_penalty;
-begin scan_int; tail_append(new_penalty(cur_val));
-if mode=vmode then begin check_filter('penalty'); build_page; end;
-end;
-
-@ The |remove_item| command removes a penalty, kern, or glue node if it
-appears at the tail of the current list, using a brute-force linear scan.
-Like \.{\\lastbox}, this command is not allowed in vertical mode (except
-internal vertical mode), since the current list in vertical mode is sent
-to the page builder. But if we happen to be able to implement it in
-vertical mode, we do.
-
-@<Cases of |main_control| that build...@>=
-any_mode(remove_item): delete_last;
-
-@ When |delete_last| is called, |cur_chr| is the |type| of node that
-will be deleted, if present.
-
-@<Declare action...@>=
-procedure delete_last;
-label exit;
-var @!p,@!q:pointer; {run through the current list}
-begin if (mode=vmode)and(tail=head) then
- @<Apologize for inability to do the operation now,
- unless \.{\\unskip} follows non-glue@>
-else begin if not is_char_node(tail) then if type(tail)=cur_chr then
- begin q:=head;
- repeat p:=q;
- if not is_char_node(q) then if type(q)=disc_node then
- begin
- if p=tail then return;
- end;
- q:=vlink(p);
- until q=tail;
- vlink(p):=null; flush_node_list(tail); tail:=p;
- end;
- end;
-exit:end;
-
-@ @<Apologize for inability to do the operation...@>=
-begin if (cur_chr<>glue_node)or(last_glue<>max_halfword) then
- begin you_cant;
- help2("Sorry...I usually can't take things from the current page.")@/
- ("Try `I\vskip-\lastskip' instead.");
- if cur_chr=kern_node then help_line[0]:=
- ("Try `I\kern-\lastkern' instead.")
- else if cur_chr<>glue_node then help_line[0]:=@|
- ("Perhaps you can make the output routine do it.");
- error;
- end;
-end
-
-@ @<Put each...@>=
-primitive_tex("unpenalty",remove_item,penalty_node,0);@/
-@!@:un_penalty_}{\.{\\unpenalty} primitive@>
-primitive_tex("unkern",remove_item,kern_node,0);@/
-@!@:un_kern_}{\.{\\unkern} primitive@>
-primitive_tex("unskip",remove_item,glue_node,0);@/
-@!@:un_skip_}{\.{\\unskip} primitive@>
-primitive_tex("unhbox",un_hbox,box_code,0);@/
-@!@:un_hbox_}{\.{\\unhbox} primitive@>
-primitive_tex("unhcopy",un_hbox,copy_code,0);@/
-@!@:un_hcopy_}{\.{\\unhcopy} primitive@>
-primitive_tex("unvbox",un_vbox,box_code,0);@/
-@!@:un_vbox_}{\.{\\unvbox} primitive@>
-primitive_tex("unvcopy",un_vbox,copy_code,0);@/
-@!@:un_vcopy_}{\.{\\unvcopy} primitive@>
-
-@ The |un_hbox| and |un_vbox| commands unwrap one of the |number_regs| current boxes.
-
-@<Cases of |main_control| that build...@>=
-vmode+un_vbox,hmode+un_hbox,mmode+un_hbox: unpackage;
-
-@ @<Declare act...@>=
-procedure unpackage;
-label done, exit;
-var p:pointer; {the box}
- r: pointer; {to remove marginal kern nodes}
-@!c:box_code..copy_code; {should we copy?}
-@!s:pointer; {for varmem assignment }
-begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
-c:=cur_chr; scan_register_num; p:=box(cur_val);
-if p=null then return;
-if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@|
- ((abs(mode)=hmode)and(type(p)<>hlist_node)) then
- begin print_err("Incompatible list can't be unboxed");
-@.Incompatible list...@>
- help3("Sorry, Pandora. (You sneaky devil.)")@/
- ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/
- ("And I can't open any boxes in math mode.");@/
- error; return;
- end;
-if c=copy_code then begin s:=copy_node_list(list_ptr(p)); vlink(tail):=s; end
-else begin vlink(tail):=list_ptr(p); box(cur_val):=null;
- list_ptr(p):=null; flush_node(p);
- end;
-done:
-while vlink(tail) <> null do begin
- r := vlink(tail);
- if not is_char_node(r) and (type(r) = margin_kern_node) then begin
- vlink(tail) := vlink(r);
- flush_node(r);
- end;
- tail:=vlink(tail);
-end;
-exit:end;
-
-@ @<Forbidden...@>=vmode+ital_corr,
-
-@ Italic corrections are converted to kern nodes when the |ital_corr| command
-follows a character. In math mode the same effect is achieved by appending
-a kern of zero here, since italic corrections are supplied later.
-
-@<Cases of |main_control| that build...@>=
-hmode+ital_corr: append_italic_correction;
-mmode+ital_corr: tail_append(new_kern(0));
-
-@ @<Declare act...@>=
-procedure append_italic_correction;
-label exit;
-var p:pointer; {|char_node| at the tail of the current list}
-@!f:internal_font_number; {the font in the |char_node|}
-begin if tail<>head then
- begin if is_char_node(tail) then p:=tail
- else return;
- f:=font(p);
- tail_append(new_kern(char_italic(f,character(p))));
- subtype(tail):=explicit;
- end;
-exit:end;
-
-@ Discretionary nodes are easy in the common case `\.{\\-}', but in the
-general case we must process three braces full of items.
-
-There are four subtypes of discretionaries, but only the first two are
-generated by primitive commands.
-
-@d discretionary_disc=0
-@d explicit_disc=1
-
-@<Put each...@>=
-primitive_tex("-",discretionary,explicit_disc,0);
-@!@:Single-character primitives -}{\quad\.{\\-}@>
-primitive_tex("discretionary",discretionary,discretionary_disc,0);
-@!@:discretionary_}{\.{\\discretionary} primitive@>
-primitive_omega("localleftbox",assign_local_box,0,0);
-@!@:assign_local_box}{\.{\\localleftbox} primitive@>
-primitive_omega("localrightbox",assign_local_box,1,0);
-@!@:assign_local_box}{\.{\\localrightbox} primitive@>
-
-@ @<Cases of |main_control| that build...@>=
-hmode+discretionary,mmode+discretionary: append_discretionary;
-any_mode(assign_local_box): append_local_box(cur_chr);
-
-@ The space factor does not change when we append a discretionary node,
-but it starts out as 1000 in the subsidiary lists.
-
-@<Declare act...@>=
-procedure append_local_box(kind:integer);
-begin
-incr(save_ptr); saved(-1):=kind; new_save_level(local_box_group);
-scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
-end;
-
-procedure append_discretionary;
-var c:integer;
-begin tail_append(new_disc);
-subtype(tail):=cur_chr;
-if cur_chr=explicit_disc then begin
- c:=get_pre_hyphen_char(cur_lang);
- if c<>0 then begin
- vlink(pre_break(tail)):=new_char(cur_font,c);
- alink(vlink(pre_break(tail))):=pre_break(tail);
- tlink(pre_break(tail)):=vlink(pre_break(tail));
- end;
- c:=get_post_hyphen_char(cur_lang);
- if c<>0 then begin
- vlink(post_break(tail)):=new_char(cur_font,c);
- alink(vlink(post_break(tail))):=post_break(tail);
- tlink(post_break(tail)):=vlink(post_break(tail));
- end;
- end
-else begin incr(save_ptr); saved(-1):=0; new_save_level(disc_group);
- scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
- end;
-end;
-
-@ The three discretionary lists are constructed somewhat as if they were
-hboxes. A~subroutine called |build_discretionary| handles the transitions.
-(This is sort of fun.)
-
-@<Cases of |handle...@>=
-disc_group: build_discretionary;
-local_box_group: build_local_box;
-
-@ @<Declare act...@>=
-procedure build_local_box;
-var p:pointer;
- kind:integer;
-begin
-unsave;
-kind:=saved(-1);
-decr(save_ptr);
-p:=vlink(head); pop_nest;
-if p<>null then
- p:=hpack(p,natural);
-if kind=0 then
- eq_define(local_left_box_base,box_ref,p)
-else
- eq_define(local_right_box_base,box_ref,p);
-if abs(mode)=hmode then
- @<LOCAL: Add local paragraph node@>;
-eq_word_define(int_base+no_local_whatsits_code,no_local_whatsits+1);
-end;
-
-procedure build_discretionary;
-label done,exit;
-var p,@!q:pointer; {for link manipulation}
-@!n:integer; {length of discretionary list}
-begin unsave;
-@<Prune the current list, if necessary, until it contains only
- |char_node|, |kern_node|, |hlist_node|, |vlist_node| and
- |rule_node| items; set |n| to the length of the list,
- and set |q| to the list's tail@>;
-p:=vlink(head); pop_nest;
-case saved(-1) of
-0: if (n>0) then begin
- vlink(pre_break(tail)):=p;
- alink(p):=pre_break(tail);
- tlink(pre_break(tail)):=q;
- end;
-1: if (n>0) then begin
- vlink(post_break(tail)):=p;
- alink(p):=post_break(tail);
- tlink(post_break(tail)):=q;
- end;
-2:@<Attach list |p| to the current list, and record its length;
- then finish up and |return|@>;
-end; {there are no other cases}
-incr(saved(-1)); new_save_level(disc_group); scan_left_brace;
-push_nest; mode:=-hmode; space_factor:=1000;
-exit:end;
-
-@ @<Attach list |p| to the current...@>=
-begin if (n>0)and(abs(mode)=mmode) then
- begin print_err("Illegal math "); print_esc("discretionary");
-@.Illegal math \\disc...@>
- help2("Sorry: The third part of a discretionary break must be")@/
- ("empty, in math formulas. I had to delete your third part.");
- flush_node_list(p); error;
- end
-else begin
- if (n>0) then begin
- vlink(no_break(tail)):=p;
- alink(p):=no_break(tail);
- tlink(no_break(tail)):=q;
- end;
- end;
-decr(save_ptr); return;
-end
-
-@ During this loop, |p=vlink(q)| and there are |n| items preceding |p|.
-
-@<Prune the current list, if necessary...@>=
-q:=head; p:=vlink(q); n:=0;
-while p<>null do
- begin if not is_char_node(p) then
- if type(p)>rule_node then if type(p)<>kern_node then
- begin print_err("Improper discretionary list");
-@.Improper discretionary list@>
- help1("Discretionary lists must contain only boxes and kerns.");@/
- error;
- begin_diagnostic;
- print_nl("The following discretionary sublist has been deleted:");
-@.The following...deleted@>
- show_box(p);
- end_diagnostic(true);
- flush_node_list(p); vlink(q):=null; goto done;
- end;
- alink(p):=q; q:=p; p:=vlink(q); incr(n);
- end;
-done:
-
-@ We need only one more thing to complete the horizontal mode routines, namely
-the \.{\\accent} primitive.
-
-@<Cases of |main_control| that build...@>=
-hmode+accent: make_accent;
-
-@ The positioning of accents is straightforward but tedious. Given an accent
-of width |a|, designed for characters of height |x| and slant |s|;
-and given a character of width |w|, height |h|, and slant |t|: We will shift
-the accent down by |x-h|, and we will insert kern nodes that have the effect of
-centering the accent over the character and shifting the accent to the
-right by $\delta={1\over2}(w-a)+h\cdot t-x\cdot s$. If either character is
-absent from the font, we will simply use the other, without shifting.
-
-@<Declare act...@>=
-procedure make_accent;
-var s,@!t: real; {amount of slant}
-@!p,@!q,@!r:pointer; {character, box, and kern nodes}
-@!f:internal_font_number; {relevant font}
-@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above}
-begin scan_char_num; f:=cur_font; p:=new_glyph(f,cur_val);
-if p<>null then
- begin x:=x_height(f); s:=slant(f)/float_constant(65536);
-@^real division@>
- a:=glyph_width(p);@/
- do_assignments;@/
- @<Create a character node |q| for the next character,
- but set |q:=null| if problems arise@>;
- if q<>null then @<Append the accent with appropriate kerns,
- then set |p:=q|@>;
- vlink(tail):=p; tail:=p; space_factor:=1000;
- end;
-end;
-
-@ @<Create a character node |q| for the next...@>=
-q:=null; f:=cur_font;
-if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then
- q:=new_glyph(f,cur_chr)
-else if cur_cmd=char_num then
- begin scan_char_num; q:=new_glyph(f,cur_val);
- end
-else back_input
-
-@ The kern nodes appended here must be distinguished from other kerns, lest
-they be wiped away by the hyphenation algorithm or by a previous line break.
-
-The two kerns are computed with (machine-dependent) |real| arithmetic, but
-their sum is machine-independent; the net effect is machine-independent,
-because the user cannot remove these nodes nor access them via \.{\\lastkern}.
-
-@<Append the accent with appropriate kerns...@>=
-begin t:=slant(f)/float_constant(65536);
-@^real division@>
-w:=glyph_width(q);
-h:=glyph_height(q);
-if h<>x then {the accent must be shifted up or down}
- begin p:=hpack(p,natural); shift_amount(p):=x-h;
- end;
-delta:=round((w-a)/float_constant(2)+h*t-x*s);
-@^real multiplication@>
-@^real addition@>
-r:=new_kern(delta); subtype(r):=acc_kern; vlink(tail):=r; vlink(r):=p;
-tail:=new_kern(-a-delta); subtype(tail):=acc_kern; vlink(p):=tail; p:=q;
-end
-
-@ When `\.{\\cr}' or `\.{\\span}' or a tab mark comes through the scanner
-into |main_control|, it might be that the user has foolishly inserted
-one of them into something that has nothing to do with alignment. But it is
-far more likely that a left brace or right brace has been omitted, since
-|get_next| takes actions appropriate to alignment only when `\.{\\cr}'
-or `\.{\\span}' or tab marks occur with |align_state=0|. The following
-program attempts to make an appropriate recovery.
-
-@<Cases of |main_control| that build...@>=
-any_mode(car_ret), any_mode(tab_mark): align_error;
-any_mode(no_align): no_align_error;
-any_mode(omit): omit_error;
-
-@ @<Declare act...@>=
-procedure align_error;
-begin if abs(align_state)>2 then
- @<Express consternation over the fact that no alignment is in progress@>
-else begin back_input;
- if align_state<0 then
- begin print_err("Missing { inserted");
-@.Missing \{ inserted@>
- incr(align_state); cur_tok:=left_brace_token+"{";
- end
- else begin print_err("Missing } inserted");
-@.Missing \} inserted@>
- decr(align_state); cur_tok:=right_brace_token+"}";
- end;
- help3("I've put in what seems to be necessary to fix")@/
- ("the current column of the current alignment.")@/
- ("Try to go on, since this might almost work."); ins_error;
- end;
-end;
-
-@ @<Express consternation...@>=
-begin print_err("Misplaced "); print_cmd_chr(cur_cmd,cur_chr);
-@.Misplaced \&@>
-@.Misplaced \\span@>
-@.Misplaced \\cr@>
-if cur_tok=tab_token+"&" then
- begin help6("I can't figure out why you would want to use a tab mark")@/
- ("here. If you just want an ampersand, the remedy is")@/
- ("simple: Just type `I\&' now. But if some right brace")@/
- ("up above has ended a previous alignment prematurely,")@/
- ("you're probably due for more error messages, and you")@/
- ("might try typing `S' now just to see what is salvageable.");
- end
-else begin help5("I can't figure out why you would want to use a tab mark")@/
- ("or \cr or \span just now. If something like a right brace")@/
- ("up above has ended a previous alignment prematurely,")@/
- ("you're probably due for more error messages, and you")@/
- ("might try typing `S' now just to see what is salvageable.");
- end;
-error;
-end
-
-@ The help messages here contain a little white lie, since \.{\\noalign}
-and \.{\\omit} are allowed also after `\.{\\noalign\{...\}}'.
-
-@<Declare act...@>=
-procedure no_align_error;
-begin print_err("Misplaced "); print_esc("noalign");
-@.Misplaced \\noalign@>
-help2("I expect to see \noalign only after the \cr of")@/
- ("an alignment. Proceed, and I'll ignore this case."); error;
-end;
-procedure omit_error;
-begin print_err("Misplaced "); print_esc("omit");
-@.Misplaced \\omit@>
-help2("I expect to see \omit only after tab marks or the \cr of")@/
- ("an alignment. Proceed, and I'll ignore this case."); error;
-end;
-
-@ We've now covered most of the abuses of \.{\\halign} and \.{\\valign}.
-Let's take a look at what happens when they are used correctly.
-
-@<Cases of |main_control| that build...@>=
-vmode+halign,hmode+valign:init_align;
-mmode+halign: if privileged then begin
- if cur_group=math_shift_group then init_align
- else off_save;
- end;
-vmode+endv,hmode+endv: do_endv;
-
-@ An |align_group| code is supposed to remain on the |save_stack|
-during an entire alignment, until |fin_align| removes it.
-
-A devious user might force an |endv| command to occur just about anywhere;
-we must defeat such hacks.
-
-@<Declare act...@>=
-procedure do_endv;
-begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
-while (input_stack[base_ptr].index_field<>v_template) and
- (input_stack[base_ptr].loc_field=null) and
- (input_stack[base_ptr].state_field=token_list) do decr(base_ptr);
-if (input_stack[base_ptr].index_field<>v_template) or
- (input_stack[base_ptr].loc_field<>null) or
- (input_stack[base_ptr].state_field<>token_list) then
- fatal_error("(interwoven alignment preambles are not allowed)");
-@.interwoven alignment preambles...@>
- if cur_group=align_group then
- begin line_break_context:=align_group; end_graf;
- if fin_col then fin_row;
- end
-else off_save;
-end;
-
-@ @<Cases of |handle_right_brace|...@>=
-align_group: begin back_input; cur_tok:=cs_token_flag+frozen_cr;
- print_err("Missing "); print_esc("cr"); print(" inserted");
-@.Missing \\cr inserted@>
- help1("I'm guessing that you meant to end an alignment here.");
- ins_error;
- end;
-
-@ @<Cases of |handle_right_brace|...@>=
-no_align_group: begin line_break_context:=no_align_group; end_graf; unsave; align_peek;
- end;
-
-@ Finally, \.{\\endcsname} is not supposed to get through to |main_control|.
-
-@<Cases of |main_control| that build...@>=
-any_mode(end_cs_name): cs_error;
-
-@ @<Declare act...@>=
-procedure cs_error;
-begin print_err("Extra "); print_esc("endcsname");
-@.Extra \\endcsname@>
-help1("I'm ignoring this, since I wasn't doing a \csname.");
-error;
-end;
-
-@* \[48] Building math lists.
-
-@ Almost all of this section is now in C, see |math.c|. Let here are just
-the definitions of the primitives and the infrastructure hooks into |main_control|,
-|print_cmd_chr| and |handle_right_brace|.
-
-@<Put each...@>=
-primitive_luatex("Ustartmath",math_shift_cs,text_style,0);
-@!@:math_shift_cs_}{\.{\\Ustartmath} primitive@>
-primitive_luatex("Ustopmath",math_shift_cs,cramped_text_style,0);
-@!@:math_shift_cs_}{\.{\\Ustopmath} primitive@>
-primitive_luatex("Ustartdisplaymath",math_shift_cs,display_style,0);
-@!@:math_shift_cs_}{\.{\\Ustartdisplaymath} primitive@>
-primitive_luatex("Ustopdisplaymath",math_shift_cs,cramped_display_style,0);
-@!@:math_shift_cs_}{\.{\\Ustopdisplaymath} primitive@>
-
-@
-
-@<Cases of |main_control| that build...@>=
-hmode+math_shift, hmode+math_shift_cs:init_math;
-mmode+eq_no: if privileged then begin
- if cur_group=math_shift_group then start_eq_no
- else off_save;
- end;
-
-@ @<Put each...@>=
-primitive_tex("eqno",eq_no,0,0);
-@!@:eq_no_}{\.{\\eqno} primitive@>
-primitive_tex("leqno",eq_no,1,0);
-@!@:leq_no_}{\.{\\leqno} primitive@>
-
-@ @<Forbidden...@>=non_math(eq_no),
-
-@ @<Cases of |main_control| that build...@>=
-mmode+left_brace: math_left_brace;
-mmode+letter,mmode+other_char,mmode+char_given:
- set_math_char(get_math_code(cur_chr));
-mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
- set_math_char(get_math_code(cur_chr));
- end;
-mmode+math_char_num: begin
- if cur_chr=0 then
- mval := scan_mathchar(tex_mathcode)
- else if cur_chr=1 then
- mval := scan_mathchar(aleph_mathcode)
- else if cur_chr=2 then
- mval := scan_mathchar(xetex_mathcode)
- else
- mval := scan_mathchar(xetexnum_mathcode);
- set_math_char(mval);
- end;
-mmode+math_given: begin
- mval := mathchar_from_integer(cur_chr,tex_mathcode);
- set_math_char(mval);
- end;
-mmode+omath_given: begin
- mval := mathchar_from_integer(cur_chr,aleph_mathcode);
- set_math_char(mval);
- end;
-mmode+xmath_given: begin
- mval := mathchar_from_integer(cur_chr,xetex_mathcode);
- set_math_char(mval);
- end;
-mmode+delim_num: begin
- if cur_chr=0 then
- mval := scan_delimiter_as_mathchar(tex_mathcode)
- else if cur_chr=1 then
- mval := scan_delimiter_as_mathchar(aleph_mathcode)
- else
- mval := scan_delimiter_as_mathchar(xetex_mathcode);
- set_math_char(mval);
- 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_tex("mathord",math_comp,ord_noad_type,0);
-@!@:math_ord_}{\.{\\mathord} primitive@>
-primitive_tex("mathop",math_comp,op_noad_type_normal,0);
-@!@:math_op_}{\.{\\mathop} primitive@>
-primitive_tex("mathbin",math_comp,bin_noad_type,0);
-@!@:math_bin_}{\.{\\mathbin} primitive@>
-primitive_tex("mathrel",math_comp,rel_noad_type,0);
-@!@:math_rel_}{\.{\\mathrel} primitive@>
-primitive_tex("mathopen",math_comp,open_noad_type,0);
-@!@:math_open_}{\.{\\mathopen} primitive@>
-primitive_tex("mathclose",math_comp,close_noad_type,0);
-@!@:math_close_}{\.{\\mathclose} primitive@>
-primitive_tex("mathpunct",math_comp,punct_noad_type,0);
-@!@:math_punct_}{\.{\\mathpunct} primitive@>
-primitive_tex("mathinner",math_comp,inner_noad_type,0);
-@!@:math_inner_}{\.{\\mathinner} primitive@>
-primitive_tex("underline",math_comp,under_noad_type,0);
-@!@:underline_}{\.{\\underline} primitive@>
-primitive_tex("overline",math_comp,over_noad_type,0);@/
-@!@:overline_}{\.{\\overline} primitive@>
-primitive_tex("displaylimits",limit_switch,op_noad_type_normal,0);
-@!@:display_limits_}{\.{\\displaylimits} primitive@>
-primitive_tex("limits",limit_switch,op_noad_type_limits,0);
-@!@:limits_}{\.{\\limits} primitive@>
-primitive_tex("nolimits",limit_switch,op_noad_type_no_limits,0);
-@!@:no_limits_}{\.{\\nolimits} primitive@>
-
-@ @<Cases of |main_control| that build...@>=
-mmode+math_comp: math_math_comp;
-mmode+limit_switch: math_limit_switch;
-mmode+radical: math_radical;
-mmode+accent,mmode+math_accent:math_ac;
-mmode+vcenter: begin scan_spec(vcenter_group,false); normal_paragraph;
- push_nest; mode:=-vmode; prev_depth:=pdf_ignored_dimen;
- if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
- end;
-
-@ @<Cases of |handle...@>=
-vcenter_group: begin line_break_context:=vcenter_group; end_graf; unsave; save_ptr:=save_ptr-2;
- p:=vpack(vlink(head),saved(1),saved(0)); pop_nest;
- p:=math_vcenter_group(p);
- tail_append(p);
- end;
-
-@ The routine that inserts a |style_node| holds no surprises.
-
-@<Put each...@>=
-primitive_tex("displaystyle",math_style,display_style,0);
-@!@:display_style_}{\.{\\displaystyle} primitive@>
-primitive_tex("textstyle",math_style,text_style,0);
-@!@:text_style_}{\.{\\textstyle} primitive@>
-primitive_tex("scriptstyle",math_style,script_style,0);
-@!@:script_style_}{\.{\\scriptstyle} primitive@>
-primitive_tex("scriptscriptstyle",math_style,script_script_style,0);
-@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@>
-primitive_luatex("crampeddisplaystyle",math_style,cramped_display_style,0);
-@!@:cramped_display_style_}{\.{\\crampeddisplaystyle} primitive@>
-primitive_luatex("crampedtextstyle",math_style,cramped_text_style,0);
-@!@:cramped_text_style_}{\.{\\crampedtextstyle} primitive@>
-primitive_luatex("crampedscriptstyle",math_style,cramped_script_style,0);
-@!@:cramped_script_style_}{\.{\\crampedscriptstyle} primitive@>
-primitive_luatex("crampedscriptscriptstyle",math_style,cramped_script_script_style,0);
-@!@:cramped_script_script_style_}{\.{\\crampedscriptscriptstyle} primitive@>
-
-@ @<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: if cur_chr=0 then append_choices else setup_math_style;
-
-@ @<Cases of |handle_right_brace|...@>=
-math_choice_group: build_choices;
-
-@ Here are two primives for explicit super- or subscript choice.
-
-@<Put each...@>=
-primitive_luatex("Usuperscript",super_sub_script,sup_mark,sup_mark);
-@!@:super_sub_script_}{\.{\\Usuperscript} primitive@>
-primitive_luatex("Usubscript",super_sub_script,sub_mark,sup_mark);
-@!@:super_sub_script_}{\.{\\Usubscript} primitive@>
-
-@ @<Cases of |main_control| that build...@>=
-mmode+sub_mark,mmode+sup_mark,mmode+super_sub_script: sub_sup;
-
-@
-@d above_code=0 { `\.{\\above}' }
-@d over_code=1 { `\.{\\over}' }
-@d atop_code=2 { `\.{\\atop}' }
-@d delimited_code=3 { `\.{\\abovewithdelims}', etc.}
-
-@<Put each...@>=
-primitive_tex("above",above,above_code,0);@/
-@!@:above_}{\.{\\above} primitive@>
-primitive_tex("over",above,over_code,0);@/
-@!@:over_}{\.{\\over} primitive@>
-primitive_tex("atop",above,atop_code,0);@/
-@!@:atop_}{\.{\\atop} primitive@>
-primitive_tex("abovewithdelims",above,delimited_code+above_code,0);@/
-@!@:above_with_delims_}{\.{\\abovewithdelims} primitive@>
-primitive_tex("overwithdelims",above,delimited_code+over_code,0);@/
-@!@:over_with_delims_}{\.{\\overwithdelims} primitive@>
-primitive_tex("atopwithdelims",above,delimited_code+atop_code,0);
-@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@>
-
-@ @<Cases of |main_control| that build...@>=
-mmode+above: math_fraction;
-
-@ @<Cases of |handle...@>=
-math_group: close_math_group(p);
-
-@
-
-@<Put each...@>=
-primitive_tex("left",left_right,left_noad_side,0);
-@!@:left_}{\.{\\left} primitive@>
-primitive_tex("right",left_right,right_noad_side,0);
-@!@:right_}{\.{\\right} primitive@>
-primitive_tex("middle",left_right,middle_noad_side,0);
-@!@:middle_}{\.{\\middle} primitive@>
-text(frozen_right):="right"; eqtb[frozen_right]:=eqtb[cur_val];
-
-@ @<Cases of |main_control| that build...@>=
-mmode+left_right: math_left_right;
-
-@ Here is the only way out of math mode.
-
-@<Cases of |main_control| that build...@>=
-mmode+math_shift,mmode+math_shift_cs: if cur_group=math_shift_group then after_math
- else off_save;
-
-
-@* \[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_tex("long",prefix,1,0);
-@!@:long_}{\.{\\long} primitive@>
-primitive_tex("outer",prefix,2,0);
-@!@:outer_}{\.{\\outer} primitive@>
-primitive_tex("global",prefix,4,0);
-@!@:global_}{\.{\\global} primitive@>
-primitive_tex("def",def,0,0);
-@!@:def_}{\.{\\def} primitive@>
-primitive_tex("gdef",def,1,0);
-@!@:gdef_}{\.{\\gdef} primitive@>
-primitive_tex("edef",def,2,0);
-@!@:edef_}{\.{\\edef} primitive@>
-primitive_tex("xdef",def,3,0);
-@!@:xdef_}{\.{\\xdef} primitive@>
-
-@ Every prefix, and every command code that might or might not be prefixed,
-calls the action procedure |prefixed_command|. This routine accumulates
-a sequence of prefixes until coming to a non-prefix, then it carries out
-the command.
-
-@<Cases of |main_control| that don't...@>=
-any_mode(toks_register),
-any_mode(assign_toks),
-any_mode(assign_int),
-any_mode(assign_attr),
-any_mode(assign_dir),
-any_mode(assign_dimen),
-any_mode(assign_glue),
-any_mode(assign_mu_glue),
-any_mode(assign_font_dimen),
-any_mode(assign_font_int),
-any_mode(set_aux),
-any_mode(set_prev_graf),
-any_mode(set_page_dimen),
-any_mode(set_page_int),
-any_mode(set_box_dimen),
-any_mode(set_tex_shape),
-any_mode(set_etex_shape),
-any_mode(def_char_code),
-any_mode(def_del_code),
-any_mode(extdef_math_code),
-any_mode(extdef_del_code),
-any_mode(def_family),
-any_mode(set_math_param),
-any_mode(set_font),
-any_mode(def_font),
-any_mode(letterspace_font),
-any_mode(pdf_copy_font),
-any_mode(register),
-any_mode(advance),
-any_mode(multiply),
-any_mode(divide),
-any_mode(prefix),
-any_mode(let),
-any_mode(shorthand_def),
-any_mode(read_to_cs),
-any_mode(def),
-any_mode(set_box),
-any_mode(hyph_data),
-any_mode(set_interaction),
-any_mode(set_ocp),
-any_mode(def_ocp),
-any_mode(set_ocp_list),
-any_mode(def_ocp_list),
-any_mode(clear_ocp_lists),
-any_mode(push_ocp_list),
-any_mode(pop_ocp_list),
-any_mode(ocp_list_op),
-any_mode(ocp_trace_level) : prefixed_command;
-
-@ If the user says, e.g., `\.{\\global\\global}', the redundancy is
-silently accepted.
-
-@<Declare act...@>=
-@t\4@>@<Declare subprocedures for |prefixed_command|@>@t@>@;@/
-procedure prefixed_command;
-label done,exit;
-var a:small_number; {accumulated prefix codes so far}
-@!f:internal_font_number; {identifies a font}
-@!j:halfword; {index into a \.{\\parshape} specification}
-@!p,@!q:pointer; {for temporary short-term use}
-@!n:integer; {ditto}
-@!e:boolean; {should a definition be expanded? or was \.{\\let} not done?}
-@!mval:mathcodeval; {for handling of \.{\\mathchardef}s}
-begin a:=0;
-while cur_cmd=prefix do
- begin if not odd(a div cur_chr) then a:=a+cur_chr;
- @<Get the next non-blank non-relax...@>;
- if cur_cmd<=max_non_prefixed_command then
- @<Discard erroneous prefixes and |return|@>;
- if tracing_commands>2 then show_cur_cmd_chr;
- end;
-@<Discard the prefixes \.{\\long} and \.{\\outer} if they are irrelevant@>;
-@<Adjust \(f)for the setting of \.{\\globaldefs}@>;
-case cur_cmd of
-@t\4@>@<Assignments@>@;
-othercases confusion("prefix")
-@:this can't happen prefix}{\quad prefix@>
-endcases;
-done: @<Insert a token saved by \.{\\afterassignment}, if any@>;
-exit:end;
-
-@ @<Discard erroneous...@>=
-begin print_err("You can't use a prefix with `");
-@.You can't use a prefix with x@>
-print_cmd_chr(cur_cmd,cur_chr); print_char("'");
-help1("I'll pretend you didn't say \long or \outer or \global 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"); print("' with `");
-@.You can't use \\long...@>
- print_cmd_chr(cur_cmd,cur_chr); print_char("'");
- help1("I'll pretend you didn't say \long or \outer here.");
- error;
- end
-
-@ The previous routine does not have to adjust |a| so that |a mod 4=0|,
-since the following routines test for the \.{\\global} prefix as follows.
-
-@d global==(a>=4)
-@d define(#)==begin if global then geq_define(#)@+else eq_define(#); end
-@d word_define(#)==begin if global then geq_word_define(#)@+else eq_word_define(#); end
-@d define_lc_code(#)==begin if global
- then set_lc_code(#,level_one)@+else set_lc_code(#,cur_level); end
-@d define_uc_code(#)==begin if global
- then set_uc_code(#,level_one)@+else set_uc_code(#,cur_level); end
-@d define_sf_code(#)==begin if global
- then set_sf_code(#,level_one)@+else set_sf_code(#,cur_level); end
-@d define_cat_code(#)==begin if global
- then set_cat_code(cat_code_table,#,level_one)@+else set_cat_code(cat_code_table,#,cur_level); end
-@d define_fam_fnt(#)==begin if global
- then def_fam_fnt(#,level_one)@+else def_fam_fnt(#,cur_level); end
-@d define_math_param(#)==begin if global
- then def_math_param(#,level_one)@+else def_math_param(#,cur_level); end
-
-
-@<Adjust \(f)for the setting of \.{\\globaldefs}@>=
-if global_defs<>0 then begin
- if global_defs<0 then
- begin if global then a:=a-4;
- end
- else begin if not global then a:=a+4;
- end;
- end
-
-@ When a control sequence is to be defined, by \.{\\def} or \.{\\let} or
-something similar, the |get_r_token| routine will substitute a special
-control sequence for a token that is not redefinable.
-
-@<Declare subprocedures for |prefixed_command|@>=
-procedure get_r_token;
-label restart;
-begin restart: repeat get_token;
-until cur_tok<>space_token;
-if (cur_cs=0)or(cur_cs>frozen_control_sequence) then
- begin print_err("Missing control sequence inserted");
-@.Missing control...@>
- help5("Please don't say `\def cs{...}', say `\def\cs{...}'.")@/
- ("I've inserted an inaccessible control sequence so that your")@/
- ("definition will be completed without mixing me up too badly.")@/
- ("You can recover graciously from this error, if you're")@/
- ("careful; see exercise 27.2 in The TeXbook.");
-@:TeXbook}{\sl The \TeX book@>
- if cur_cs=0 then back_input;
- cur_tok:=cs_token_flag+frozen_protection; ins_error; goto restart;
- end;
-end;
-
-@ @<Initialize table entries...@>=
-text(frozen_protection):="inaccessible";
-
-@ Assignments from Lua need helpers.
-
-@p function is_int_assign(cmd:halfword):boolean;
-begin
- is_int_assign := (cmd=assign_int);
-end;
-function is_dim_assign(cmd:halfword):boolean;
-begin
- is_dim_assign := (cmd=assign_dimen);
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure assign_internal_value(a:small_number;p:halfword;cur_val:integer);
-var n:halfword;
-begin
-if (p>=int_base)and(p<attribute_base) then begin
- if p=(int_base+cat_code_table_code) then begin
- if valid_catcode_table(cur_val) then begin
- if cur_val<>cat_code_table then
- word_define(p,cur_val);
- end
- else begin
- print_err("Invalid \catcode table");
- help2("You can only switch to a \catcode table that is initialized")
- ("using \savecatcodetable or \initcatcodetable, or to table 0");
- error;
- end;
- end
- else if (p=(int_base+output_box_code)and((cur_val>65535)or(cur_val<0))) then begin
- print_err("Invalid \outputbox");
- help1("The value for \outputbox has to be between 0 and 65535.");
- error;
- end
- else if ((p=new_line_char)and((cur_val>127)or(cur_val<0))) then begin
- print_err("Invalid \newlinechar");
- help1("The value for \newlinechar has to be between 0 and 127.");
- error;
- end
- else if p=end_line_char then begin
- if (cur_val<0)or(cur_val>biggest_char) then
- word_define(p,-1)
- else
- word_define(p,13);
- end
- else
- word_define(p,cur_val);
-{If we are defining subparagraph penalty levels while we are
-in hmode, then we put out a whatsit immediately, otherwise
-we leave it alone. This mechanism might not be sufficiently
-powerful, and some other algorithm, searching down the stack,
-might be necessary. Good first step.}
- if (abs(mode)=hmode) and
- ((p=(int_base+local_inter_line_penalty_code)) or
- (p=(int_base+local_broken_penalty_code))) then begin
- @<LOCAL: Add local paragraph node@>;
- eq_word_define(int_base+no_local_whatsits_code,no_local_whatsits+1);
- end;
- if p=int_base+language_code then word_define(int_base+cur_lang_code,cur_val);
- end
-else if (p>=dimen_base)and(p<eqtb_size) then begin
- if p=(dimen_base+page_left_offset_code) then begin
- n:=cur_val - one_true_inch;
- word_define(dimen_base+h_offset_code, n);
- end
- else if p=(dimen_base+h_offset_code) then begin
- n:=cur_val + one_true_inch;
- word_define(dimen_base+page_left_offset_code, n);
- end
- else if p=(dimen_base+page_top_offset_code) then begin
- n:=cur_val - one_true_inch;
- word_define(dimen_base+v_offset_code, n);
- end
- else if p=(dimen_base+v_offset_code) then begin
- n:=cur_val + one_true_inch;
- word_define(dimen_base+page_top_offset_code, n);
- end;
- word_define(p,cur_val);
- end
-else
- confusion("assign internal value");
-end;
-
-
-@ Here's an example of the way many of the following routines operate.
-(Unfortunately, they aren't all as simple as this.)
-
-@<Assignments@>=
-set_font: define(cur_font_loc,data,cur_chr);
-
-@ When a |def| command has been scanned,
-|cur_chr| is odd if the definition is supposed to be global, and
-|cur_chr>=2| if the definition is supposed to be expanded.
-
-@<Assignments@>=
-def: begin if odd(cur_chr)and not global and(global_defs>=0) then a:=a+4;
- e:=(cur_chr>=2); get_r_token; p:=cur_cs;
- q:=scan_toks(true,e);
- if j<>0 then
- begin q:=get_avail; info(q):=j; link(q):=link(def_ref);
- link(def_ref):=q;
- end;
- define(p,call+(a mod 4),def_ref);
- end;
-
-@ Both \.{\\let} and \.{\\futurelet} share the command code |let|.
-
-@<Put each...@>=
-primitive_tex("let",let,normal,0);@/
-@!@:let_}{\.{\\let} primitive@>
-primitive_tex("futurelet",let,normal+1,0);@/
-@!@:future_let_}{\.{\\futurelet} primitive@>
-
-@ @<Assignments@>=
-let: begin n:=cur_chr;
- get_r_token; p:=cur_cs;
- if n=normal then
- begin repeat get_token;
- until cur_cmd<>spacer;
- if cur_tok=other_token+"=" then
- begin get_token;
- if cur_cmd=spacer then get_token;
- end;
- end
- else begin get_token; q:=cur_tok; get_token; back_input;
- cur_tok:=q; back_input; {look ahead, then back up}
- end; {note that |back_input| doesn't affect |cur_cmd|, |cur_chr|}
- if cur_cmd>=call then add_token_ref(cur_chr);
- define(p,cur_cmd,cur_chr);
- end;
-
-@ A \.{\\chardef} creates a control sequence whose |cmd| is |char_given|;
-a \.{\\mathchardef} creates a control sequence whose |cmd| is |math_given|;
-and the corresponding |chr| is the character code or math code. A \.{\\countdef}
-or \.{\\dimendef} or \.{\\skipdef} or \.{\\muskipdef} creates a control
-sequence whose |cmd| is |assign_int| or \dots\ or |assign_mu_glue|, and the
-corresponding |chr| is the |eqtb| location of the internal register in question.
-
-@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
-@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
-@d omath_char_def_code=2 {|shorthand_def| for \.{\\omathchardef}}
-@d xmath_char_def_code=3 {|shorthand_def| for \.{\\Umathchardef}}
-@d count_def_code=4 {|shorthand_def| for \.{\\countdef}}
-@d attribute_def_code=5 {|shorthand_def| for \.{\\attributedef}}
-@d dimen_def_code=6 {|shorthand_def| for \.{\\dimendef}}
-@d skip_def_code=7 {|shorthand_def| for \.{\\skipdef}}
-@d mu_skip_def_code=8 {|shorthand_def| for \.{\\muskipdef}}
-@d toks_def_code=9 {|shorthand_def| for \.{\\toksdef}}
-
-@<Put each...@>=
-primitive_tex("chardef",shorthand_def,char_def_code,0);@/
-@!@:char_def_}{\.{\\chardef} primitive@>
-primitive_tex("mathchardef",shorthand_def,math_char_def_code,0);@/
-@!@:math_char_def_}{\.{\\mathchardef} primitive@>
-primitive_omega("omathchardef",shorthand_def,omath_char_def_code,0);@/
-@!@:math_char_def_}{\.{\\omathchardef} primitive@>
-primitive_luatex("Umathchardef",shorthand_def,xmath_char_def_code,0);@/
-@!@:math_char_def_}{\.{\\Umathchardef} primitive@>
-primitive_tex("countdef",shorthand_def,count_def_code,0);@/
-@!@:count_def_}{\.{\\countdef} primitive@>
-primitive_luatex("attributedef",shorthand_def,attribute_def_code,0);@/
-@!@:attribute_def_}{\.{\\attributedef} primitive@>
-primitive_tex("dimendef",shorthand_def,dimen_def_code,0);@/
-@!@:dimen_def_}{\.{\\dimendef} primitive@>
-primitive_tex("skipdef",shorthand_def,skip_def_code,0);@/
-@!@:skip_def_}{\.{\\skipdef} primitive@>
-primitive_tex("muskipdef",shorthand_def,mu_skip_def_code,0);@/
-@!@:mu_skip_def_}{\.{\\muskipdef} primitive@>
-primitive_tex("toksdef",shorthand_def,toks_def_code,0);@/
-@!@:toks_def_}{\.{\\toksdef} primitive@>
-
-@ We temporarily define |p| to be |relax|, so that an occurrence of |p|
-while scanning the definition will simply stop the scanning instead of
-producing an ``undefined control sequence'' error or expanding the
-previous meaning. This allows, for instance, `\.{\\chardef\\foo=123\\foo}'.
-
-@<Assignments@>=
-shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs;
- define(p,relax,too_big_char); scan_optional_equals;
- case n of
- char_def_code: begin scan_char_num; define(p,char_given,cur_val);
- end;
- math_char_def_code: begin
- mval:=scan_mathchar(tex_mathcode);
- cur_val:=(mval.class_value*16+mval.family_value)*256+mval.character_value;
- define(p,math_given,cur_val);
- end;
- omath_char_def_code: begin
- mval:=scan_mathchar(aleph_mathcode);
- cur_val:=(mval.class_value*256+mval.family_value)*65536+mval.character_value;
- define(p,omath_given,cur_val);
- end;
- xmath_char_def_code: begin
- mval:=scan_mathchar(xetex_mathcode);
- cur_val:=(mval.class_value+(8*mval.family_value))*(65536*32)+mval.character_value;
- define(p,xmath_given,cur_val);
- end;
- othercases begin scan_register_num;
- case n of
- count_def_code: define(p,assign_int,count_base+cur_val);
- attribute_def_code: define(p,assign_attr,attribute_base+cur_val);
- dimen_def_code: define(p,assign_dimen,scaled_base+cur_val);
- skip_def_code: define(p,assign_glue,skip_base+cur_val);
- mu_skip_def_code: define(p,assign_mu_glue,mu_skip_base+cur_val);
- toks_def_code: define(p,assign_toks,toks_base+cur_val);
- end; {there are no other cases}
- end
- endcases;
- end;
-
-@ @<Assignments@>=
-read_to_cs: begin j:=cur_chr; scan_int; n:=cur_val;
- if not scan_keyword('to') then
-@.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;
- if cur_cmd=toks_register then
- begin scan_register_num; p:=toks_base+cur_val;
- end
- else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
- scan_optional_equals;
- @<Get the next non-blank non-relax non-call token@>;
- if cur_cmd<>left_brace then @<If the right-hand side is a token parameter
- or token register, finish the assignment and |goto done|@>;
- back_input; cur_cs:=q; q:=scan_toks(false,false);
- if link(def_ref)=null then {empty list: revert to the default}
- begin define(p,undefined_cs,null); free_avail(def_ref);
- end
- else begin if p=output_routine_loc then {enclose in curlies}
- begin p:=get_avail; link(q):=p; p:=output_routine_loc;
- q:=link(q);info(q):=right_brace_token+"}";
- q:=get_avail;
- info(q):=left_brace_token+"{";
- link(q):=link(def_ref); link(def_ref):=q;
- end;
- define(p,call,def_ref);
- end;
- end;
-
-@ @<If the right-hand side is a token parameter...@>=
-begin if cur_cmd=toks_register then
- begin scan_register_num; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
- end;
-if cur_cmd=assign_toks then
- begin q:=equiv(cur_chr);
- if q=null then define(p,undefined_cs,null)
- else begin add_token_ref(q); define(p,call,q);
- end;
- goto done;
- end;
-end
-
-@ Similar routines are used to assign values to the numeric parameters.
-
-@<Assignments@>=
-assign_int: begin p:=cur_chr; scan_optional_equals; scan_int;
- assign_internal_value(a,p,cur_val);
- end;
-assign_attr: begin p:=cur_chr; scan_optional_equals; scan_int;
- if (p-attribute_base)>max_used_attr then max_used_attr:=(p-attribute_base);
- attr_list_cache:=cache_disabled;
- word_define(p,cur_val); end;
-assign_dir: begin
- @<DIR: Assign direction codes@>
- end;
-assign_dimen: begin p:=cur_chr; scan_optional_equals;
- scan_normal_dimen; assign_internal_value(a,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_tex("catcode",def_char_code,cat_code_base,cat_code_base);
-@!@:cat_code_}{\.{\\catcode} primitive@>
-primitive_tex("mathcode",def_char_code,math_code_base,cat_code_base);
-@!@:math_code_}{\.{\\mathcode} primitive@>
-primitive_tex("lccode",def_char_code,lc_code_base,cat_code_base);
-@!@:lc_code_}{\.{\\lccode} primitive@>
-primitive_tex("uccode",def_char_code,uc_code_base,cat_code_base);
-@!@:uc_code_}{\.{\\uccode} primitive@>
-primitive_tex("sfcode",def_char_code,sf_code_base,cat_code_base);
-@!@:sf_code_}{\.{\\sfcode} primitive@>
-primitive_tex("delcode",def_del_code,del_code_base,del_code_base);
-@!@:del_code_}{\.{\\delcode} primitive@>
-primitive_tex("textfont",def_family,text_size,0);
-@!@:text_font_}{\.{\\textfont} primitive@>
-primitive_tex("scriptfont",def_family,script_size,0);
-@!@:script_font_}{\.{\\scriptfont} primitive@>
-primitive_tex("scriptscriptfont",def_family,script_script_size,0);
-@!@:script_script_font_}{\.{\\scriptscriptfont} primitive@>
-primitive_luatex("Umathquad", set_math_param, math_param_quad,0);
-primitive_luatex("Umathaxis", set_math_param, math_param_axis,0);
-primitive_luatex("Umathoperatorsize", set_math_param, math_param_operator_size,0);
-primitive_luatex("Umathoverbarkern", set_math_param, math_param_overbar_kern,0);
-primitive_luatex("Umathoverbarrule", set_math_param, math_param_overbar_rule,0);
-primitive_luatex("Umathoverbarvgap", set_math_param, math_param_overbar_vgap,0);
-primitive_luatex("Umathunderbarkern", set_math_param, math_param_underbar_kern,0);
-primitive_luatex("Umathunderbarrule", set_math_param, math_param_underbar_rule,0);
-primitive_luatex("Umathunderbarvgap", set_math_param, math_param_underbar_vgap,0);
-primitive_luatex("Umathradicalkern", set_math_param, math_param_radical_kern,0);
-primitive_luatex("Umathradicalrule", set_math_param, math_param_radical_rule,0);
-primitive_luatex("Umathradicalvgap", set_math_param, math_param_radical_vgap,0);
-primitive_luatex("Umathradicaldegreebefore",set_math_param, math_param_radical_degree_before,0);
-primitive_luatex("Umathradicaldegreeafter", set_math_param, math_param_radical_degree_after,0);
-primitive_luatex("Umathradicaldegreeraise", set_math_param, math_param_radical_degree_raise,0);
-primitive_luatex("Umathstackvgap", set_math_param, math_param_stack_vgap,0);
-primitive_luatex("Umathstacknumup", set_math_param, math_param_stack_num_up,0);
-primitive_luatex("Umathstackdenomdown", set_math_param, math_param_stack_denom_down,0);
-primitive_luatex("Umathfractionrule", set_math_param, math_param_fraction_rule,0);
-primitive_luatex("Umathfractionnumvgap", set_math_param, math_param_fraction_num_vgap,0);
-primitive_luatex("Umathfractionnumup", set_math_param, math_param_fraction_num_up,0);
-primitive_luatex("Umathfractiondenomvgap",set_math_param, math_param_fraction_denom_vgap,0);
-primitive_luatex("Umathfractiondenomdown",set_math_param, math_param_fraction_denom_down,0);
-primitive_luatex("Umathfractiondelsize", set_math_param, math_param_fraction_del_size,0);
-primitive_luatex("Umathlimitabovevgap", set_math_param, math_param_limit_above_vgap,0);
-primitive_luatex("Umathlimitabovebgap", set_math_param, math_param_limit_above_bgap,0);
-primitive_luatex("Umathlimitabovekern", set_math_param, math_param_limit_above_kern,0);
-primitive_luatex("Umathlimitbelowvgap", set_math_param, math_param_limit_below_vgap,0);
-primitive_luatex("Umathlimitbelowbgap", set_math_param, math_param_limit_below_bgap,0);
-primitive_luatex("Umathlimitbelowkern", set_math_param, math_param_limit_below_kern,0);
-primitive_luatex("Umathunderdelimitervgap", set_math_param, math_param_under_delimiter_vgap,0);
-primitive_luatex("Umathunderdelimiterbgap", set_math_param, math_param_under_delimiter_bgap,0);
-primitive_luatex("Umathoverdelimitervgap",set_math_param, math_param_over_delimiter_vgap,0);
-primitive_luatex("Umathoverdelimiterbgap",set_math_param, math_param_over_delimiter_bgap,0);
-primitive_luatex("Umathsubshiftdrop", set_math_param, math_param_sub_shift_drop,0);
-primitive_luatex("Umathsupshiftdrop", set_math_param, math_param_sup_shift_drop,0);
-primitive_luatex("Umathsubshiftdown", set_math_param, math_param_sub_shift_down,0);
-primitive_luatex("Umathsubsupshiftdown", set_math_param, math_param_sub_sup_shift_down,0);
-primitive_luatex("Umathsubtopmax", set_math_param, math_param_sub_top_max,0);
-primitive_luatex("Umathsupshiftup", set_math_param, math_param_sup_shift_up,0);
-primitive_luatex("Umathsupbottommin", set_math_param, math_param_sup_bottom_min,0);
-primitive_luatex("Umathsupsubbottommax", set_math_param, math_param_sup_sub_bottom_max,0);
-primitive_luatex("Umathsubsupvgap", set_math_param, math_param_subsup_vgap,0);
-primitive_luatex("Umathspaceafterscript", set_math_param, math_param_space_after_script,0);
-primitive_luatex("Umathconnectoroverlapmin", set_math_param, math_param_connector_overlap_min,0);
-primitive_luatex("Umathordordspacing", set_math_param, math_param_ord_ord_spacing,0);
-primitive_luatex("Umathordopspacing", set_math_param, math_param_ord_op_spacing,0);
-primitive_luatex("Umathordbinspacing", set_math_param, math_param_ord_bin_spacing,0);
-primitive_luatex("Umathordrelspacing", set_math_param, math_param_ord_rel_spacing,0);
-primitive_luatex("Umathordopenspacing", set_math_param, math_param_ord_open_spacing,0);
-primitive_luatex("Umathordclosespacing", set_math_param, math_param_ord_close_spacing,0);
-primitive_luatex("Umathordpunctspacing", set_math_param, math_param_ord_punct_spacing,0);
-primitive_luatex("Umathordinnerspacing", set_math_param, math_param_ord_inner_spacing,0);
-primitive_luatex("Umathopordspacing", set_math_param, math_param_op_ord_spacing,0);
-primitive_luatex("Umathopopspacing", set_math_param, math_param_op_op_spacing,0);
-primitive_luatex("Umathopbinspacing", set_math_param, math_param_op_bin_spacing,0);
-primitive_luatex("Umathoprelspacing", set_math_param, math_param_op_rel_spacing,0);
-primitive_luatex("Umathopopenspacing", set_math_param, math_param_op_open_spacing,0);
-primitive_luatex("Umathopclosespacing", set_math_param, math_param_op_close_spacing,0);
-primitive_luatex("Umathoppunctspacing", set_math_param, math_param_op_punct_spacing,0);
-primitive_luatex("Umathopinnerspacing", set_math_param, math_param_op_inner_spacing,0);
-primitive_luatex("Umathbinordspacing", set_math_param, math_param_bin_ord_spacing,0);
-primitive_luatex("Umathbinopspacing", set_math_param, math_param_bin_op_spacing,0);
-primitive_luatex("Umathbinbinspacing", set_math_param, math_param_bin_bin_spacing,0);
-primitive_luatex("Umathbinrelspacing", set_math_param, math_param_bin_rel_spacing,0);
-primitive_luatex("Umathbinopenspacing", set_math_param, math_param_bin_open_spacing,0);
-primitive_luatex("Umathbinclosespacing", set_math_param, math_param_bin_close_spacing,0);
-primitive_luatex("Umathbinpunctspacing", set_math_param, math_param_bin_punct_spacing,0);
-primitive_luatex("Umathbininnerspacing", set_math_param, math_param_bin_inner_spacing,0);
-primitive_luatex("Umathrelordspacing", set_math_param, math_param_rel_ord_spacing,0);
-primitive_luatex("Umathrelopspacing", set_math_param, math_param_rel_op_spacing,0);
-primitive_luatex("Umathrelbinspacing", set_math_param, math_param_rel_bin_spacing,0);
-primitive_luatex("Umathrelrelspacing", set_math_param, math_param_rel_rel_spacing,0);
-primitive_luatex("Umathrelopenspacing", set_math_param, math_param_rel_open_spacing,0);
-primitive_luatex("Umathrelclosespacing", set_math_param, math_param_rel_close_spacing,0);
-primitive_luatex("Umathrelpunctspacing", set_math_param, math_param_rel_punct_spacing,0);
-primitive_luatex("Umathrelinnerspacing", set_math_param, math_param_rel_inner_spacing,0);
-primitive_luatex("Umathopenordspacing", set_math_param, math_param_open_ord_spacing,0);
-primitive_luatex("Umathopenopspacing", set_math_param, math_param_open_op_spacing,0);
-primitive_luatex("Umathopenbinspacing", set_math_param, math_param_open_bin_spacing,0);
-primitive_luatex("Umathopenrelspacing", set_math_param, math_param_open_rel_spacing,0);
-primitive_luatex("Umathopenopenspacing", set_math_param, math_param_open_open_spacing,0);
-primitive_luatex("Umathopenclosespacing", set_math_param, math_param_open_close_spacing,0);
-primitive_luatex("Umathopenpunctspacing", set_math_param, math_param_open_punct_spacing,0);
-primitive_luatex("Umathopeninnerspacing", set_math_param, math_param_open_inner_spacing,0);
-primitive_luatex("Umathcloseordspacing", set_math_param, math_param_close_ord_spacing,0);
-primitive_luatex("Umathcloseopspacing", set_math_param, math_param_close_op_spacing,0);
-primitive_luatex("Umathclosebinspacing", set_math_param, math_param_close_bin_spacing,0);
-primitive_luatex("Umathcloserelspacing", set_math_param, math_param_close_rel_spacing,0);
-primitive_luatex("Umathcloseopenspacing", set_math_param, math_param_close_open_spacing,0);
-primitive_luatex("Umathcloseclosespacing",set_math_param, math_param_close_close_spacing,0);
-primitive_luatex("Umathclosepunctspacing",set_math_param, math_param_close_punct_spacing,0);
-primitive_luatex("Umathcloseinnerspacing",set_math_param, math_param_close_inner_spacing,0);
-primitive_luatex("Umathpunctordspacing", set_math_param, math_param_punct_ord_spacing,0);
-primitive_luatex("Umathpunctopspacing", set_math_param, math_param_punct_op_spacing,0);
-primitive_luatex("Umathpunctbinspacing", set_math_param, math_param_punct_bin_spacing,0);
-primitive_luatex("Umathpunctrelspacing", set_math_param, math_param_punct_rel_spacing,0);
-primitive_luatex("Umathpunctopenspacing", set_math_param, math_param_punct_open_spacing,0);
-primitive_luatex("Umathpunctclosespacing",set_math_param, math_param_punct_close_spacing,0);
-primitive_luatex("Umathpunctpunctspacing",set_math_param, math_param_punct_punct_spacing,0);
-primitive_luatex("Umathpunctinnerspacing",set_math_param, math_param_punct_inner_spacing,0);
-primitive_luatex("Umathinnerordspacing", set_math_param, math_param_inner_ord_spacing,0);
-primitive_luatex("Umathinneropspacing", set_math_param, math_param_inner_op_spacing,0);
-primitive_luatex("Umathinnerbinspacing", set_math_param, math_param_inner_bin_spacing,0);
-primitive_luatex("Umathinnerrelspacing", set_math_param, math_param_inner_rel_spacing,0);
-primitive_luatex("Umathinneropenspacing", set_math_param, math_param_inner_open_spacing,0);
-primitive_luatex("Umathinnerclosespacing",set_math_param, math_param_inner_close_spacing,0);
-primitive_luatex("Umathinnerpunctspacing",set_math_param, math_param_inner_punct_spacing,0);
-primitive_luatex("Umathinnerinnerspacing",set_math_param, math_param_inner_inner_spacing,0);
-primitive_omega("omathcode",extdef_math_code,math_code_base,math_code_base);
-@!@:math_code_}{\.{\\omathcode} primitive@>
-primitive_omega("odelcode",extdef_del_code,del_code_base,del_code_base);
-@!@:del_code_}{\.{\\odelcode} primitive@>
-primitive_luatex("Umathcode",extdef_math_code,math_code_base+1,math_code_base);
-@!@:math_code_}{\.{\\Umathcode} primitive@>
-primitive_luatex("Udelcode",extdef_del_code,del_code_base+1,del_code_base);
-@!@:del_code_}{\.{\\Udelcode} primitive@>
-primitive_luatex("Umathcodenum",extdef_math_code,math_code_base+2,math_code_base);
-@!@:math_code_}{\.{\\Umathcodenum} primitive@>
-primitive_luatex("Udelcodenum",extdef_del_code,del_code_base+2,del_code_base);
-@!@:del_code_}{\.{\\Udelcodenum} primitive@>
-
-
-@ The different types of code values have different legal ranges; the
-following program is careful to check each case properly.
-
-@d check_def_code(#)== if ((cur_val<0)and(p<#))or(cur_val>n) then
- begin print_err("Invalid code ("); print_int(cur_val);
- if p<# then print("), should be in the range 0..")
- else print("), should be at most ");
- print_int(n);
- help1("I'm going to use 0 instead of that illegal code value.");@/
- error; cur_val:=0;
- end
-@.Invalid code@>
-
-
-@<Assignments@>=
-def_char_code,def_del_code: begin
- @<Let |n| be the largest legal code value, based on |cur_chr|@>;
- p:=cur_chr;
- if cur_chr=math_code_base then begin
- if global then cur_val1:=level_one else cur_val1:=cur_level;
- scan_extdef_math_code(cur_val1,tex_mathcode);
- end
- else if cur_chr=lc_code_base then begin
- scan_char_num; p:= cur_val;
- scan_optional_equals;
- scan_int;
- check_def_code(lc_code_base);
- define_lc_code(p,cur_val);
- end
- else if cur_chr=uc_code_base then begin
- scan_char_num; p:= cur_val;
- scan_optional_equals;
- scan_int;
- check_def_code(uc_code_base);
- define_uc_code(p,cur_val);
- end
- else if cur_chr=sf_code_base then begin
- scan_char_num; p:= cur_val;
- scan_optional_equals;
- scan_int;
- check_def_code(sf_code_base);
- define_sf_code(p,cur_val);
- end
- else if cur_chr=cat_code_base then begin
- scan_char_num; p:= cur_val;
- scan_optional_equals;
- scan_int;
- check_def_code(cat_code_base);
- define_cat_code(p,cur_val);
- end
- else if cur_chr=del_code_base then begin
- if global then cur_val1:=level_one else cur_val1:=cur_level;
- scan_extdef_del_code(cur_val1,tex_mathcode);
- end;
- end;
-extdef_math_code, extdef_del_code: begin
- if global then cur_val1:=level_one else cur_val1:=cur_level;
- if cur_chr=math_code_base then
- scan_extdef_math_code(cur_val1,aleph_mathcode)
- else if cur_chr=math_code_base+1 then
- scan_extdef_math_code(cur_val1,xetex_mathcode)
- else if cur_chr=math_code_base+2 then
- scan_extdef_math_code(cur_val1,xetexnum_mathcode)
- else if cur_chr=del_code_base then
- scan_extdef_del_code(cur_val1,aleph_mathcode)
- else if cur_chr=del_code_base+1 then
- scan_extdef_del_code(cur_val1,xetex_mathcode)
- else if cur_chr=del_code_base+2 then
- scan_extdef_del_code(cur_val1,xetexnum_mathcode);
- end;
-
-
-@ @<Let |n| be the largest...@>=
-if cur_chr=cat_code_base then n:=max_char_code
-else if cur_chr=lc_code_base then n:=biggest_char
-else if cur_chr=uc_code_base then n:=biggest_char
-else if cur_chr=sf_code_base then n:=@'77777
-else n:=biggest_char
-
-@ @<Assignments@>=
-def_family: begin p:=cur_chr; scan_math_family_int; cur_val1:=cur_val;
- scan_optional_equals; scan_font_ident;
- define_fam_fnt(cur_val1,p,cur_val);
- end;
-set_math_param: begin p:=cur_chr; get_token;
- if cur_cmd<>math_style then begin
- print_err("Missing math style, treated as \displaystyle");
-@.Missing number...@>
- help1("A style should have been here; I inserted `\displaystyle'.");
- cur_val1:=display_style;
- back_error;
- end
- else
- cur_val1:=cur_chr;
- scan_optional_equals;
- if p<math_param_first_mu_glue then begin
- if p=math_param_radical_degree_raise then
- scan_int
- else
- scan_dimen(false, false, false);
- end
- else begin
- scan_glue(mu_val); trap_zero_glue;
- if cur_val=thin_mu_skip then cur_val:=thin_mu_skip_code
- else if cur_val=med_mu_skip then cur_val:=med_mu_skip_code
- else if cur_val=thick_mu_skip then cur_val:=thick_mu_skip_code
- end;
- define_math_param(p,cur_val1,cur_val);
- end;
-
-@ Next we consider changes to \TeX's numeric registers.
-
-@<Assignments@>=
-register,advance,multiply,divide: do_register_command(a);
-
-@ We use the fact that |register<advance<multiply<divide|.
-
-@<Declare subprocedures for |prefixed_command|@>=
-procedure do_register_command(@!a:small_number);
-label found,exit;
-var l,@!q,@!r,@!s:pointer; {for list manipulation}
-@!p:int_val..mu_val; {type of register involved}
-begin q:=cur_cmd;
-@<Compute the register location |l| and its type |p|; but |return| if invalid@>;
-if q=register then scan_optional_equals
-else if scan_keyword('by') then do_nothing; {optional `\.{by}'}
-@.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 begin
- if p=attr_val then begin
- if (l-attribute_base)>max_used_attr then max_used_attr:=(l-attribute_base);
- attr_list_cache:=cache_disabled;
- end;
- if (p=int_val) or (p=dimen_val) then
- assign_internal_value(a,l,cur_val)
- else
- word_define(l,cur_val);
- end
-else begin trap_zero_glue; define(l,glue_ref,cur_val);
- end;
-exit: end;
-
-@ Here we use the fact that the consecutive codes |int_val..mu_val| and
-|assign_int..assign_mu_glue| correspond to each other nicely.
-
-@<Compute the register location |l| and its type |p|...@>=
-begin l:=0;
-if q<>register then
- begin get_x_token;
- if (cur_cmd>=assign_int)and(cur_cmd<=assign_mu_glue) then
- begin l:=cur_chr; p:=cur_cmd-assign_int; goto found;
- end;
- if cur_cmd<>register then
- begin print_err("You can't use `"); print_cmd_chr(cur_cmd,cur_chr);
-@.You can't use x after ...@>
- print("' after "); print_cmd_chr(q,0);
- help1("I'm forgetting what you said and not changing anything.");
- error; return;
- end;
- end;
-p:=cur_chr; scan_register_num;
-case p of
-int_val: l:=cur_val+count_base;
-attr_val: l:=cur_val+attribute_base;
-dimen_val: l:=cur_val+scaled_base;
-glue_val: l:=cur_val+skip_base;
-mu_val: l:=cur_val+mu_skip_base;
-end; {there are no other cases}
-end;
-found:
-
-@ @<Compute result of |register| or |advance|...@>=
-if p<glue_val then
- begin if (p=int_val) or (p=attr_val) then scan_int@+else scan_normal_dimen;
- if q=advance then cur_val:=cur_val+eqtb[l].int;
- end
-else begin scan_glue(p);
- if q=advance then @<Compute the sum of two glue specs@>;
- end
-
-@ @<Compute the sum of two glue specs@>=
-begin q:=new_spec(cur_val); r:=equiv(l);
-delete_glue_ref(cur_val);
-width(q):=width(q)+width(r);
-if stretch(q)=0 then stretch_order(q):=normal;
-if stretch_order(q)=stretch_order(r) then stretch(q):=stretch(q)+stretch(r)
-else if (stretch_order(q)<stretch_order(r))and(stretch(r)<>0) then
- begin stretch(q):=stretch(r); stretch_order(q):=stretch_order(r);
- end;
-if shrink(q)=0 then shrink_order(q):=normal;
-if shrink_order(q)=shrink_order(r) then shrink(q):=shrink(q)+shrink(r)
-else if (shrink_order(q)<shrink_order(r))and(shrink(r)<>0) then
- begin shrink(q):=shrink(r); shrink_order(q):=shrink_order(r);
- end;
-cur_val:=q;
-end
-
-@ @<Compute result of |multiply| or |divide|...@>=
-begin scan_int;
-if p<glue_val then
- if q=multiply then
- if (p=int_val)or(p=attr_val) then cur_val:=mult_integers(eqtb[l].int,cur_val)
- else cur_val:=nx_plus_y(eqtb[l].int,cur_val,0)
- else cur_val:=x_over_n(eqtb[l].int,cur_val)
-else begin s:=equiv(l); r:=new_spec(s);
- if q=multiply then
- begin width(r):=nx_plus_y(width(s),cur_val,0);
- stretch(r):=nx_plus_y(stretch(s),cur_val,0);
- shrink(r):=nx_plus_y(shrink(s),cur_val,0);
- end
- else begin width(r):=x_over_n(width(s),cur_val);
- stretch(r):=x_over_n(stretch(s),cur_val);
- shrink(r):=x_over_n(shrink(s),cur_val);
- end;
- cur_val:=r;
- end;
-end
-
-@ The processing of boxes is somewhat different, because we may need
-to scan and create an entire box before we actually change the value of the old
-one.
-
-@<Assignments@>=
-set_box: begin scan_register_num;
- if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
- scan_optional_equals;
- if set_box_allowed then scan_box(n)
- else begin print_err("Improper "); print_esc("setbox");
-@.Improper \\setbox@>
- help2("Sorry, \setbox is not allowed after \halign in a display,")@/
- ("or between \accent and an accented character."); error;
- end;
- end;
-
-@ The |space_factor| or |prev_depth| settings are changed when a |set_aux|
-command is sensed. Similarly, |prev_graf| is changed in the presence of
-|set_prev_graf|, and |dead_cycles| or |insert_penalties| in the presence of
-|set_page_int|. These definitions are always global.
-
-When some dimension of a box register is changed, the change isn't exactly
-global; but \TeX\ does not look at the \.{\\global} switch.
-
-@<Assignments@>=
-set_aux:alter_aux;
-set_prev_graf:alter_prev_graf;
-set_page_dimen:alter_page_so_far;
-set_page_int:alter_integer;
-set_box_dimen:alter_box_dimen;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure alter_aux;
-var c:halfword; {|hmode| or |vmode|}
-begin if cur_chr<>abs(mode) then report_illegal_case
-else begin c:=cur_chr; scan_optional_equals;
- if c=vmode then
- begin scan_normal_dimen; prev_depth:=cur_val;
- end
- else begin scan_int;
- if (cur_val<=0)or(cur_val>32767) then
- begin print_err("Bad space factor");
-@.Bad space factor@>
- help1("I allow only values in the range 1..32767 here.");
- int_error(cur_val);
- end
- else space_factor:=cur_val;
- end;
- end;
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure alter_prev_graf;
-var p:0..nest_size; {index into |nest|}
-begin nest[nest_ptr]:=cur_list; p:=nest_ptr;
-while abs(nest[p].mode_field)<>vmode do decr(p);
-scan_optional_equals; scan_int;
-if cur_val<0 then
- begin print_err("Bad "); print_esc("prevgraf");
-@.Bad \\prevgraf@>
- help1("I allow only nonnegative values here.");
- int_error(cur_val);
- end
-else begin nest[p].pg_field:=cur_val; cur_list:=nest[nest_ptr];
- end;
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure alter_page_so_far;
-var c:0..7; {index into |page_so_far|}
-begin c:=cur_chr; scan_optional_equals; scan_normal_dimen;
-page_so_far[c]:=cur_val;
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure alter_integer;
-var c:small_number;
- {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc.}
-begin c:=cur_chr; scan_optional_equals; scan_int;
-if c=0 then dead_cycles:=cur_val
-@/@<Cases for |alter_integer|@>@/
-else insert_penalties:=cur_val;
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure alter_box_dimen;
-var c:small_number; {|width_offset| or |height_offset| or |depth_offset|}
-@!b:eight_bits; {box number}
-begin c:=cur_chr; scan_register_num; b:=cur_val; scan_optional_equals;
-scan_normal_dimen;
-if box(b)<>null then vmem(box(b)+c).sc:=cur_val;
-end;
-
-@ Paragraph shapes are set up in an obvious way. It needs one word more than in
-\TeX, though.
-
-@<Assignments@>=
-set_tex_shape: begin q:=cur_chr; scan_optional_equals; scan_int; n:=cur_val;
- if n<=0 then p:=null
- else begin p:=new_node(shape_node,2*(n+1)+1); vinfo(p+1):=n;
- for j:=1 to n do
- begin scan_normal_dimen;
- vmem(p+2*j).sc:=cur_val; {indentation}
- scan_normal_dimen;
- vmem(p+2*j+1).sc:=cur_val; {width}
- end;
- end;
- define(q,shape_ref,p);
- end;
-set_etex_shape: begin q:=cur_chr; scan_optional_equals; scan_int; n:=cur_val;
- if n<=0 then p:=null
- else begin n:=(cur_val div 2)+1; p:=new_node(shape_node,2*n+1+1); vinfo(p+1):=n;
- n:=cur_val; vmem(p+2).int:=n; {number of penalties}
- for j:=p+3 to p+n+2 do
- begin scan_int; vmem(j).int:=cur_val; {penalty values}
- end;
- if not odd(n) then vmem(p+n+3).int:=0; {unused}
- end;
- define(q,shape_ref,p);
- end;
-
-@ New language information data is loaded by the |hyph_data| command.
-
-@<Put each...@>=
-primitive_tex("hyphenation",hyph_data,0,0);
-@!@:hyphenation_}{\.{\\hyphenation} primitive@>
-primitive_tex("patterns",hyph_data,1,0);
-@!@:patterns_}{\.{\\patterns} primitive@>
-primitive_luatex("prehyphenchar",hyph_data,2,0);
-@!@:prehyphenchar_}{\.{\\prehyphenchar} primitive@>
-primitive_luatex("posthyphenchar",hyph_data,3,0);
-@!@:posthyphenchar_}{\.{\\posthyphenchar} primitive@>
-primitive_luatex("preexhyphenchar",hyph_data,4,0);
-@!@:preexhyphenchar_}{\.{\\preexhyphenchar} primitive@>
-primitive_luatex("postexhyphenchar",hyph_data,5,0);
-@!@:postexhyphenchar_}{\.{\\postexhyphenchar} primitive@>
-
-@ @<Assignments@>=
-hyph_data: begin
- case cur_chr of
- 0: new_hyph_exceptions;
- 1: new_patterns;
- 2: new_pre_hyphen_char;
- 3: new_post_hyphen_char;
- 4: new_pre_exhyphen_char;
- 5: new_post_exhyphen_char;
- endcases;
- goto done;
- end;
-
-@ All of \TeX's parameters are kept in |eqtb| except the font information,
-the interaction mode, and the hyphenation tables; these are strictly global.
-
-@<Assignments@>=
-assign_font_dimen: set_font_dimen;
-assign_font_int: begin
- n:=cur_chr; scan_font_ident; f:=cur_val;
- if n = no_lig_code then set_no_ligatures(f)
- else if n < lp_code_base then begin
- scan_optional_equals; scan_int;
- if n=0 then set_hyphen_char(f,cur_val)@+else set_skew_char(f,cur_val);
- end
- else begin
- scan_char_num; p := cur_val;
- scan_optional_equals; scan_int;
- case n of
- lp_code_base: set_lp_code(f, p, cur_val);
- rp_code_base: set_rp_code(f, p, cur_val);
- ef_code_base: set_ef_code(f, p, cur_val);
- tag_code: set_tag_code(f, p, cur_val);
- end;
- end;
-end;
-
-@ @<Put each...@>=
-primitive_tex("hyphenchar",assign_font_int,0,0);
-@!@:hyphen_char_}{\.{\\hyphenchar} primitive@>
-primitive_tex("skewchar",assign_font_int,1,0);
-@!@:skew_char_}{\.{\\skewchar} primitive@>
-primitive_pdftex("lpcode",assign_font_int,lp_code_base,0);
-@!@:lp_code_}{\.{\\lpcode} primitive@>
-primitive_pdftex("rpcode",assign_font_int,rp_code_base,0);
-@!@:rp_code_}{\.{\\rpcode} primitive@>
-primitive_pdftex("efcode",assign_font_int,ef_code_base,0);
-@!@:ef_code_}{\.{\\efcode} primitive@>
-primitive_pdftex("tagcode",assign_font_int,tag_code,0);
-@!@:tag_code_}{\.{\\tagcode} primitive@>
-primitive_pdftex("pdfnoligatures",assign_font_int,no_lig_code,0);
-@!@:no_lig_code_}{\.{\\pdfnoligatures} primitive@>
-
-@ Here is where the information for a new font gets loaded.
-
-@<Assignments@>=
-def_font: tex_def_font(a); {in C}
-letterspace_font: new_letterspaced_font(a);
-pdf_copy_font: make_font_copy(a);
-
-@ @<Put each...@>=
-primitive_tex("batchmode",set_interaction,batch_mode,0);
-@!@:batch_mode_}{\.{\\batchmode} primitive@>
-primitive_tex("nonstopmode",set_interaction,nonstop_mode,0);
-@!@:nonstop_mode_}{\.{\\nonstopmode} primitive@>
-primitive_tex("scrollmode",set_interaction,scroll_mode,0);
-@!@:scroll_mode_}{\.{\\scrollmode} primitive@>
-primitive_tex("errorstopmode",set_interaction,error_stop_mode,0);
-@!@:error_stop_mode_}{\.{\\errorstopmode} primitive@>
-
-@ @<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_tex("openin",in_stream,1,0);
-@!@:open_in_}{\.{\\openin} primitive@>
-primitive_tex("closein",in_stream,0,0);
-@!@:close_in_}{\.{\\closein} primitive@>
-
-@ @<Cases of |main_control| that don't...@>=
-any_mode(in_stream): open_or_close_in;
-
-@ @<Declare act...@>=
-procedure open_or_close_in;
-var c:0..1; {1 for \.{\\openin}, 0 for \.{\\closein}}
-@!n:0..15; {stream number}
-begin c:=cur_chr; scan_four_bit_int; n:=cur_val;
-if read_open[n]<>closed then
- begin lua_a_close_in(read_file[n],(n+1)); read_open[n]:=closed;
- end;
-if c<>0 then
- begin scan_optional_equals; scan_file_name;
- if cur_ext="" then cur_ext:=".tex";
- pack_cur_name;
- if lua_a_open_in(read_file[n],(n+1)) then begin
- read_file[n]:= name_file_pointer;
- read_open[n]:=just_open;
- end;
- end;
-end;
-
-@ The user can issue messages to the terminal, regardless of the
-current mode.
-
-@<Cases of |main_control| that don't...@>=
-any_mode(message):issue_message;
-
-@ @<Put each...@>=
-primitive_tex("message",message,0,0);
-@!@:message_}{\.{\\message} primitive@>
-primitive_tex("errmessage",message,1,0);
-@!@:err_message_}{\.{\\errmessage} primitive@>
-
-@ @<Declare act...@>=
-procedure issue_message;
-var old_setting:0..max_selector; {holds |selector| setting}
-junk:pointer;
-@!c:0..1; {identifies \.{\\message} and \.{\\errmessage}}
-@!s:str_number; {the message}
-begin c:=cur_chr; junk:=scan_toks(false,true);
-old_setting:=selector; selector:=new_string;
-token_show(def_ref); selector:=old_setting;
-flush_list(def_ref);
-str_room(1); s:=make_string;
-if c=0 then @<Print string |s| on the terminal@>
-else @<Print string |s| as an error message@>;
-flush_string;
-end;
-
-@ @<Print string |s| on the terminal@>=
-begin if term_offset+length(s)>max_print_line-2 then print_ln
-else if (term_offset>0)or(file_offset>0) then print_char(" ");
-slow_print(s); update_terminal;
-end
-
-@ If \.{\\errmessage} occurs often in |scroll_mode|, without user-defined
-\.{\\errhelp}, we don't want to give a long help message each time. So we
-give a verbose explanation only once.
-
-@<Glob...@>=
-@!long_help_seen:boolean; {has the long \.{\\errmessage} help been used?}
-
-@ @<Set init...@>=long_help_seen:=false;
-
-@ @<Print string |s| as an error message@>=
-begin print_err(""); slow_print(s);
-if err_help<>null then use_err_help:=true
-else if long_help_seen then help1("(That was another \errmessage.)")
-else begin if interaction<error_stop_mode then long_help_seen:=true;
- help4("This error message was generated by an \errmessage")@/
- ("command, so I can't give any explicit help.")@/
- ("Pretend that you're Hercule Poirot: Examine all clues,")@/
-@^Poirot, Hercule@>
- ("and deduce the truth by order and method.");
- end;
-error; use_err_help:=false;
-end
-
-@ The |error| routine calls on |give_err_help| if help is requested from
-the |err_help| parameter.
-
-@p procedure give_err_help;
-begin token_show(err_help);
-end;
-
-@ The \.{\\uppercase} and \.{\\lowercase} commands are implemented by
-building a token list and then changing the cases of the letters in it.
-
-@<Cases of |main_control| that don't...@>=
-any_mode(case_shift):shift_case;
-
-@ @<Put each...@>=
-primitive_tex("lowercase",case_shift,lc_code_base,lc_code_base);
-@!@:lowercase_}{\.{\\lowercase} primitive@>
-primitive_tex("uppercase",case_shift,uc_code_base,lc_code_base);
-@!@:uppercase_}{\.{\\uppercase} primitive@>
-
-@ @<Declare act...@>=
-procedure shift_case;
-var b:pointer; {|lc_code_base| or |uc_code_base|}
-@!p:pointer; {runs through the token list}
-@!t:halfword; {token}
-@!c:halfword; {character code}
-@!i:halfword; {inbetween}
-begin b:=cur_chr; p:=scan_toks(false,false); p:=link(def_ref);
-while p<>null do
- begin @<Change the case of the token in |p|, if a change is appropriate@>;
- p:=link(p);
- end;
-back_list(link(def_ref)); free_avail(def_ref); {omit reference count}
-end;
-
-@ When the case of a |chr_code| changes, we don't change the |cmd|.
-We also change active characters.
-
-@<Change the case of the token in |p|, if a change is appropriate@>=
-t:=info(p);
-if t<cs_token_flag then begin
- c:=t mod string_offset;
- if b=uc_code_base then
- i:=get_uc_code(c)
- else
- i:=get_lc_code(c);
- if i<>0 then info(p):=t-c+i;
- end
-else if is_active_csname(t-cs_token_flag) then begin
- c:=active_csname_value(t-cs_token_flag);
- if b=uc_code_base then
- i:=get_uc_code(c)
- else
- i:= get_lc_code(c);
- if i<>0 then info(p):=active_to_cs(i,true)+cs_token_flag;
-end
-
-@ We come finally to the last pieces missing from |main_control|, namely the
-`\.{\\show}' commands that are useful when debugging.
-
-@<Cases of |main_control| that don't...@>=
-any_mode(xray): show_whatever;
-
-@ @d show_code=0 { \.{\\show} }
-@d show_box_code=1 { \.{\\showbox} }
-@d show_the_code=2 { \.{\\showthe} }
-@d show_lists=3 { \.{\\showlists} }
-
-@<Put each...@>=
-primitive_tex("show",xray,show_code,0);
-@!@:show_}{\.{\\show} primitive@>
-primitive_tex("showbox",xray,show_box_code,0);
-@!@:show_box_}{\.{\\showbox} primitive@>
-primitive_tex("showthe",xray,show_the_code,0);
-@!@:show_the_}{\.{\\showthe} primitive@>
-primitive_tex("showlists",xray,show_lists,0);
-@!@:show_lists_}{\.{\\showlists} primitive@>
-
-@ @<Declare act...@>=
-procedure show_whatever;
-label common_ending;
-var p:pointer; {tail of a token list to show}
-@!t:small_number; {type of conditional being shown}
-@!m:normal..or_code; {upper bound on |fi_or_else| codes}
-@!l:integer; {line where that conditional began}
-@!n:integer; {level of \.{\\if...\\fi} nesting}
-begin case cur_chr of
-show_lists: begin begin_diagnostic; show_activities;
- end;
-show_box_code: @<Show the current contents of a box@>;
-show_code: @<Show the current meaning of a token, then |goto common_ending|@>;
-@<Cases for |show_whatever|@>@;@/
-othercases @<Show the current value of some parameter or register,
- then |goto common_ending|@>
-endcases;@/
-@<Complete a potentially long \.{\\show} command@>;
-common_ending: if interaction<error_stop_mode then
- begin help0; decr(error_count);
- end
-else if tracing_online>0 then
- begin@t@>@;@/
- help3("This isn't an error message; I'm just \showing something.")@/
- ("Type `I\show...' to show more (e.g., \show\cs,")@/
- ("\showthe\count10, \showbox255, \showlists).");
- end
-else begin@t@>@;@/
- help5("This isn't an error message; I'm just \showing something.")@/
- ("Type `I\show...' to show more (e.g., \show\cs,")@/
- ("\showthe\count10, \showbox255, \showlists).")@/
- ("And type `I\tracingonline=1\show...' to show boxes and")@/
- ("lists on your terminal as well as in the transcript file.");
- end;
-error;
-end;
-
-@ @<Show the current meaning of a token...@>=
-begin get_token;
-if interaction=error_stop_mode then wake_up_terminal;
-print_nl("> ");
-if cur_cs<>0 then
- begin sprint_cs(cur_cs); print_char("=");
- end;
-print_meaning; goto common_ending;
-end
-
-@ @<Show the current contents of a box@>=
-begin scan_register_num; begin_diagnostic;
-print_nl("> \box"); print_int(cur_val); print_char("=");
-if box(cur_val)=null then print("void")
-else show_box(box(cur_val));
-end
-
-@ @<Show the current value of some parameter...@>=
-begin p:=the_toks;
-if interaction=error_stop_mode then wake_up_terminal;
-print_nl("> "); token_show(temp_token_head);
-flush_list(link(temp_token_head)); goto common_ending;
-end
-
-@ @<Complete a potentially long \.{\\show} command@>=
-end_diagnostic(true); print_err("OK");
-@.OK@>
-if selector=term_and_log then if tracing_online<=0 then
- begin selector:=term_only; print(" (see the transcript file)");
- selector:=term_and_log;
- end
-
-@* \[50] Dumping and undumping the tables.
-After \.{INITEX} has seen a collection of fonts and macros, it
-can write all the necessary information on an auxiliary file so
-that production versions of \TeX\ are able to initialize their
-memory at high speed. The present section of the program takes
-care of such output and input. We shall consider simultaneously
-the processes of storing and restoring,
-so that the inverse relation between them is clear.
-@.INITEX@>
-
-The global variable |format_ident| is a string that is printed right
-after the |banner| line when \TeX\ is ready to start. For \.{INITEX} this
-string says simply `\.{(INITEX)}'; for other versions of \TeX\ it says,
-for example, `\.{(preloaded format=plain 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;
-@!format_name:str_number; {principal file name}
-
-@ @<Set init...@>=
-format_ident:=0;
-format_name:="";
-
-@ @<Initialize table entries...@>=
-format_ident:=" (INITEX)";
-
-@ @<Declare act...@>=
-@!init procedure store_fmt_file;
-label found1,found2,done1,done2;
-var j,@!k,@!l:integer; {all-purpose indices}
-@!p: pointer; {all-purpose pointer}
-@!x: integer; {something to dump}
-@!w: four_quarters; {four ASCII codes}
-begin @<If dumping is not allowed, abort@>;
-@<Create the |format_ident|, open the format file,
- and inform the user that dumping has begun@>;
-@<Dump constants for consistency check@>;
-@<Dump the string pool@>;
-@<Dump the dynamic memory@>;
-@<Dump the table of equivalents@>;
-@<Dump the font information@>;
-@<Dump the active ocp information@>;
-@<Dump the ocp information@>;
-@<Dump the ocp list information@>;
-@<Dump the hyphenation tables@>;
-@<Dump pdftex data@>;
-@<Dump a couple more things and the closing check word@>;
-@<Dump the lua bytecodes@>;
-@<Close the format file@>;
-end;
-tini
-
-@ Corresponding to the procedure that dumps a format file, we have a function
-that reads one in. The function returns |false| if the dumped format is
-incompatible with the present \TeX\ table sizes, etc.
-
-@d bad_fmt=6666 {go here if the format file is unacceptable}
-@d too_small(#)==begin wake_up_terminal;
- wterm_ln('---! Must increase the ',#);
-@.Must increase the x@>
- goto bad_fmt;
- end
-
-@p @t\4@>@<Declare the function called |open_fmt_file|@>@;
-function load_fmt_file:boolean;
-label bad_fmt,exit;
-var j,@!k:integer; {all-purpose indices}
-@!p: pointer; {all-purpose pointer}
-@!x: integer; {something undumped}
-@!w: four_quarters; {four ASCII codes}
-begin @<Undump constants for consistency check@>;
-@<Undump the string pool@>;
-@<Undump the dynamic memory@>;
-@<Undump the table of equivalents@>;
-@<Undump the font information@>;
-@<Undump the active ocp information@>;
-@<Undump the ocp information@>;
-@<Undump the ocp list information@>;
-@<Undump the hyphenation tables@>;
-@<Undump pdftex data@>;
-@<Undump a couple more things and the closing check word@>;
-@<Undump the lua bytecodes@>;
-prev_depth := pdf_ignored_dimen;
-load_fmt_file:=true; return; {it worked!}
-bad_fmt: wake_up_terminal;
- wterm_ln('(Fatal format file error; I''m stymied)');
-@.Fatal format file error@>
-load_fmt_file:=false;
-exit:end;
-
-@ The user is not allowed to dump a format file unless |save_ptr=0|.
-This condition implies that |cur_level=level_one|, hence
-the |xeq_level| array is constant and it need not be dumped.
-
-@<If dumping is not allowed, abort@>=
-if save_ptr<>0 then
- begin print_err("You can't dump inside a group");
-@.You can't dump...@>
- help1("`{...\dump}' is a no-no."); succumb;
- end
-
-@ Format files consist of |memory_word| items, and we use the following
-macros to dump words of different types:
-
-@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
-@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
-@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
-@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
-
-@<Glob...@>=
-@!fmt_file:word_file; {for input or output of format information}
-
-@ The inverse macros are slightly more complicated, since we need to check
-the range of the values we are reading in. We say `|undump(a)(b)(x)|' to
-read an integer value |x| that is supposed to be in the range |a<=x<=b|.
-
-@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
-@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
-@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
-@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
-@d undump_end_end(#)==#:=x;@+end
-@d undump_end(#)==(x>#) then goto bad_fmt@+else undump_end_end
-@d undump(#)==begin undump_int(x); if (x<#) or undump_end
-@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
-@d undump_size_end(#)==if x># then undump_size_end_end
-@d undump_size(#)==begin undump_int(x);
- if x<# then goto bad_fmt; undump_size_end
-
-@ The next few sections of the program should make it clear how we use the
-dump/undump macros.
-
-@<Dump constants for consistency check@>=
-dump_int(@$);@/
-dump_int(eqtb_size);@/
-dump_int(hash_prime)
-
-@ Sections of a \.{WEB} program that are ``commented out'' still contribute
-strings to the string pool; therefore \.{INITEX} and \TeX\ will have
-the same strings. (And it is, of course, a good thing that they do.)
-@.WEB@>
-@^string pool@>
-
-@<Undump constants for consistency check@>=
-x:=fmt_file^.int;
-if x<>@$ then goto bad_fmt; {check that strings are the same}
-undump_int(x);@/
-if x<>eqtb_size then goto bad_fmt;
-undump_int(x);
-if x<>hash_prime then goto bad_fmt
-
-@ @d dump_four_ASCII==
- w.b0:=qi(so(str_pool[k])); w.b1:=qi(so(str_pool[k+1]));
- w.b2:=qi(so(str_pool[k+2])); w.b3:=qi(so(str_pool[k+3]));
- dump_qqqq(w)
-
-@<Dump the string pool@>=
-dump_int(pool_ptr);
-dump_int(str_ptr);
-for k:=string_offset to str_ptr do dump_int(str_start_macro(k));
-k:=0;
-while k+4<pool_ptr do
- begin dump_four_ASCII; k:=k+4;
- end;
-k:=pool_ptr-4; dump_four_ASCII;
-print_ln; print_int(str_ptr-string_offset); print(" strings of total length ");
-print_int(pool_ptr)
-
-@ @d undump_four_ASCII==
- undump_qqqq(w);
- str_pool[k]:=si(qo(w.b0)); str_pool[k+1]:=si(qo(w.b1));
- str_pool[k+2]:=si(qo(w.b2)); str_pool[k+3]:=si(qo(w.b3))
-
-@<Undump the string pool@>=
-undump_size(0)(pool_size)('string pool size')(pool_ptr);
-undump_size(0)(max_strings)('max strings')(str_ptr);
-for k:=string_offset to str_ptr do undump(0)(pool_ptr)(str_start_macro(k));
-k:=0;
-while k+4<pool_ptr do
- begin undump_four_ASCII; k:=k+4;
- end;
-k:=pool_ptr-4; undump_four_ASCII;
-init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr
-
-@ By sorting the list of available spaces in the variable-size portion of
-|mem|, we are usually able to get by without having to dump very much
-of the dynamic memory.
-
-We recompute |var_used| and |dyn_used|, so that \.{INITEX} dumps valid
-information even when it has not been gathering statistics.
-
-@<Dump the dynamic memory@>=
-dump_node_mem;
-@#
-dump_int(temp_token_head); dump_int(hold_token_head);
-dump_int(omit_template); dump_int(null_list);
-dump_int(backup_head); dump_int(garbage);
-dump_int(fix_mem_min); dump_int(fix_mem_max);
-dump_int(fix_mem_end);
-dump_int(avail);
-dyn_used:=fix_mem_end+1;
-for k:=fix_mem_min to fix_mem_end do dump_wd(mem(k));
-x:=x+(fix_mem_end+1-fix_mem_min);
-p:=avail;
-while p<>null do
- begin decr(dyn_used); p:=link(p);
- end;
-dump_int(dyn_used);
-print_ln; print_int(x);
-print(" memory locations dumped; current usage is ");
-print_int(var_used); print_char("&"); print_int(dyn_used)
-
-@ @<Undump the dynamic memory@>=
-undump_node_mem;
-@#
-undump_int(temp_token_head); undump_int(hold_token_head);
-undump_int(omit_template); undump_int(null_list);
-undump_int(backup_head); undump_int(garbage);
-undump_int(fix_mem_min);undump_int(fix_mem_max);
-fixmem:= xmallocarray (smemory_word, fix_mem_max+1);
-memset (voidcast(fixmem),0,(fix_mem_max+1)*sizeof(smemory_word));
-undump_int(fix_mem_end);
-undump_int(avail);
-for k:=fix_mem_min to fix_mem_end do undump_wd(mem(k));
-undump_int(dyn_used)
-
-@ @<Dump the table of equivalents@>=
-@<Dump regions 1 to 4 of |eqtb|@>;
-@<Dump regions 5 and 6 of |eqtb|@>;
-dump_int(par_loc); dump_int(write_loc);@/
-dump_math_codes;
-dump_text_codes;
-@<Dump the hash table@>
-
-@ @<Undump the table of equivalents@>=
-@<Undump regions 1 to 6 of |eqtb|@>;
-undump(hash_base)(frozen_control_sequence)(par_loc);
-par_token:=cs_token_flag+par_loc;@/
-undump(hash_base)(frozen_control_sequence)(write_loc);@/
-undump_math_codes;
-undump_text_codes;
-@<Undump the hash table@>
-
-@ The table of equivalents usually contains repeated information, so we dump it
-in compressed form: The sequence of $n+2$ values $(n,x_1,\ldots,x_n,m)$ in the
-format file represents $n+m$ consecutive entries of |eqtb|, with |m| extra
-copies of $x_n$, namely $(x_1,\ldots,x_n,x_n,\ldots,x_n)$.
-
-@<Dump regions 1 to 4 of |eqtb|@>=
-k:=null_cs;
-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:=null_cs;
-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@>=
-dump_primitives;
-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@>=
-undump_primitives;
-undump(hash_base)(frozen_control_sequence)(hash_used); p:=hash_base-1;
-repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]);
-until p=hash_used;
-for p:=hash_used+1 to undefined_control_sequence-1 do undump_hh(hash[p]);
-undump_int(cs_count)
-
-@ @<Dump the font information@>=
-dump_int(max_font_id);
-for k:=0 to max_font_id do
- @<Dump the array info for internal font number |k|@>;
-print_ln; print_int(max_font_id); print(" preloaded font");
-if max_font_id<>1 then print_char("s");
-dump_math_data
-
-@ @<Undump the font information@>=
-undump_int(x);
-set_max_font_id(x);
-for k:=0 to max_font_id do
- @<Undump the array info for internal font number |k|@>;
-undump_math_data
-
-@ @<Dump the array info for internal font number |k|@>=
-begin dump_font(k);
-print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
-print_file_name(tex_font_name(k),tex_font_area(k),"");
-flush_string; flush_string;
-if font_size(k)<>font_dsize(k) then
- begin print(" at "); print_scaled(font_size(k)); print("pt");
- end;
-end
-
-@ @<Undump the array info for internal font number |k|@>=
-begin undump_font(k);@/
-end
-
-@ @<Dump the active ocp information@>=
-dump_int(active_min_ptr);
-dump_int(active_max_ptr);
-for k:=0 to active_max_ptr-1 do dump_wd(active_info[k]);
-if active_max_ptr>0 then begin
- print_ln; print_int(active_max_ptr); print(" words of active ocps");
- end;
-
-@ @<Undump the active ocp information@>=
-undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
-undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
-for k:=0 to active_max_ptr-1 do undump_wd(active_info[k]);
-
-@ @<Dump the ocp information@>=
-dump_int(ocp_ptr);
-for k:=null_ocp to ocp_ptr do
- @<Dump the array info for internal ocp number |k|@>;
-if ocp_ptr-ocp_base>0 then begin
- print_ln; print_int(ocp_ptr-ocp_base); print(" preloaded ocp");
- if ocp_ptr<>ocp_base+1 then print_char("s");
- end
-
-@ @<Undump the ocp information@>=
-undump_size(ocp_base)(ocp_biggest)('ocp max')(ocp_ptr);
-for k:=null_ocp to ocp_ptr do
- @<Undump the array info for internal ocp number |k|@>
-
-@ @<Dump the array info for internal ocp number |k|@>=
-begin dump_ocp_table(k);
-if ocp_ptr-ocp_base>0 then begin
- print_nl("\ocp"); print_esc(ocp_id_text(k)); print_char("=");
- print_file_name(ocp_name(k),ocp_area(k),"");
- end;
-end
-
-@ @<Undump the array info for internal ocp number |k|@>=
-begin undump_ocp_table(k);
-end
-
-@ @<Dump the ocp list information@>=
-dump_int(ocp_listmem_ptr);
-for k:=0 to ocp_listmem_ptr-1 do dump_wd(ocp_list_info[k]);
-dump_int(ocp_list_ptr);
-for k:=null_ocp_list to ocp_list_ptr do begin
- dump_int(ocp_list_list[k]);
- if null_ocp_list<>ocp_list_ptr then begin
- print_nl("\ocplist");
- print_esc(ocp_list_id_text(k));
- print_char("=");
- print_ocp_list(ocp_list_list[k]);
- end;
- end;
-dump_int(ocp_lstackmem_ptr);
-for k:=0 to ocp_lstackmem_ptr-1 do dump_wd(ocp_lstack_info[k])
-
-@ @<Undump the ocp list information@>=
-undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
-for k:=0 to ocp_listmem_ptr-1 do undump_wd(ocp_list_info[k]);
-undump_size(ocp_list_base)(ocp_list_biggest)('ocp list max')(ocp_list_ptr);
-for k:=null_ocp_list to ocp_list_ptr do
- undump_int(ocp_list_list[k]);
-undump_size(1)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
-for k:=0 to ocp_lstackmem_ptr-1 do undump_wd(ocp_lstack_info[k])
-
-@ This is done in C
-
-@<Dump the hyphenation tables@>=
-dump_language_data
-
-@ @<Undump the hyphenation tables@>=
-undump_language_data
-
-@ Store some of the pdftex data structures in the format. The idea here is
-to ensure that any data structures referenced from pdftex-specific whatsit
-nodes are retained. For the sake of simplicity and speed, all the filled parts
-of |pdf_mem| and |obj_tab| are retained, in the present implementation. We also
-retain three of the linked lists that start from |head_tab|, so that it is
-possible to, say, load an image in the \.{INITEX} run and then reference it in a
-\.{VIRTEX} run that uses the dumped format.
-
-@<Dump pdftex data@>=
-begin
-dumpimagemeta; {the image information array }
-dump_int(pdf_mem_size);
-dump_int(pdf_mem_ptr);
-for k:=1 to pdf_mem_ptr-1 do begin
- dump_int(pdf_mem[k]);
- end;
-print_ln; print_int(pdf_mem_ptr-1); print(" words of pdf memory");
-dump_int(obj_tab_size);
-dump_int(obj_ptr);
-dump_int(sys_obj_ptr);
-for k:=1 to sys_obj_ptr do begin
- dump_int(obj_tab[k].int0);
- dump_int(obj_tab[k].int1);
- dump_int(obj_tab[k].int3);
- dump_int(obj_tab[k].int4);
- end;
-print_ln; print_int(sys_obj_ptr); print(" indirect objects");
-dump_int(pdf_obj_count);
-dump_int(pdf_xform_count);
-dump_int(pdf_ximage_count);
-dump_int(head_tab[obj_type_obj]);
-dump_int(head_tab[obj_type_xform]);
-dump_int(head_tab[obj_type_ximage]);
-dump_int(pdf_last_obj);
-dump_int(pdf_last_xform);
-dump_int(pdf_last_ximage);
-end
-
-@ And restoring the pdftex data structures from the format. The
-two function arguments to |undumpimagemeta| have been restored
-already in an earlier module.
-
-@<Undump pdftex data@>=
-begin
-undumpimagemeta(pdf_minor_version,pdf_inclusion_errorlevel); {the image information array }
-undump_int(pdf_mem_size);
-pdf_mem := xreallocarray(pdf_mem, integer, pdf_mem_size);
-undump_int(pdf_mem_ptr);
-for k:=1 to pdf_mem_ptr-1 do begin
- undump_int(pdf_mem[k]);
- end;
-undump_int(obj_tab_size);
-undump_int(obj_ptr);
-undump_int(sys_obj_ptr);
-for k:=1 to sys_obj_ptr do begin
- undump_int(obj_tab[k].int0);
- undump_int(obj_tab[k].int1);
- obj_tab[k].int2 := -1;
- undump_int(obj_tab[k].int3);
- undump_int(obj_tab[k].int4);
- end;
-undump_int(pdf_obj_count);
-undump_int(pdf_xform_count);
-undump_int(pdf_ximage_count);
-undump_int(head_tab[obj_type_obj]);
-undump_int(head_tab[obj_type_xform]);
-undump_int(head_tab[obj_type_ximage]);
-undump_int(pdf_last_obj);
-undump_int(pdf_last_xform);
-undump_int(pdf_last_ximage);
-end
-
-
-@ This is also done in C
-
-@<Dump the lua bytecodes@>=
-dump_luac_registers;
-
-@ @<Undump the lua bytecodes@>=
-undump_luac_registers;
-
-@ We have already printed a lot of statistics, so we set |tracing_stats:=0|
-to prevent them from appearing again.
-
-@<Dump a couple more things and the closing check word@>=
-dump_int(interaction); dump_int(format_ident); dump_int(format_name); dump_int(69069);
-tracing_stats:=0
-
-@ @<Undump a couple more things and the closing check word@>=
-undump(batch_mode)(error_stop_mode)(interaction);
-undump(0)(str_ptr)(format_ident);
-undump(0)(str_ptr)(format_name);
-undump_int(x);
-if (x<>69069)or eof(fmt_file) then goto bad_fmt
-
-@ @<Create the |format_ident|...@>=
-selector:=new_string;
-print(" (preloaded format="); print(job_name); print_char(" ");
-print_int(year); print_char(".");
-print_int(month); print_char("."); print_int(day); print_char(")");
-str_room(2);
-format_ident:=make_string;
-print(job_name);
-format_name:=make_string;
-if interaction=batch_mode then selector:=log_only
-else selector:=term_and_log;
-pack_job_name(format_extension);
-while not w_open_out(fmt_file) do
- prompt_file_name('format file name',format_extension);
-print_nl("Beginning to dump on file ");
-@.Beginning to dump...@>
-slow_print(w_make_name_string(fmt_file)); flush_string;
-print_nl(""); slow_print(format_ident)
-
-@ @<Close the format file@>=
-w_close(fmt_file)
-
-@* \[51] The main program.
-This is it: the part of \TeX\ that executes all those procedures we have
-written.
-
-Well---almost. Let's leave space for a few more routines that we may
-have forgotten.
-
-@p @<Last-minute procedures@>
-
-@ We have noted that there are two versions of \TeX82. One, called \.{INITEX},
-@.INITEX@>
-has to be run first; it initializes everything from scratch, without
-reading a format file, and it has the capability of dumping a format file.
-The other one is called `\.{VIRTEX}'; it is a ``virgin'' program that needs
-@.VIRTEX@>
-to input a format file in order to get started. \.{VIRTEX} typically has
-more memory capacity than \.{INITEX}, because it does not need the space
-consumed by the auxiliary hyphenation tables and the numerous calls on
-|primitive|, etc.
-
-The \.{VIRTEX} program cannot read a format file instantaneously, of course;
-the best implementations therefore allow for production versions of \TeX\ that
-not only avoid the loading routine for \PASCAL\ object code, they also have
-a format file pre-loaded. This is impossible to do if we stick to standard
-\PASCAL; but there is a simple way to fool many systems into avoiding the
-initialization, as follows:\quad(1)~We declare a global integer variable
-called |ready_already|. The probability is negligible that this
-variable holds any particular value like 314159 when \.{VIRTEX} is first
-loaded.\quad(2)~After we have read in a format file and initialized
-everything, we set |ready_already:=314159|.\quad(3)~Soon \.{VIRTEX}
-will print `\.*', waiting for more input; and at this point we
-interrupt the program and save its core image in some form that the
-operating system can reload speedily.\quad(4)~When that core image is
-activated, the program starts again at the beginning; but now
-|ready_already=314159| and all the other global variables have
-their initial values too. The former chastity has vanished!
-
-In other words, if we allow ourselves to test the condition
-|ready_already=314159|, before |ready_already| has been
-assigned a value, we can avoid the lengthy initialization. Dirty tricks
-rarely pay off so handsomely.
-@^dirty \PASCAL@>
-@^system dependencies@>
-
-On systems that allow such preloading, the standard program called \.{TeX}
-should be the one that has \.{plain} format preloaded, since that agrees
-with {\sl The \TeX book}. Other versions, e.g., \.{AmSTeX}, should also
-@:TeXbook}{\sl The \TeX book@>
-@.AmSTeX@>
-@.plain@>
-be provided for commonly used formats.
-
-@<Glob...@>=
-@!ready_already:integer; {a sacrifice of purity for economy}
-
-@ Now this is really it: \TeX\ starts and ends here.
-
-The initial test involving |ready_already| should be deleted if the
-\PASCAL\ runtime system is smart enough to detect such a ``mistake.''
-@^system dependencies@>
-
-@p begin @!{|start_here|}
-history:=fatal_error_stop; {in case we quit during initialization}
-t_open_out; {open the terminal for output}
-if ready_already=314159 then goto start_of_TEX;
-@<Check the ``constant'' values...@>@;
-if bad>0 then
- begin wterm_ln('Ouch---my internal constants have been clobbered!',
- '---case ',bad:1);
-@.Ouch...clobbered@>
- goto final_end;
- end;
-initialize; {set global variables to their starting values}
-@!init if not get_strings_started then goto final_end;
-init_prim; {call |primitive| for each primitive}
-init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
-tini@/
-ready_already:=314159;
-start_of_TEX: @<Initialize the output routines@>;
-@<Get the first line of input and prepare to start@>;
-history:=spotless; {ready to go!}
-@<Initialize synctex primitive@>
-main_control; {come to life}
-final_cleanup; {prepare for death}
-end_of_TEX: close_files_and_terminate;
-final_end: ready_already:=0;
-end.
-
-@ Put this in a function because two extra variables are needed
-for callback testing, and putting those inside the main body is
-ugly
-
-@<Basic print...@>=
-procedure print_banner;
-var res:boolean;
- callback_id:integer;
-begin
-callback_id:=callback_defined(start_run_callback);
-if callback_id=0 then begin
- wterm(banner);
- if format_ident=0 then wterm_ln(' (no format preloaded)')
- else begin slow_print(format_ident); print_ln;
- end;
- end
-else if callback_id>0 then
- res:= run_callback(callback_id,'->');
-update_terminal;
-end;
-@#
-procedure print_version_banner;
-begin
-wterm(banner);
-write_svnversion(luatex_svnversion);
-end;
-
-
-@ Here we do whatever is needed to complete \TeX's job gracefully on the
-local operating system. The code here might come into play after a fatal
-error; it must therefore consist entirely of ``safe'' operations that
-cannot produce error messages. For example, it would be a mistake to call
-|str_room| or |make_string| at this time, because a call on |overflow|
-might lead to an infinite loop.
-@^system dependencies@>
-
-Actually there's one way to get error messages, via |prepare_mag|;
-but that can't cause infinite recursion.
-@^recursion@>
-
-This program doesn't bother to close the input files that may still be open.
-
-@<Last-minute...@>=
-procedure close_files_and_terminate;
-label done, done1;
-var a, b, i, j, k, l: integer; {all-purpose index}
- is_names: boolean; {flag for name tree output: is it Names or Kids?}
- root, outlines, threads, names_tree, dests: integer;
- xref_offset_width, names_head, names_tail: integer;
- callback_id:integer;
- res:boolean;
-begin
-callback_id:=callback_defined(stop_run_callback);
-@<Finish the extensions@>;
-@!stat if tracing_stats>0 then
- if callback_id=0 then @<Output statistics about this job@>;@;@+tats@/
-wake_up_terminal;
-if not fixed_pdfoutput_set then {else there will be an infinite loop in error case}
- fix_pdfoutput;
-if fixed_pdfoutput > 0 then begin
- if history = fatal_error_stop then begin
- remove_pdffile;
- print_err(" ==> Fatal error occurred, no output PDF file produced!")
- end
- else begin
- @<Finish the PDF file@>;
- if callback_id=0 then begin
- if log_opened then
- begin wlog_cr;
- wlog_ln('PDF statistics:');
- wlog_ln(' ',obj_ptr:1,' PDF objects out of ',obj_tab_size:1,
- ' (max. ',sup_obj_tab_size:1,')');
- if pdf_os_cntr > 0 then begin
- wlog(' ',((pdf_os_cntr - 1) * pdf_os_max_objs + pdf_os_objidx + 1):1,
- ' compressed objects within ',pdf_os_cntr:1,' object stream');
- if pdf_os_cntr > 1 then
- wlog('s');
- wlog_cr;
- end;
- wlog_ln(' ',pdf_dest_names_ptr:1,' named destinations out of ',dest_names_size:1,
- ' (max. ',sup_dest_names_size:1,')');
- wlog_ln(' ',pdf_mem_ptr:1,' words of extra memory for PDF output out of ',pdf_mem_size:1,
- ' (max. ',sup_pdf_mem_size:1,')');
- end;
- end;
- end;
-end
-else begin
- @<Finish the \.{DVI} file@>;
-end;
-@<Close {\sl Sync\TeX} file and write status@>;
-free_text_codes;
-free_math_codes;
-if log_opened then
- begin wlog_cr; selector:=selector-2;
- if (selector=term_only)and(callback_id=0) then begin
- print_nl("Transcript written on ");
-@.Transcript written...@>
- slow_print(log_name); print_char(".");
- end;
- lua_a_close_out(log_file);
- end;
-end;
-
-@ The present section goes directly to the log file instead of using
-|print| commands, because there's no need for these strings to take
-up |str_pool| memory when a non-{\bf stat} version of \TeX\ is being used.
-
-@<Output statistics...@>=
-if log_opened then
- begin wlog_ln(' ');
- wlog_ln('Here is how much of TeX''s memory',' you used:');
-@.Here is how much...@>
- wlog(' ',str_ptr-init_str_ptr:1,' string');
- if str_ptr<>init_str_ptr+1 then wlog('s');
- wlog_ln(' out of ', max_strings-init_str_ptr+string_offset:1);@/
- wlog_ln(' ',pool_ptr-init_pool_ptr:1,' string characters out of ',
- pool_size-init_pool_ptr:1);@/
- wlog_ln(' ',var_mem_max:1,',',fix_mem_max:1,@|
- ' words of node,token memory allocated');@/
- print_node_mem_stats;
- wlog_ln(' ',cs_count:1,' multiletter control sequences out of ',
- hash_size:1);@/
- wlog(' ',max_font_id,' font');
- if max_font_id<>1 then wlog('s');
- wlog_ln(' using ', font_bytes:1, ' bytes');
- wlog_ln(' ',max_in_stack:1,'i,',max_nest_stack:1,'n,',@|
- max_param_stack:1,'p,',@|
- max_buf_stack+1:1,'b,',@|
- max_save_stack+6:1,'s stack positions out of ',@|
- stack_size:1,'i,',
- nest_size:1,'n,',
- param_size:1,'p,',
- buf_size:1,'b,',
- save_size:1,'s');
- end
-
-@ We get to the |final_cleanup| routine when \.{\\end} or \.{\\dump} has
-been scanned and |its_all_over|\kern-2pt.
-
-@<Last-minute...@>=
-procedure final_cleanup;
-label exit;
-var c:small_number; {0 for \.{\\end}, 1 for \.{\\dump}}
-i:halfword; { for looping marks }
-begin c:=cur_chr;
-if job_name=0 then open_log_file;
-while input_ptr>0 do
- if state=token_list then end_token_list@+else end_file_reading;
-while open_parens>0 do
- begin
- if tracefilenames then print(" )");
- decr(open_parens);
- end;
-if cur_level>level_one then
- begin print_nl("("); print_esc("end occurred ");
- print("inside a group at level ");
-@:end_}{\.{(\\end occurred...)}@>
- print_int(cur_level-level_one); print_char(")");
- show_save_groups;
- end;
-while cond_ptr<>null do
- begin print_nl("("); print_esc("end occurred ");
- print("when "); print_cmd_chr(if_test,cur_if);
- if if_line<>0 then
- begin print(" on line "); print_int(if_line);
- end;
- print(" was incomplete)");
- if_line:=if_line_field(cond_ptr);
- cur_if:=subtype(cond_ptr); temp_ptr:=cond_ptr;
- cond_ptr:=vlink(cond_ptr); flush_node(temp_ptr);
- end;
-if callback_defined(stop_run_callback)=0 then
- if history<>spotless then
- if ((history=warning_issued)or(interaction<error_stop_mode)) then
- if selector=term_and_log then
- begin selector:=term_only;
- print_nl("(see the transcript file for additional information)");
-@.see the transcript file...@>
- selector:=term_and_log;
- end;
-if c=1 then
- begin @!init for i:=0 to biggest_used_mark do begin
- delete_top_mark(i); delete_first_mark(i); delete_bot_mark(i);
- delete_split_first_mark(i); delete_split_bot_mark(i);
- end;
- for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
- if last_glue<>max_halfword then delete_glue_ref(last_glue);
- @<Close the pseudo files@>;
- store_fmt_file; return;@+tini@/
- print_nl("(\dump is performed only by INITEX)"); return;
-@:dump_}{\.{\\dump...only by INITEX}@>
- end;
-exit:end;
-
-@ @<Last-minute...@>=
-@!init procedure init_prim; {initialize all the primitives}
-begin no_new_control_sequence:=false;
-first:=0;
-@<Put each...@>;
-no_new_control_sequence:=true;
-end;
-tini
-
-@ When we begin the following code, \TeX's tables may still contain garbage;
-the strings might not even be present. Thus we must proceed cautiously to get
-bootstrapped in.
-
-But when we finish this part of the program, \TeX\ is ready to call on the
-|main_control| routine to do its work.
-
-@<Get the first line...@>=
-begin @<Initialize the input routines@>;
-@<Enable \eTeX, if requested@>@;@/
-if (format_ident=0)or(buffer[loc]="&") then
- begin if format_ident<>0 then initialize; {erase preloaded format}
- if not open_fmt_file then goto final_end;
- if not load_fmt_file then
- begin w_close(fmt_file); goto final_end;
- end;
- w_close(fmt_file);
- while (loc<limit)and(buffer[loc]=" ") do incr(loc);
- end;
-if (pdf_output_option <> 0) then pdf_output := pdf_output_value;
-if (pdf_draftmode_option <> 0) then pdf_draftmode := pdf_draftmode_value;
-pdf_init_map_file('pdftex.map');
-if false then wterm_ln('entering extended mode');
-if end_line_char_inactive then decr(limit)
-else buffer[limit]:=end_line_char;
-fix_date_and_time;@/
-random_seed :=(microseconds*1000)+(epochseconds mod 1000000);@/
-init_randoms(random_seed);@/
-initialize_math;
-@<Initialize the print |selector|...@>;
-check_texconfig_init;
-if (loc<limit)and(get_cat_code(cat_code_table,buffer[loc])<>escape) then start_input;
- {\.{\\input} assumed}
-@<DIR: Initialize |text_dir_ptr|@>;
-end
-
-@* \[52] Debugging.
-Once \TeX\ is working, you should be able to diagnose most errors with
-the \.{\\show} commands and other diagnostic features. But for the initial
-stages of debugging, and for the revelation of really deep mysteries, you
-can compile \TeX\ with a few more aids, including the \PASCAL\ runtime
-checks and its debugger. An additional routine called |debug_help|
-will also come into play when you type `\.D' after an error message;
-|debug_help| also occurs just before a fatal error causes \TeX\ to succumb.
-@^debugging@>
-@^system dependencies@>
-
-The interface to |debug_help| is primitive, but it is good enough when used
-with a \PASCAL\ debugger that allows you to set breakpoints and to read
-variables and change their values. After getting the prompt `\.{debug \#}', you
-type either a negative number (this exits |debug_help|), or zero (this
-goes to a location where you can set a breakpoint, thereby entering into
-dialog with the \PASCAL\ debugger), or a positive number |m| followed by
-an argument |n|. The meaning of |m| and |n| will be clear from the
-program below. (If |m=13|, there is an additional argument, |l|.)
-@.debug \#@>
-
-@d breakpoint=888 {place where a breakpoint is desirable}
-
-@<Last-minute...@>=
-@!debug procedure debug_help; {routine to display various things}
-label breakpoint,exit;
-var k,@!l,@!m,@!n:integer;
-begin loop begin wake_up_terminal;
- print_nl("debug # (-1 to exit):"); update_terminal;
-@.debug \#@>
- read(term_in,m);
- if m<0 then return
- else if m=0 then
- begin goto breakpoint;@\ {go to every label at least once}
- breakpoint: m:=0; @{'BREAKPOINT'@}@\
- end
- else begin read(term_in,n);
- case m of
- @t\4@>@<Numbered cases for |debug_help|@>@;
- othercases print("?")
- endcases;
- end;
- end;
-exit:end;
-gubed
-
-@ @<Numbered cases...@>=
-1: print_word(mem(n)); {display |mem[n]| in all forms}
-2: print_int(info(n));
-3: print_int(link(n));
-4: print_word(eqtb[n]);
-5: ;
-6: print_word(save_stack[n]);
-7: show_box(n);
- {show a box, abbreviated by |show_box_depth| and |show_box_breadth|}
-8: begin breadth_max:=10000; depth_threshold:=pool_size-pool_ptr-10;
- show_node_list(n); {show a box in its entirety}
- end;
-9: show_token_list(n,null,1000);
-10: slow_print(n);
-13: begin read(term_in,l); print_cmd_chr(n,l);
- end;
-14: for k:=0 to n do print(buffer[k]);
-15: begin font_in_short_display:=null_font; short_display(n);
- end;
-
-@* \[53] Extensions.
-The program above includes a bunch of ``hooks'' that allow further
-capabilities to be added without upsetting \TeX's basic structure.
-Most of these hooks are concerned with ``whatsit'' nodes, which are
-intended to be used for special purposes; whenever a new extension to
-\TeX\ involves a new kind of whatsit node, a corresponding change needs
-to be made to the routines below that deal with such nodes,
-but it will usually be unnecessary to make many changes to the
-other parts of this program.
-
-In order to demonstrate how extensions can be made, we shall treat
-`\.{\\write}', `\.{\\openout}', `\.{\\closeout}', `\.{\\immediate}',
-and `\.{\\special}' as if they were extensions.
-These commands are actually primitives of \TeX, and they should
-appear in all implementations of the system; but let's try to imagine
-that they aren't. Then the program below illustrates how a person
-could add them.
-
-Sometimes, of course, an extension will require changes to \TeX\ itself;
-no system of hooks could be complete enough for all conceivable extensions.
-The features associated with `\.{\\write}' are almost all confined to the
-following paragraphs, but there are small parts of the |print_ln| and
-|print_char| procedures that were introduced specifically to \.{\\write}
-characters. Furthermore one of the token lists recognized by the scanner
-is a |write_text|; and there are a few other miscellaneous places where we
-have already provided for some aspect of \.{\\write}. The goal of a \TeX\
-extender should be to minimize alterations to the standard parts of the
-program, and to avoid them completely if possible. He or she should also
-be quite sure that there's no easy way to accomplish the desired goals
-with the standard features that \TeX\ already has. ``Think thrice before
-extending,'' because that may save a lot of work, and it will also keep
-incompatible extensions of \TeX\ from proliferating.
-@^system dependencies@>
-@^extensions to \TeX@>
-
-@ First let's consider the format of whatsit nodes that are used to represent
-the data associated with \.{\\write} and its relatives. Recall that a whatsit
-has |type=whatsit_node|, and the |subtype| is supposed to distinguish
-different kinds of whatsits. Each node occupies two or more words; the
-exact number is immaterial, as long as it is readily determined from the
-|subtype| or other data.
-
-We shall introduce five |subtype| values here, corresponding to the
-control sequences \.{\\openout}, \.{\\write}, \.{\\closeout}, and \.{\\special}.
-The second word of I/O whatsits has a |write_stream| field
-that identifies the write-stream number (0 to 15, or 16 for out-of-range and
-positive, or 17 for out-of-range and negative).
-In the case of \.{\\write} and \.{\\special}, there is also a field that
-points to the reference count of a token list that should be sent. In the
-case of \.{\\openout}, we need three words and three auxiliary subfields
-to hold the string numbers for name, area, and extension.
-
-@d open_node=0 {|subtype| in whatsits that represent files to \.{\\openout}}
-@d 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 dir_dir(#)==vinfo(#+2) {keep the direction to be taken}
-@d dir_level(#)==vlink(#+2) {the save level at which the direction was defined}
-@d dir_dvi_ptr(#)==vinfo(#+3) {for reflecting dvi output}
-@d dir_dvi_h(#)==vlink(#+3) {for reflecting dvi output}
-@d dir_box_pos_h(#)==vinfo(#+4) {for reflecting dvi output}
-@d dir_box_pos_v(#)==vlink(#+4) {for reflecting dvi output}
-@d dir_cur_h(#)==vinfo(#+5) {for reflecting dvi output}
-@d dir_cur_v(#)==vlink(#+5) {for reflecting dvi output}
-@d what_lang(#)==vlink(#+2) {language number, in the range |0..255|}
-@d what_lhm(#)==type(#+2) {minimum left fragment, in the range |1..63|}
-@d what_rhm(#)==subtype(#+2) {minimum right fragment, in the range |1..63|}
-@d write_tokens(#) == vlink(#+2) {reference count of token list to write}
-@d write_stream(#) == vinfo(#+2) {stream number (0 to 17)}
-@d open_name(#) == vlink(#+2) {string number of file name to open}
-@d open_area(#) == vinfo(#+3) {string number of file area for |open_name|}
-@d open_ext(#) == vlink(#+3) {string number of file extension for |open_name|}
-
-@ The sixteen possible \.{\\write} streams are represented by the |write_file|
-array. The |j|th file is open if and only if |write_open[j]=true|. The last
-two streams are special; |write_open[16]| represents a stream number
-greater than 15, while |write_open[17]| represents a negative stream number,
-and both of these variables are always |false|.
-
-@<Glob...@>=
-@!write_file:array[0..15] of alpha_file;
-@!write_file_mode:array[0..15] of halfword;
-@!write_file_translation:array[0..15] of halfword;
-@!write_open:array[0..17] of boolean;
-@!neg_wd:scaled;
-@!pos_wd:scaled;
-@!neg_ht:scaled;
-@!dvi_direction:integer;
-@!dir_primary:array[0..31] of 0..31;
-@!dir_secondary:array[0..31] of 0..31;
-@!dir_tertiary:array[0..31] of 0..31;
-@!dir_rearrange:array[0..3] of 0..31;
-@!dir_names:array[0..3] of str_number;
-@!text_dir_ptr:pointer;
-@!text_dir_tmp:pointer;
-
-@
-@<Set init...@>=
-for k:=0 to 17 do write_open[k]:=false;
-pack_direction:=-1;
-for k:= 0 to 7 do begin
- dir_primary [k ]:=dir_T;
- dir_primary [k+ 8]:=dir_L;
- dir_primary [k+16]:=dir_B;
- dir_primary [k+24]:=dir_R;
- end;
-for k:= 0 to 3 do begin
- dir_secondary[k ]:=dir_L;
- dir_secondary[k+ 4]:=dir_R;
- dir_secondary[k+ 8]:=dir_T;
- dir_secondary[k+12]:=dir_B;
-
- dir_secondary[k+16]:=dir_L;
- dir_secondary[k+20]:=dir_R;
- dir_secondary[k+24]:=dir_T;
- dir_secondary[k+28]:=dir_B;
- end;
-for k:=0 to 7 do begin
- dir_tertiary[k*4 ]:=dir_T;
- dir_tertiary[k*4+1]:=dir_L;
- dir_tertiary[k*4+2]:=dir_B;
- dir_tertiary[k*4+3]:=dir_R;
- end;
-dir_rearrange[0]:=0;
-dir_rearrange[1]:=0;
-dir_rearrange[2]:=1;
-dir_rearrange[3]:=1;
-dir_names[0]:="T";
-dir_names[1]:="L";
-dir_names[2]:="B";
-dir_names[3]:="R";
-
-@ Extensions might introduce new command codes; but it's best to use
-|extension| with a modifier, whenever possible, so that |main_control|
-stays the same.
-
-@d immediate_code=4 {command modifier for \.{\\immediate}}
-@d local_par_node==6 {|subtype| in whatsits for local paragraph node}
-{|local_par_node| has to be a macro, not numeric }
-@d dir_node=7 {|subtype| in whatsits for change direction node}
-@d pdftex_first_extension_code = 8
-@d pdf_literal_node == pdftex_first_extension_code + 0
-@d pdf_obj_code == pdftex_first_extension_code + 1
-@d pdf_refobj_node == pdftex_first_extension_code + 2
-@d pdf_xform_code == pdftex_first_extension_code + 3
-@d pdf_refxform_node == pdftex_first_extension_code + 4
-@d pdf_ximage_code == pdftex_first_extension_code + 5
-@d pdf_refximage_node == pdftex_first_extension_code + 6
-@d pdf_annot_node == pdftex_first_extension_code + 7
-@d pdf_start_link_node == pdftex_first_extension_code + 8
-@d pdf_end_link_node == pdftex_first_extension_code + 9
-@d pdf_outline_code == pdftex_first_extension_code + 10
-@d pdf_dest_node == pdftex_first_extension_code + 11
-@d pdf_thread_node == pdftex_first_extension_code + 12
-@d pdf_start_thread_node == pdftex_first_extension_code + 13
-@d pdf_end_thread_node == pdftex_first_extension_code + 14
-@d pdf_save_pos_node == pdftex_first_extension_code + 15
-@d pdf_info_code == pdftex_first_extension_code + 16
-@d pdf_thread_data_node == pdftex_first_extension_code + 16
-@d pdf_catalog_code == pdftex_first_extension_code + 17
-@d pdf_link_data_node == pdftex_first_extension_code + 17
-@d pdf_names_code == pdftex_first_extension_code + 18
-@d pdf_font_attr_code == pdftex_first_extension_code + 19
-@d pdf_include_chars_code == pdftex_first_extension_code + 20
-@d pdf_map_file_code == pdftex_first_extension_code + 21
-@d pdf_map_line_code == pdftex_first_extension_code + 22
-@d pdf_trailer_code == pdftex_first_extension_code + 23
-@d pdf_font_expand_code == pdftex_first_extension_code + 24
-@d set_random_seed_code == pdftex_first_extension_code + 25
-@d pdf_glyph_to_unicode_code == pdftex_first_extension_code + 26
-@d late_lua_node == pdftex_first_extension_code + 27
-@d save_cat_code_table_code == pdftex_first_extension_code + 29
-@d init_cat_code_table_code == pdftex_first_extension_code + 30
-@d pdf_colorstack_node == pdftex_first_extension_code + 31
-@d pdf_setmatrix_node == pdftex_first_extension_code + 32
-@d pdf_save_node == pdftex_first_extension_code + 33
-@d pdf_restore_node == pdftex_first_extension_code + 34
-@d pdftex_last_extension_code == pdftex_first_extension_code + 34
-
-@<Put each...@>=
-primitive_tex("openout",extension,open_node,0);@/
-@!@:open_out_}{\.{\\openout} primitive@>
-primitive_tex("write",extension,write_node,0); write_loc:=cur_val;@/
-@!@:write_}{\.{\\write} primitive@>
-primitive_tex("closeout",extension,close_node,0);@/
-@!@:close_out_}{\.{\\closeout} primitive@>
-primitive_tex("special",extension,special_node,0);@/
-@!@:special_}{\.{\\special} primitive@>
-text(frozen_special):="special"; eqtb[frozen_special]:=eqtb[cur_val];@/
-primitive_tex("immediate",extension,immediate_code,0);@/
-@!@:immediate_}{\.{\\immediate} primitive@>
-primitive_omega("localinterlinepenalty",assign_int,int_base+local_inter_line_penalty_code,int_base);@/
-primitive_omega("localbrokenpenalty",assign_int,int_base+local_broken_penalty_code,int_base);@/
-primitive_omega("pagedir",assign_dir,dir_base+page_direction_code,dir_base);@/
-primitive_omega("bodydir",assign_dir,dir_base+body_direction_code,dir_base);@/
-primitive_omega("pardir",assign_dir,dir_base+par_direction_code,dir_base);@/
-primitive_omega("textdir",assign_dir,dir_base+text_direction_code,dir_base);@/
-primitive_omega("mathdir",assign_dir,dir_base+math_direction_code,dir_base);@/
-primitive_luatex("pageleftoffset",assign_dimen,dimen_base+page_left_offset_code,dimen_base);
-primitive_luatex("pagetopoffset",assign_dimen,dimen_base+page_top_offset_code,dimen_base);
-primitive_aleph("pagerightoffset",assign_dimen,dimen_base+page_right_offset_code,dimen_base);
-primitive_aleph("pagebottomoffset",assign_dimen,dimen_base+page_bottom_offset_code,dimen_base);
-primitive_pdftex("pdfliteral",extension,pdf_literal_node,0);@/
-@!@:pdf_literal_}{\.{\\pdfliteral} primitive@>
-primitive_pdftex("pdfcolorstack",extension,pdf_colorstack_node,0);@/
-@!@:pdf_colorstack_}{\.{\\pdfcolorstack} primitive@>
-primitive_pdftex("pdfsetmatrix",extension,pdf_setmatrix_node,0);@/
-@!@:pdf_setmatrix_}{\.{\\pdfsetmatrix} primitive@>
-primitive_pdftex("pdfsave",extension,pdf_save_node,0);@/
-@!@:pdf_save_}{\.{\\pdfsave} primitive@>
-primitive_pdftex("pdfrestore",extension,pdf_restore_node,0);@/
-@!@:pdf_restore_}{\.{\\pdfrestore} primitive@>
-primitive_pdftex("pdfobj",extension,pdf_obj_code,0);@/
-@!@:pdf_obj_}{\.{\\pdfobj} primitive@>
-primitive_pdftex("pdfrefobj",extension,pdf_refobj_node,0);@/
-@!@:pdf_refobj_}{\.{\\pdfrefobj} primitive@>
-primitive_pdftex("pdfxform",extension,pdf_xform_code,0);@/
-@!@:pdf_xform_}{\.{\\pdfxform} primitive@>
-primitive_pdftex("pdfrefxform",extension,pdf_refxform_node,0);@/
-@!@:pdf_refxform_}{\.{\\pdfrefxform} primitive@>
-primitive_pdftex("pdfximage",extension,pdf_ximage_code,0);@/
-@!@:pdf_ximage_}{\.{\\pdfximage} primitive@>
-primitive_pdftex("pdfrefximage",extension,pdf_refximage_node,0);@/
-@!@:pdf_refximage_}{\.{\\pdfrefximage} primitive@>
-primitive_pdftex("pdfannot",extension,pdf_annot_node,0);@/
-@!@:pdf_annot_}{\.{\\pdfannot} primitive@>
-primitive_pdftex("pdfstartlink",extension,pdf_start_link_node,0);@/
-@!@:pdf_start_link_}{\.{\\pdfstartlink} primitive@>
-primitive_pdftex("pdfendlink",extension,pdf_end_link_node,0);@/
-@!@:pdf_end_link_}{\.{\\pdfendlink} primitive@>
-primitive_pdftex("pdfoutline",extension,pdf_outline_code,0);@/
-@!@:pdf_outline_}{\.{\\pdfoutline} primitive@>
-primitive_pdftex("pdfdest",extension,pdf_dest_node,0);@/
-@!@:pdf_dest_}{\.{\\pdfdest} primitive@>
-primitive_pdftex("pdfthread",extension,pdf_thread_node,0);@/
-@!@:pdf_thread_}{\.{\\pdfthread} primitive@>
-primitive_pdftex("pdfstartthread",extension,pdf_start_thread_node,0);@/
-@!@:pdf_start_thread_}{\.{\\pdfstartthread} primitive@>
-primitive_pdftex("pdfendthread",extension,pdf_end_thread_node,0);@/
-@!@:pdf_end_thread_}{\.{\\pdfendthread} primitive@>
-primitive_pdftex("pdfsavepos",extension,pdf_save_pos_node,0);@/
-@!@:pdf_save_pos_}{\.{\\pdfsavepos} primitive@>
-primitive_pdftex("pdfinfo",extension,pdf_info_code,0);@/
-@!@:pdf_info_}{\.{\\pdfinfo} primitive@>
-primitive_pdftex("pdfcatalog",extension,pdf_catalog_code,0);@/
-@!@:pdf_catalog_}{\.{\\pdfcatalog} primitive@>
-primitive_pdftex("pdfnames",extension,pdf_names_code,0);@/
-@!@:pdf_names_}{\.{\\pdfnames} primitive@>
-primitive_pdftex("pdfincludechars",extension,pdf_include_chars_code,0);@/
-@!@:pdf_include_chars_}{\.{\\pdfincludechars} primitive@>
-primitive_pdftex("pdffontattr",extension,pdf_font_attr_code,0);@/
-@!@:pdf_font_attr_}{\.{\\pdffontattr} primitive@>
-primitive_pdftex("pdfmapfile",extension,pdf_map_file_code,0);@/
-@!@:pdf_map_file_}{\.{\\pdfmapfile} primitive@>
-primitive_pdftex("pdfmapline",extension,pdf_map_line_code,0);@/
-@!@:pdf_map_line_}{\.{\\pdfmapline} primitive@>
-primitive_pdftex("pdftrailer",extension,pdf_trailer_code,0);@/
-@!@:pdf_trailer_}{\.{\\pdftrailer} primitive@>
-primitive_luatex("savecatcodetable",extension,save_cat_code_table_code,0);@/
-@!@:save_cat_code_table_}{\.{\\savecatcodetable} primitive@>
-primitive_luatex("initcatcodetable",extension,init_cat_code_table_code,0);@/
-@!@:init_cat_code_table_}{\.{\\initcatcodetable} primitive@>
-primitive_pdftex("pdfsetrandomseed",extension,set_random_seed_code,0);@/
-@!@:set_random_seed_code}{\.{\\pdfsetrandomseed} primitive@>
-primitive_luatex("latelua",extension,late_lua_node,0);@/
-@!@:late_lua_node_}{\.{\\latelua} primitive@>
-primitive_pdftex("pdffontexpand",extension,pdf_font_expand_code,0);@/
-@!@:pdf_font_expand_}{\.{\\pdffontexpand} primitive@>
-primitive_pdftex("pdfglyphtounicode",extension,pdf_glyph_to_unicode_code,0);@/
-@!@:pdf_glyph_to_unicode_}{\.{\\pdfglyphtounicode} primitive@>
-
-@ The variable |write_loc| just introduced is used to provide an
-appropriate error message in case of ``runaway'' write texts.
-
-@<Glob...@>=
-@!write_loc:pointer; {|eqtb| address of \.{\\write}}
-
-@ 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}
-@!sn:integer; {a potential lua state name}
-begin case cur_chr of
- open_node:@<Implement \.{\\openout}@>;
- write_node:@<Implement \.{\\write}@>;
- close_node:@<Implement \.{\\closeout}@>;
- special_node:@<Implement \.{\\special}@>;
- immediate_code:@<Implement \.{\\immediate}@>;
- pdf_annot_node: @<Implement \.{\\pdfannot}@>;
- pdf_catalog_code: @<Implement \.{\\pdfcatalog}@>;
- pdf_dest_node: @<Implement \.{\\pdfdest}@>;
- pdf_end_link_node: @<Implement \.{\\pdfendlink}@>;
- pdf_end_thread_node: @<Implement \.{\\pdfendthread}@>;
- pdf_font_attr_code: @<Implement \.{\\pdffontattr}@>;
- pdf_font_expand_code: @<Implement \.{\\pdffontexpand}@>;
- pdf_include_chars_code: @<Implement \.{\\pdfincludechars}@>;
- pdf_info_code: @<Implement \.{\\pdfinfo}@>;
- pdf_literal_node: @<Implement \.{\\pdfliteral}@>;
- pdf_colorstack_node: @<Implement \.{\\pdfcolorstack}@>;
- pdf_setmatrix_node: @<Implement \.{\\pdfsetmatrix}@>;
- pdf_save_node: @<Implement \.{\\pdfsave}@>;
- pdf_restore_node: @<Implement \.{\\pdfrestore}@>;
- pdf_map_file_code: @<Implement \.{\\pdfmapfile}@>;
- pdf_map_line_code: @<Implement \.{\\pdfmapline}@>;
- pdf_names_code: @<Implement \.{\\pdfnames}@>;
- pdf_obj_code: @<Implement \.{\\pdfobj}@>;
- pdf_outline_code: @<Implement \.{\\pdfoutline}@>;
- pdf_refobj_node: @<Implement \.{\\pdfrefobj}@>;
- pdf_refxform_node: @<Implement \.{\\pdfrefxform}@>;
- pdf_refximage_node: @<Implement \.{\\pdfrefximage}@>;
- pdf_save_pos_node: @<Implement \.{\\pdfsavepos}@>;
- pdf_start_link_node: @<Implement \.{\\pdfstartlink}@>;
- pdf_start_thread_node: @<Implement \.{\\pdfstartthread}@>;
- pdf_thread_node: @<Implement \.{\\pdfthread}@>;
- pdf_trailer_code: @<Implement \.{\\pdftrailer}@>;
- pdf_xform_code: @<Implement \.{\\pdfxform}@>;
- pdf_ximage_code: @<Implement \.{\\pdfximage}@>;
- save_cat_code_table_code: @<Implement \.{\\savecatcodetable}@>;
- init_cat_code_table_code: @<Implement \.{\\initcatcodetable}@>;
- set_random_seed_code: @<Implement \.{\\pdfsetrandomseed}@>;
- pdf_glyph_to_unicode_code: @<Implement \.{\\pdfglyphtounicode}@>;
- late_lua_node: @<Implement \.{\\latelua}@>;
-othercases confusion("ext1")
-@:this can't happen ext1}{\quad ext1@>
-endcases;
-end;
-
-@ Here is a subroutine that creates a whatsit node having a given |subtype|
-and a given number of words. It initializes only the first word of the whatsit,
-and appends it to the current list.
-
-@<Declare procedures needed in |do_extension|@>=
-procedure new_whatsit(@!s:small_number);
-var p:pointer; {the new node}
-begin p:=new_node(whatsit_node,s);
-vlink(tail):=p; tail:=p;
-end;
-
-@ The next subroutine uses |cur_chr| to decide what sort of whatsit is
-involved, and also inserts a |write_stream| number.
-
-@<Declare procedures needed in |do_ext...@>=
-procedure new_write_whatsit(@!w:small_number);
-begin new_whatsit(cur_chr);
-if w<>write_node_size then scan_four_bit_int
-else begin scan_int;
- if cur_val<0 then cur_val:=17
- else if cur_val>15 then cur_val:=16;
- end;
-write_stream(tail):=cur_val;
-end;
-
-@ @<Implement \.{\\openout}@>=
-begin new_write_whatsit(open_node_size);
-scan_optional_equals; scan_file_name;@/
-open_name(tail):=cur_name; open_area(tail):=cur_area; open_ext(tail):=cur_ext;
-end
-
-@ When `\.{\\write 12\{...\}}' appears, we scan the token list `\.{\{...\}}'
-without expanding its macros; the macros will be expanded later when this
-token list is rescanned.
-
-@<Implement \.{\\write}@>=
-begin k:=cur_cs; new_write_whatsit(write_node_size);@/
-cur_cs:=k; p:=scan_toks(false,false); write_tokens(tail):=def_ref;
-end
-
-@ @<Implement \.{\\closeout}@>=
-begin new_write_whatsit(write_node_size); write_tokens(tail):=null;
-end
-
-@ When `\.{\\special\{...\}}' appears, we expand the macros in the token
-list as in \.{\\xdef} and \.{\\mark}.
-
-@<Implement \.{\\special}@>=
-begin new_whatsit(special_node); write_stream(tail):=null;
-p:=scan_toks(false,true); write_tokens(tail):=def_ref;
-end
-
-@ @<Implement \.{\\pdffontexpand}@>=
- read_expand_font
-
-@ The following macros are needed for further manipulation with whatsit nodes
-for \pdfTeX{} extensions (copying, destroying etc.)
-
-@d add_action_ref(#) == incr(pdf_action_refcount(#)) {increase count of
-references to this action}
-
-@d delete_action_ref(#) == {decrease count of references to this
-action; free it if there is no reference to this action}
-begin
- if pdf_action_refcount(#) = null then begin
- if pdf_action_type(#) = pdf_action_user then
- delete_token_ref(pdf_action_tokens(#))
- else begin
- if pdf_action_file(#) <> null then
- delete_token_ref(pdf_action_file(#));
- if pdf_action_type(#) = pdf_action_page then
- delete_token_ref(pdf_action_tokens(#))
- else if pdf_action_named_id(#) > 0 then
- delete_token_ref(pdf_action_id(#));
- end;
- flush_node(#);
- end
- else
- decr(pdf_action_refcount(#));
-end
-
-@ We have to check whether \.{\\pdfoutput} is set for using \pdfTeX{}
- extensions.
-@<Declare procedures needed in |do_ext...@>=
-procedure check_pdfoutput(s: str_number; is_error : boolean);
-begin
- if pdf_output <= 0 then
- begin
- if is_error then
- pdf_error(s, "not allowed in DVI mode (\pdfoutput <= 0)")
- else
- pdf_warning(s, "not allowed in DVI mode (\pdfoutput <= 0); ignoring it", true,true);
- end
-end;
-
-procedure scan_pdf_ext_toks;
-begin
- call_func(scan_toks(false, true)); {like \.{\\special}}
-end;
-
-@ @<Implement \.{\\pdfliteral}@>=
-begin
- check_pdfoutput("\pdfliteral", true);
- new_whatsit(pdf_literal_node);
- if scan_keyword('direct') then
- pdf_literal_mode(tail) := direct_always
- else if scan_keyword('page') then
- pdf_literal_mode(tail) := direct_page
- else
- pdf_literal_mode(tail) := set_origin;
- scan_pdf_ext_toks;
- pdf_literal_type(tail) := normal;
- pdf_literal_data(tail) := def_ref;
-end
-
-@ @<Implement \.{\\pdfcolorstack}@>=
-begin
- check_pdfoutput("\pdfcolorstack", true);
- {Scan and check the stack number and store in |cur_val|}
- scan_int;
- if cur_val >= colorstackused then begin
- print_err("Unknown color stack number ");
- print_int(cur_val);
-@.Unknown color stack@>
- help3("Allocate and initialize a color stack with \\pdfcolorstackinit.")@/
- ("I'll use default color stack 0 here.")@/
- ("Proceed, with fingers crossed.");
- error;
- cur_val := 0;
- end;
- if cur_val < 0 then begin
- print_err("Invalid negative color stack number");
-@.Invalid negative color stack number@>
- help2("I'll use default color stack 0 here.")@/
- ("Proceed, with fingers crossed.");
- error;
- cur_val := 0;
- end;
- if scan_keyword('set') then begin
- i := colorstack_set;
- end
- else if scan_keyword('push') then begin
- i := colorstack_push;
- end
- else if scan_keyword('pop') then begin
- i := colorstack_pop;
- end
- else if scan_keyword('current') then begin
- i := colorstack_current;
- end
- else begin
- i := -1; {error}
- end;
- if i >= 0 then begin
- new_whatsit(pdf_colorstack_node);
- pdf_colorstack_stack(tail) := cur_val;
- pdf_colorstack_cmd(tail) := i;
- pdf_colorstack_data(tail) := null;
- if i <= colorstack_data then begin
- scan_pdf_ext_toks;
- pdf_colorstack_data(tail) := def_ref;
- end;
- end
- else begin
- print_err("Color stack action is missing");
-@.Color stack action is missing@>
- help3("The expected actions for \pdfcolorstack:")@/
- (" set, push, pop, current")@/
- ("I'll ignore the color stack command.");
- error;
- end
-end
-
-@ @<Implement \.{\\pdfsetmatrix}@>=
-begin
- check_pdfoutput("\pdfsetmatrix", true);
- new_whatsit(pdf_setmatrix_node);
- scan_pdf_ext_toks;
- pdf_setmatrix_data(tail) := def_ref;
-end
-
-@ @<Implement \.{\\pdfsave}@>=
-begin
- check_pdfoutput("\pdfsave", true);
- new_whatsit(pdf_save_node);
-end
-
-@ @<Implement \.{\\pdfrestore}@>=
-begin
- check_pdfoutput("\pdfrestore", true);
- new_whatsit(pdf_restore_node);
-end
-
-
-@ @<Implement \.{\\latelua}@>=
-begin
- check_pdfoutput("\latelua", true);
- new_whatsit(late_lua_node);
- if scan_keyword('name') then begin
- scan_pdf_ext_toks;
- late_lua_name(tail) := def_ref;
- end;
- sn:=0;
- @<Parse optional lua state...@>;
- if sn then late_lua_name(tail) := sn;
- call_func(scan_toks(false, false));
- late_lua_data(tail) := def_ref;
-end
-
-@ The \.{\\pdfobj} primitive is used to create a ``raw'' object in the PDF
- output file. The object contents will be hold in memory and will be written
- out only when the object is referenced by \.{\\pdfrefobj}. When \.{\\pdfobj}
- is used with \.{\\immediate}, the object contents will be written out
- immediately. Objects referenced in the current page are appended into
- |pdf_obj_list|.
-
-@<Glob...@>=
-@!pdf_last_obj: integer;
-
-@ @<Implement \.{\\pdfobj}@>=
-begin
- check_pdfoutput("\pdfobj", true);
- if scan_keyword('reserveobjnum') then begin
- @<Scan an optional space@>;
- incr(pdf_obj_count);
- pdf_create_obj(obj_type_obj, pdf_obj_count);
- pdf_last_obj := obj_ptr;
- end
- else begin
- k := -1;
- if scan_keyword('useobjnum') then begin
- scan_int;
- k := cur_val;
- if (k <= 0) or (k > obj_ptr) or (obj_data_ptr(k) <> 0) then begin
- pdf_warning("\pdfobj", "invalid object number being ignored", true, true);
- pdf_retval := -1; {signal the problem}
- k := -1; {will be generated again}
- end;
- end;
- if k < 0 then begin
- incr(pdf_obj_count);
- pdf_create_obj(obj_type_obj, pdf_obj_count);
- k := obj_ptr;
- end;
- obj_data_ptr(k) := pdf_get_mem(pdfmem_obj_size);
- if scan_keyword('stream') then begin
- obj_obj_is_stream(k) := 1;
- if scan_keyword('attr') then begin
- scan_pdf_ext_toks;
- obj_obj_stream_attr(k) := def_ref;
- end
- else
- obj_obj_stream_attr(k) := null;
- end
- else
- obj_obj_is_stream(k) := 0;
- if scan_keyword('file') then
- obj_obj_is_file(k) := 1
- else
- obj_obj_is_file(k) := 0;
- scan_pdf_ext_toks;
- obj_obj_data(k) := def_ref;
- pdf_last_obj := k;
- end;
-end
-
-@ We need to check whether the referenced object exists.
-
-@<Declare procedures that need to be declared forward for \pdfTeX@>=
-function prev_rightmost(s, e: pointer): pointer;
-{finds the node preceding the rightmost node |e|; |s| is some node
-before |e|}
-var p: pointer;
-begin
- prev_rightmost := null;
- p := s;
- if p = null then
- return;
- while vlink(p) <> e do begin
- p := vlink(p);
- if p = null then
- return;
- end;
- prev_rightmost := p;
-end;
-
-procedure pdf_check_obj(t, n: integer);
-var k: integer;
-begin
- k := head_tab[t];
- while (k <> 0) and (k <> n) do
- k := obj_link(k);
- if k = 0 then
- pdf_error("ext1", "cannot find referenced object");
-end;
-
-@ @<Implement \.{\\pdfrefobj}@>=
-begin
- check_pdfoutput("\pdfrefobj", true);
- scan_int;
- pdf_check_obj(obj_type_obj, cur_val);
- new_whatsit(pdf_refobj_node);
- pdf_obj_objnum(tail) := cur_val;
-end
-
-@ \.{\\pdfxform} and \.{\\pdfrefxform} are similiar to \.{\\pdfobj} and
- \.{\\pdfrefobj}
-
-@<Glob...@>=
-@!pdf_last_xform: integer;
-
-@ @<Implement \.{\\pdfxform}@>=
-begin
- check_pdfoutput("\pdfxform", true);
- incr(pdf_xform_count);
- pdf_create_obj(obj_type_xform, pdf_xform_count);
- k := obj_ptr;
- obj_data_ptr(k) := pdf_get_mem(pdfmem_xform_size);
- if scan_keyword('attr') then begin
- scan_pdf_ext_toks;
- obj_xform_attr(k) := def_ref;
- end
- else
- obj_xform_attr(k) := null;
- if scan_keyword('resources') then begin
- scan_pdf_ext_toks;
- obj_xform_resources(k) := def_ref;
- end
- else
- obj_xform_resources(k) := null;
- scan_int;
- p:=box(cur_val);
- if p = null then
- pdf_error("ext1", "\pdfxform cannot be used with a void box");
- obj_xform_width(k) := width(p);
- obj_xform_height(k) := height(p);
- obj_xform_depth(k) := depth(p);
- obj_xform_box(k) := p; {save pointer to the box}
- box(cur_val):=null;
- pdf_last_xform := k;
-end
-
-@ @<Implement \.{\\pdfrefxform}@>=
-begin
- check_pdfoutput("\pdfrefxform", true);
- scan_int;
- pdf_check_obj(obj_type_xform, cur_val);
- new_whatsit(pdf_refxform_node);
- pdf_xform_objnum(tail) := cur_val;
- pdf_width(tail) := obj_xform_width(cur_val);
- pdf_height(tail) := obj_xform_height(cur_val);
- pdf_depth(tail) := obj_xform_depth(cur_val);
-end
-
-@ \.{\\pdfximage} and \.{\\pdfrefximage} are similiar to \.{\\pdfxform} and
- \.{\\pdfrefxform}. As we have to scan |<rule spec>| quite often, it is better
- have a |rule_node| that holds the most recently scanned |<rule spec>|.
-
-@<Glob...@>=
-@!pdf_last_ximage: integer;
-@!pdf_last_ximage_pages: integer;
-@!pdf_last_ximage_colordepth: integer;
-@!alt_rule: pointer;
-@!warn_pdfpagebox: boolean;
-
-@ @<Set init...@>=
-alt_rule := null;
-warn_pdfpagebox := true;
-
-@ @<Declare procedures needed in |do_ext...@>=
-
-function scan_pdf_box_spec: integer; {scans PDF pagebox specification}
-begin
- scan_pdf_box_spec := 0;
- if scan_keyword('mediabox') then
- scan_pdf_box_spec := pdf_box_spec_media
- else if scan_keyword('cropbox') then
- scan_pdf_box_spec := pdf_box_spec_crop
- else if scan_keyword('bleedbox') then
- scan_pdf_box_spec := pdf_box_spec_bleed
- else if scan_keyword('trimbox') then
- scan_pdf_box_spec := pdf_box_spec_trim
- else if scan_keyword('artbox') then
- scan_pdf_box_spec := pdf_box_spec_art
-end;
-
-procedure scan_alt_rule; {scans rule spec to |alt_rule|}
-label reswitch;
-begin
- if alt_rule = null then
- alt_rule := new_rule;
- width(alt_rule) := null_flag;
- height(alt_rule) := null_flag;
- depth(alt_rule) := null_flag;
-reswitch:
- if scan_keyword('width') then begin
- scan_normal_dimen;
- width(alt_rule) := cur_val;
- goto reswitch;
- end;
- if scan_keyword('height') then begin
- scan_normal_dimen;
- height(alt_rule) := cur_val;
- goto reswitch;
- end;
- if scan_keyword('depth') then begin
- scan_normal_dimen;
- depth(alt_rule) := cur_val;
- goto reswitch;
- end;
-end;
-
-procedure scan_image;
-label reswitch;
-var k, img_wd, img_ht, img_dp, ref: integer;
- named, attr: str_number;
- s: str_number;
- page, pagebox, colorspace: integer;
-begin
- incr(pdf_ximage_count);
- pdf_create_obj(obj_type_ximage, pdf_ximage_count);
- k := obj_ptr;
- scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
- img_wd := width(alt_rule);
- img_ht := height(alt_rule);
- img_dp := depth(alt_rule);
- attr := 0;
- named := 0;
- page := 1;
- colorspace := 0;
- if scan_keyword('attr') then begin
- scan_pdf_ext_toks;
- attr := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- end;
- if scan_keyword('named') then begin
- scan_pdf_ext_toks;
- named := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- page := 0;
- end
- else if scan_keyword('page') then begin
- scan_int;
- page := cur_val;
- end;
- if scan_keyword('colorspace') then begin
- scan_int;
- colorspace := cur_val;
- end;
- pagebox := scan_pdf_box_spec;
- if pagebox = 0 then
- pagebox := pdf_pagebox;
- scan_pdf_ext_toks;
- s := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- if pdf_option_always_use_pdfpagebox <> 0 then begin
- pdf_warning("PDF inclusion", "Primitive \pdfoptionalwaysusepdfpagebox is obsolete; use \pdfpagebox instead.", true, true);
- pdf_force_pagebox := pdf_option_always_use_pdfpagebox;
- pdf_option_always_use_pdfpagebox := 0; {warn once}
- warn_pdfpagebox := false;
- end;
- if pdf_option_pdf_inclusion_errorlevel <> 0 then begin
- pdf_warning("PDF inclusion", "Primitive \pdfoptionpdfinclusionerrorlevel is obsolete; use \pdfinclusionerrorlevel instead.", true, true);
- pdf_inclusion_errorlevel := pdf_option_pdf_inclusion_errorlevel;
- pdf_option_pdf_inclusion_errorlevel := 0; {warn once}
- end;
- if pdf_force_pagebox > 0 then begin
- if warn_pdfpagebox then begin
- pdf_warning("PDF inclusion", "Primitive \pdfforcepagebox is obsolete; use \pdfpagebox instead.", true, true);
- warn_pdfpagebox := false;
- end;
- pagebox := pdf_force_pagebox;
- end;
- if pagebox = 0 then {no pagebox specification given}
- pagebox := pdf_box_spec_crop;
- ref := read_image(k, pdf_ximage_count, s, page, named, attr, colorspace, pagebox,
- pdf_minor_version, pdf_inclusion_errorlevel);
- flush_str(s);
- obj_data_ptr(k) := ref;
- if named <> 0 then flush_str(named);
- set_image_dimensions(ref, img_wd, img_ht, img_dp);
- if attr <> 0 then flush_str(attr);
- scale_image(ref);
- pdf_last_ximage := k;
- pdf_last_ximage_pages := image_pages(ref);
- pdf_last_ximage_colordepth := image_colordepth(ref);
-end;
-
-@ @<Implement \.{\\pdfximage}@>=
-begin
- check_pdfoutput("\pdfximage", true);
- check_pdfminorversion;
- scan_image;
-end
-
-@ @<Implement \.{\\pdfrefximage}@>=
-begin
- check_pdfoutput("\pdfrefximage", true);
- scan_int;
- pdf_check_obj(obj_type_ximage, cur_val);
- new_whatsit(pdf_refximage_node);
- j := obj_data_ptr(cur_val);
- pdf_ximage_idx(tail) := j;
- pdf_width(tail) := image_width(j);
- pdf_height(tail) := image_height(j);
- pdf_depth(tail) := image_depth(j);
-end
-
-@ The following function finds object with identifier |i| and type |t|.
- |i < 0| indicates that |-i| should be treated as a string number. If no
- such object exists then it will be created. This function is used mainly to
- find destination for link annotations and outlines; however it is also used
- in |pdf_ship_out| (to check whether a Page object already exists) so we need
- to declare it together with subroutines needed in |pdf_hlist_out| and
- |pdf_vlist_out|.
-
-@<Declare procedures that need to be declared forward for \pdfTeX@>=
-function find_obj(t, i: integer; byname: boolean): integer;
-begin
- find_obj := avl_find_obj(t, i, byname);
-end;
-
-procedure flush_str(s: str_number); {flush a string if possible}
-begin
- if flushable(s) then
- flush_string;
-end;
-
-function get_obj(t, i: integer; byname: boolean): integer;
-var r: integer;
- s: str_number;
-begin
- if byname > 0 then begin
- s := tokens_to_string(i);
- r := find_obj(t, s, true);
- end
- else begin
- s := 0;
- r := find_obj(t, i, false);
- end;
- if r = 0 then begin
- if byname > 0 then begin
- pdf_create_obj(t, -s);
- s := 0;
- end
- else
- pdf_create_obj(t, i);
- r := obj_ptr;
- if t = obj_type_dest then
- obj_dest_ptr(r) := null;
- end;
- if s <> 0 then
- flush_str(s);
- get_obj := r;
-end;
-
-function get_microinterval:integer;
-var s,@!m:integer; {seconds and microseconds}
-begin
- seconds_and_micros(s,m);
- if (s-epochseconds)>32767 then
- get_microinterval := max_integer
- else if (microseconds>m) then
- get_microinterval := ((s-1-epochseconds)*65536)+ (((m+1000000-microseconds)/100)*65536)/10000
- else
- get_microinterval := ((s-epochseconds)*65536) + (((m-microseconds)/100)*65536)/10000;
-end;
-
-
-@ @<Declare procedures needed in |do_ext...@>=
-function scan_action: pointer; {read an action specification}
-var p: integer;
-begin
- p := new_node(action_node,0);
- scan_action := p;
- if scan_keyword('user') then
- pdf_action_type(p) := pdf_action_user
- else if scan_keyword('goto') then
- pdf_action_type(p) := pdf_action_goto
- else if scan_keyword('thread') then
- pdf_action_type(p) := pdf_action_thread
- else
- pdf_error("ext1", "action type missing");
- if pdf_action_type(p) = pdf_action_user then begin
- scan_pdf_ext_toks;
- pdf_action_tokens(p) := def_ref;
- return;
- end;
- if scan_keyword('file') then begin
- scan_pdf_ext_toks;
- pdf_action_file(p) := def_ref;
- end;
- if scan_keyword('page') then begin
- if pdf_action_type(p) <> pdf_action_goto then
- pdf_error("ext1", "only GoTo action can be used with `page'");
- pdf_action_type(p) := pdf_action_page;
- scan_int;
- if cur_val <= 0 then
- pdf_error("ext1", "page number must be positive");
- pdf_action_id(p) := cur_val;
- pdf_action_named_id(p) := 0;
- scan_pdf_ext_toks;
- pdf_action_tokens(p) := def_ref;
- end
- else if scan_keyword('name') then begin
- scan_pdf_ext_toks;
- pdf_action_named_id(p) := 1;
- pdf_action_id(p) := def_ref;
- end
- else if scan_keyword('num') then begin
- if (pdf_action_type(p) = pdf_action_goto) and
- (pdf_action_file(p) <> null) then
- pdf_error("ext1",
- "`goto' option cannot be used with both `file' and `num'");
- scan_int;
- if cur_val <= 0 then
- pdf_error("ext1", "num identifier must be positive");
- pdf_action_named_id(p) := 0;
- pdf_action_id(p) := cur_val;
- end
- else
- pdf_error("ext1", "identifier type missing");
- if scan_keyword('newwindow') then begin
- pdf_action_new_window(p) := 1;
- @<Scan an optional space@>; end
- else if scan_keyword('nonewwindow') then begin
- pdf_action_new_window(p) := 2;
- @<Scan an optional space@>; end
- else
- pdf_action_new_window(p) := 0;
- if (pdf_action_new_window(p) > 0) and
- (((pdf_action_type(p) <> pdf_action_goto) and
- (pdf_action_type(p) <> pdf_action_page)) or
- (pdf_action_file(p) = null)) then
- pdf_error("ext1",
- "`newwindow'/`nonewwindow' must be used with `goto' and `file' option");
-end;
-
-procedure new_annot_whatsit(w: small_number); {create a new whatsit node for
-annotation}
-begin
- new_whatsit(w);
- scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
- pdf_width(tail) := width(alt_rule);
- pdf_height(tail) := height(alt_rule);
- pdf_depth(tail) := depth(alt_rule);
- if (w = pdf_thread_node) or (w = pdf_start_thread_node) then begin
- if scan_keyword('attr') then begin
- scan_pdf_ext_toks;
- pdf_thread_attr(tail) := def_ref;
- end
- else
- pdf_thread_attr(tail) := null;
- end;
-end;
-
-@ @<Glob...@>=
-@!pdf_last_annot: integer;
-
-@ @<Implement \.{\\pdfannot}@>=
-begin
- check_pdfoutput("\pdfannot", true);
- if scan_keyword('reserveobjnum') then begin
- pdf_last_annot := pdf_new_objnum;
- @<Scan an optional space@>; end
- else begin
- if scan_keyword('useobjnum') then begin
- scan_int;
- k := cur_val;
- if (k <= 0) or (k > obj_ptr) or (obj_annot_ptr(k) <> 0) then
- pdf_error("ext1", "invalid object number");
- end
- else
- k := pdf_new_objnum;
- new_annot_whatsit(pdf_annot_node);
- pdf_annot_objnum(tail) := k;
- scan_pdf_ext_toks;
- pdf_annot_data(tail) := def_ref;
- pdf_last_annot := k;
- end
-end
-
-@ pdflastlink needs an extra global variable
-@<Glob...@>=
-@!pdf_last_link: integer;
-
-@ @<Implement \.{\\pdfstartlink}@>=
-begin
- check_pdfoutput("\pdfstartlink", true);
- if abs(mode) = vmode then
- pdf_error("ext1", "\pdfstartlink cannot be used in vertical mode");
- k := pdf_new_objnum;
- new_annot_whatsit(pdf_start_link_node);
- pdf_link_attr(tail) := null;
- if scan_keyword('attr') then begin
- scan_pdf_ext_toks;
- pdf_link_attr(tail) := def_ref;
- end;
- r := scan_action; pdf_link_action(tail) := r;
- pdf_link_objnum(tail) := k;
- pdf_last_link := k;
- {N.B.: although it is possible to set |obj_annot_ptr(k) := tail| here, it
- is not safe if nodes are later copied/destroyed/moved; a better place
- to do this is inside |do_link|, when the whatsit node is written out}
-end
-
-@ @<Implement \.{\\pdfendlink}@>=
-begin
- check_pdfoutput("\pdfendlink", true);
- if abs(mode) = vmode then
- pdf_error("ext1", "\pdfendlink cannot be used in vertical mode");
- new_whatsit(pdf_end_link_node);
-end
-
-@ @<Declare procedures needed in |do_ext...@>=
-function outline_list_count(p: pointer): integer; {return number of outline
-entries in the same level with |p|}
-var k: integer;
-begin
- k := 1;
- while obj_outline_prev(p) <> 0 do begin
- incr(k);
- p := obj_outline_prev(p);
- end;
- outline_list_count := k;
-end;
-
-@ @<Implement \.{\\pdfoutline}@>=
-begin
- check_pdfoutput("\pdfoutline", true);
- if scan_keyword('attr') then begin
- scan_pdf_ext_toks;
- r := def_ref;
- end
- else
- r := 0;
- p := scan_action;
- if scan_keyword('count') then begin
- scan_int;
- i := cur_val;
- end
- else
- i := 0;
- scan_pdf_ext_toks;
- q := def_ref;
- pdf_new_obj(obj_type_others, 0, 1);
- j := obj_ptr;
- write_action(p);
- pdf_end_obj;
- delete_action_ref(p);
- pdf_create_obj(obj_type_outline, 0);
- k := obj_ptr;
- obj_outline_ptr(k) := pdf_get_mem(pdfmem_outline_size);
- obj_outline_action_objnum(k) := j;
- obj_outline_count(k) := i;
- pdf_new_obj(obj_type_others, 0, 1);
- pdf_print_str_ln(tokens_to_string(q));
- flush_str(last_tokens_string);
- delete_token_ref(q);
- pdf_end_obj;
- obj_outline_title(k) := obj_ptr;
- obj_outline_prev(k) := 0;
- obj_outline_next(k) := 0;
- obj_outline_first(k) := 0;
- obj_outline_last(k) := 0;
- obj_outline_parent(k) := pdf_parent_outline;
- obj_outline_attr(k) := r;
- if pdf_first_outline = 0 then
- pdf_first_outline := k;
- if pdf_last_outline = 0 then begin
- if pdf_parent_outline <> 0 then
- obj_outline_first(pdf_parent_outline) := k;
- end
- else begin
- obj_outline_next(pdf_last_outline) := k;
- obj_outline_prev(k) := pdf_last_outline;
- end;
- pdf_last_outline := k;
- if obj_outline_count(k) <> 0 then begin
- pdf_parent_outline := k;
- pdf_last_outline := 0;
- end
- else if (pdf_parent_outline <> 0) and
- (outline_list_count(k) = abs(obj_outline_count(pdf_parent_outline))) then
- begin
- j := pdf_last_outline;
- repeat
- obj_outline_last(pdf_parent_outline) := j;
- j := pdf_parent_outline;
- pdf_parent_outline := obj_outline_parent(pdf_parent_outline);
- until (pdf_parent_outline = 0) or
- (outline_list_count(j) < abs(obj_outline_count(pdf_parent_outline)));
- if pdf_parent_outline = 0 then
- pdf_last_outline := pdf_first_outline
- else
- pdf_last_outline := obj_outline_first(pdf_parent_outline);
- while obj_outline_next(pdf_last_outline) <> 0 do
- pdf_last_outline := obj_outline_next(pdf_last_outline);
- end;
-end
-
-@ When a destination is created we need to check whether another destination
-with the same identifier already exists and give a warning if needed.
-
-@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure warn_dest_dup(id: integer; byname: small_number; s1, s2: str_number);
-begin
- pdf_warning(s1, "destination with the same identifier (", false, false);
- if byname > 0 then begin
- print("name");
- print_mark(id);
- end
- else begin
- print("num");
- print_int(id);
- end;
- print(") ");
- print(s2);
- print_ln;
- show_context;
-end;
-
-@ Notice that |scan_keyword| doesn't care if two words have same prefix; so
-we should be careful when scan keywords with same prefix. The main rule: if
-there are two or more keywords with the same prefix, then always test in
-order from the longest one to the shortest one.
-
-@<Implement \.{\\pdfdest}@>=
-begin
- check_pdfoutput("\pdfdest", true);
- q := tail;
- new_whatsit(pdf_dest_node);
- if scan_keyword('num') then begin
- scan_int;
- if cur_val <= 0 then
- pdf_error("ext1", "num identifier must be positive");
- if cur_val > max_halfword then
- pdf_error("ext1", "number too big");
- pdf_dest_id(tail) := cur_val;
- pdf_dest_named_id(tail) := 0;
- end
- else if scan_keyword('name') then begin
- scan_pdf_ext_toks;
- pdf_dest_id(tail) := def_ref;
- pdf_dest_named_id(tail) := 1;
- end
- else
- pdf_error("ext1", "identifier type missing");
- if scan_keyword('xyz') then begin
- pdf_dest_type(tail) := pdf_dest_xyz;
- if scan_keyword('zoom') then begin
- scan_int;
- if cur_val > max_halfword then
- pdf_error("ext1", "number too big");
- pdf_dest_xyz_zoom(tail) := cur_val;
- end
- else
- pdf_dest_xyz_zoom(tail) := null;
- end
- else if scan_keyword('fitbh') then
- pdf_dest_type(tail) := pdf_dest_fitbh
- else if scan_keyword('fitbv') then
- pdf_dest_type(tail) := pdf_dest_fitbv
- else if scan_keyword('fitb') then
- pdf_dest_type(tail) := pdf_dest_fitb
- else if scan_keyword('fith') then
- pdf_dest_type(tail) := pdf_dest_fith
- else if scan_keyword('fitv') then
- pdf_dest_type(tail) := pdf_dest_fitv
- else if scan_keyword('fitr') then
- pdf_dest_type(tail) := pdf_dest_fitr
- else if scan_keyword('fit') then
- pdf_dest_type(tail) := pdf_dest_fit
- else
- pdf_error("ext1", "destination type missing");
- @<Scan an optional space@>;
- if pdf_dest_type(tail) = pdf_dest_fitr then begin
- scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
- pdf_width(tail) := width(alt_rule);
- pdf_height(tail) := height(alt_rule);
- pdf_depth(tail) := depth(alt_rule);
- end;
- if pdf_dest_named_id(tail) <> 0 then begin
- i := tokens_to_string(pdf_dest_id(tail));
- k := find_obj(obj_type_dest, i, true);
- flush_str(i);
- end
- else
- k := find_obj(obj_type_dest, pdf_dest_id(tail), false);
- if (k <> 0) and (obj_dest_ptr(k) <> null) then begin
- warn_dest_dup(pdf_dest_id(tail), pdf_dest_named_id(tail),
- "ext4", "has been already used, duplicate ignored");
- flush_node_list(tail);
- tail := q;
- vlink(q) := null;
- end;
-end
-
-@ @<Declare procedures needed in |do_ext...@>=
-procedure scan_thread_id;
-begin
- if scan_keyword('num') then begin
- scan_int;
- if cur_val <= 0 then
- pdf_error("ext1", "num identifier must be positive");
- if cur_val > max_halfword then
- pdf_error("ext1", "number too big");
- pdf_thread_id(tail) := cur_val;
- pdf_thread_named_id(tail) := 0;
- end
- else if scan_keyword('name') then begin
- scan_pdf_ext_toks;
- pdf_thread_id(tail) := def_ref;
- pdf_thread_named_id(tail) := 1;
- end
- else
- pdf_error("ext1", "identifier type missing");
-end;
-
-@ @<Implement \.{\\pdfthread}@>=
-begin
- check_pdfoutput("\pdfthread", true);
- new_annot_whatsit(pdf_thread_node);
- scan_thread_id;
-end
-
-@ @<Implement \.{\\pdfstartthread}@>=
-begin
- check_pdfoutput("\pdfstartthread", true);
- new_annot_whatsit(pdf_start_thread_node);
- scan_thread_id;
-end
-
-@ @<Implement \.{\\pdfendthread}@>=
-begin
- check_pdfoutput("\pdfendthread", true);
- new_whatsit(pdf_end_thread_node);
-end
-
-@ @<Glob...@>=
-@!pdf_last_x_pos: integer;
-@!pdf_last_y_pos: integer;
-
-@ @<Implement \.{\\pdfsavepos}@>=
-begin
- new_whatsit(pdf_save_pos_node);
-end
-
-@ To implement primitives as \.{\\pdfinfo}, \.{\\pdfcatalog} or
-\.{\\pdfnames} we need to concatenate tokens lists.
-
-@<Declare procedures needed in |do_ext...@>=
-function concat_tokens(q, r: pointer): pointer; {concat |q| and |r| and
-returns the result tokens list}
-var p: pointer;
-begin
- if q = null then begin
- concat_tokens := r;
- return;
- end;
- p := q;
- while link(p) <> null do
- p := link(p);
- link(p) := link(r);
- free_avail(r);
- concat_tokens := q;
-end;
-
-@ @<Implement \.{\\pdfinfo}@>=
-begin
- check_pdfoutput("\pdfinfo", false);
- scan_pdf_ext_toks;
- if pdf_output > 0 then
- pdf_info_toks := concat_tokens(pdf_info_toks, def_ref);
-end
-
-@ @<Implement \.{\\pdfcatalog}@>=
-begin
- check_pdfoutput("\pdfcatalog", false);
- scan_pdf_ext_toks;
- if pdf_output > 0 then
- pdf_catalog_toks := concat_tokens(pdf_catalog_toks, def_ref);
- if scan_keyword('openaction') then begin
- if pdf_catalog_openaction <> 0 then
- pdf_error("ext1", "duplicate of openaction")
- else begin
- p := scan_action;
- pdf_new_obj(obj_type_others, 0, 1);
- if pdf_output > 0 then
- pdf_catalog_openaction := obj_ptr;
- write_action(p);
- pdf_end_obj;
- delete_action_ref(p);
- end;
- end
-end
-
-@ @<Implement \.{\\pdfnames}@>=
-begin
- check_pdfoutput("\pdfnames", true);
- scan_pdf_ext_toks;
- pdf_names_toks := concat_tokens(pdf_names_toks, def_ref);
-end
-
-@ @<Implement \.{\\pdftrailer}@>=
-begin
- check_pdfoutput("\pdftrailer", false);
- scan_pdf_ext_toks;
- if pdf_output > 0 then
- pdf_trailer_toks := concat_tokens(pdf_trailer_toks, def_ref);
-end
-
-@ @<Glob...@>=
-@!pdf_retval: integer; {global multi-purpose return value}
-
-@ @<Set initial values of key variables@>=
- seconds_and_micros(epochseconds,microseconds);
- init_start_time;
-
-@ Negative random seed values are silently converted to positive ones
-
-@<Implement \.{\\pdfsetrandomseed}@>=
-begin
- scan_int;
- if cur_val<0 then negate(cur_val);
- random_seed := cur_val;
- init_randoms(random_seed);
-end
-
-@ @<Implement \.{\\savecatcodetable}@>=
-begin
- scan_int;
- if (cur_val<0)or(cur_val>@"FFFF) then begin
- print_err("Invalid \catcode table");
- help1("All \catcode table ids must be between 0 and 0xFFFF");
- error;
- end
- else begin if cur_val=cat_code_table then begin
- print_err("Invalid \catcode table");
- help1("You cannot overwrite the current \catcode table");
- error;
- end
- else
- copy_cat_codes(cat_code_table,cur_val);
- end;
-end
-
-@ @<Implement \.{\\initcatcodetable}@>=
-begin
- scan_int;
- if (cur_val<0)or(cur_val>@"FFFF) then begin
- print_err("Invalid \catcode table");
- help1("All \catcode table ids must be between 0 and 0xFFFF");
- error;
- end
- else begin if cur_val=cat_code_table then begin
- print_err("Invalid \catcode table");
- help1("You cannot overwrite the current \catcode table");
- error;
- end
- else
- initex_cat_codes(cur_val);
- end;
-end
-
-@ The following subroutines are about PDF-specific font issues.
-
-@<Declare procedures needed in |do_ext...@>=
-procedure pdf_include_chars;
-var s: str_number;
- k: pool_pointer; {running indices}
- f: internal_font_number;
-begin
- scan_font_ident;
- f := cur_val;
- if f = null_font then
- pdf_error("font", "invalid font identifier");
- pdf_check_vf_cur_val;
- if not font_used(f) then
- pdf_init_font(f);
- scan_pdf_ext_toks;
- s := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- k := str_start_macro(s);
- while k < str_start_macro(s + 1) do begin
- pdf_mark_char(f, str_pool[k]);
- incr(k);
- end;
- flush_str(s);
-end;
-
-procedure glyph_to_unicode;
-var s1, s2: str_number;
-begin
- scan_pdf_ext_toks;
- s1 := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- scan_pdf_ext_toks;
- s2 := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- def_tounicode(s1, s2);
- flush_str(s2);
- flush_str(s1);
-end;
-
-@ @<Implement \.{\\pdfincludechars}@>=
-begin
- check_pdfoutput("\pdfincludechars", true);
- pdf_include_chars;
-end
-
-@ @<Implement \.{\\pdfglyphtounicode}@>=
-begin
- glyph_to_unicode;
-end
-
-@ A change from \THANH's original code: the font attributes are simply
-initialized to zero now, this is easier to deal with from C than an
-empty \TeX{} string, and surely nobody will want to set
-\.{\\pdffontattr} to a string containing a single zero, as that
-would be nonsensical in the PDF output.
-
-@<Implement \.{\\pdffontattr}@>=
-begin
- check_pdfoutput("\pdffontattr", true);
- scan_font_ident;
- k := cur_val;
- if k = null_font then
- pdf_error("font", "invalid font identifier");
- scan_pdf_ext_toks;
- set_pdf_font_attr(k, tokens_to_string(def_ref));
- if length(pdf_font_attr(k)) = 0 then begin
- flush_string;
- set_pdf_font_attr(k,0);
- end;
-end
-
-@ @<Implement \.{\\pdfmapfile}@>=
-begin
- check_pdfoutput("\pdfmapfile", true);
- scan_pdf_ext_toks;
- pdfmapfile(def_ref);
- delete_token_ref(def_ref);
-end
-
-@ @<Implement \.{\\pdfmapline}@>=
-begin
- check_pdfoutput("\pdfmapline", true);
- scan_pdf_ext_toks;
- pdfmapline(def_ref);
- delete_token_ref(def_ref);
-end
-
-@ The following function are needed for outputing article thread.
-
-@<Declare procedures needed in |do_ext...@>=
-procedure thread_title(thread: integer);
-begin
- pdf_print("/Title (");
- if obj_info(thread) < 0 then
- pdf_print(-obj_info(thread))
- else
- pdf_print_int(obj_info(thread));
- pdf_print_ln(")");
-end;
-
-procedure pdf_fix_thread(thread: integer);
-var a: pointer;
-begin
- pdf_warning("thread", "destination ", false, false);
- if obj_info(thread) < 0 then begin
- print("name{");
- print(-obj_info(thread));
- print("}");
- end
- else begin
- print("num");
- print_int(obj_info(thread));
- end;
- print(" has been referenced but does not exist, replaced by a fixed one");
- print_ln; print_ln;
- pdf_new_dict(obj_type_others, 0, 0);
- a := obj_ptr;
- pdf_indirect_ln("T", thread);
- pdf_indirect_ln("V", a);
- pdf_indirect_ln("N", a);
- pdf_indirect_ln("P", head_tab[obj_type_page]);
- pdf_print("/R [0 0 ");
- pdf_print_bp(page_width); pdf_out(" ");
- pdf_print_bp(page_height);
- pdf_print_ln("]");
- pdf_end_dict;
- pdf_begin_dict(thread, 1);
- pdf_print_ln("/I << ");
- thread_title(thread);
- pdf_print_ln(">>");
- pdf_indirect_ln("F", a);
- pdf_end_dict;
-end;
-
-procedure out_thread(thread: integer);
-var a, b: pointer;
- last_attr: integer;
-begin
- if obj_thread_first(thread) = 0 then begin
- pdf_fix_thread(thread);
- return;
- end;
- pdf_begin_dict(thread, 1);
- a := obj_thread_first(thread);
- b := a;
- last_attr := 0;
- repeat
- if obj_bead_attr(a) <> 0 then
- last_attr := obj_bead_attr(a);
- a := obj_bead_next(a);
- until a = b;
- if last_attr <> 0 then
- pdf_print_ln(last_attr)
- else begin
- pdf_print_ln("/I << ");
- thread_title(thread);
- pdf_print_ln(">>");
- end;
- pdf_indirect_ln("F", a);
- pdf_end_dict;
- repeat
- pdf_begin_dict(a, 1);
- if a = b then
- pdf_indirect_ln("T", thread);
- pdf_indirect_ln("V", obj_bead_prev(a));
- pdf_indirect_ln("N", obj_bead_next(a));
- pdf_indirect_ln("P", obj_bead_page(a));
- pdf_indirect_ln("R", obj_bead_rect(a));
- pdf_end_dict;
- a := obj_bead_next(a);
- until a = b;
-end;
-
-
-@ Three extra node types carry information from |main_control|.
-
-@ |cancel_boundary_nodes| indicate that the next left boundary be
-ignored. These are created by the \.{\\noboundary} command in
-horizontal mode.
-
-@d cancel_boundary_node==pdf_restore_node+1
-@d cancel_boundary_size==3
-
-@<Append a |cancel_boundary_node| @>=
-begin new_whatsit(cancel_boundary_node);
-end
-
-@ User defined whatsits can be inserted into node lists to pass data
-along from one lua call to anotherb without interference from the
-typesetting engine itself. Each has an id, a type, and a value. The
-type of the value depends on the |user_node_type| field.
-
-@d user_defined_node==cancel_boundary_node+1
-@d user_node_id(#)==vlink(#+2)
-@d user_node_type(#)==vinfo(#+2)
-@d user_node_value(#)==vinfo(#+3)
-
-
-@ @<Incorporate a whatsit node into a vbox@>=
-if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
-begin x:=x+d+pdf_height(p); d:=pdf_depth(p);
-s:=0;
-if pdf_width(p)+s>w then w:=pdf_width(p)+s;
-end
-
-@ @<Incorporate a whatsit node into an hbox@>=
-begin
-if subtype(p)=dir_node then
- begin
- @<DIR: Adjust the dir stack for the |hpack| routine@>;
- end
-else begin
-if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
-begin x:=x+pdf_width(p);
-s:=0;
-if pdf_height(p)-s>h then h:=pdf_height(p)-s;
-if pdf_depth(p)+s>d then d:=pdf_depth(p)+s;
-end;
-end;
-end
-
-@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
-begin
- if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
- begin page_total:=page_total+page_depth+pdf_height(p);
- page_depth:=pdf_depth(p);
- end;
- goto contribute;
-end
-
-@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
-begin
- if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
- begin cur_height:=cur_height+prev_dp+pdf_height(p); prev_dp:=pdf_depth(p);
- end;
- goto not_found;
-end
-
-@ @<Output the whatsit node |p| in a vlist@>=
-out_what(p)
-
-@ @<Output the whatsit node |p| in an hlist@>=
-if subtype(p)<>dir_node then out_what(p)
-else @<Output a reflection instruction if the direction has changed@>
-
-@ After all this preliminary shuffling, we come finally to the routines
-that actually send out the requested data. Let's do \.{\\special} first
-(it's easier).
-
-@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
-procedure special_out(@!p:pointer);
-var old_setting:0..max_selector; {holds print |selector|}
-@!k:pool_pointer; {index into |str_pool|}
-begin synch_dvi_with_cur;@/
-old_setting:=selector; selector:=new_string;
-show_token_list(link(write_tokens(p)),null,pool_size-pool_ptr);
-selector:=old_setting;
-str_room(1);
-if cur_length<256 then
- begin dvi_out(xxx1); dvi_out(cur_length);
- end
-else begin dvi_out(xxx4); dvi_four(cur_length);
- end;
-for k:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[k]));
-pool_ptr:=str_start_macro(str_ptr); {erase the string}
-end;
-
-@ To write a token list, we must run it through \TeX's scanner, expanding
-macros and \.{\\the} and \.{\\number}, etc. This might cause runaways,
-if a delimited macro parameter isn't matched, and runaways would be
-extremely confusing since we are calling on \TeX's scanner in the middle
-of a \.{\\shipout} command. Therefore we will put a dummy control sequence as
-a ``stopper,'' right after the token list. This control sequence is
-artificially defined to be \.{\\outer}.
-@:end_write_}{\.{\\endwrite}@>
-
-@<Initialize table...@>=
-text(end_write):="endwrite"; eq_level(end_write):=level_one;
-eq_type(end_write):=outer_call; equiv(end_write):=null;
-
-@ @<Declare procedures needed in |hlist_out|, |vlist_out|@>=
-procedure write_out(@!p:pointer);
-var old_setting:0..max_selector; {holds print |selector|}
-@!old_mode:integer; {saved |mode|}
-@!j:small_number; {write stream number}
-@!q,@!r:pointer; {temporary variables for list manipulation}
-begin @<Expand macros in the token list
- and make |link(def_ref)| point to the result@>;
-old_setting:=selector; j:=write_stream(p);
-if write_open[j] then selector:=j
-else begin {write to the terminal if file isn't open}
- if (j=17)and(selector=term_and_log) then selector:=log_only;
- print_nl("");
- end;
-token_show(def_ref); print_ln;
-flush_list(def_ref); selector:=old_setting;
-end;
-procedure expand_late_lua(@!p:pointer);
-var @!old_mode:integer; {saved |mode|}
-@!q,@!r:pointer; {temporary variables for list manipulation}
-begin @<Expand macros in the token list
- and make |link(def_ref)| point to the result@>;
-end;
-
-
-@ The final line of this routine is slightly subtle; at least, the author
-didn't think about it until getting burnt! There is a used-up token list
-@^Knuth, Donald Ervin@>
-on the stack, namely the one that contained |end_write_token|. (We
-insert this artificial `\.{\\endwrite}' to prevent runaways, as explained
-above.) If it were not removed, and if there were numerous writes on a
-single page, the stack would overflow.
-
-@d end_write_token==cs_token_flag+end_write
-
-@<Expand macros in the token list and...@>=
-q:=get_avail; info(q):=right_brace_token+"}";@/
-r:=get_avail; link(q):=r; info(r):=end_write_token; ins_list(q);@/
-begin_token_list(write_tokens(p),write_text);@/
-q:=get_avail; info(q):=left_brace_token+"{"; ins_list(q);
-{now we're ready to scan
- `\.\{$\langle\,$token list$\,\rangle$\.{\} \\endwrite}'}
-old_mode:=mode; mode:=0;
- {disable \.{\\prevdepth}, \.{\\spacefactor}, \.{\\lastskip}, \.{\\prevgraf}}
-cur_cs:=write_loc; q:=scan_toks(false,true); {expand macros, etc.}
-get_token;@+if cur_tok<>end_write_token then
- @<Recover from an unbalanced write command@>;
-mode:=old_mode;
-end_token_list {conserve stack space}
-
-@ @<Recover from an unbalanced write command@>=
-begin print_err("Unbalanced write command");
-@.Unbalanced write...@>
-help2("On this page there's a \write with fewer real {'s than }'s.")@/
-("I can't handle that very well; good luck."); error;
-repeat get_token;
-until cur_tok=end_write_token;
-end
-
-@ The |out_what| procedure takes care of outputting whatsit nodes for
-|vlist_out| and |hlist_out|\kern-.3pt.
-
-@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
-procedure out_what(@!p:pointer);
-var j:small_number; {write stream number}
-begin case subtype(p) of
-open_node,write_node,close_node:@<Do some work that has been queued up
- for \.{\\write}@>;
-special_node:special_out(p);
-pdf_save_pos_node:
- @<Save current position@>;
-local_par_node:do_nothing;
-cancel_boundary_node: do_nothing;
-user_defined_node: do_nothing;
-othercases confusion("ext4") {TH: those will be pdf extension nodes in dvi mode, most likely}
-@:this can't happen ext4}{\quad ext4@>
-endcases;
-end;
-
-@ @<Save current position@>=
-begin
- synch_pos_with_cur;
- pdf_last_x_pos := pos.h;
- pdf_last_y_pos := pos.v;
-end
-
-@ We don't implement \.{\\write} inside of leaders. (The reason is that
-the number of times a leader box appears might be different in different
-implementations, due to machine-dependent rounding in the glue calculations.)
-@^leaders@>
-
-@<Do some work that has been queued up...@>=
-if not doing_leaders then
- begin j:=write_stream(p);
- if subtype(p)=write_node then write_out(p)
- else begin if write_open[j] then lua_a_close_out(write_file[j]);
- if subtype(p)=close_node then write_open[j]:=false
- else if j<16 then
- begin cur_name:=open_name(p); cur_area:=open_area(p);
- cur_ext:=open_ext(p);
- if cur_ext="" then cur_ext:=".tex";
- pack_cur_name;
- while not lua_a_open_out(write_file[j],(j+1)) do
- prompt_file_name('output file name','.tex');
- write_file[j]:= name_file_pointer;
- write_open[j]:=true;
- end;
- end;
- end
-
-@ The presence of `\.{\\immediate}' causes the |do_extension| procedure
-to descend to one level of recursion. Nothing happens unless \.{\\immediate}
-is followed by `\.{\\openout}', `\.{\\write}', or `\.{\\closeout}'.
-@^recursion@>
-
-@<Implement \.{\\immediate}@>=
-begin get_x_token;
-if cur_cmd=extension then begin
- if cur_chr<=close_node then
- begin p:=tail; do_extension; {append a whatsit node}
- out_what(tail); {do the action immediately}
- flush_node_list(tail); tail:=p; vlink(p):=null;
- end
- else case cur_chr of
- pdf_obj_code: begin
- do_extension; {scan object and set |pdf_last_obj|}
- if obj_data_ptr(pdf_last_obj) = 0 then {this object has not been initialized yet}
- pdf_error("ext1", "`\pdfobj reserveobjnum' cannot be used with \immediate");
- pdf_write_obj(pdf_last_obj);
- end;
- pdf_xform_code: begin
- do_extension; {scan form and set |pdf_last_xform|}
- pdf_cur_form := pdf_last_xform;
- pdf_ship_out(obj_xform_box(pdf_last_xform), false);
- end;
- pdf_ximage_code: begin
- do_extension; {scan image and set |pdf_last_ximage|}
- pdf_write_image(pdf_last_ximage);
- end;
- othercases back_input
- endcases;
-end
-else
- back_input;
-end
-
-@ @<Finish the extensions@>=
-for k:=0 to 15 do if write_open[k] then lua_a_close_out(write_file[k])
-
-@
-@d local_pen_inter(#)==vinfo(#+2) {\.{\\localinterlinepenalty}}
-@d local_pen_broken(#)==vlink(#+2) {\.{\\localbrokenpenalty}}
-@d local_box_left(#)==vlink(#+3) {\.{\\localleftbox}}
-@d local_box_left_width(#)==vinfo(#+3)
-@d local_box_right(#)==vlink(#+4) {\.{\\localleftbox}}
-@d local_box_right_width(#)==vinfo(#+4)
-@d local_par_dir(#)==vinfo(#+5)
-
-@<LOCAL: Declare |make_local_par_node|@>=
-function make_local_par_node:pointer;
-{This function creates a |local_paragraph| node}
-var p,q:pointer;
-begin
-p:=new_node(whatsit_node,local_par_node);
-local_pen_inter(p):=local_inter_line_penalty;
-local_pen_broken(p):=local_broken_penalty;
-if local_left_box<>null then begin
- q:=copy_node_list(local_left_box); local_box_left(p):=q;
- local_box_left_width(p):=width(local_left_box);
- end;
-if local_right_box<>null then begin
- q:=copy_node_list(local_right_box); local_box_right(p):=q;
- local_box_right_width(p):=width(local_right_box);
- end;
-local_par_dir(p):=par_direction;
-make_local_par_node:=p;
-end
-
-@ @<LOCAL: Add local paragraph node@>=
-begin tail_append(make_local_par_node) end
-
-@ @<DIR: Assign direction codes@>=
-case cur_chr of
-dir_base+page_direction_code: begin
- scan_direction;
- eq_word_define(dir_base+page_direction_code,cur_val);
- end;
-dir_base+body_direction_code: begin
- scan_direction;
- eq_word_define(dir_base+body_direction_code,cur_val);
- end;
-dir_base+par_direction_code: begin
- scan_direction;
- eq_word_define(dir_base+par_direction_code,cur_val);
- end;
-dir_base+text_direction_code: begin scan_direction;
- if (no_local_dirs>0) and (abs(mode)=hmode) then begin
- @<DIR: Add local dir node@>;
- dir_dir(tail):=dir_dir(tail);
- end;
- if dir_level(text_dir_ptr)=cur_level then
- @<DIR: Remove from |text_dir_ptr|@>;
- eq_word_define(dir_base+text_direction_code,cur_val);
- @<DIR: Add to |text_dir_ptr|@>;
- if abs(mode)=hmode then
- begin
- @<DIR: Add local dir node@>;
- dir_level(tail):=cur_level;
- end;
- eq_word_define(int_base+no_local_dirs_code,no_local_dirs+1);
- eq_word_define(int_base+level_local_dir_code,cur_level);
- end;
-dir_base+math_direction_code: begin scan_direction;
- eq_word_define(dir_base+math_direction_code,cur_val);
- end;
-end;
-
-@
-@d push_dir(#)==
-begin dir_tmp:=new_dir(#);
-vlink(dir_tmp):=dir_ptr;
-dir_ptr:=dir_tmp;
-end
-
-@d push_dir_node(#)==
-begin dir_tmp:=copy_node(#);
-vlink(dir_tmp):=dir_ptr;
-dir_ptr:=dir_tmp;
-end
-
-@d pop_dir_node==
-begin dir_tmp:=dir_ptr;
-dir_ptr:=vlink(dir_tmp);
-flush_node(dir_tmp);
-end
-
-@ @<DIR: Declare |new_dir|@>=
-function new_dir(s:small_number): pointer;
-var p:pointer; {the new node}
-begin p:=new_node(whatsit_node,dir_node);
-dir_dir(p):=s; dir_dvi_ptr(p):=-1;
-dir_level(p):=cur_level; new_dir:=p;
-end
-
-@ @<DIR: Add local dir node@>=
-tail_append(new_dir(text_direction))
-
-@ @<DIR: Adjust the dir stack for the |hpack| routine@>=
-begin
-if dir_dir(p)>=0 then begin
- hpack_dir:=dir_dir(p);
- push_dir_node(p);
- end
-else begin
- pop_dir_node;
- if dir_ptr<>null then
- hpack_dir:=dir_dir(dir_ptr);
- end
-end
-
-@ @<DIR: Reset |dir_ptr|@>=
-begin
- while dir_ptr<>null do
- pop_dir_node
-end
-
-@ @<DIR: Adjust |text_dir_ptr| for |scan_spec|@>=
-begin
-if spec_direction<>-1 then begin
- saved(4):=text_dir_ptr;
- text_dir_ptr:=new_dir(spec_direction);
- end
-else saved(4):=null;
-end
-
-@ @<DIR: Adjust back |text_dir_ptr| for |scan_spec|@>=
-begin
-flush_node_list(text_dir_ptr);
-text_dir_ptr:=saved(4);
-end
-
-@ @<DIR: Add to |text_dir_ptr|@>=
-begin
-text_dir_tmp:=new_dir(text_direction);
-vlink(text_dir_tmp):=text_dir_ptr;
-text_dir_ptr:=text_dir_tmp;
-end
-
-@ @<DIR: Remove from |text_dir_ptr|@>=
-begin
-text_dir_tmp:=vlink(text_dir_ptr);
-flush_node(text_dir_ptr);
-text_dir_ptr:=text_dir_tmp;
-end
-
-@ @<DIR: Initialize |text_dir_ptr|@>=
-begin
-text_dir_ptr:=new_dir(0);
-end
-
-@ @<DIR: Initialize |dir_ptr| for |ship_out|@>=
-begin dir_ptr:=null; push_dir(dvi_direction);
-dir_dvi_ptr(dir_ptr):=dvi_ptr;
-end
-
-@ @<Output a reflection instruction if the direction has changed@>=
-begin
- if dir_dir(p)>=0 then begin
- push_dir_node(p);
- @<(PDF) Calculate the needed width to the matching |enddir|, and store it in |w|, as
- well as in the enddir's |dir_dvi_h|@>;
- if (dir_opposite(dir_secondary[dir_dir(dir_ptr)])(dir_secondary[dvi_direction]))
- or (dir_eq(dir_secondary[dir_dir(dir_ptr)])(dir_secondary[dvi_direction]))
- then begin
- dir_cur_h(temp_ptr) := cur.h + w;
- if dir_opposite(dir_secondary[dir_dir(dir_ptr)])(dir_secondary[dvi_direction]) then
- cur.h := cur.h + w;
- end else
- dir_cur_h(temp_ptr) := cur.h;
- dir_cur_v(temp_ptr) := cur.v;
- dir_box_pos_h(temp_ptr) := box_pos.h;
- dir_box_pos_v(temp_ptr) := box_pos.v;
- synch_pos_with_cur; {no need for |synch_dvi_with_cur|, as there is no DVI grouping}
- box_pos := pos; {fake a nested |hlist_out|}
- set_to_zero(cur);
- dvi_direction:=dir_dir(dir_ptr);
- end
- else begin
- pop_dir_node;
- box_pos.h := dir_box_pos_h(p);
- box_pos.v := dir_box_pos_v(p);
- cur.h := dir_cur_h(p);
- cur.v := dir_cur_v(p);
- if dir_ptr<>null then
- dvi_direction:=dir_dir(dir_ptr)
- else
- dvi_direction:=0;
- end
-end
-
-@ This code scans forward to the ending |dir_node| while keeping
-track of the needed width in |w|. When it finds the node that will end
-this segment, it stores the accumulated with in the |dir_dvi_h| field
-of that end node, so that when that node is found later in the
-processing, the correct glue correction can be applied.
-
-@p
-function simple_advance_width(p:halfword):scaled;
-var q:halfword;
-@!w:scaled;
-begin
- q:=p; w:=0;
- while (q<>null) and (vlink(q)<>null) do begin
- q:=vlink(q);
- if is_char_node(q) then begin
- w:=w+glyph_width(q);
- end
- else begin
- case type(q) of
- hlist_node_case,vlist_node_case,rule_node_case,
- margin_kern_node_case,kern_node_case:
- w:=w+width(q);
- disc_node_case: if vlink(no_break(q))<>null then begin
- w:=w+simple_advance_width(no_break(q));
- end;
- othercases do_nothing;
- endcases;
- end;
- end;
- simple_advance_width:=w;
-end;
-
-
-@ @<(PDF) Calculate the needed width to the matching |enddir|...@>=
-begin
- q:=p; w:=0;
- save_cur_g:=cur_g;
- save_cur_glue:=cur_glue;
- { to me, it looks like the next is needed. but Aleph doesn't do that,
- so let us not do it either }
- {|w:=w-cur_g; cur_glue:=0;|}
- dir_nest:=1;
- while (q<>null) and (vlink(q)<>null) do begin
- q:=vlink(q);
- if is_char_node(q) then begin
- w:=w+glyph_width(q); {TODO no vertical support for now}
- end
- else begin
- case type(q) of
- hlist_node_case,vlist_node_case,rule_node_case,
- margin_kern_node_case,kern_node_case:w:=w+width(q);
- glue_node_case: begin
- g:=glue_ptr(q);
- w:=w+width(g)-cur_g;
- if g_sign<>normal then
- begin if g_sign=stretching then
- begin if stretch_order(g)=g_order then
- begin cur_glue:=cur_glue+stretch(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
- cur_g:=round(glue_temp);
- end;
- end
- else if shrink_order(g)=g_order then
- begin cur_glue:=cur_glue-shrink(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
- cur_g:=round(glue_temp);
- end;
- end;
- w:=w+cur_g;
- end;
- disc_node_case: if vlink(no_break(q))<>null then begin
- w:=w+simple_advance_width(no_break(q));
- end;
- math_node_case: w:=w+surround(q);
- whatsit_node_case: begin
- if subtype(q)=dir_node then begin
- if dir_dir(q)>=0 then incr(dir_nest) else decr(dir_nest);
- if dir_nest=0 then begin
- dir_dvi_h(q) := w;
- temp_ptr := q;
- q:=null;
- end;
- end
- else if (subtype(q) = pdf_refxform_node) or
- (subtype(q) = pdf_refximage_node) then
- w:=w+pdf_width(q);
- end;
- othercases do_nothing;
- endcases;
- end;
- end;
- cur_g:=save_cur_g;
- cur_glue:=save_cur_glue;
-end
-
-
-@ Shipping out PDF marks.
-
-@<Types...@>=
-dest_name_entry = record
- objname: str_number; {destination name}
- objnum: integer; {destination object number}
-end;
-
-@ @<Glob...@>=
-@!cur_page_size: scaledpos; {width and height of page being shipped}
-@!pdf_obj_list: pointer; {list of objects in the current page}
-@!pdf_xform_list: pointer; {list of forms in the current page}
-@!pdf_ximage_list: pointer; {list of images in the current page}
-@!last_thread: pointer; {pointer to the last thread}
-@!pdf_thread_ht, pdf_thread_dp, pdf_thread_wd: scaled; {dimensions of the last
-thread}
-@!pdf_last_thread_id: halfword; {identifier of the last thread}
-@!pdf_last_thread_named_id: boolean; {is identifier of the last thread named}
-@!pdf_thread_level: integer; {depth of nesting of box containing the last thread}
-@!pdf_annot_list: pointer; {list of annotations in the current page}
-@!pdf_link_list: pointer; {list of link annotations in the current page}
-@!pdf_dest_list: pointer; {list of destinations in the current page}
-@!pdf_bead_list: pointer; {list of thread beads in the current page}
-@!pdf_obj_count: integer; {counter of objects}
-@!pdf_xform_count: integer; {counter of forms}
-@!pdf_ximage_count: integer; {counter of images}
-@!pdf_cur_form: integer; {the form being output}
-@!pdf_first_outline, pdf_last_outline, pdf_parent_outline: integer;
-@!pdf_info_toks: pointer; {additional keys of Info dictionary}
-@!pdf_catalog_toks: pointer; {additional keys of Catalog dictionary}
-@!pdf_catalog_openaction: integer;
-@!pdf_names_toks: pointer; {additional keys of Names dictionary}
-@!pdf_dest_names_ptr: integer; {first unused position in |dest_names|}
-@!dest_names_size: integer; {maximum number of names in name tree of PDF output file}
-@!dest_names: ^dest_name_entry;
-@!pk_dpi: integer; {PK pixel density value from \.{texmf.cnf}}
-@!image_orig_x, image_orig_y: integer; {origin of cropped PDF images}
-@!pdf_trailer_toks: pointer; {additional keys of Trailer dictionary}
-
-@ @<Set init...@>=
-pdf_first_outline:= 0;
-pdf_last_outline:= 0;
-pdf_parent_outline:= 0;
-pdf_obj_count := 0;
-pdf_xform_count := 0;
-pdf_ximage_count := 0;
-pdf_dest_names_ptr := 0;
-pdf_info_toks := null;
-pdf_catalog_toks := null;
-pdf_names_toks := null;
-pdf_catalog_openaction := 0;
-pdf_trailer_toks := null;
-
-@ The following procedures are needed for outputing whatsit nodes for
-\pdfTeX{}.
-
-@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure write_action(p: pointer); {write an action specification}
-var s: str_number;
- d: integer;
-begin d:=0;
- if pdf_action_type(p) = pdf_action_user then begin
- pdf_print_toks_ln(pdf_action_tokens(p));
- return;
- end;
- pdf_print("<< ");
- if pdf_action_file(p) <> null then begin
- pdf_print("/F ");
- s := tokens_to_string(pdf_action_file(p));
- if (str_pool[str_start_macro(s)] = 40) and
- (str_pool[str_start_macro(s) + length(s) - 1] = 41) then
- pdf_print(s)
- else begin
- pdf_print_str(s);
- end;
- flush_str(s);
- pdf_print(" ");
- if pdf_action_new_window(p) > 0 then begin
- pdf_print("/NewWindow ");
- if pdf_action_new_window(p) = 1 then
- pdf_print("true ")
- else
- pdf_print("false ");
- end;
- end;
- case pdf_action_type(p) of
- pdf_action_page: begin
- if pdf_action_file(p) = null then begin
- pdf_print("/S /GoTo /D [");
- pdf_print_int(get_obj(obj_type_page, pdf_action_id(p), false));
- pdf_print(" 0 R");
- end
- else begin
- pdf_print("/S /GoToR /D [");
- pdf_print_int(pdf_action_id(p) - 1);
- end;
- pdf_out(" ");
- pdf_print(tokens_to_string(pdf_action_tokens(p)));
- flush_str(last_tokens_string);
- pdf_out("]");
- end;
- pdf_action_goto: begin
- if pdf_action_file(p) = null then begin
- pdf_print("/S /GoTo ");
- d := get_obj(obj_type_dest, pdf_action_id(p),
- pdf_action_named_id(p));
- end
- else
- pdf_print("/S /GoToR ");
- if pdf_action_named_id(p) > 0 then begin
- pdf_str_entry("D", tokens_to_string(pdf_action_id(p)));
- flush_str(last_tokens_string);
- end
- else if pdf_action_file(p) = null then
- pdf _indirect("D", d)
- else
- pdf_error("ext4", "`goto' option cannot be used with both `file' and `num'");
- end;
- pdf_action_thread: begin
- pdf_print("/S /Thread ");
- if pdf_action_file(p) = null then
- d := get_obj(obj_type_thread, pdf_action_id(p),
- pdf_action_named_id(p));
- if pdf_action_named_id(p) > 0 then begin
- pdf_str_entry("D", tokens_to_string(pdf_action_id(p)));
- flush_str(last_tokens_string);
- end
- else if pdf_action_file(p) = null then
- pdf_indirect("D", d)
- else
- pdf_int_entry("D", pdf_action_id(p));
- end;
- endcases;
- pdf_print_ln(" >>");
-end;
-
-procedure set_rect_dimens(p, parent_box: pointer; x, y, wd, ht, dp, margin: scaled);
-var ll, ur, pos_ll, pos_ur, tmp: scaledpos;
-begin
- ll.h := cur.h;
- if is_running(dp) then
- ll.v := y + depth(parent_box)
- else
- ll.v := cur.v + dp;
- if is_running(wd) then
- ur.h := x + width(parent_box)
- else
- ur.h := cur.h + wd;
- if is_running(ht) then
- ur.v := y - height(parent_box)
- else
- ur.v := cur.v - ht;
- pos_ll := synch_p_with_c(ll);
- pos_ur := synch_p_with_c(ur);
- if pos_ll.h > pos_ur.h then begin
- tmp.h := pos_ll.h; pos_ll.h := pos_ur.h; pos_ur.h := tmp.h; end;
- if pos_ll.v > pos_ur.v then begin
- tmp.v := pos_ll.v; pos_ll.v := pos_ur.v; pos_ur.v := tmp.v; end;
- if is_shipping_page and matrixused then begin
- matrixtransformrect(pos_ll.h, pos_ll.v, pos_ur.h, pos_ur.v);
- pos_ll.h := getllx;
- pos_ll.v := getlly;
- pos_ur.h := geturx;
- pos_ur.v := getury;
- end;
- pdf_ann_left(p) := pos_ll.h - margin;
- pdf_ann_bottom(p) := pos_ll.v - margin;
- pdf_ann_right(p) := pos_ur.h + margin;
- pdf_ann_top(p) := pos_ur.v + margin;
-end;
-
-procedure do_annot(p, parent_box: pointer; x, y: scaled);
-begin
- if not is_shipping_page then
- pdf_error("ext4", "annotations cannot be inside an XForm");
- if doing_leaders then
- return;
- if is_obj_scheduled(pdf_annot_objnum(p)) then
- pdf_annot_objnum(p) := pdf_new_objnum;
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p), 0);
- obj_annot_ptr(pdf_annot_objnum(p)) := p;
- pdf_append_list(pdf_annot_objnum(p))(pdf_annot_list);
- set_obj_scheduled(pdf_annot_objnum(p));
-end;
-
-@ To implement nested link annotations, we need a stack to hold copy of
-|pdf_start_link_node|'s that are being written out, together with their box
-nesting level.
-
-@d pdf_link_stack_top == pdf_link_stack[pdf_link_stack_ptr]
-
-@<Constants...@>=
-@!pdf_max_link_level = 10; {maximum depth of link nesting}
-
-@ @<Types...@>=
-@!pdf_link_stack_record = record
- nesting_level: integer;
- link_node: pointer; {holds a copy of the corresponding |pdf_start_link_node|}
- ref_link_node: pointer; {points to original |pdf_start_link_node|, or a
- copy of |link_node| created by |append_link| in
- case of multi-line link}
-end;
-
-@ @<Glob...@>=
-@!pdf_link_stack: array[1..pdf_max_link_level] of pdf_link_stack_record;
-@!pdf_link_stack_ptr: small_number;
-
-@ @<Set init...@>=
-pdf_link_stack_ptr := 0;
-
-@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure push_link_level(p: pointer);
-begin
- if pdf_link_stack_ptr >= pdf_max_link_level then
- overflow("pdf link stack size", pdf_max_link_level);
- pdfassert((type(p) = whatsit_node) and (subtype(p) = pdf_start_link_node));
- incr(pdf_link_stack_ptr);
- pdf_link_stack_top.nesting_level := cur_s;
- pdf_link_stack_top.link_node := copy_node_list(p);
- pdf_link_stack_top.ref_link_node := p;
-end;
-
-procedure pop_link_level;
-begin
- pdfassert(pdf_link_stack_ptr > 0);
- flush_node_list(pdf_link_stack_top.link_node);
- decr(pdf_link_stack_ptr);
-end;
-
-procedure do_link(p, parent_box: pointer; x, y: scaled);
-begin
- if not is_shipping_page then
- pdf_error("ext4", "link annotations cannot be inside an XForm");
- pdfassert(type(parent_box) = hlist_node);
- if is_obj_scheduled(pdf_link_objnum(p)) then
- pdf_link_objnum(p) := pdf_new_objnum;
- push_link_level(p);
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_link_margin);
- obj_annot_ptr(pdf_link_objnum(p)) := p; {the reference for the pdf annot object
- must be set here}
- pdf_append_list(pdf_link_objnum(p))(pdf_link_list);
- set_obj_scheduled(pdf_link_objnum(p));
-end;
-
-procedure end_link;
-var p: pointer;
-tmp1, tmp2: scaledpos;
-begin
- if pdf_link_stack_ptr < 1 then
- pdf_error("ext4", "pdf_link_stack empty, \pdfendlink used without \pdfstartlink?");
- if pdf_link_stack_top.nesting_level <> cur_s then
- pdf_error("ext4", "\pdfendlink ended up in different nesting level than \pdfstartlink");
-
- {N.B.: test for running link must be done on |link_node| and not |ref_link_node|,
- as |ref_link_node| can be set by |do_link| or |append_link| already}
-
- if is_running(pdf_width(pdf_link_stack_top.link_node)) then begin
- p := pdf_link_stack_top.ref_link_node;
- if is_shipping_page and matrixused then begin
- matrixrecalculate(cur.h + pdf_link_margin);
- pdf_ann_left(p) := getllx - pdf_link_margin;
- pdf_ann_top(p) := cur_page_size.v - getury - pdf_link_margin;
- pdf_ann_right(p) := geturx + pdf_link_margin;
- pdf_ann_bottom(p) := cur_page_size.v - getlly + pdf_link_margin;
- end
- else begin
- tmp1.h := cur.h; tmp1.v := cur.v;
- tmp2 := synch_p_with_c(tmp1);
- case box_direction(dvi_direction) of
- dir_TL_, dir_BL_: pdf_ann_right(p) := tmp2.h + pdf_link_margin;
- dir_TR_, dir_BR_: pdf_ann_left(p) := tmp2.h - pdf_link_margin;
- dir_LT_, dir_RT_: pdf_ann_bottom(p) := tmp2.v - pdf_link_margin;
- dir_LB_, dir_RB_: pdf_ann_top(p) := tmp2.v + pdf_link_margin;
- endcases;
- end;
- end;
- pop_link_level;
-end;
-
-@ For ``running'' annotations we must append a new node when the end of
-annotation is in other box than its start. The new created node is identical to
-corresponding whatsit node representing the start of annotation, but its
-|info| field is |max_halfword|. We set |info| field just before destroying the
-node, in order to use |flush_node_list| to do the job.
-
-@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure append_link(parent_box: pointer; x, y: scaled; i: small_number); {append a new
-pdf annot to |pdf_link_list|}
-var p: pointer;
-begin
- pdfassert(type(parent_box) = hlist_node);
- p := copy_node(pdf_link_stack[i].link_node);
- pdf_link_stack[i].ref_link_node := p;
- subtype(p) := pdf_link_data_node; { this node is not a normal link node}
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_link_margin);
- pdf_create_obj(obj_type_others, 0);
- obj_annot_ptr(obj_ptr) := p;
- pdf_append_list(obj_ptr)(pdf_link_list);
-end;
-
-@ Threads are handled in similar way as link annotations.
-
-@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure append_bead(p: pointer);
-var a, b, c, t: integer;
-begin
- if not is_shipping_page then
- pdf_error("ext4", "threads cannot be inside an XForm");
- t := get_obj(obj_type_thread, pdf_thread_id(p), pdf_thread_named_id(p));
- b := pdf_new_objnum;
- obj_bead_ptr(b) := pdf_get_mem(pdfmem_bead_size);
- obj_bead_page(b) := pdf_last_page;
- obj_bead_data(b) := p;
- if pdf_thread_attr(p) <> null then
- obj_bead_attr(b) := tokens_to_string(pdf_thread_attr(p))
- else
- obj_bead_attr(b) := 0;
- if obj_thread_first(t) = 0 then begin
- obj_thread_first(t) := b;
- obj_bead_next(b) := b;
- obj_bead_prev(b) := b;
- end
- else begin
- a := obj_thread_first(t);
- c := obj_bead_prev(a);
- obj_bead_prev(b) := c;
- obj_bead_next(b) := a;
- obj_bead_prev(a) := b;
- obj_bead_next(c) := b;
- end;
- pdf_append_list(b)(pdf_bead_list);
-end;
-
-procedure do_thread(p, parent_box: pointer; x, y: scaled);
-begin
- if doing_leaders then
- return;
- if subtype(p) = pdf_start_thread_node then begin
- pdf_thread_wd := pdf_width(p);
- pdf_thread_ht := pdf_height(p);
- pdf_thread_dp := pdf_depth(p);
- pdf_last_thread_id := pdf_thread_id(p);
- pdf_last_thread_named_id := (pdf_thread_named_id(p) > 0);
- if pdf_last_thread_named_id then
- add_token_ref(pdf_thread_id(p));
- pdf_thread_level := cur_s;
- end;
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_thread_margin);
- append_bead(p);
- last_thread := p;
-end;
-
-procedure append_thread(parent_box: pointer; x, y: scaled);
-var p: pointer;
-begin
- p := new_node(whatsit_node,pdf_thread_data_node);
- pdf_width(p) := pdf_thread_wd;
- pdf_height(p) := pdf_thread_ht;
- pdf_depth(p) := pdf_thread_dp;
- pdf_thread_attr(p) := null;
- pdf_thread_id(p) := pdf_last_thread_id;
- if pdf_last_thread_named_id then begin
- add_token_ref(pdf_thread_id(p));
- pdf_thread_named_id(p) := 1;
- end
- else
- pdf_thread_named_id(p) := 0;
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_thread_margin);
- append_bead(p);
- last_thread := p;
-end;
-
-procedure end_thread;
-var tmp1, tmp2: scaledpos;
-begin
- if pdf_thread_level <> cur_s then
- pdf_error("ext4", "\pdfendthread ended up in different nesting level than \pdfstartthread");
- if is_running(pdf_thread_dp) and (last_thread <> null) then begin
- tmp1.h := cur.h; tmp1.v := cur.v;
- tmp2 := synch_p_with_c(tmp1);
- case box_direction(dvi_direction) of
- dir_TL_, dir_TR_: pdf_ann_bottom(last_thread) := tmp2.v - pdf_thread_margin;
- dir_BL_, dir_BR_: pdf_ann_top(last_thread) := tmp2.v + pdf_thread_margin;
- dir_LT_, dir_LB_: pdf_ann_right(last_thread) := tmp2.h + pdf_thread_margin;
- dir_RT_, dir_RB_: pdf_ann_left(last_thread) := tmp2.h - pdf_thread_margin;
- endcases;
- end;
- if pdf_last_thread_named_id then
- delete_token_ref(pdf_last_thread_id);
- last_thread := null;
-end;
-
-function open_subentries(p: pointer): integer;
-var k, c: integer;
- l, r: integer;
-begin
- k := 0;
- if obj_outline_first(p) <> 0 then begin
- l := obj_outline_first(p);
- repeat
- incr(k);
- c := open_subentries(l);
- if obj_outline_count(l) > 0 then
- k := k + c;
- obj_outline_parent(l) := p;
- r := obj_outline_next(l);
- if r = 0 then
- obj_outline_last(p) := l;
- l := r;
- until l = 0;
- end;
- if obj_outline_count(p) > 0 then
- obj_outline_count(p) := k
- else
- obj_outline_count(p) := -k;
- open_subentries := k;
-end;
-
-procedure do_dest(p, parent_box: pointer; x, y: scaled);
-var k: integer;
-tmp1, tmp2: scaledpos;
-begin
- if not is_shipping_page then
- pdf_error("ext4", "destinations cannot be inside an XForm");
- if doing_leaders then
- return;
- k := get_obj(obj_type_dest, pdf_dest_id(p), pdf_dest_named_id(p));
- if obj_dest_ptr(k) <> null then begin
- warn_dest_dup(pdf_dest_id(p), pdf_dest_named_id(p),
- "ext4", "has been already used, duplicate ignored");
- return;
- end;
- obj_dest_ptr(k) := p;
- pdf_append_list(k)(pdf_dest_list);
- case pdf_dest_type(p) of
- pdf_dest_xyz:
- if matrixused then
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_dest_margin)
- else begin
- tmp1.h := cur.h; tmp1.v := cur.v;
- tmp2 := synch_p_with_c(tmp1);
- pdf_ann_left(p) := tmp2.h;
- pdf_ann_top(p) := tmp2.v;
- end;
- pdf_dest_fith,
- pdf_dest_fitbh:
- if matrixused then
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_dest_margin)
- else begin
- tmp1.h := cur.h; tmp1.v := cur.v;
- tmp2 := synch_p_with_c(tmp1);
- pdf_ann_top(p) := tmp2.v;
- end;
- pdf_dest_fitv,
- pdf_dest_fitbv:
- if matrixused then
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_dest_margin)
- else begin
- tmp1.h := cur.h; tmp1.v := cur.v;
- tmp2 := synch_p_with_c(tmp1);
- pdf_ann_left(p) := tmp2.h;
- end;
- pdf_dest_fit,
- pdf_dest_fitb:
- do_nothing;
- pdf_dest_fitr:
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_dest_margin);
- endcases;
-end;
-
-procedure output_form(p: pointer);
-begin
- pdf_goto_pagemode;
- pdf_place_form(pos.h, pos.v, obj_info(pdf_xform_objnum(p)));
- if pdf_lookup_list(pdf_xform_list, pdf_xform_objnum(p)) = null then
- pdf_append_list(pdf_xform_objnum(p))(pdf_xform_list);
-end;
-
-procedure output_image(idx: integer);
-begin
- pdf_goto_pagemode;
- out_image(idx, pos.h, pos.v);
- if pdf_lookup_list(pdf_ximage_list, image_objnum(idx)) = null then
- pdf_append_list(image_objnum(idx))(pdf_ximage_list);
-end;
-
-@ @<Output the whatsit node |p| in |pdf_vlist_out|@>=
-case subtype(p) of
-pdf_literal_node:
- pdf_out_literal(p);
-pdf_colorstack_node:
- pdf_out_colorstack(p);
-pdf_setmatrix_node:
- pdf_out_setmatrix(p);
-pdf_save_node:
- pdf_out_save;
-pdf_restore_node:
- pdf_out_restore;
-late_lua_node:
- do_late_lua(p);
-pdf_refobj_node:
- if not is_obj_scheduled(pdf_obj_objnum(p)) then begin
- pdf_append_list(pdf_obj_objnum(p))(pdf_obj_list);
- set_obj_scheduled(pdf_obj_objnum(p));
- end;
-pdf_refxform_node:
- @<Output a Form node in a vlist@>;
-pdf_refximage_node:
- @<Output an Image node in a vlist@>;
-pdf_annot_node:
- do_annot(p, this_box, left_edge, top_edge + height(this_box));
-pdf_start_link_node:
- pdf_error("ext4", "\pdfstartlink ended up in vlist");
-pdf_end_link_node:
- pdf_error("ext4", "\pdfendlink ended up in vlist");
-pdf_dest_node:
- do_dest(p, this_box, left_edge, top_edge + height(this_box));
-pdf_thread_node,
-pdf_start_thread_node:
- do_thread(p, this_box, left_edge, top_edge + height(this_box));
-pdf_end_thread_node:
- end_thread;
-pdf_save_pos_node:
- @<Save current position@>;
-special_node:
- pdf_special(p);
-othercases out_what(p);
-endcases
-
-@ @<Glob...@>=
-@!is_shipping_page: boolean; {set to |shipping_page| when |pdf_ship_out| starts}
-
-@ @<Output an Image node in a vlist@>=
-begin cur.h:=left_edge;
- synch_pos_with_cur;
- case box_direction(dvi_direction) of
- dir_TL_: begin
- pos_down(pdf_height(p)+pdf_depth(p));
- end;
- dir_TR_: begin
- pos_left(pdf_width(p));
- pos_down(pdf_height(p)+pdf_depth(p));
- end;
- dir_BL_: begin
- end;
- dir_BR_: begin
- pos_left(pdf_width(p));
- end;
- dir_LT_: begin
- pos_down(pdf_width(p));
- end;
- dir_RT_: begin
- pos_left(pdf_height(p)+pdf_depth(p));
- pos_down(pdf_width(p));
- end;
- dir_LB_: begin
- end;
- dir_RB_: begin
- pos_left(pdf_height(p)+pdf_depth(p));
- end;
- othercases
- endcases;
- output_image(pdf_ximage_idx(p));
- cur.v:=cur.v+pdf_height(p)+pdf_depth(p);
-end
-
-@ @<Output a Form node in a vlist@>=
-begin
- cur.h:=left_edge;
- synch_pos_with_cur;
- case box_direction(dvi_direction) of
- dir_TL_: begin
- pos_down(pdf_height(p)+pdf_depth(p));
- end;
- dir_TR_: begin
- pos_left(pdf_width(p));
- pos_down(pdf_height(p)+pdf_depth(p));
- end;
- othercases
- endcases;
- output_form(p);
- cur.v:=cur.v+pdf_height(p)+pdf_depth(p);
-end
-
-@ @<Output the whatsit node |p| in |pdf_hlist_out|@>=
-case subtype(p) of
-pdf_literal_node:
- pdf_out_literal(p);
-pdf_colorstack_node:
- pdf_out_colorstack(p);
-pdf_setmatrix_node:
- pdf_out_setmatrix(p);
-pdf_save_node:
- pdf_out_save;
-pdf_restore_node:
- pdf_out_restore;
-late_lua_node:
- do_late_lua(p);
-pdf_refobj_node:
- if not is_obj_scheduled(pdf_obj_objnum(p)) then begin
- pdf_append_list(pdf_obj_objnum(p))(pdf_obj_list);
- set_obj_scheduled(pdf_obj_objnum(p));
- end;
-pdf_refxform_node:
- @<Output a Form node in a hlist@>;
-pdf_refximage_node:
- @<Output an Image node in a hlist@>;
-pdf_annot_node:
- do_annot(p, this_box, left_edge, base_line);
-pdf_start_link_node:
- do_link(p, this_box, left_edge, base_line);
-pdf_end_link_node:
- end_link;
-pdf_dest_node:
- do_dest(p, this_box, left_edge, base_line);
-pdf_thread_node:
- do_thread(p, this_box, left_edge, base_line);
-pdf_start_thread_node:
- pdf_error("ext4", "\pdfstartthread ended up in hlist");
-pdf_end_thread_node:
- pdf_error("ext4", "\pdfendthread ended up in hlist");
-pdf_save_pos_node:
- @<Save current position@>;
-special_node:
- pdf_special(p);
-othercases if subtype(p)<>dir_node then out_what(p)
-else @<Output a reflection instruction if the direction has changed@>;
-endcases
-
-@ @<Output an Image node in a hlist@>=
-begin
- cur.v:=base_line;
- synch_pos_with_cur;
- case box_direction(dvi_direction) of
- dir_TL_: begin
- pos_down(pdf_depth(p));
- end;
- dir_TR_: begin
- pos_left(pdf_width(p));
- pos_down(pdf_depth(p));
- end;
- dir_BL_: begin
- pos_down(pdf_height(p));
- end;
- dir_BR_: begin
- pos_left(pdf_width(p));
- pos_down(pdf_height(p));
- end;
- dir_LT_: begin
- pos_left(pdf_height(p));
- pos_down(pdf_width(p));
- end;
- dir_RT_: begin
- pos_left(pdf_depth(p));
- pos_down(pdf_width(p));
- end;
- dir_LB_: begin
- pos_left(pdf_height(p));
- end;
- dir_RB_: begin
- pos_left(pdf_depth(p));
- end;
- othercases
- endcases;
- output_image(pdf_ximage_idx(p));
- edge:=cur.h+pdf_width(p); cur.h:=edge;
-end
-
-@ @<Output a Form node in a hlist@>=
-begin
- cur.v:=base_line;
- synch_pos_with_cur;
- case box_direction(dvi_direction) of
- dir_TL_: begin
- pos_down(pdf_depth(p));
- end;
- dir_TR_: begin
- pos_down(pdf_depth(p));
- pos_left(pdf_width(p));
- end;
- othercases
- endcases;
- output_form(p);
- edge:=cur.h+pdf_width(p); cur.h:=edge;
-end
-
-@* \[53a] The extended features of \eTeX.
-The program has two modes of operation: (1)~In \TeX\ compatibility mode
-it fully deserves the name \TeX\ and there are neither extended features
-nor additional primitive commands. There are, however, a few
-modifications that would be legitimate in any implementation of \TeX\
-such as, e.g., preventing inadequate results of the glue to \.{DVI}
-unit conversion during |ship_out|. (2)~In extended mode there are
-additional primitive commands and the extended features of \eTeX\ are
-available.
-
-The distinction between these two modes of operation initially takes
-place when a `virgin' \.{eINITEX} starts without reading a format file.
-Later on the values of all \eTeX\ state variables are inherited when
-\.{eVIRTEX} (or \.{eINITEX}) reads a format file.
-
-The code below is designed to work for cases where `$|init|\ldots|tini|$'
-is a run-time switch.
-
-@<Enable \eTeX, if requested@>=
-@!init if format_ident=" (INITEX)" then
- begin no_new_control_sequence:=false;
- @<Generate all \eTeX\ primitives@>@;
- if buffer[loc]="*" then incr(loc);
- end;
-tini@;@/
-if not no_new_control_sequence then {just entered extended mode ?}
- no_new_control_sequence:=true@+else
-
-@ The \eTeX\ features available in extended mode are grouped into two
-categories: (1)~Some of them are permanently enabled and have no
-semantic effect as long as none of the additional primitives are
-executed. (2)~The remaining \eTeX\ features are optional and can be
-individually enabled and disabled. For each optional feature there is
-an \eTeX\ state variable named \.{\\...state}; the feature is enabled,
-resp.\ disabled by assigning a positive, resp.\ non-positive value to
-that integer.
-
-
-@d Aleph_version_code=Aleph_int {code for \.{\\Alephversion}}
-@d Omega_version_code=Aleph_int+1 {code for \.{\\Omegaversion}}
-@d Aleph_minor_version_code=Aleph_int+2 {code for \.{\\Alephminorversion}}
-@d Omega_minor_version_code=Aleph_int+3 {code for \.{\\Omegaminorversion}}
-@d eTeX_minor_version_code=Aleph_int+4 {code for \.{\\eTeXminorversion}}
-@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
-@d Aleph_revision_code=job_name_code+1 {command code for \.{\\Alephrevision}}
-@d Omega_revision_code=job_name_code+2 {command code for \.{\\Omegarevision}}
-@d eTeX_revision_code=job_name_code+3 {command code for \.{\\eTeXrevision}}
-@d font_identifier_code==job_name_code+4 {command code for \.{tex.fontidentifer} (lua)}
-
-@<Generate all \eTeX...@>=
-primitive_etex("lastnodetype",last_item,last_node_type_code,0);
-@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
-primitive_aleph("Alephversion",last_item,Aleph_version_code,0);
-@!@:eTeX_version_}{\.{\\Alephversion} primitive@>
-primitive_aleph("Omegaversion",last_item,Omega_version_code,0);
-@!@:eTeX_version_}{\.{\\Omegaversion} primitive@>
-primitive_etex("eTeXversion",last_item,eTeX_version_code,0);
-@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
-primitive_aleph("Alephminorversion",last_item,Aleph_minor_version_code,0);
-@!@:eTeX_minor_version_}{\.{\\Alephminorversion} primitive@>
-primitive_aleph("Omegaminorversion",last_item,Omega_minor_version_code,0);
-@!@:eTeX_minor_version_}{\.{\\Omegaminorversion} primitive@>
-primitive_etex("eTeXminorversion",last_item,eTeX_minor_version_code,0);
-@!@:eTeX_minor_version_}{\.{\\eTeXminorversion} primitive@>
-primitive_aleph("Alephrevision",convert,Aleph_revision_code,0);@/
-@!@:eTeX_revision_}{\.{\\Alephrevision} primitive@>
-primitive_aleph("Omegarevision",convert,Omega_revision_code,0);@/
-@!@:eTeX_revision_}{\.{\\Omegarevision} primitive@>
-primitive_etex("eTeXrevision",convert,eTeX_revision_code,0);@/
-@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
-
-@ @<Cases for fetching an integer value@>=
-Aleph_version_code: cur_val:=Aleph_version;
-Omega_version_code: cur_val:=Omega_version;
-eTeX_version_code: cur_val:=eTeX_version;
-Aleph_minor_version_code: cur_val:=Aleph_minor_version;
-Omega_minor_version_code: cur_val:=Omega_minor_version;
-eTeX_minor_version_code: cur_val:=eTeX_minor_version;
-
-@ @<Cases of `Scan the argument for command |c|'@>=
-Aleph_revision_code: do_nothing;
-Omega_revision_code: do_nothing;
-eTeX_revision_code: do_nothing;
-
-@ @<Cases of `Print the result of command |c|'@>=
-Aleph_revision_code: print(Aleph_revision);
-Omega_revision_code: print(Omega_revision);
-eTeX_revision_code: print(eTeX_revision);
-
-@ First we implement the additional \eTeX\ parameters in the table of
-equivalents.
-
-@<Generate all \eTeX...@>=
-primitive_etex("everyeof",assign_toks,every_eof_loc,local_base);
-@!@:every_eof_}{\.{\\everyeof} primitive@>
-primitive_etex("tracingassigns",assign_int,int_base+tracing_assigns_code,int_base);@/
-@!@:tracing_assigns_}{\.{\\tracingassigns} primitive@>
-primitive_etex("tracinggroups",assign_int,int_base+tracing_groups_code,int_base);@/
-@!@:tracing_groups_}{\.{\\tracinggroups} primitive@>
-primitive_etex("tracingifs",assign_int,int_base+tracing_ifs_code,int_base);@/
-@!@:tracing_ifs_}{\.{\\tracingifs} primitive@>
-primitive_etex("tracingscantokens",assign_int,int_base+tracing_scan_tokens_code,int_base);@/
-@!@:tracing_scan_tokens_}{\.{\\tracingscantokens} primitive@>
-primitive_etex("tracingnesting",assign_int,int_base+tracing_nesting_code,int_base);@/
-@!@:tracing_nesting_}{\.{\\tracingnesting} primitive@>
-primitive_etex("predisplaydirection", assign_int,int_base+pre_display_direction_code,int_base);@/
-@!@:pre_display_direction_}{\.{\\predisplaydirection} primitive@>
-primitive_etex("lastlinefit",assign_int,int_base+last_line_fit_code,int_base);@/
-@!@:last_line_fit_}{\.{\\lastlinefit} primitive@>
-primitive_etex("savingvdiscards",assign_int,int_base+saving_vdiscards_code,int_base);@/
-@!@:saving_vdiscards_}{\.{\\savingvdiscards} primitive@>
-primitive_etex("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code,int_base);@/
-@!@:saving_hyph_codes_}{\.{\\savinghyphcodes} primitive@>
-primitive_luatex("suppressfontnotfounderror",assign_int,int_base+suppress_fontnotfound_error_code,int_base);@/
-@!@:suppress_fontnotfound_error_code_}{\.{\\suppressfontnotfounderror} primitive@>
-primitive_luatex("suppresslongerror",assign_int,int_base+suppress_long_error_code,int_base);@/
-@!@:suppress_long_error_code_}{\.{\\suppresslongerror} primitive@>
-primitive_luatex("suppressifcsnameerror",assign_int,int_base+suppress_ifcsname_error_code,int_base);@/
-@!@:suppress_ifcsname_error_code_}{\.{\\suppressifcsnameerror} primitive@>
-primitive_luatex("suppressoutererror",assign_int,int_base+suppress_outer_error_code,int_base);@/
-@!@:suppress_outer_error_code_}{\.{\\suppressoutererror} primitive@>
-primitive_luatex("synctex",assign_int,int_base+synctex_code,int_base);@/
-@!@:synctex_}{\.{\\synctex} primitive@>
-
-@ @d every_eof==equiv(every_eof_loc)
-
-@ @<Cases for |print_param|@>=
-tracing_assigns_code:print_esc("tracingassigns");
-tracing_groups_code:print_esc("tracinggroups");
-tracing_ifs_code:print_esc("tracingifs");
-tracing_scan_tokens_code:print_esc("tracingscantokens");
-tracing_nesting_code:print_esc("tracingnesting");
-pre_display_direction_code:print_esc("predisplaydirection");
-last_line_fit_code:print_esc("lastlinefit");
-saving_vdiscards_code:print_esc("savingvdiscards");
-saving_hyph_codes_code:print_esc("savinghyphcodes");
-suppress_fontnotfound_error_code:print_esc("suppressfontnotfounderror");
-suppress_long_error_code:print_esc("suppresslongerror");
-suppress_outer_error_code:print_esc("suppressoutererror");
-synctex_code:print_esc("synctex");
-
-@ 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_etex("currentgrouplevel",last_item,current_group_level_code,0);
-@!@:current_group_level_}{\.{\\currentgrouplevel} primitive@>
-primitive_etex("currentgrouptype",last_item,current_group_type_code,0);
-@!@:current_group_type_}{\.{\\currentgrouptype} primitive@>
-
-@ @<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_etex("currentiflevel",last_item,current_if_level_code,0);
-@!@:current_if_level_}{\.{\\currentiflevel} primitive@>
-primitive_etex("currentiftype",last_item,current_if_type_code,0);
-@!@:current_if_type_}{\.{\\currentiftype} primitive@>
-primitive_etex("currentifbranch",last_item,current_if_branch_code,0);
-@!@:current_if_branch_}{\.{\\currentifbranch} primitive@>
-
-@ @<Cases for fetching an integer value@>=
-current_if_level_code: begin q:=cond_ptr; cur_val:=0;
- while q<>null do
- begin incr(cur_val); q:=vlink(q);
- end;
- end;
-current_if_type_code: if cond_ptr=null then cur_val:=0
- else if cur_if<unless_code then cur_val:=cur_if+1
- else cur_val:=-(cur_if-unless_code+1);
-current_if_branch_code:
- if (if_limit=or_code)or(if_limit=else_code) then cur_val:=1
- else if if_limit=fi_code then cur_val:=-1
- else cur_val:=0;
-
-@ The \.{\\fontcharwd}, \.{\\fontcharht}, \.{\\fontchardp}, and
-\.{\\fontcharic} commands return information about a character in a
-font.
-
-@d font_char_wd_code=eTeX_dim {code for \.{\\fontcharwd}}
-@d font_char_ht_code=eTeX_dim+1 {code for \.{\\fontcharht}}
-@d font_char_dp_code=eTeX_dim+2 {code for \.{\\fontchardp}}
-@d font_char_ic_code=eTeX_dim+3 {code for \.{\\fontcharic}}
-
-@<Generate all \eTeX...@>=
-primitive_omega("charwd",last_item,font_char_wd_code,0);
-primitive_etex("fontcharwd",last_item,font_char_wd_code,0);
-@!@:font_char_wd_}{\.{\\fontcharwd} primitive@>
-primitive_omega("charht",last_item,font_char_ht_code,0);
-primitive_etex("fontcharht",last_item,font_char_ht_code,0);
-@!@:font_char_ht_}{\.{\\fontcharht} primitive@>
-primitive_omega("chardp",last_item,font_char_dp_code,0);
-primitive_etex("fontchardp",last_item,font_char_dp_code,0);
-@!@:font_char_dp_}{\.{\\fontchardp} primitive@>
-primitive_omega("charit",last_item,font_char_ic_code,0);
-primitive_etex("fontcharic",last_item,font_char_ic_code,0);
-@!@:font_char_ic_}{\.{\\fontcharic} primitive@>
-
-@ @<Cases for fetching a dimension value@>=
-font_char_wd_code,
-font_char_ht_code,
-font_char_dp_code,
-font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num;
- if char_exists(q,cur_val) then
- begin
- case m of
- font_char_wd_code: cur_val:=char_width(q,cur_val);
- font_char_ht_code: cur_val:=char_height(q,cur_val);
- font_char_dp_code: cur_val:=char_depth(q,cur_val);
- font_char_ic_code: cur_val:=char_italic(q,cur_val);
- end; {there are no other cases}
- end
- else cur_val:=0;
- end;
-
-@ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength}
-commands return the indent and length parameters of the current
-\.{\\parshape} specification.
-
-@d par_shape_length_code=eTeX_dim+4 {code for \.{\\parshapelength}}
-@d par_shape_indent_code=eTeX_dim+5 {code for \.{\\parshapeindent}}
-@d par_shape_dimen_code=eTeX_dim+6 {code for \.{\\parshapedimen}}
-
-@<Generate all \eTeX...@>=
-primitive_etex("parshapelength",last_item,par_shape_length_code,0);
-@!@:par_shape_length_}{\.{\\parshapelength} primitive@>
-primitive_etex("parshapeindent",last_item,par_shape_indent_code,0);
-@!@:par_shape_indent_}{\.{\\parshapeindent} primitive@>
-primitive_etex("parshapedimen",last_item,par_shape_dimen_code,0);
-@!@:par_shape_dimen_}{\.{\\parshapedimen} primitive@>
-
-@ @<Cases for fetching a dimension value@>=
-par_shape_length_code,
-par_shape_indent_code,
-par_shape_dimen_code: begin q:=cur_chr-par_shape_length_code; scan_int;
- if (par_shape_ptr=null)or(cur_val<=0) then cur_val:=0
- else begin if q=2 then
- begin q:=cur_val mod 2; cur_val:=(cur_val+q)div 2;
- end;
- if cur_val>vinfo(par_shape_ptr+1) then cur_val:=vinfo(par_shape_ptr+1);
- cur_val:=vmem(par_shape_ptr+2*cur_val-q+1).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_etex("showgroups",xray,show_groups,0);
-@!@:show_groups_}{\.{\\showgroups} primitive@>
-
-@ @<Cases for |show_whatever|@>=
-show_groups: begin begin_diagnostic; show_save_groups;
- end;
-
-@ @<Types...@>=
-@!save_pointer=0..save_size; {index into |save_stack|}
-
-@ The modifications of \TeX\ required for the display produced by the
-|show_save_groups| procedure were first discussed by Donald~E. Knuth in
-{\sl TUGboat\/} {\bf 11}, 165--170 and 499--511, 1990.
-@^Knuth, Donald Ervin@>
-
-In order to understand a group type we also have to know its mode.
-Since unrestricted horizontal modes are not associated with grouping,
-they are skipped when traversing the semantic nest.
-
-@<Declare \eTeX\ procedures for use...@>=
-procedure show_save_groups;
-label found1,found2,found,done;
-var p:0..nest_size; {index into |nest|}
-@!m:-mmode..mmode; {mode}
-@!v:save_pointer; {saved value of |save_ptr|}
-@!l:quarterword; {saved value of |cur_level|}
-@!c:group_code; {saved value of |cur_group|}
-@!a:-1..1; {to keep track of alignments}
-@!i:integer;
-@!j:quarterword;
-@!s:str_number;
-begin p:=nest_ptr; nest[p]:=cur_list; {put the top level into the array}
-v:=save_ptr; l:=cur_level; c:=cur_group;
-save_ptr:=cur_boundary; decr(cur_level);@/
-a:=1; s:="";
-print_nl(""); print_ln;
-loop@+begin print_nl("### "); print_group(true);
- if cur_group=bottom_level then goto done;
- repeat m:=nest[p].mode_field;
- if p>0 then decr(p) else m:=vmode;
- until m<>hmode;
- print(" (");
- case cur_group of
- simple_group: begin incr(p); goto found2;
- end;
- hbox_group,adjusted_hbox_group: s:="hbox";
- vbox_group: s:="vbox";
- vtop_group: s:="vtop";
- align_group: if a=0 then
- begin if m=-vmode then s:="halign" else s:="valign";
- a:=1; goto found1;
- end
- else begin if a=1 then print("align entry") else print_esc("cr");
- if p>=a then p:=p-a;
- a:=0; goto found;
- end;
- no_align_group:
- begin incr(p); a:=-1; print_esc("noalign"); goto found2;
- end;
- output_group:
- begin print_esc("output"); goto found;
- end;
- math_group: goto found2;
- disc_group,math_choice_group:
- begin if cur_group=disc_group then print_esc("discretionary")
- else print_esc("mathchoice");
- for i:=1 to 3 do if i<=saved(-2) then print("{}");
- goto found2;
- end;
- insert_group:
- begin if saved(-2)=output_box 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 subtype(nest[p+1].eTeX_aux_field)=left_noad_side 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 begin
- 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));
- end
-
-@ The |scan_general_text| procedure is much like |scan_toks(false,false)|,
-but will be invoked via |expand|, i.e., recursively.
-@^recursion@>
-
-@<Declare \eTeX\ procedures for sc...@>=
-procedure@?scan_general_text; forward;@t\2@>
-
-@ The token list (balanced text) created by |scan_general_text| begins
-at |link(temp_token_head)| and ends at |cur_val|. (If |cur_val=temp_token_head|,
-the list is empty.)
-
-@<Declare \eTeX\ procedures for tok...@>=
-procedure scan_general_text;
-label found;
-var s:normal..absorbing; {to save |scanner_status|}
-@!w:pointer; {to save |warning_index|}
-@!d:pointer; {to save |def_ref|}
-@!p:pointer; {tail of the token list being built}
-@!q:pointer; {new node being added to the token list via |store_new_token|}
-@!unbalance:halfword; {number of unmatched left braces}
-begin s:=scanner_status; w:=warning_index; d:=def_ref;
-scanner_status:=absorbing; warning_index:=cur_cs;
-p:=get_avail; def_ref:=p; token_ref_count(def_ref):=0; p:=def_ref;
-scan_left_brace; {remove the compulsory left brace}
-unbalance:=1;
-loop@+ begin get_token;
- if cur_tok<right_brace_limit then begin
- if cur_cmd<right_brace then incr(unbalance)
- else begin decr(unbalance);
- if unbalance=0 then goto found;
- end;
- end;
- store_new_token(cur_tok);
- end;
-found: q:=link(def_ref); free_avail(def_ref); {discard reference count}
-if q=null then cur_val:=temp_token_head @+ else cur_val:=p;
-link(temp_token_head):=q;
-scanner_status:=s; warning_index:=w; def_ref:=d;
-end;
-
-@ The \.{\\showtokens} command displays a token list.
-
-@d show_tokens=5 { \.{\\showtokens} , must be odd! }
-
-@<Generate all \eTeX...@>=
-primitive_etex("showtokens",xray,show_tokens,0);
-@!@:show_tokens_}{\.{\\showtokens} primitive@>
-
-@ 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_etex("unexpanded",the,1,0);@/
-@!@:unexpanded_}{\.{\\unexpanded} primitive@>
-primitive_etex("detokenize",the,show_tokens,0);@/
-@!@:detokenize_}{\.{\\detokenize} primitive@>
-
-@ @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>=
-if odd(cur_chr) then
- begin c:=cur_chr; scan_general_text;
- if c=1 then the_toks:=cur_val
- else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
- p:=get_avail; link(p):=link(temp_token_head);
- token_show(p); flush_list(p);
- selector:=old_setting; the_toks:=str_toks(b);
- end;
- return;
- end
-
-@ The \.{\\showifs} command displays all currently active conditionals.
-
-@d show_ifs=6 { \.{\\showifs} }
-
-@<Generate all \eTeX...@>=
-primitive_etex("showifs",xray,show_ifs,0);
-@!@:show_ifs_}{\.{\\showifs} primitive@>
-
-@
-@d print_if_line(#)==if #<>0 then
- begin print(" entered on line "); print_int(#);
- end
-
-@<Cases for |show_whatever|@>=
-show_ifs: begin begin_diagnostic; print_nl(""); print_ln;
- if cond_ptr=null then
- begin print_nl("### "); print("no active conditionals");
- end
- else begin p:=cond_ptr; n:=0;
- repeat incr(n); p:=vlink(p);@+until p=null;
- p:=cond_ptr; t:=cur_if; l:=if_line; m:=if_limit;
- repeat print_nl("### level "); print_int(n); print(": ");
- print_cmd_chr(if_test,t);
- if m=fi_code then print_esc("else");
- print_if_line(l);
- decr(n); t:=if_limit_subtype(p); l:=if_line_field(p); m:=if_limit_type(p); p:=vlink(p);
- until p=null;
- end;
- end;
-
-@ The \.{\\interactionmode} primitive allows to query and set the
-interaction mode.
-
-@<Generate all \eTeX...@>=
-primitive_etex("interactionmode",set_page_int,2,0);
-@!@:interaction_mode_}{\.{\\interactionmode} primitive@>
-
-@ @<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 |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens}
-primitive.
-
-@<Generate all \eTeX...@>=
-primitive_etex("scantokens",input,2,0);
-@!@:scan_tokens_}{\.{\\scantokens} primitive@>
-primitive_luatex("scantextokens",input,3,0);
-@!@:scan_tex_tokens_}{\.{\\scantextokens} primitive@>
-
-@ @<Cases for |input|@>=
-else if cur_chr=2 then pseudo_start
-else if cur_chr=3 then begin pseudo_start; name := 19; end
-
-@ The global variable |pseudo_files| is used to maintain a stack of
-pseudo files. The |pseudo_lines| field of each pseudo file points to
-a linked list of variable size nodes representing lines not yet
-processed: the |subtype| field contains the size of this node,
-all the following words contain ASCII codes.
-
-@<Glob...@>=
-@!pseudo_files:pointer; {stack of pseudo files}
-
-@ @<Set init...@>=
-pseudo_files:=null;
-
-@ The |pseudo_start| procedure initiates reading from a pseudo file.
-
-@<Declare \eTeX\ procedures for ex...@>=
-procedure@?pseudo_start; forward;@t\2@>
-
-@ @<Declare \eTeX\ procedures for tok...@>=
-procedure pseudo_start;
-var old_setting:0..max_selector; {holds |selector| setting}
-@!s:str_number; {string to be converted into a pseudo file}
-@!p:pointer; {for list construction}
-begin scan_general_text;
-old_setting:=selector; selector:=new_string;
-token_show(temp_token_head); selector:=old_setting;
-flush_list(link(temp_token_head));
-str_room(1); s:=make_string;
-@<Convert string |s| into a new pseudo file@>;
-flush_string;
-@<Initiate input from new pseudo file@>;
-end;
-
-procedure pseudo_from_string;
-var @!s:str_number; {string to be converted into a pseudo file}
-@!p:pointer; {for list construction}
-begin
-s:=make_string;
-@<Convert string |s| into a new pseudo file@>;
-flush_string;
-@<Initiate input from new pseudo file@>;
-end;
-
-procedure lua_string_start;
-begin
-begin_file_reading; {set up |cur_file| and new level of input}
-line:=0; limit:=start; loc:=limit+1; {force line read}
-name:=21; luacstring_start(index);
-end;
-
-@ @<Convert string |s| into a new pseudo file@>=
-str_pool[pool_ptr]:=si(" ");
-p:=string_to_pseudo(str_start_macro(s),pool_ptr,new_line_char);
-vlink(p):=pseudo_files; pseudo_files:=p
-
-@ @<Initiate input from new pseudo file@>=
-begin_file_reading; {set up |cur_file| and new level of input}
-line:=0; limit:=start; loc:=limit+1; {force line read}
-if tracing_scan_tokens>0 then
- begin if term_offset>max_print_line-3 then print_ln
- else if (term_offset>0)or(file_offset>0) then print_char(" ");
- name:=20; print("( "); incr(open_parens); update_terminal;
- end
-else begin
- name:=18;
- @<Prepare pseudo file {\sl Sync\TeX} information@>;
-end
-
-@ Here we read a line from the current pseudo file into |buffer|.
-
-@d pseudo_lines(#)==vlink(#+1)
-
-@<Declare \eTeX\ procedures for tr...@>=
-function pseudo_input: boolean; {inputs the next line or returns |false|}
-var p:pointer; {current line from pseudo file}
-@!sz:integer; {size of node |p|}
-@!w:four_quarters; {four ASCII codes}
-@!r:pointer; {loop index}
-begin last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
-p:=pseudo_lines(pseudo_files);
-if p=null then begin pseudo_input:=false; end
-else begin pseudo_lines(pseudo_files):=vlink(p); sz:=subtype(p);
- if 4*sz-3>=buf_size-last then
- check_buffer_overflow(last+4*sz);
- last:=first;
- for r:=p+1 to p+sz-1 do
- begin w:=vmem(r).qqqq;
- buffer[last]:=w.b0; buffer[last+1]:=w.b1;
- buffer[last+2]:=w.b2; buffer[last+3]:=w.b3;
- last:=last+4;
- end;
- if last>=max_buf_stack then max_buf_stack:=last+1;
- while (last>first)and(buffer[last-1]=" ") do decr(last);
- flush_node(p);
- pseudo_input:=true;
- end;
-end;
-
-@ When we are done with a pseudo file we `close' it.
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure pseudo_close; {close the top level pseudo file}
-var p: pointer;
-begin p:=vlink(pseudo_files);
-flush_node(pseudo_files);
-pseudo_files:=p;
-end;
-
-@ @<Close the pseudo files@>=
-while pseudo_files<>null do pseudo_close; {flush pseudo files}
-
-@ @<Generate all \eTeX...@>=
-primitive_etex("readline",read_to_cs,1,0);@/
-@!@:read_line_}{\.{\\readline} primitive@>
-
-@ @<Handle \.{\\readline} and |goto done|@>=
-if j=1 then
- begin while loc<=limit do {current line not yet finished}
- begin cur_chr:=buffer[loc]; incr(loc);
- if cur_chr=" " then cur_tok:=space_token
- @+else cur_tok:=cur_chr+other_token;
- store_new_token(cur_tok);
- end;
- goto done;
- end
-
-@ Here we define the additional conditionals of \eTeX\ as well as the
-\.{\\unless} prefix.
-
-@d if_def_code=17 { `\.{\\ifdefined}' }
-@d if_cs_code=18 { `\.{\\ifcsname}' }
-@d if_font_char_code=19 { `\.{\\iffontchar}' }
-@d if_in_csname_code=20 { `\.{\\ifincsname}' }
-@d if_abs_num_code=22 { `\.{\\ifabsnum}' } { 21 = |if_primitive|}
-@d if_abs_dim_code=23 { `\.{\\ifabsdim}' }
-
-@<Generate all \eTeX...@>=
-primitive_etex("unless",expand_after,1,0);@/
-@!@:unless_}{\.{\\unless} primitive@>
-primitive_etex("ifdefined",if_test,if_def_code,0);
-@!@:if_defined_}{\.{\\ifdefined} primitive@>
-primitive_etex("ifcsname",if_test,if_cs_code,0);
-@!@:if_cs_name_}{\.{\\ifcsname} primitive@>
-primitive_etex("iffontchar",if_test,if_font_char_code,0);
-@!@:if_font_char_}{\.{\\iffontchar} primitive@>
-primitive_pdftex("ifincsname",if_test,if_in_csname_code,0);
-@!@:if_in_csname_}{\.{\\ifincsname} primitive@>
-primitive_luatex("ifabsnum",if_test,if_abs_num_code,0);
-@!@:if_abs_num_}{\.{\\ifabsnum} primitive@>
-primitive_luatex("ifabsdim",if_test,if_abs_dim_code,0);
-@!@:if_abs_dim_}{\.{\\ifabsdim} primitive@>
-primitive_pdftex("ifpdfabsnum",if_test,if_abs_num_code,0);
-@!@:if_abs_num_}{\.{\\ifpdfabsnum} primitive@>
-primitive_pdftex("ifpdfabsdim",if_test,if_abs_dim_code,0);
-@!@:if_abs_dim_}{\.{\\ifpdfabsdim} primitive@>
-
-@ The result of a boolean condition is reversed when the conditional is
-preceded by \.{\\unless}.
-
-@<Negate a boolean conditional and |goto reswitch|@>=
-begin get_token;
-if (cur_cmd=if_test)and(cur_chr<>if_case_code) then
- begin cur_chr:=cur_chr+unless_code; goto reswitch;
- end;
-print_err("You can't use `"); print_esc("unless"); print("' before `");
-@.You can't use \\unless...@>
-print_cmd_chr(cur_cmd,cur_chr); print_char("'");
-help1("Continue, and I'll forget that it ever happened.");
-back_error;
-end
-
-@ The conditional \.{\\ifdefined} tests if a control sequence is
-defined.
-
-We need to reset |scanner_status|, since \.{\\outer} control sequences
-are allowed, but we might be scanning a macro definition or preamble.
-
-@<Cases for |conditional|@>=
-if_def_code:begin save_scanner_status:=scanner_status;
- scanner_status:=normal;
- get_filtered_next; b:=(cur_cmd<>undefined_cs);
- scanner_status:=save_scanner_status;
- end;
-
-@ The conditional \.{\\ifcsname} is equivalent to \.{\{\\expandafter}
-\.{\}\\expandafter} \.{\\ifdefined} \.{\\csname}, except that no new
-control sequence will be entered into the hash table (once all tokens
-preceding the mandatory \.{\\endcsname} have been expanded).
-
-@<Cases for |conditional|@>=
-if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
- b:=false;
- repeat get_x_token;
- if cur_cs=0 then store_new_token(cur_tok);
- until cur_cs<>0;
- if cur_cmd<>end_cs_name then begin
- if suppress_ifcsname_error then begin
- repeat get_x_token;
- until cur_cmd=end_cs_name;
- end
- else begin
- @<Complain about missing \.{\\endcsname}@>;
- @<Look up the characters of list |n| in the hash table, and set |cur_cs|@>;
- b:=(eq_type(cur_cs)<>undefined_cs);
- end;
- end
- else begin
- @<Look up the characters of list |n| in the hash table, and set |cur_cs|@>;
- b:=(eq_type(cur_cs)<>undefined_cs);
- end;
- flush_list(n);
- end;
-
-@ @<Look up the characters of list |n| in the hash table...@>=
-m:=first; p:=link(n);
-while p<>null do
- begin if m>=max_buf_stack then
- begin max_buf_stack:=m+4;
- if max_buf_stack=buf_size then
- check_buffer_overflow(max_buf_stack);
-@:TeX capacity exceeded buffer size}{\quad buffer size@>
- end;
- s := info(p) mod string_offset;
- if s <= @"7F then begin
- buffer[m]:=s; incr(m);
- end
- else if s<=@"7FF then begin
- buffer[m]:=@"C0 + s div @"40; incr(m);
- buffer[m]:=@"80 + s mod @"40; incr(m);
- end
- else if s<=@"FFFF then begin
- buffer[m]:=@"E0 + s div @"1000; incr(m);
- buffer[m]:=@"80 + (s mod @"1000) div @"40; incr(m);
- buffer[m]:=@"80 + (s mod @"1000) mod @"40; incr(m);
- end
- else begin
- buffer[m]:=@"F0 + s div @"40000; incr(m);
- buffer[m]:=@"80 + (s mod @"40000) div @"1000; incr(m);
- buffer[m]:=@"80 + ((s mod @"40000) mod @"1000) div @"40; incr(m);
- buffer[m]:=@"80 + ((s mod @"40000) mod @"1000) mod @"40; incr(m);
- end;
- p:=link(p);
- end;
-if m>first then
- cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|}
-else if m=first then cur_cs:=null_cs {the list is empty}
-
-@ The conditional \.{\\iffontchar} tests the existence of a character in
-a font.
-
-@<Cases for |conditional|@>=
-if_in_csname_code: b := is_in_csname;
-if_abs_dim_code, if_abs_num_code: begin
- if this_if=if_abs_num_code then scan_int@+else scan_normal_dimen;
- n:=cur_val;
- if n < 0 then negate(n);
- @<Get the next non-blank non-call...@>;
- if (cur_tok>=other_token+"<")and(cur_tok<=other_token+">") then
- r:=cur_tok-other_token
- else begin print_err("Missing = inserted for ");
- @.Missing = inserted@>
- print_cmd_chr(if_test,this_if);
- help1("I was expecting to see `<', `=', or `>'. Didn't.");
- back_error; r:="=";
- end;
- if this_if=if_abs_num_code then scan_int@+else scan_normal_dimen;
- if cur_val < 0 then negate(cur_val);
- case r of
- "<": b:=(n<cur_val);
- "=": b:=(n=cur_val);
- ">": b:=(n>cur_val);
- end;
- end;
-if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num;
- b:=char_exists(n,cur_val);
- end;
-
-@ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix
-command for macro definitions. Such macros are protected against
-expansions when lists of expanded tokens are built, e.g., for \.{\\edef}
-or during \.{\\write}.
-
-@<Generate all \eTeX...@>=
-primitive_etex("protected",prefix,8,0);
-@!@:protected_}{\.{\\protected} primitive@>
-
-@ The |get_x_or_protected| procedure is like |get_x_token| except that
-protected macros are not expanded.
-
-@<Declare \eTeX\ procedures for sc...@>=
-procedure get_x_or_protected; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
- and expands non-protected macros}
-label exit;
-begin loop@+begin get_token;
- if cur_cmd<=max_command then return;
- if (cur_cmd>=call)and(cur_cmd<end_template) then
- if info(link(cur_chr))=protected_token then return;
- expand;
- end;
-exit:end;
-
-@ A group entered (or a conditional started) in one file may end in a
-different file. Such slight anomalies, although perfectly legitimate,
-may cause errors that are difficult to locate. In order to be able to
-give a warning message when such anomalies occur, \eTeX\ uses the
-|grp_stack| and |if_stack| arrays to record the initial |cur_boundary|
-and |cond_ptr| values for each input file.
-
-@<Glob...@>=
-@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
-@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
-
-@ When a group ends that was apparently entered in a different input
-file, the |group_warning| procedure is invoked in order to update the
-|grp_stack|. If moreover \.{\\tracingnesting} is positive we want to
-give a warning message. The situation is, however, somewhat complicated
-by two facts: (1)~There may be |grp_stack| elements without a
-corresponding \.{\\input} file or \.{\\scantokens} pseudo file (e.g.,
-error insertions from the terminal); and (2)~the relevant information is
-recorded in the |name_field| of the |input_stack| only loosely
-synchronized with the |in_open| variable indexing |grp_stack|.
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure group_warning;
-var i:0..max_in_open; {index into |grp_stack|}
-@!w:boolean; {do we need a warning?}
-begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
- {store current state}
-i:=in_open; w:=false;
-while (grp_stack[i]=cur_boundary)and(i>0) do
- begin @<Set variable |w| to indicate if this case should be reported@>;
- grp_stack[i]:=save_index(save_ptr); decr(i);
- end;
-if w then
- begin print_nl("Warning: end of "); print_group(true);
-@.Warning: end of...@>
- print(" of a different file"); print_ln;
- if tracing_nesting>1 then show_context;
- if history=spotless then history:=warning_issued;
- end;
-end;
-
-@ This code scans the input stack in order to determine the type of the
-current input file.
-
-@<Set variable |w| to...@>=
-if tracing_nesting>0 then
- begin while (input_stack[base_ptr].state_field=token_list)or@|
- (input_stack[base_ptr].index_field>i) do decr(base_ptr);
- if input_stack[base_ptr].name_field>17 then w:=true;
- end
-
-@ When a conditional ends that was apparently started in a different
-input file, the |if_warning| procedure is invoked in order to update the
-|if_stack|. If moreover \.{\\tracingnesting} is positive we want to
-give a warning message (with the same complications as above).
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure if_warning;
-var i:0..max_in_open; {index into |if_stack|}
-@!w:boolean; {do we need a warning?}
-begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
- {store current state}
-i:=in_open; w:=false;
-while if_stack[i]=cond_ptr do
- begin @<Set variable |w| to...@>;
- if_stack[i]:=vlink(cond_ptr); decr(i);
- end;
-if w then
- begin print_nl("Warning: end of "); print_cmd_chr(if_test,cur_if);
-@.Warning: end of...@>
- print_if_line(if_line); print(" of a different file"); print_ln;
- if tracing_nesting>1 then show_context;
- if history=spotless then history:=warning_issued;
- end;
-end;
-
-@ Conversely, the |file_warning| procedure is invoked when a file ends
-and some groups entered or conditionals started while reading from that
-file are still incomplete.
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure file_warning;
-var p:pointer; {saved value of |save_ptr| or |cond_ptr|}
-@!l:quarterword; {saved value of |cur_level| or |if_limit|}
-@!c:quarterword; {saved value of |cur_group| or |cur_if|}
-@!i:integer; {saved value of |if_line|}
-begin
-p:=save_ptr; l:=cur_level; c:=cur_group; save_ptr:=cur_boundary;
-while grp_stack[in_open]<>save_ptr do
- begin decr(cur_level);
- print_nl("Warning: end of file when ");
-@.Warning: end of file when...@>
- print_group(true); print(" is incomplete");@/
- cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
- end;
-save_ptr:=p; cur_level:=l; cur_group:=c; {restore old values}
-p:=cond_ptr; l:=if_limit; c:=cur_if; i:=if_line;
-while if_stack[in_open]<>cond_ptr do
- begin print_nl("Warning: end of file when ");
-@.Warning: end of file when...@>
- print_cmd_chr(if_test,cur_if);
- if if_limit=fi_code then print_esc("else");
- print_if_line(if_line); print(" is incomplete");@/
- if_line:=if_line_field(cond_ptr); cur_if:=if_limit_subtype(cond_ptr);
- if_limit:=if_limit_type(cond_ptr); cond_ptr:=vlink(cond_ptr);
- end;
-cond_ptr:=p; if_limit:=l; cur_if:=c; if_line:=i; {restore old values}
-print_ln;
-if tracing_nesting>1 then show_context;
-if history=spotless then history:=warning_issued;
-end;
-
-@ Here are the additional \eTeX\ primitives for expressions.
-
-@<Generate all \eTeX...@>=
-primitive_etex("numexpr",last_item,eTeX_expr-int_val+int_val,0);
-@!@:num_expr_}{\.{\\numexpr} primitive@>
-primitive_etex("dimexpr",last_item,eTeX_expr-int_val+dimen_val,0);
-@!@:dim_expr_}{\.{\\dimexpr} primitive@>
-primitive_etex("glueexpr",last_item,eTeX_expr-int_val+glue_val,0);
-@!@:glue_expr_}{\.{\\glueexpr} primitive@>
-primitive_etex("muexpr",last_item,eTeX_expr-int_val+mu_val,0);
-@!@:mu_expr_}{\.{\\muexpr} primitive@>
-
-@ 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 begin
- 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);
- end;
-return;
-end
-
-@ @<Declare \eTeX\ procedures for sc...@>=
-procedure@?scan_expr; forward;@t\2@>
-
-@ The |scan_expr| procedure scans and evaluates an expression.
-
-@<Declare procedures needed for expressions@>=
-@t\4@>@<Declare subprocedures for |scan_expr|@>
-procedure scan_expr; {scans and evaluates an expression}
-label restart, continue, found;
-var a,@!b:boolean; {saved values of |arith_error|}
-@!l:small_number; {type of expression}
-@!r:small_number; {state of expression so far}
-@!s:small_number; {state of term so far}
-@!o:small_number; {next operation or type of next factor}
-@!e:integer; {expression so far}
-@!t:integer; {term so far}
-@!f:integer; {current factor}
-@!n:integer; {numerator of combined multiplication and division}
-@!p:pointer; {top of expression stack}
-@!q:pointer; {for stack manipulations}
-begin l:=cur_val_level; a:=arith_error; b:=false; p:=null;
-@<Scan and evaluate an expression |e| of type |l|@>;
-if b then
- begin print_err("Arithmetic overflow");
-@.Arithmetic overflow@>
- help2("I can't evaluate this expression,")@/
- ("since the result is out of range.");
- error;
- if l>=glue_val then
- begin delete_glue_ref(e); e:=zero_glue; add_glue_ref(e);
- end
- else e:=0;
- end;
-arith_error:=a; cur_val:=e; cur_val_level:=l;
-end;
-
-@ Evaluating an expression is a recursive process: When the left
-parenthesis of a subexpression is scanned we descend to the next level
-of recursion; the previous level is resumed with the matching right
-parenthesis.
-
-@d expr_none=0 {\.( seen, or \.( $\langle\it expr\rangle$ \.) seen}
-@d expr_add=1 {\.( $\langle\it expr\rangle$ \.+ seen}
-@d expr_sub=2 {\.( $\langle\it expr\rangle$ \.- seen}
-@d expr_mult=3 {$\langle\it term\rangle$ \.* seen}
-@d expr_div=4 {$\langle\it term\rangle$ \./ seen}
-@d expr_scale=5 {$\langle\it term\rangle$ \.*
- $\langle\it factor\rangle$ \./ seen}
-
-@<Scan and eval...@>=
-restart: r:=expr_none; e:=0; s:=expr_none; t:=0; n:=0;
-continue: if s=expr_none then o:=l@+else o:=int_val;
-@<Scan a factor |f| of type |o| or start a subexpression@>;
-found: @<Scan the next operator and set |o|@>;
-arith_error:=b;
-@<Make sure that |f| is in the proper range@>;
-case s of @<Cases for evaluation of the current term@>@;
-end; {there are no other cases}
-if o>expr_sub then s:=o@+else @<Evaluate the current expression@>;
-b:=arith_error;
-if o<>expr_none then goto continue;
-if p<>null then @<Pop the expression stack and |goto found|@>
-
-@ @<Scan the next op...@>=
-@<Get the next non-blank non-call token@>;
-if cur_tok=other_token+"+" then o:=expr_add
-else if cur_tok=other_token+"-" then o:=expr_sub
-else if cur_tok=other_token+"*" then o:=expr_mult
-else if cur_tok=other_token+"/" then o:=expr_div
-else begin o:=expr_none;
- if p=null then
- begin if cur_cmd<>relax then back_input;
- end
- else if cur_tok<>other_token+")" then
- begin print_err("Missing ) inserted for expression");
-@.Missing ) inserted@>
- help1("I was expecting to see `+', `-', `*', `/', or `)'. Didn't.");
- back_error;
- end;
- end
-
-@ @<Scan a factor...@>=
-@<Get the next non-blank non-call token@>;
-if cur_tok=other_token+"(" then
- @<Push the expression stack and |goto restart|@>;
-back_input;
-if (o=int_val)or(o=attr_val) then scan_int
-else if o=dimen_val then scan_normal_dimen
-else if o=glue_val then scan_normal_glue
-else scan_mu_glue;
-f:=cur_val
-
-@ @<Declare \eTeX\ procedures for sc...@>=
-procedure@?scan_normal_glue; forward;@t\2@>@/
-procedure@?scan_mu_glue; forward;@t\2@>
-
-@ Here we declare to trivial procedures in order to avoid mutually
-recursive procedures with parameters.
-
-@<Declare procedures needed for expressions@>=
-procedure scan_normal_glue;
-begin scan_glue(glue_val);
-end;
-@#
-procedure scan_mu_glue;
-begin scan_glue(mu_val);
-end;
-
-@ Parenthesized subexpressions can be inside expressions, and this
-nesting has a stack. Seven local variables represent the top of the
-expression stack: |p| points to pushed-down entries, if any; |l|
-specifies the type of expression currently beeing evaluated; |e| is the
-expression so far and |r| is the state of its evaluation; |t| is the
-term so far and |s| is the state of its evaluation; finally |n| is the
-numerator for a combined multiplication and division, if any.
-
-@d expr_type(#)==type(#+1)
-@d expr_state(#)==subtype(#+1)
-@d expr_e_field(#)==vlink(#+1) {saved expression so far}
-@d expr_t_field(#)==vlink(#+2) {saved term so far}
-@d expr_n_field(#)==vinfo(#+2) {saved numerator}
-
-@<Push the expression...@>=
-begin q:=new_node(expr_node,0); vlink(q):=p;
-expr_type(q):=l; expr_state(q):=4*s+r;
-expr_e_field(q):=e; expr_t_field(q):=t; expr_n_field(q):=n;
-p:=q; l:=o; goto restart;
-end
-
-@ @<Pop the expression...@>=
-begin f:=e; q:=p;
-e:=expr_e_field(q); t:=expr_t_field(q); n:=expr_n_field(q);
-s:=expr_state(q) div 4; r:=expr_state(q) mod 4;
-l:=expr_type(q); p:=vlink(q); flush_node(q);
-goto found;
-end
-
-@ We want to make sure that each term and (intermediate) result is in
-the proper range. Integer values must not exceed |infinity|
-($2^{31}-1$) in absolute value, dimensions must not exceed |max_dimen|
-($2^{30}-1$). We avoid the absolute value of an integer, because this
-might fail for the value $-2^{31}$ using 32-bit arithmetic.
-
-@d num_error(#)== {clear a number or dimension and set |arith_error|}
- begin arith_error:=true; #:=0;
- end
-@d glue_error(#)== {clear a glue spec and set |arith_error|}
- begin arith_error:=true; delete_glue_ref(#); #:=new_spec(zero_glue);
- end
-
-@<Make sure that |f|...@>=
-if ((l=int_val)or(l=attr_val))or(s>expr_sub) then
- begin if (f>infinity)or(f<-infinity) then num_error(f);
- end
-else if l=dimen_val then
- begin if abs(f)>max_dimen then num_error(f);
- end
-else begin if (abs(width(f))>max_dimen)or@|
- (abs(stretch(f))>max_dimen)or@|
- (abs(shrink(f))>max_dimen) then glue_error(f);
- end
-
-@ Applying the factor |f| to the partial term |t| (with the operator
-|s|) is delayed until the next operator |o| has been scanned. Here we
-handle the first factor of a partial term. A glue spec has to be copied
-unless the next operator is a right parenthesis; this allows us later on
-to simply modify the glue components.
-
-@d normalize_glue(#)==
- if stretch(#)=0 then stretch_order(#):=normal;
- if shrink(#)=0 then shrink_order(#):=normal
-
-@<Cases for evaluation of the current term@>=
-expr_none: if (l>=glue_val)and(o<>expr_none) then
- begin t:=new_spec(f); delete_glue_ref(f); normalize_glue(t);
- end
- else t:=f;
-
-@ When a term |t| has been completed it is copied to, added to, or
-subtracted from the expression |e|.
-
-@d expr_add_sub(#)==add_or_sub(#,r=expr_sub)
-@d expr_a(#)==expr_add_sub(#,max_dimen)
-
-@<Evaluate the current expression@>=
-begin s:=expr_none;
-if r=expr_none then e:=t
-else if (l=int_val)or(l=attr_val) then e:=expr_add_sub(e,t,infinity)
-else if l=dimen_val then e:=expr_a(e,t)
-else @<Compute the sum or difference of two glue specs@>;
-r:=o;
-end
-
-@ The function |add_or_sub(x,y,max_answer,negative)| computes the sum
-(for |negative=false|) or difference (for |negative=true|) of |x| and
-|y|, provided the absolute value of the result does not exceed
-|max_answer|.
-
-@<Declare subprocedures for |scan_expr|@>=
-function add_or_sub(@!x,@!y,@!max_answer:integer;@!negative:boolean):integer;
-var a:integer; {the answer}
-begin if negative then negate(y);
-if x>=0 then
- if y<=max_answer-x then a:=x+y@+else num_error(a)
-else if y>=-max_answer-x then a:=x+y@+else num_error(a);
-add_or_sub:=a;
-end;
-
-@ We know that |stretch_order(e)>normal| implies |stretch(e)<>0| and
-|shrink_order(e)>normal| implies |shrink(e)<>0|.
-
-@<Compute the sum or diff...@>=
-begin width(e):=expr_a(width(e),width(t));
-if stretch_order(e)=stretch_order(t) then
- stretch(e):=expr_a(stretch(e),stretch(t))
-else if (stretch_order(e)<stretch_order(t))and(stretch(t)<>0) then
- begin stretch(e):=stretch(t); stretch_order(e):=stretch_order(t);
- end;
-if shrink_order(e)=shrink_order(t) then
- shrink(e):=expr_a(shrink(e),shrink(t))
-else if (shrink_order(e)<shrink_order(t))and(shrink(t)<>0) then
- begin shrink(e):=shrink(t); shrink_order(e):=shrink_order(t);
- end;
-delete_glue_ref(t); normalize_glue(e);
-end
-
-@ If a multiplication is followed by a division, the two operations are
-combined into a `scaling' operation. Otherwise the term |t| is
-multiplied by the factor |f|.
-
-@d expr_m(#)==#:=nx_plus_y(#,f,0)
-
-@<Cases for evaluation of the current term@>=
-expr_mult: if o=expr_div then
- begin n:=f; o:=expr_scale;
- end
- else if (l=int_val)or(l=attr_val) then t:=mult_integers(t,f)
- else if l=dimen_val then expr_m(t)
- else begin expr_m(width(t)); expr_m(stretch(t)); expr_m(shrink(t));
- end;
-
-@ Here we divide the term |t| by the factor |f|.
-
-@d expr_d(#)==#:=quotient(#,f)
-
-@<Cases for evaluation of the current term@>=
-expr_div: if l<glue_val then expr_d(t)
- else begin expr_d(width(t)); expr_d(stretch(t)); expr_d(shrink(t));
- end;
-
-@ The function |quotient(n,d)| computes the rounded quotient
-$q=\lfloor n/d+{1\over2}\rfloor$, when $n$ and $d$ are positive.
-
-@<Declare subprocedures for |scan_expr|@>=
-function quotient(@!n,@!d:integer):integer;
-var negative:boolean; {should the answer be negated?}
-@!a:integer; {the answer}
-begin if d=0 then num_error(a)
-else begin if d>0 then negative:=false
- else begin negate(d); negative:=true;
- end;
- if n<0 then
- begin negate(n); negative:=not negative;
- end;
- a:=n div d; n:=n-a*d; d:=n-d; {avoid certain compiler optimizations!}
- if d+n>=0 then incr(a);
- if negative then negate(a);
- end;
-quotient:=a;
-end;
-
-@ Here the term |t| is multiplied by the quotient $n/f$.
-
-@d expr_s(#)==#:=fract(#,n,f,max_dimen)
-
-@<Cases for evaluation of the current term@>=
-expr_scale: if (l=int_val)or(l=attr_val) then t:=fract(t,n,f,infinity)
- else if l=dimen_val then expr_s(t)
- else begin expr_s(width(t)); expr_s(stretch(t)); expr_s(shrink(t));
- end;
-
-@ Finally, the function |fract(x,n,d,max_answer)| computes the integer
-$q=\lfloor xn/d+{1\over2}\rfloor$, when $x$, $n$, and $d$ are positive
-and the result does not exceed |max_answer|. We can't use floating
-point arithmetic since the routine must produce identical results in all
-cases; and it would be too dangerous to multiply by~|n| and then divide
-by~|d|, in separate operations, since overflow might well occur. Hence
-this subroutine simulates double precision arithmetic, somewhat
-analogous to \MF's |make_fraction| and |take_fraction| routines.
-
-@d too_big=88 {go here when the result is too big}
-
-@<Declare subprocedures for |scan_expr|@>=
-function fract(@!x,@!n,@!d,@!max_answer:integer):integer;
-label found, found1, too_big, done;
-var negative:boolean; {should the answer be negated?}
-@!a:integer; {the answer}
-@!f:integer; {a proper fraction}
-@!h:integer; {smallest integer such that |2*h>=d|}
-@!r:integer; {intermediate remainder}
-@!t:integer; {temp variable}
-begin if d=0 then goto too_big;
-a:=0;
-if d>0 then negative:=false
-else begin negate(d); negative:=true;
- end;
-if x<0 then
- begin negate(x); negative:=not negative;
- end
-else if x=0 then goto done;
-if n<0 then
- begin negate(n); negative:=not negative;
- end;
-t:=n div d;
-if t>max_answer div x then goto too_big;
-a:=t*x; n:=n-t*d;
-if n=0 then goto found;
-t:=x div d;
-if t>(max_answer-a) div n then goto too_big;
-a:=a+t*n; x:=x-t*d;
-if x=0 then goto found;
-if x<n then
- begin t:=x; x:=n; n:=t;
- end; {now |0<n<=x<d|}
-@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>@;
-if f>(max_answer-a) then goto too_big;
-a:=a+f;
-found: if negative then negate(a);
-goto done;
-too_big: num_error(a);
-done: fract:=a;
-end;
-
-@ The loop here preserves the following invariant relations
-between |f|, |x|, |n|, and~|r|:
-(i)~$f+\lfloor(xn+(r+d))/d\rfloor=\lfloor x_0n_0/d+{1\over2}\rfloor$;
-(ii)~|-d<=r<0<n<=x<d|, where $x_0$, $n_0$ are the original values of~$x$
-and $n$.
-
-Notice that the computation specifies |(x-d)+x| instead of |(x+x)-d|,
-because the latter could overflow.
-
-@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>=
-f:=0; r:=(d div 2)-d; h:=-r;
-loop@+begin if odd(n) then
- begin r:=r+x;
- if r>=0 then
- begin r:=r-d; incr(f);
- end;
- end;
- n:=n div 2;
- if n=0 then goto found1;
- if x<h then x:=x+x
- else begin t:=x-d; x:=t+x; f:=f+n;
- if x<n then
- begin if x=0 then goto found1;
- t:=x; x:=n; n:=t;
- end;
- end;
- end;
-found1:
-
-@ The \.{\\gluestretch}, \.{\\glueshrink}, \.{\\gluestretchorder}, and
-\.{\\glueshrinkorder} commands return the stretch and shrink components
-and their orders of ``infinity'' of a glue specification.
-
-@d glue_stretch_order_code=eTeX_int+6 {code for \.{\\gluestretchorder}}
-@d glue_shrink_order_code=eTeX_int+7 {code for \.{\\glueshrinkorder}}
-@d glue_stretch_code=eTeX_dim+7 {code for \.{\\gluestretch}}
-@d glue_shrink_code=eTeX_dim+8 {code for \.{\\glueshrink}}
-
-@<Generate all \eTeX...@>=
-primitive_etex("gluestretchorder",last_item,glue_stretch_order_code,0);
-@!@:glue_stretch_order_}{\.{\\gluestretchorder} primitive@>
-primitive_etex("glueshrinkorder",last_item,glue_shrink_order_code,0);
-@!@:glue_shrink_order_}{\.{\\glueshrinkorder} primitive@>
-primitive_etex("gluestretch",last_item,glue_stretch_code,0);
-@!@:glue_stretch_}{\.{\\gluestretch} primitive@>
-primitive_etex("glueshrink",last_item,glue_shrink_code,0);
-@!@:glue_shrink_}{\.{\\glueshrink} primitive@>
-
-@ @<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_etex("mutoglue",last_item,mu_to_glue_code,0);
-@!@:mu_to_glue_}{\.{\\mutoglue} primitive@>
-primitive_etex("gluetomu",last_item,glue_to_mu_code,0);
-@!@:glue_to_mu_}{\.{\\gluetomu} primitive@>
-
-@ @<Cases for fetching a glue value@>=
-mu_to_glue_code: scan_mu_glue;
-
-@ @<Cases for fetching a mu value@>=
-glue_to_mu_code: scan_normal_glue;
-
-@ @<Glob...@>=
-@!last_line_fill:pointer; {the |par_fill_skip| glue node of the new paragraph}
-
-@ When |saving_vdiscards| is positive then the glue, kern, and penalty
-nodes removed by the page builder or by \.{\\vsplit} from the top of a
-vertical list are saved in special lists instead of being discarded.
-
-@d tail_page_disc==disc_ptr[copy_code] {last item removed by page builder}
-@d page_disc==disc_ptr[last_box_code] {first item removed by page builder}
-@d split_disc==disc_ptr[vsplit_code] {first item removed by \.{\\vsplit}}
-
-@<Glob...@>=
-@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers}
-
-@ @<Set init...@>=
-page_disc:=null; split_disc:=null;
-
-@ The \.{\\pagediscards} and \.{\\splitdiscards} commands share the
-command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are
-distinguished by their |chr_code| values |last_box_code| and
-|vsplit_code|. These |chr_code| values are larger than |box_code| and
-|copy_code|.
-
-@<Generate all \eTeX...@>=
-primitive_etex("pagediscards",un_vbox,last_box_code,0);@/
-@!@:page_discards_}{\.{\\pagediscards} primitive@>
-primitive_etex("splitdiscards",un_vbox,vsplit_code,0);@/
-@!@:split_discards_}{\.{\\splitdiscards} primitive@>
-
-@ @<Handle saved items and |goto done|@>=
-begin vlink(tail):=disc_ptr[cur_chr]; disc_ptr[cur_chr]:=null;
-goto done;
-end
-
-@ The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties},
-and \.{\\displaywidowpenalties} commands allow to define arrays of
-penalty values to be used instead of the corresponding single values.
-
-@d inter_line_penalties_ptr==equiv(inter_line_penalties_loc)
-@d club_penalties_ptr==equiv(club_penalties_loc)
-@d widow_penalties_ptr==equiv(widow_penalties_loc)
-@d display_widow_penalties_ptr==equiv(display_widow_penalties_loc)
-
-@<Generate all \eTeX...@>=
-primitive_etex("interlinepenalties",set_etex_shape,inter_line_penalties_loc,etex_pen_base);@/
-@!@:inter_line_penalties_}{\.{\\interlinepenalties} primitive@>
-primitive_etex("clubpenalties",set_etex_shape,club_penalties_loc,etex_pen_base);@/
-@!@:club_penalties_}{\.{\\clubpenalties} primitive@>
-primitive_etex("widowpenalties",set_etex_shape,widow_penalties_loc,etex_pen_base);@/
-@!@:widow_penalties_}{\.{\\widowpenalties} primitive@>
-primitive_etex("displaywidowpenalties",set_etex_shape,display_widow_penalties_loc,etex_pen_base);@/
-@!@:display_widow_penalties_}{\.{\\displaywidowpenalties} primitive@>
-
-@ @<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;
-cur_val_level:=int_val;
-end
-
-@ This is needed to get the relative order of the marks code correct
-
-@<Show the meaning of a mark node@>=
-if (cur_cmd=top_bot_mark)and(cur_chr<marks_code) then
- begin print_char(":"); print_ln;
- case cur_chr of
- first_mark_code: token_show(first_mark(0));
- bot_mark_code: token_show(bot_mark(0));
- split_first_mark_code: token_show(split_first_mark(0));
- split_bot_mark_code: token_show(split_bot_mark(0));
- othercases token_show(top_mark(0));
- endcases;
-end
-
-
-@ The lua interface needs some extra pascal functions. The functions
-themselves are quite boring, but they are handy because otherwise this
-internal stuff has to be accessed from C directly, where lots of the
-pascal defines are not available.
-
-@p function get_tex_dimen_register (j:integer):scaled;
-begin
- get_tex_dimen_register := dimen(j);
-end;
-
-function set_tex_dimen_register (j:integer;v:scaled):integer;
-var a:small_number;
-begin {return non-nil for error}
-if global_defs>0 then a:=4 else a:=0;
-word_define(j+scaled_base,v);
-set_tex_dimen_register := 0;
-end;
-
-function get_tex_skip_register (j:integer):halfword;
-begin
- get_tex_skip_register := skip(j);
-end;
-
-function set_tex_skip_register (j:integer;v:halfword):integer;
-var a:small_number;
-begin {return non-nil for error}
- if global_defs>0 then a:=4 else a:=0;
- if type(v) <> glue_spec_node then
- set_tex_skip_register := 1
- else begin
- word_define(j+skip_base,v);
- set_tex_skip_register := 0;
- end;
-end;
-
-function get_tex_count_register (j:integer):scaled;
-begin
- get_tex_count_register := count(j);
-end;
-
-function set_tex_count_register (j:integer;v:scaled):integer;
-var a:small_number;
-begin {return non-nil for error}
- if global_defs>0 then a:=4 else a:=0;
- word_define(j+count_base,v);
- set_tex_count_register := 0;
-end;
-
-function get_tex_attribute_register (j:integer):scaled;
-begin
- get_tex_attribute_register := attribute(j);
-end;
-
-function set_tex_attribute_register (j:integer;v:scaled):integer;
-var a:small_number;
-begin {return non-nil for error}
-if global_defs>0 then a:=4 else a:=0;
-if (j)>max_used_attr then max_used_attr:=(j);
-attr_list_cache:=cache_disabled;
-word_define(j+attribute_base,v);
-set_tex_attribute_register := 0;
-end;
-
-function get_tex_toks_register (j:integer):str_number;
-var s:str_number;
-begin
- s:="";
- if toks(j) <> min_halfword then begin
- s := tokens_to_string(toks(j));
- end;
- get_tex_toks_register := s;
-end;
-
-function set_tex_toks_register (j:integer;s:str_number):integer;
-var s_pool_ptr:pool_pointer;
- ref:pointer;
- a:small_number;
- junk:pointer;
-begin
- set_tex_toks_register := 0;
- s_pool_ptr := pool_ptr;
- pool_ptr := str_start_macro(s+1);
- ref := get_avail;
- junk := str_toks(str_start_macro(s));
- pool_ptr := s_pool_ptr;
- token_ref_count(ref) := 0;
- link(ref) := link(temp_token_head);
- if global_defs>0 then a:=4 else a:=0;
- define(j+toks_base,call,ref);
- flush_str(s);
-end;
-
-function get_tex_box_register (j:integer):integer;
-begin
- get_tex_box_register := box(j);
-end;
-
-function set_tex_box_register (j:integer;v:scaled):integer;
-var a:small_number;
-begin {return non-nil for error}
-if global_defs>0 then a:=4 else a:=0;
-define(j+box_base,box_ref,v);
-set_tex_box_register := 0;
-end;
-
-
-function get_tex_box_width (j:integer):scaled;
-var q:pointer;
-begin
- q := box(j);
- get_tex_box_width := 0;
- if q <> null then
- get_tex_box_width := width(q);
-end;
-
-function set_tex_box_width (j:integer;v:scaled):integer;
-var q:pointer;
-begin
- q := box(j);
- set_tex_box_width := 0;
- if q <> null then
- width(q) := v
- else
- set_tex_box_width := 1;
-end;
-
-function get_tex_box_height (j:integer):scaled;
-var q:pointer;
-begin
- q := box(j);
- get_tex_box_height := 0;
- if q <> null then
- get_tex_box_height := height(q);
-end;
-
-function set_tex_box_height (j:integer;v:scaled):integer;
-var q:pointer;
-begin
- q := box(j);
- set_tex_box_height := 0;
- if q <> null then
- height(q) := v
- else
- set_tex_box_height := 1;
-end;
-
-function get_tex_box_depth (j:integer):scaled;
-var q:pointer;
-begin
- q := box(j);
- get_tex_box_depth := 0;
- if q <> null then
- get_tex_box_depth := depth(q);
-end;
-
-function set_tex_box_depth (j:integer;v:scaled):integer;
-var q:pointer;
-begin
- q := box(j);
- set_tex_box_depth := 0;
- if q <> null then
- depth(q) := v
- else
- set_tex_box_depth := 1;
-end;
-
-function get_cur_v: integer;
-begin
- get_cur_v := cur_page_size.v - cur.v;
-end;
-
-function get_cur_h: integer;
-begin
- get_cur_h := cur.h;
-end;
-
-@* \[54] $\Omega$ changes.
-
-@ Here we do the main work required for reading and interpreting
- $\Omega$ Compiled Translation Processes.
-
-@ Here are all the instructions in our mini-assembler.
-@d otp_right_output=1
-@d otp_right_num=2
-@d otp_right_char=3
-@d otp_right_lchar=4
-@d otp_right_some=5
-
-@d otp_pback_output=6
-@d otp_pback_num=7
-@d otp_pback_char=8
-@d otp_pback_lchar=9
-@d otp_pback_some=10
-
-@d otp_add=11
-@d otp_sub=12
-@d otp_mult=13
-@d otp_div=14
-@d otp_mod=15
-@d otp_lookup=16
-@d otp_push_num=17
-@d otp_push_char=18
-@d otp_push_lchar=19
-
-@d otp_state_change=20
-@d otp_state_push=21
-@d otp_state_pop=22
-
-@d otp_left_start=23
-@d otp_left_return=24
-@d otp_left_backup=25
-
-@d otp_goto=26
-@d otp_goto_ne=27
-@d otp_goto_eq=28
-@d otp_goto_lt=29
-@d otp_goto_le=30
-@d otp_goto_gt=31
-@d otp_goto_ge=32
-@d otp_goto_no_advance=33
-@d otp_goto_beg=34
-@d otp_goto_end=35
-
-@d otp_stop=36
-
-@
-@<Glob...@>=
-@!otp_init_input_start:halfword;
-@!otp_init_input_last:halfword;
-@!otp_init_input_end:halfword;
-@!otp_i:halfword;
-@!otp_init_input_buf:array[0..20000] of quarterword;
-
-@!otp_input_start:halfword;
-@!otp_input_last:halfword;
-@!otp_input_end:halfword;
-@!otp_input_buf:array[0..20000] of quarterword;
-
-@!otp_output_end:halfword;
-@!otp_output_buf:array[0..20000] of quarterword;
-
-@!otp_stack_used:halfword;
-@!otp_stack_last:halfword;
-@!otp_stack_new:halfword;
-@!otp_stack_buf:array[0..1000] of quarterword;
-
-@!otp_pc:halfword;
-
-@!otp_calc_ptr:halfword;
-@!otp_calcs:array[0..1000] of halfword;
-@!otp_state_ptr:halfword;
-@!otp_states:array[0..1000] of halfword;
-
-@!otp_input_char:halfword;
-@!otp_calculated_char:halfword;
-@!otp_no_input_chars:halfword;
-
-@!otp_instruction:halfword;
-@!otp_instr:halfword;
-@!otp_arg:halfword;
-@!otp_first_arg:halfword;
-@!otp_second_arg:halfword;
-
-@!otp_input_ocp:halfword;
-@!otp_counter:halfword;
-
-@!otp_finished:boolean;
-@!otp_ext_str:integer;
-@!otp_ext_str_arg:integer;
-@!otp_ext_i:integer;
-
-@
-@<Initialize table...@>=
-
-@
-@<Create a buffer with character |cur_chr| and the following
- characters (if~any) and then apply the current active OCP filter
- to this buffer@>=
-begin
-@<Read in the buffer for treatment@>;
-@<Apply the OCP to the input buffer@>;
-@<Place the output buffer back on the stream@>;
-goto big_switch;
-end;
-
-@ The OTP input buffer is an array of 16-bit values.
-In the future, the range |@"D800| \dots |@"DFFF| will be used for
-surrogate pairs, so it cannot be used for simple 16-bit values
-like it is in Omega, so a future incompatibility with Aleph is
-unavoidable.
-
-@<Read in the buffer for treatment@>=
-begin
-otp_init_input_end:=0;
-while (cur_cmd=letter) or (cur_cmd=other_char) or
- (cur_cmd=char_given) or (cur_cmd=spacer) do begin
- incr(otp_init_input_end);
- if otp_init_input_end >ocp_buf_size then
- overflow_ocp_buf_size;
- { |cur_chr| can cover the full range |0..0x10FFFF| }
- if cur_chr<@"10000 then
- otp_init_input_buf[otp_init_input_end]:=cur_chr
- else begin
- otp_init_input_buf[otp_init_input_end]:=((cur_chr - @"10000) div @"400) + @"D800;
- incr(otp_init_input_end);
- if otp_init_input_end >ocp_buf_size then
- overflow_ocp_buf_size;
- otp_init_input_buf[otp_init_input_end]:=((cur_chr - @"10000) mod @"400) + @"DC00;
- end;
- get_token;
- if (cur_cmd<>letter) and (cur_cmd<>other_char) and
- (cur_cmd<>char_given) then begin
- x_token;
- if (cur_cmd=char_num) then begin
- scan_char_num; cur_cmd:=other_char; cur_chr:=cur_val;
- end;
- end;
- end;
-back_input;
-otp_input_end:=otp_init_input_end;
-for otp_i:=0 to otp_init_input_end do begin
- otp_input_buf[otp_i]:=otp_init_input_buf[otp_i];
- end;
-end
-
-@
-@<Apply the OCP to the input buffer@>=
-begin
-otp_input_ocp:=active_ocp(active_real);
-if otp_input_ocp=0 then begin
- print_err("Null ocp being used: all input lost");
- error;
- otp_output_end:=0;
- end
-else if ocp_external(otp_input_ocp)=0 then begin
- otp_input_start:=0;
- otp_input_last:=0;
- otp_stack_used:=0;
- otp_stack_last:=0;
- otp_stack_new:=0;
- otp_output_end:=0;
- otp_pc:=0;
- otp_finished:=false;
- otp_calc_ptr:=0;
- otp_calcs[otp_calc_ptr]:=0;
- otp_state_ptr:=0;
- otp_states[otp_state_ptr]:=0;
- while not otp_finished do
- @<Run the OTP program@>;
- end
-else begin
- k:=0;
- if nameoffile then libcfree (nameoffile);
- otp_ext_str:=ocp_external(otp_input_ocp);
- otp_ext_str_arg:=ocp_external_arg(otp_input_ocp);
- nameoffile := xmalloc (4 + length(otp_ext_str) + length(otp_ext_str_arg));
- for otp_ext_i:=str_start_macro(otp_ext_str) to
- str_start_macro(otp_ext_str)+length(otp_ext_str)-1 do
- append_to_name(str_pool[otp_ext_i]);
- append_to_name(" ");
- for otp_ext_i:=str_start_macro(otp_ext_str_arg) to
- str_start_macro(otp_ext_str_arg)+length(otp_ext_str_arg)-1 do
- append_to_name(str_pool[otp_ext_i]);
- nameoffile[length(otp_ext_str)+length(otp_ext_str_arg)+2]:=0;
- run_external_ocp(nameoffile);
- end
-end
-
-@ The OTP output buffer is an array of 16-bit values. To convert back
-to the |buffer| it has to be re-encoded into UTF-8. An incompatibility
-with Aleph is unavoidable here: The range |@"D800| \dots |@"DFFF| is
-used for surrogate pairs, not for simple 16-bit values.
-
-@<Place the output buffer back on the stream@>=
-begin
-if (first+otp_output_end)>=ocp_buf_size then
- overflow_ocp_buf_size;
-push_input;
-current_ocp_lstack:=active_lstack_no(active_real);
-current_ocp_no:=active_counter(active_real);
-state:=mid_line;
-start:=first;
-last:=start;
-loc:=start;
-line_catcode_table:=DEFAULT_CAT_TABLE; line_partial:=false;
-for otp_counter:=1 to otp_output_end do begin
- { convert back to utf-8 }
- t := otp_output_buf[otp_counter];
- if otp_counter < otp_output_end then begin
- if ((t>=@"D800) and (t<@"DC00)) then begin
- if (otp_output_buf[otp_counter+1]>=@"DC00)
- and (otp_output_buf[otp_counter+1]<@"E000) then begin
- incr(otp_counter);
- t := (t-@"D800) * @"400 + (otp_output_buf[otp_counter]-@"DC00) + @"10000;
- end
- else if ((t>=@"DC00) and (t<@"E000)) then
- if (otp_output_buf[otp_counter+1]>=@"D800)
- and (otp_output_buf[otp_counter+1]<@"DC00) then begin
- incr(otp_counter);
- t := (otp_output_buf[otp_counter]-@"D800) * @"400 + (t-@"DC00) + @"10000;
- end;
- end;
- end;
- if t <= @"7F then
- buffer[last]:= t
- else if t<=@"7FF then begin
- buffer[last]:=@"C0 + t div @"40;
- incr(last);
- if last=buf_size-2 then
- @<Report overflow of the input buffer, and abort@>;
- buffer[last]:=@"80 + t mod @"40;
- end
- else if t<=@"FFFF then begin
- buffer[last]:=@"E0 + t div @"1000;
- incr(last);
- if last=buf_size-2 then
- @<Report overflow of the input buffer, and abort@>;
- buffer[last]:=@"80 + (t mod @"1000) div @"40;
- incr(last);
- if last=buf_size-2 then
- @<Report overflow of the input buffer, and abort@>;
- buffer[last]:=@"80 + (t mod @"1000) mod @"40;
- end
- else begin
- buffer[last]:=@"F0 + t div @"40000;
- incr(last);
- if last=buf_size-2 then
- @<Report overflow of the input buffer, and abort@>;
- buffer[last]:=@"80 + (t mod @"40000) div @"1000;
- incr(last);
- if last=buf_size-2 then
- @<Report overflow of the input buffer, and abort@>;
- buffer[last]:=@"80 + ((t mod @"40000) mod @"1000) div @"40;
- incr(last);
- if last=buf_size-2 then
- @<Report overflow of the input buffer, and abort@>;
- buffer[last]:=@"80 + ((t mod @"40000) mod @"1000) mod @"40;
- end;
- incr(last);
- if last=buf_size-2 then
- @<Report overflow of the input buffer, and abort@>;
- end;
-limit:=last-1;
-if (t>@"FFFF) then decr(limit);
-if (t>@"7FF) then decr(limit);
-if (t>@"7F) then decr(limit);
-first:=last;
-end
-
-@
-@d otp_cur_state==otp_states[otp_state_ptr]
-@d otp_set_instruction==begin
-if otp_pc>=ocp_state_no(otp_input_ocp)(otp_cur_state) then begin
- print_err("bad OCP program -- PC not valid");
- succumb;
- end;
-otp_instruction:=ocp_state_entry(otp_input_ocp)(otp_cur_state)(otp_pc);
-otp_instr:=otp_instruction div @"1000000;
-otp_arg:=otp_instruction mod @"1000000;
-end
-
-@<Run the OTP program@>=
-begin
-otp_set_instruction;
-case otp_instr of
- @<Run the |otp_right| instructions@>;
- @<Run the |otp_pback| instructions@>;
- @<Run the arithmetic instructions@>;
- @<Run the |otp_state| instructions@>;
- @<Run the |otp_left| instructions@>;
- @<Run the |otp_goto| instructions@>;
- @<Run the |otp_stop| instruction@>;
- othercases begin
- print_err("bad OCP program -- unknown instruction");
- succumb;
- end
- endcases;
-end
-
-@
-
-@d otp_check_char(#)==
-if (1>#) or (#>otp_no_input_chars) then begin
- print_err("right hand side of OCP expression is bad");
- succumb;
- end
-
-@d otp_get_char(#)==begin
-otp_check_char(#);
-if #>otp_stack_last then begin
- otp_calculated_char:=otp_input_buf[otp_input_start+#-otp_stack_last];
- end
-else begin
- otp_calculated_char:=otp_stack_buf[#];
- end;
-end
-
-@<Run the |otp_right| instructions@>=
- otp_right_output: begin
- incr(otp_output_end);
- if otp_output_end >ocp_buf_size then
- overflow_ocp_buf_size;
- otp_output_buf[otp_output_end]:=otp_calcs[otp_calc_ptr];
- decr(otp_calc_ptr);
- incr(otp_pc);
- end;
- otp_right_num: begin
- incr(otp_output_end);
- if otp_output_end >ocp_buf_size then
- overflow_ocp_buf_size;
- otp_output_buf[otp_output_end]:=otp_arg;
- incr(otp_pc);
- end;
- otp_right_char: begin
- otp_get_char(otp_arg);
- incr(otp_output_end);
- if otp_output_end >ocp_buf_size then
- overflow_ocp_buf_size;
- otp_output_buf[otp_output_end]:=otp_calculated_char;
- incr(otp_pc);
- end;
- otp_right_lchar: begin
- otp_get_char(otp_no_input_chars-otp_arg);
- incr(otp_output_end);
- if otp_output_end >ocp_buf_size then
- overflow_ocp_buf_size;
- otp_output_buf[otp_output_end]:=otp_calculated_char;
- incr(otp_pc);
- end;
- otp_right_some: begin
- otp_first_arg:=otp_arg+1;
- incr(otp_pc);
- otp_set_instruction;
- otp_second_arg:=otp_no_input_chars-otp_arg;
- for otp_counter:=otp_first_arg to otp_second_arg do begin
- otp_get_char(otp_counter);
- incr(otp_output_end);
- if otp_output_end >ocp_buf_size then
- overflow_ocp_buf_size;
- otp_output_buf[otp_output_end]:=otp_calculated_char;
- end;
- incr(otp_pc);
- end
-
-@
-@<Run the |otp_pback| instructions@>=
- otp_pback_output: begin
- incr(otp_stack_new);
- if otp_stack_new >= ocp_stack_size then
- overflow_ocp_stack_size;
- otp_stack_buf[otp_stack_new]:=otp_calcs[otp_calc_ptr];
- decr(otp_calc_ptr);
- incr(otp_pc);
- end;
- otp_pback_num: begin
- incr(otp_stack_new);
- if otp_stack_new >= ocp_stack_size then
- overflow_ocp_stack_size;
- otp_stack_buf[otp_stack_new]:=otp_arg;
- incr(otp_pc);
- end;
- otp_pback_char: begin
- otp_get_char(otp_arg);
- incr(otp_stack_new);
- if otp_stack_new >= ocp_stack_size then
- overflow_ocp_stack_size;
- otp_stack_buf[otp_stack_new]:=otp_calculated_char;
- incr(otp_pc);
- end;
- otp_pback_lchar: begin
- otp_get_char(otp_no_input_chars-otp_arg);
- incr(otp_stack_new);
- if otp_stack_new >= ocp_stack_size then
- overflow_ocp_stack_size;
- otp_stack_buf[otp_stack_new]:=otp_calculated_char;
- incr(otp_pc);
- end;
- otp_pback_some: begin
- otp_first_arg:=otp_arg+1;
- incr(otp_pc);
- otp_set_instruction;
- otp_second_arg:=otp_no_input_chars-otp_arg;
- for otp_counter:=otp_first_arg to otp_second_arg do begin
- otp_get_char(otp_counter);
- incr(otp_stack_new);
- if otp_stack_new >= ocp_stack_size then
- overflow_ocp_stack_size;
- otp_stack_buf[otp_stack_new]:=otp_calculated_char;
- end;
- incr(otp_pc);
- end
-
-@
-@<Run the arithmetic instructions@>=
- otp_add: begin
- otp_calcs[otp_calc_ptr-1] :=
- otp_calcs[otp_calc_ptr-1] + otp_calcs[otp_calc_ptr];
- incr(otp_pc);
- decr(otp_calc_ptr);
- end;
- otp_sub: begin
- otp_calcs[otp_calc_ptr-1] :=
- otp_calcs[otp_calc_ptr-1] - otp_calcs[otp_calc_ptr];
- incr(otp_pc);
- decr(otp_calc_ptr);
- end;
- otp_mult: begin
- otp_calcs[otp_calc_ptr-1] :=
- otp_calcs[otp_calc_ptr-1] * otp_calcs[otp_calc_ptr];
- incr(otp_pc);
- decr(otp_calc_ptr);
- end;
- otp_div: begin
- otp_calcs[otp_calc_ptr-1] :=
- otp_calcs[otp_calc_ptr-1] div otp_calcs[otp_calc_ptr];
- incr(otp_pc);
- decr(otp_calc_ptr);
- end;
- otp_mod: begin
- otp_calcs[otp_calc_ptr-1] :=
- otp_calcs[otp_calc_ptr-1] mod otp_calcs[otp_calc_ptr];
- incr(otp_pc);
- decr(otp_calc_ptr);
- end;
- otp_lookup: begin
- if otp_calcs[otp_calc_ptr]>=
- ocp_table_no(otp_input_ocp)(otp_calcs[otp_calc_ptr-1]) then begin
- print_err("bad OCP program -- table index not valid");
- succumb;
- end;
- otp_calcs[otp_calc_ptr-1]:=
- ocp_table_entry(otp_input_ocp)(otp_calcs[otp_calc_ptr-1])
- (otp_calcs[otp_calc_ptr]);
- incr(otp_pc);
- decr(otp_calc_ptr);
- end;
- otp_push_num: begin
- incr(otp_calc_ptr);
- if otp_calc_ptr >= ocp_stack_size then
- overflow_ocp_stack_size;
- otp_calcs[otp_calc_ptr]:=otp_arg;
- incr(otp_pc);
- end;
- otp_push_char: begin
- otp_get_char(otp_arg);
- incr(otp_calc_ptr);
- if otp_calc_ptr >= ocp_stack_size then
- overflow_ocp_stack_size;
- otp_calcs[otp_calc_ptr]:=otp_calculated_char;
- incr(otp_pc);
- end;
- otp_push_lchar: begin
- otp_get_char(otp_no_input_chars-otp_arg);
- incr(otp_calc_ptr);
- if otp_calc_ptr >= ocp_stack_size then
- overflow_ocp_stack_size;
- otp_calcs[otp_calc_ptr]:=otp_calculated_char;
- incr(otp_pc);
- end
-
-@
-@<Run the |otp_state| instructions@>=
- otp_state_change: begin
- otp_input_start:=otp_input_last;
- for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
- otp_stack_buf[otp_counter] :=
- otp_stack_buf[otp_counter+otp_stack_used];
- end;
- otp_stack_new:=otp_stack_new-otp_stack_used;
- otp_stack_last:=otp_stack_new;
- otp_stack_used:=0;
- otp_states[otp_state_ptr]:=otp_arg;
- otp_pc:=0;
- end;
- otp_state_push: begin
- otp_input_start:=otp_input_last;
- for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
- otp_stack_buf[otp_counter] :=
- otp_stack_buf[otp_counter+otp_stack_used];
- end;
- otp_stack_new:=otp_stack_new-otp_stack_used;
- otp_stack_last:=otp_stack_new;
- otp_stack_used:=0;
- incr(otp_state_ptr);
- if otp_state_ptr >= ocp_stack_size then
- overflow_ocp_stack_size;
- otp_states[otp_state_ptr]:=otp_arg;
- otp_pc:=0;
- end;
- otp_state_pop: begin
- otp_input_start:=otp_input_last;
- for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
- otp_stack_buf[otp_counter] :=
- otp_stack_buf[otp_counter+otp_stack_used];
- end;
- otp_stack_new:=otp_stack_new-otp_stack_used;
- otp_stack_last:=otp_stack_new;
- otp_stack_used:=0;
- if otp_state_ptr>0 then decr(otp_state_ptr);
- otp_pc:=0;
- end
-
-@
-@<Run the |otp_left| instructions@>=
- otp_left_start: begin
- otp_input_start:=otp_input_last;
- otp_input_last:=otp_input_start;
- otp_stack_used:=0;
- if (otp_stack_last=0) and (otp_input_last>=otp_input_end) then
- otp_finished:=true
- else if (otp_stack_used < otp_stack_last) then begin
- incr(otp_stack_used); {no overflow problem}
- otp_input_char:=otp_stack_buf[otp_stack_used];
- otp_no_input_chars:=1;
- incr(otp_pc);
- end
- else begin
- incr(otp_input_last); {no overflow problem}
- otp_input_char:=otp_input_buf[otp_input_last];
- otp_no_input_chars:=1;
- incr(otp_pc);
- end;
- end;
- otp_left_return: begin
- otp_input_last:=otp_input_start;
- otp_stack_used:=0;
- if (otp_stack_used < otp_stack_last) then begin
- incr(otp_stack_used); {no overflow problem}
- otp_input_char:=otp_stack_buf[otp_stack_used];
- otp_no_input_chars:=1;
- incr(otp_pc);
- end
- else begin
- incr(otp_input_last); {no overflow problem}
- otp_input_char:=otp_input_buf[otp_input_last];
- otp_no_input_chars:=1;
- incr(otp_pc);
- end;
- end;
- otp_left_backup: begin
- if otp_input_start < otp_input_last then begin
- decr(otp_input_last); otp_input_char:=otp_input_buf[otp_input_last];
- end
- else begin
- decr(otp_stack_used); otp_input_char:=otp_stack_buf[otp_stack_used];
- end;
- decr(otp_no_input_chars);
- incr(otp_pc);
- end
-
-@
-@<Run the |otp_goto| instructions@>=
- otp_goto: begin
- otp_pc:=otp_arg;
- end;
- otp_goto_ne: begin
- otp_first_arg:=otp_arg;
- incr(otp_pc);
- otp_set_instruction;
- if otp_input_char <> otp_first_arg then begin
- otp_pc:=otp_arg;
- end
- else begin
- incr(otp_pc);
- end;
- end;
- otp_goto_eq: begin
- otp_first_arg:=otp_arg;
- incr(otp_pc);
- otp_set_instruction;
- if otp_input_char = otp_first_arg then begin
- otp_pc:=otp_arg;
- end
- else begin
- incr(otp_pc);
- end;
- end;
- otp_goto_lt: begin
- otp_first_arg:=otp_arg;
- incr(otp_pc);
- otp_set_instruction;
- if otp_input_char < otp_first_arg then begin
- otp_pc:=otp_arg;
- end
- else begin
- incr(otp_pc);
- end;
- end;
- otp_goto_le: begin
- otp_first_arg:=otp_arg;
- incr(otp_pc);
- otp_set_instruction;
- if otp_input_char <= otp_first_arg then begin
- otp_pc:=otp_arg;
- end
- else begin
- incr(otp_pc);
- end;
- end;
- otp_goto_gt: begin
- otp_first_arg:=otp_arg;
- incr(otp_pc);
- otp_set_instruction;
- if otp_input_char > otp_first_arg then begin
- otp_pc:=otp_arg;
- end
- else begin
- incr(otp_pc);
- end;
- end;
- otp_goto_ge: begin
- otp_first_arg:=otp_arg;
- incr(otp_pc);
- otp_set_instruction;
- if otp_input_char >= otp_first_arg then begin
- otp_pc:=otp_arg;
- end
- else begin
- incr(otp_pc);
- end;
- end;
- otp_goto_no_advance: begin
- if (otp_stack_used < otp_stack_last) then begin
- incr(otp_stack_used); {no overflow problem}
- otp_input_char:=otp_stack_buf[otp_stack_used];
- incr(otp_no_input_chars); {no overflow problem}
- incr(otp_pc);
- end
- else if otp_input_last>=otp_input_end then begin
- otp_pc:=otp_arg;
- end
- else begin
- incr(otp_input_last); {no overflow problem}
- otp_input_char:=otp_input_buf[otp_input_last];
- incr(otp_no_input_chars); {no overflow problem}
- incr(otp_pc);
- end;
- end;
- otp_goto_beg: begin
- if otp_input_last=0 then begin
- otp_pc:=otp_arg;
- end
- else begin
- incr(otp_pc);
- end;
- end;
- otp_goto_end: begin
- if otp_input_last>=otp_input_end then begin
- otp_pc:=otp_arg;
- end
- else begin
- incr(otp_pc);
- end;
- end
-
-@
-@<Run the |otp_stop| instruction@>=
- otp_stop: begin
- otp_input_start:=otp_input_last;
- for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
- otp_stack_buf[otp_counter] :=
- otp_stack_buf[otp_counter+otp_stack_used];
- end;
- otp_stack_new:=otp_stack_new-otp_stack_used;
- otp_stack_last:=otp_stack_new;
- otp_stack_used:=0;
- otp_pc:=0;
- end
-
-@ @<Put each...@>=
-primitive_omega("ocp", def_ocp, 0,0);
-primitive_omega("externalocp", def_ocp, 1,0);
-primitive_omega("ocplist", def_ocp_list, 0,0);
-primitive_omega("pushocplist", push_ocp_list, 0,0);
-primitive_omega("popocplist", pop_ocp_list, 0,0);
-primitive_omega("clearocplists", clear_ocp_lists, 0,0);
-primitive_omega("addbeforeocplist", ocp_list_op, add_before_op,0);
-primitive_omega("addafterocplist", ocp_list_op, add_after_op,0);
-primitive_omega("removebeforeocplist", ocp_list_op, remove_before_op,0);
-primitive_omega("removeafterocplist", ocp_list_op, remove_after_op,0);
-primitive_omega("ocptracelevel", ocp_trace_level, 0,0);
-equiv(ocp_trace_level_base):=0;
-
-@ @<Assignments@>=
-set_ocp: begin
- print_err("To use ocps, use the "); print_esc("pushocplist");
- print(" primitive");print_ln
- end;
-def_ocp: new_ocp(a);
-set_ocp_list: begin
- print_err("To use ocp lists, use the ");
- print_esc("pushocplist"); print(" primitive");print_ln
- end;
-def_ocp_list: new_ocp_list(a);
-push_ocp_list: do_push_ocp_list(a);
-pop_ocp_list: do_pop_ocp_list(a);
-clear_ocp_lists: do_clear_ocp_lists(a);
-ocp_list_op: begin
- print_err("To build ocp lists, use the ");
- print_esc("ocplist"); print(" primitive"); print_ln
- end;
-ocp_trace_level: begin scan_optional_equals; scan_int;
- if cur_val<>0 then cur_val:=1;
- define(ocp_trace_level_base, data, cur_val);
- end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure new_ocp(@!a:small_number);
-label common_ending;
-var u:pointer; {user's ocp identifier}
-@!f:internal_ocp_number; {runs through existing ocps}
-@!t:str_number; {name for the frozen ocp identifier}
-@!flushable_string:str_number; {string not yet referenced}
-@!external_ocp:boolean; {external binary file}
-begin if job_name=0 then open_log_file;
- {avoid confusing \.{texput} with the ocp name}
-@.texput@>
-if cur_chr=1 then external_ocp:=true
-else external_ocp:=false;
-get_r_token; u:=cur_cs;
-if u>=hash_base then t:=text(u) else t:="OCP";
-define(u,set_ocp,null_ocp); scan_optional_equals; scan_file_name;
-@<If this ocp has already been loaded, set |f| to the internal
- ocp number and |goto common_ending|@>;
-f:=read_ocp_info(u,cur_name,cur_area,cur_ext,external_ocp);
-common_ending:
-equiv(u):=f; eqtb[ocp_id_base+f] := eqtb[u];
-text(ocp_id_base+f) := t;
-if equiv(ocp_trace_level_base)=1 then begin
- print_nl(""); print_esc("ocp"); print_esc(t); print("="); print(cur_name);
- end;
-end;
-
-@ When the user gives a new identifier to a ocp that was previously loaded,
-the new name becomes the ocp identifier of record. OCP names `\.{xyz}' and
-`\.{XYZ}' are considered to be different.
-
-@<If this ocp has already been loaded...@>=
-flushable_string:=str_ptr-1;
-for f:=ocp_base+1 to ocp_ptr do
- if str_eq_str(ocp_name(f),cur_name)and str_eq_str(ocp_area(f),cur_area) then
- begin
- if cur_name=flushable_string then begin
- flush_string; cur_name:=ocp_name(f);
- end;
- goto common_ending
- end
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure new_ocp_list(@!a:small_number);
-var u:pointer; {user's ocp list identifier}
-@!f:internal_ocp_list_number; {runs through existing ocp lists}
-@!t:str_number; {name for the frozen ocp list identifier}
-begin if job_name=0 then open_log_file;
- {avoid confusing \.{texput} with the ocp list name}
-@.texput@>
-get_r_token; u:=cur_cs;
-if u>=hash_base then t:=text(u) else t:="OCPLIST";
-define(u,set_ocp_list,null_ocp_list); scan_optional_equals;
-f:=read_ocp_list;
- equiv(u) := f; eqtb[ocp_list_id_base+f] := eqtb[u];
- text(ocp_list_id_base+f) := t;
-if equiv(ocp_trace_level_base)=1 then begin
- print_nl(""); print_esc("ocplist"); print_esc(t); print("=");
- print_ocp_list(ocp_list_list[f]);
- end;
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure do_push_ocp_list(@!a:small_number);
-var ocp_list_no:halfword;
- old_number:halfword;
- i:integer;
-begin
-scan_ocp_list_ident; ocp_list_no:=cur_val;
-old_number:=equiv(ocp_active_number_base);
-define(ocp_active_base+old_number, data, ocp_list_no);
-define(ocp_active_number_base, data, (old_number+1));
-
-if equiv(ocp_trace_level_base)=1 then begin
- print_nl("New active ocp list: {");
- for i:=old_number downto 0 do begin
- print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
- print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
- if i<>0 then print(",");
- end;
- print("}");
- end;
-
-active_compile;
-define(ocp_active_min_ptr_base, data, active_min_ptr);
-define(ocp_active_max_ptr_base, data, active_max_ptr);
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure do_pop_ocp_list(@!a:small_number);
-var old_number:halfword;
- i:integer;
-begin
-old_number:=equiv(ocp_active_number_base);
-if old_number=0 then begin
- print_err("No active ocp lists to be popped");
- end
-else
- define(ocp_active_number_base, data, (old_number-1));
-
-if equiv(ocp_trace_level_base)=1 then begin
- print_nl("New active ocp list: {");
- for i:=(old_number-2) downto 0 do begin
- print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
- print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
- if i<>0 then print(",");
- end;
- print("}");
- end;
-
-active_compile;
-define(ocp_active_min_ptr_base, data, active_min_ptr);
-define(ocp_active_max_ptr_base, data, active_max_ptr);
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure do_clear_ocp_lists(@!a:small_number);
-begin
-define(ocp_active_number_base, data, 0);
-active_compile;
-define(ocp_active_min_ptr_base, data, active_min_ptr);
-define(ocp_active_max_ptr_base, data, active_max_ptr);
-end;
-
-
-@* \[54/SyncTeX] The {\sl Synchronize \TeX nology}.
-This section is devoted to the {\sl Synchronize \TeX nology}
-- or simply {\sl Sync\TeX} - used to synchronize between input and output.
-This section explains how synchronization basics are implemented.
-Before we enter into more technical details,
-let us recall in a few words what is synchronization.
-
-\TeX\ typesetting system clearly separates the input and the output material,
-and synchronization will provide a new link between both that can help
-text editors and viewers to work together.
-More precisely, forwards synchronization is the ability,
-given a location in the input source file,
-to find what is the corresponding place in the output.
-Backwards synchronization just performs the opposite:
-given a location in the output,
-retrieve the corresponding material in the input source file.
-
-For better code management and maintainance, we adopt a naming convention.
-Throughout this program, code related to the {\sl Synchronize \TeX nology} is tagged
-with the ``{\sl synctex}'' key word. Any code extract where {\sl Sync\TeX} plays
-its part, either explicitly or implicitly, (should) contain the string ``{\sl synctex}''.
-This naming convention also holds for external files.
-Moreover, all the code related to {\sl Sync\TeX} is gathered in this section,
-except the definitions.
-
-@ Enabling synchronization should be performed from the command line,
-|synctexoption| is used for that purpose.
-This global integer variable is declared here but it is not used here.
-This is just a placeholder where the command line controller will put
-the {\sl Sync\TeX} related options, and the {\sl Sync\TeX} controller will read them.
-
-@ @<Glob...@>=
-@!synctexoption:integer;
-
-@ A convenient primitive is provided:
-\.{\\synctex=1} in the input source file enables synchronization whereas
-\.{\\synctex=0} disables it.
-Its memory address is |synctex_code|.
-It is initialized by the {\sl Sync\TeX} controller to the command-line option if given.
-The controller may filter some reserved bits.
-
-@ In order to give the {\sl Sync\TeX} controller read and write access to
-the contents of the \.{\\synctex} primitive, we declare |synctexoffset|,
-such that |mem[synctexoffset]| and \.{\\synctex} correspond to
-the same memory storage. |synctexoffset| is initialized to
-the correct value when quite everything is initialized.
-
-@ @<Glob...@>=
-@!synctexoffset:integer; {holds the true value of |synctex_code|}
-
-@ @<Initialize whatever...@>=
-synctexoffset:=int_base+synctex_code;
-
-@ @<Initialize synctex primitive@>=
-synctex_init_command;
-
-@ Synchronization is achieved with the help of an auxiliary file named
-`\.{{\sl jobname}.synctex}' ({\sl jobname} is the contents of the
-\.{\\jobname} macro), where a {\sl Sync\TeX} controller implemented
-in the external |synctex.c| file will store geometrical information.
-This {\sl Sync\TeX} controller will take care of every technical details
-concerning the {\sl Sync\TeX} file, we will only focus on the messages
-the controller will receive from the \TeX\ program.
-
-The most accurate synchronization information should allow to map
-any character of the input source file to the corresponding location
-in the output, if relevant.
-Ideally, the synchronization information of the input material consists of
-the file name, the line and column numbers of every character.
-The synchronization information in the output is simply the page number and
-either point coordinates, or box dimensions and position.
-The problem is that the mapping between these informations is only known at
-ship out time, which means that we must keep track of the input
-synchronization information until the pages ship out.
-
-As \TeX\ only knows about file names and line numbers,
-but forgets the column numbers, we only consider a
-restricted input synchronization information called {\sl Sync\TeX\ information}.
-It consists of a unique file name identifier, the {\sl Sync\TeX\ file tag},
-and the line number.
-
-Keeping track of such information,
-should be different whether characters or nodes are involved.
-Actually, only certain nodes are involved in {\sl Sync\TeX},
-we call them {\sl synchronized nodes}.
-Synchronized nodes store the {\sl Sync\TeX} information in their last two words:
-the first one contains a {\sl Sync\TeX\ file tag} uniquely identifying
-the input file, and the second one contains the current line number,
-as returned by the \.{\\inputlineno} primitive.
-The |synctex_field_size| macro contains the necessary size to store
-the {\sl Sync\TeX} information in a node.
-
-When declaring the size of a new node, it is recommanded to use the following
-convention: if the node is synchronized, use a definition similar to
-|my_synchronized_node_size|={\sl xxx}+|synctex_field_size|.
-Moreover, one should expect that the {\sl Sync\TeX} information is always stored
-in the last two words of a synchronized node.
-
-@ By default, every node with a sufficiently big size is initialized
-at creation time in the |get_node| routine with the current
-{\sl Sync\TeX} information, whether or not the node is synchronized.
-One purpose is to set this information very early in order to minimize code
-dependencies, including forthcoming extensions.
-Another purpose is to avoid the assumption that every node type has a dedicated getter,
-where initialization should take place. Actually, it appears that some nodes are created
-using directly the |get_node| routine and not the dedicated constructor.
-And finally, initializing the node at only one place is less error prone.
-
-@ Instead of storing the input file name, it is better to store just an identifier.
-Each time \TeX\ opens a new file, it notifies the {\sl Sync\TeX} controller with
-a |synctex_start_input| message.
-This controller will create a new {\sl Sync\TeX} file tag and
-will update the current input state record accordingly.
-If the input comes from the terminal or a pseudo file, the |synctex_tag| is set to 0.
-It results in automatically disabling synchronization for material
-input from the terminal or pseudo files.
-
-@ @<Prepare new file {\sl Sync\TeX} information@>=
-synctex_start_input; {Give control to the {\sl Sync\TeX} controller}
-
-@ @<Prepare terminal input {\sl Sync\TeX} information@>=
-synctex_tag:=0;
-
-@ @<Prepare pseudo file {\sl Sync\TeX} information@>=
-synctex_tag:=0;
-
-@ @<Close {\sl Sync\TeX} file and write status@>=
-synctex_terminate(log_opened); {Let the {\sl Sync\TeX} controller close its files.}
-
-@ Synchronized nodes are boxes, math, kern and glue nodes.
-Other nodes should be synchronized too, in particular math noads.
-\TeX\ assumes that math, kern and glue nodes have the same size,
-this is why both are synchronized.
-{\sl In fine}, only horizontal lists are really used in {\sl Sync\TeX},
-but all box nodes are considered the same with respect to synchronization,
-because a box node type is allowed to change at execution time.
-
-The next sections are the various messages sent to the {\sl Sync\TeX} controller.
-The argument is either the box or the node currently shipped out.
-The vertical boxes are not recorded, but the code is available for clients.
-
-@ @<Start sheet {\sl Sync\TeX} information record@>=
-pdf_output_value:=pdf_output; {{\sl Sync\TeX}: we assume that |pdf_output| is properly set up}
-synctex_sheet(mag);
-
-@ @<Finish sheet {\sl Sync\TeX} information record@>=
-synctex_teehs;
-
-@ @<Start vlist {\sl Sync\TeX} information record@>=
-synctex_vlist(this_box);
-
-@ @<Finish vlist {\sl Sync\TeX} information record@>=
-synctex_tsilv(this_box);
-
-@ @<Start hlist {\sl Sync\TeX} information record@>=
-synctex_hlist(this_box);
-
-@ @<Finish hlist {\sl Sync\TeX} information record@>=
-synctex_tsilh(this_box);
-
-@ @<Record void list {\sl Sync\TeX} information@>=
- if type(p)=vlist_node then begin
- synctex_void_vlist(p,this_box);
- end
- else begin
- synctex_void_hlist(p,this_box);
- end;
-
-@ @<Record current point {\sl Sync\TeX} information@>=
-synctex_current;
-
-@ @<Record horizontal |rule_node| or |glue_node| {\sl Sync\TeX} information@>=
-synctex_horizontal_rule_or_glue(p,this_box);
-
-@ @<Record |kern_node| {\sl Sync\TeX} information@>=
-synctex_kern(p,this_box);
-
-@ @<Record |math_node| {\sl Sync\TeX} information@>=
-synctex_math(p,this_box);
-
-
-@ {\sl Nota Bene:}
-The {\sl Sync\TeX} code is very close to the memory model.
-It is not connected to any other part of the code,
-except for memory management. It is possible to neutralize the {\sl Sync\TeX} code
-rather simply. The first step is to define a null |synctex_field_size|.
-The second step is to comment out the code in ``Initialize bigger nodes...'' and every
-``Copy ... {\sl Sync\TeX} information''.
-The last step will be to comment out the |synctex_tag_field| related code in the
-definition of |synctex_tag| and the various ``Prepare ... {\sl Sync\TeX} information''.
-Then all the remaining code should be just harmless.
-The resulting program would behave exactly the same as if absolutely no {\sl Sync\TeX}
-related code was there, including memory management.
-Of course, all this assumes that {\sl Sync\TeX} is turned off from the command line.
-@^synctex@>
-@^synchronization@>
-
-@* \[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.