diff options
Diffstat (limited to 'Build/source/texk/web2c/luatexdir/luatex.web')
-rw-r--r-- | Build/source/texk/web2c/luatexdir/luatex.web | 31941 |
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. |