summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/pdftexdir
diff options
context:
space:
mode:
authorDenis Bitouzé <dbitouze@wanadoo.fr>2021-02-25 18:23:07 +0000
committerDenis Bitouzé <dbitouze@wanadoo.fr>2021-02-25 18:23:07 +0000
commitc6101f91d071883b48b1b4b51e5eba0f36d9a78d (patch)
tree1bf7f5a881d7a4f5c5bf59d0b2821943dd822372 /Build/source/texk/web2c/pdftexdir
parent07ee7222e389b0777456b427a55c22d0e6ffd267 (diff)
French translation for tlmgr updated
git-svn-id: svn://tug.org/texlive/trunk@57912 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c/pdftexdir')
-rw-r--r--Build/source/texk/web2c/pdftexdir/COPYINGv2339
-rw-r--r--Build/source/texk/web2c/pdftexdir/ChangeLog1641
-rw-r--r--Build/source/texk/web2c/pdftexdir/NEWS774
-rw-r--r--Build/source/texk/web2c/pdftexdir/README60
-rw-r--r--Build/source/texk/web2c/pdftexdir/am/libpdftex.am65
-rw-r--r--Build/source/texk/web2c/pdftexdir/am/pdftex.am132
-rw-r--r--Build/source/texk/web2c/pdftexdir/am/pdftosrc.am42
-rw-r--r--Build/source/texk/web2c/pdftexdir/am/ttf2afm.am37
-rw-r--r--Build/source/texk/web2c/pdftexdir/avl.c796
-rw-r--r--Build/source/texk/web2c/pdftexdir/avl.h117
-rw-r--r--Build/source/texk/web2c/pdftexdir/avlstuff.c172
-rw-r--r--Build/source/texk/web2c/pdftexdir/avlstuff.h24
-rw-r--r--Build/source/texk/web2c/pdftexdir/change-files.txt41
-rw-r--r--Build/source/texk/web2c/pdftexdir/char-warning-pdftex.ch62
-rw-r--r--Build/source/texk/web2c/pdftexdir/epdf.c111
-rw-r--r--Build/source/texk/web2c/pdftexdir/etex_version.h1
-rwxr-xr-xBuild/source/texk/web2c/pdftexdir/expanded.test19
-rw-r--r--Build/source/texk/web2c/pdftexdir/image.h111
-rw-r--r--Build/source/texk/web2c/pdftexdir/macnames.c309
-rw-r--r--Build/source/texk/web2c/pdftexdir/mapfile.c933
-rwxr-xr-xBuild/source/texk/web2c/pdftexdir/pdfimage.test15
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex-common.h118
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex.ch468
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex.defines148
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex.h64
-rwxr-xr-xBuild/source/texk/web2c/pdftexdir/pdftex.test11
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex.web39995
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftex_version.h1
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftexextra.c12
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftexextra.h40
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftoepdf.cc1076
-rw-r--r--Build/source/texk/web2c/pdftexdir/pdftosrc.cc204
-rwxr-xr-xBuild/source/texk/web2c/pdftexdir/pdftosrc.test20
-rw-r--r--Build/source/texk/web2c/pdftexdir/pkin.c425
-rw-r--r--Build/source/texk/web2c/pdftexdir/ptexlib.h359
-rw-r--r--Build/source/texk/web2c/pdftexdir/ptexmac.h246
-rw-r--r--Build/source/texk/web2c/pdftexdir/regex/COPYING.LIB510
-rw-r--r--Build/source/texk/web2c/pdftexdir/regex/README122
-rw-r--r--Build/source/texk/web2c/pdftexdir/regex/regcomp.c3797
-rw-r--r--Build/source/texk/web2c/pdftexdir/regex/regex.c31
-rw-r--r--Build/source/texk/web2c/pdftexdir/regex/regex.h556
-rw-r--r--Build/source/texk/web2c/pdftexdir/regex/regex_internal.c1719
-rw-r--r--Build/source/texk/web2c/pdftexdir/regex/regex_internal.h781
-rw-r--r--Build/source/texk/web2c/pdftexdir/regex/regexec.c4303
-rw-r--r--Build/source/texk/web2c/pdftexdir/subfont.c228
-rwxr-xr-xBuild/source/texk/web2c/pdftexdir/tests/cnfline.test23
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/cnfline.tex13
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/expanded.tex46
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/expanded.txt61
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/pdfimage.tex27
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/postV3.afm69
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/postV3.ttfbin7456 -> 0 bytes
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/postV7.afm69
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/postV7.ttfbin7456 -> 0 bytes
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/test-13.pdfbin18081 -> 0 bytes
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/test-13.xref13
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/test-15.pdfbin17438 -> 0 bytes
-rw-r--r--Build/source/texk/web2c/pdftexdir/tests/test-15.xref15
-rw-r--r--Build/source/texk/web2c/pdftexdir/tex.ch038
-rw-r--r--Build/source/texk/web2c/pdftexdir/tounicode.c531
-rw-r--r--Build/source/texk/web2c/pdftexdir/ttf2afm.c1127
-rwxr-xr-xBuild/source/texk/web2c/pdftexdir/ttf2afm.test35
-rw-r--r--Build/source/texk/web2c/pdftexdir/utils.c1558
-rw-r--r--Build/source/texk/web2c/pdftexdir/vfpacket.c107
-rwxr-xr-xBuild/source/texk/web2c/pdftexdir/wprob.test19
-rw-r--r--Build/source/texk/web2c/pdftexdir/writeenc.c180
-rw-r--r--Build/source/texk/web2c/pdftexdir/writefont.c720
-rw-r--r--Build/source/texk/web2c/pdftexdir/writeimg.c549
-rw-r--r--Build/source/texk/web2c/pdftexdir/writejbig2.c834
-rw-r--r--Build/source/texk/web2c/pdftexdir/writejpg.c404
-rw-r--r--Build/source/texk/web2c/pdftexdir/writepng.c675
-rw-r--r--Build/source/texk/web2c/pdftexdir/writet1.c1711
-rw-r--r--Build/source/texk/web2c/pdftexdir/writet3.c429
-rw-r--r--Build/source/texk/web2c/pdftexdir/writettf.c1463
-rw-r--r--Build/source/texk/web2c/pdftexdir/writettf.h125
-rw-r--r--Build/source/texk/web2c/pdftexdir/writezip.c95
76 files changed, 0 insertions, 71971 deletions
diff --git a/Build/source/texk/web2c/pdftexdir/COPYINGv2 b/Build/source/texk/web2c/pdftexdir/COPYINGv2
deleted file mode 100644
index d159169d105..00000000000
--- a/Build/source/texk/web2c/pdftexdir/COPYINGv2
+++ /dev/null
@@ -1,339 +0,0 @@
- GNU GENERAL PUBLIC LICENSE
- Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it. (Some other Free Software Foundation software is covered by
-the GNU Lesser General Public License instead.) You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
- To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. You must make sure that they, too, receive or can get the
-source code. And you must show them these terms so they know their
-rights.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- Finally, any free program is threatened constantly by software
-patents. We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary. To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License. The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language. (Hereinafter, translation is included without limitation in
-the term "modification".) Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
- 1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
- 2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) You must cause the modified files to carry prominent notices
- stating that you changed the files and the date of any change.
-
- b) You must cause any work that you distribute or publish, that in
- whole or in part contains or is derived from the Program or any
- part thereof, to be licensed as a whole at no charge to all third
- parties under the terms of this License.
-
- c) If the modified program normally reads commands interactively
- when run, you must cause it, when started running for such
- interactive use in the most ordinary way, to print or display an
- announcement including an appropriate copyright notice and a
- notice that there is no warranty (or else, saying that you provide
- a warranty) and that users may redistribute the program under
- these conditions, and telling the user how to view a copy of this
- License. (Exception: if the Program itself is interactive but
- does not normally print such an announcement, your work based on
- the Program is not required to print an announcement.)
-
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
- a) Accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of Sections
- 1 and 2 above on a medium customarily used for software interchange; or,
-
- b) Accompany it with a written offer, valid for at least three
- years, to give any third party, for a charge no more than your
- cost of physically performing source distribution, a complete
- machine-readable copy of the corresponding source code, to be
- distributed under the terms of Sections 1 and 2 above on a medium
- customarily used for software interchange; or,
-
- c) Accompany it with the information you received as to the offer
- to distribute corresponding source code. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form with such
- an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it. For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable. However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
- 4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
- 5. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Program or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
- 7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all. For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
- 8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
- 10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
- END OF TERMS AND CONDITIONS
-
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License along
- with this program; if not, write to the Free Software Foundation, Inc.,
- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) year name of author
- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
- `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
- <signature of Ty Coon>, 1 April 1989
- Ty Coon, President of Vice
-
-This General Public License does not permit incorporating your program into
-proprietary programs. If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library. If this is what you want to do, use the GNU Lesser General
-Public License instead of this License.
diff --git a/Build/source/texk/web2c/pdftexdir/ChangeLog b/Build/source/texk/web2c/pdftexdir/ChangeLog
deleted file mode 100644
index b7423541d95..00000000000
--- a/Build/source/texk/web2c/pdftexdir/ChangeLog
+++ /dev/null
@@ -1,1641 +0,0 @@
-2021-02-22 Phelype Oleinik <phe.h.o1@gmail.com>
-
- * pdftex.web: avoid "expansion depth" overflow with \numexpr.
-
-2021-02-17 Karl Berry <karl@tug.org>
-
- * NEWS,
- * pdftex_version.h,
- * pdftex.web (pdftex_revision, pdftex_version_string):
- version [1.40.]22 for TL21.
-
- * char-warning-pdftex.ch: doc tweak.
-
-2021-02-13 Karl Berry <karl@freefriends.org>
-
- * am/pdftex.am (pdftex_ch_srcs): adjust for split enctex changes.
-
-2021-02-06 Akira Kakuto <kakuto@w32tex.org>
-
- * pdftex.web: sync \tracingparagraphs fix from tex.web.
-
-2021-01-28 Marcel Fabian Krueger <tex@2krueger.de>
-
- * tounicode.c ((un)dumptounicode): use integer, not size_t,
- so .fmt files work across platforms.
-
-2021-01-20 Karl Berry <karl@freefriends.org>
-
- * NEWS: update.
- * ptexmac.h (undumpcharptr): use xmalloc, not malloc.
-
-2021-01-20 Marcel Fabian Krueger <tex@2krueger.de>
-
- (Un)dump \pdfglyphtounicode assignments in the .fmt.
- * pdftex.web (Dump/Undump pdftex data): call (un)dumptounicode.
- * ptexlib.h ((un)dumptounicode): declare.
- * tounicode.c ((un)dumptounicode): define.
- * ptexmac.h ((un)dumpcharptr): #define here, from writeimg.c
- (using generic_dump).
- * writeimg.c: #defines moved.
- ntg-pdftex mail, 17 Jan 2021 21:47:33.
-
-2021-01-04 Thanh Han The <hanthethanh@gmail.com>
-
- * ttf2afm.c (make_name): yet another attempt at filtering
- control characters, since the test font, SourceCodePro (as well
- as many other Mac fonts), actually contains control characters
- (24 and 25), due to UTF-16BE.
-
-2021-01-11 Karl Berry <karl@freefriends.org>
-
- * ttf2afm.c (make_name): better to use unsigned char.
-
-2021-01-10 Karl Berry <karl@freefriends.org>
-
- * ttf2afm.c (make_name): go back to copying all characters
- to try to placate NetBSD. No harm in it?
- https://tug.org/pipermail/tlbuild/2021q1/004780.html
-
-2021-01-06 Karl Berry <karl@freefriends.org>
-
- * ttf2afm.c (make_name): let's exclude iscntrl() per Thanh,
- but accept crlf and tab.
-
-2021-01-05 Karl Berry <karl@freefriends.org>
-
- * ttf2afm.c (make_name): copy all characters, not just isprint().
- From Akira/Mojca.
-
-2021-01-04 Thanh Han The <hanthethanh@gmail.com>
-
- * ttf2afm.c (make_name): new fn.
- (read_font): output FontName etc. in afm.
- Request from Doug McAllaster, mail to Thanh of 4 Jan 2021 14:17:40.
-
-2020-10-31 Thanh Han The <hanthethanh@gmail.com>
-
- * pdftex.web (pdf_begin_string): don't output fake space
- unless pdf_doing_string. pdftex r838-839.
- Report from Ulrike Fischer, 18oct20.
-
-2020-08-31 Marcel Fabian Krueger <tex@2krueger.de>
-
- * pdftex.web (Scan the argument for command |c|) <expanded_code>:
- free_avail(def_ref) to avoid memory exhaustion with many \expanded.
-
-2020-08-04 Andreas Scherer <https://ascherer.github.io>
-
- * pdftex.web: Pick a few obvious nits.
-
-2020-08-03 Andreas Scherer <https://ascherer.github.io>
-
- * pdftex.ch: Move pdfTeX variants of MLTeX code next to originals.
-
-2020-07-22 Akira Kakuto <kakuto@w32tex.org>
-
- * pdftex.web, writeimg.c: Show unfound file names in
- fatal error messages.
- https://tug.org/pipermail/pdftex/2020-July/009203.html
-
-2020-07-20 Andreas Scherer <https://ascherer.github.io>
-
- * pdftex.ch: Avoid overful hboxes in table-of-contents.
-
-2020-07-19 Karl Berry <karl@freefriends.org>
-
- * char-warning-pdftex.ch: new file to implement new feature;
- if \tracinglostchars>=3, missing characters cause an error and not
- just a diagnostic message. Also, always report the hex code of the
- missing character. From David Jones, tex-implements 30jun2020.
- * am/pdftex.am (pdftex_ch_srcs): add it.
- * change-files.txt: update.
-
-2020-07-17 Andreas Scherer <https://ascherer.github.io>
-
- * am/pdftex.am: Avoid changefile ambiguity.
-
-2020-06-11 Thanh Han The <hanthethanh@gmail.com>
-
- * pdftex.web (Create link annotations...): check for gen_running_link.
- (pdf_running_link_{off,on}_node): new @d for new primitives.
- (Put each ...): define them.
- (Cases of |print_cmd_chr|...): print them.
- (Declare act...): switch on them.
- (Implement \.{\\pdfrunninglinkoff}, ...on): new modules to
- implement them.
- (Display the whatsit...),
- (Mark a partial copy...),
- (Wipe out the whatsit...): handle them as whatsits.
- (gen_running_link): new global, define and initialize.
- (Output the whatsit...): set gen_running_link according
- to the new primitives.
- pdftex r835. Following suggestion from Ulrike Fischer,
- https://tug.org/pipermail/tex-live/2018-November/042759.html.
-
-2020-06-10 Thanh Han The <hanthethanh@gmail.com>
-
- * pdftex.web (end_link): warn instead of fatal for
- "\pdfendlink ended up in different nesting level than \pdfstartlink".
- pdftex r832. Suggestion from Ulrike Fischer,
- https://tug.org/pipermail/tex-live/2018-November/042759.html.
-
-2020-06-03 Thanh Han The <hanthethanh@gmail.com>
-
- * pdftex.web: Initialize save_tail to avoid a value of 0 given at
- compile time. Remove unnecessary codes. (from Hironobu
- Yamashita). pdftex r829.
- https://mailman.ntg.nl/pipermail/ntg-pdftex/2020-May/004330.html
-
-2020-06-02 Thanh Han The <hanthethanh@gmail.com>
-
- * pdftex.web (auto_kern): @d=3, rather than "explicit".
- (Display kern |p|): report auto_kern message; avoid link(r)
- when r=null. pdftex r828. Report from Robert Schlict,
- https://mailman.ntg.nl/pipermail/ntg-pdftex/2020-May/004317.html
-
-2020-05-31 Hironobu Yamashita <h.y.acetaminophen@gmail.com>
-
- * writepng.c: Suppress a compiler warning: '&&' within '||'
-
-2020-05-15 Akira Kakuto <kakuto@w32tex.org>
-
- * pdftoepdf.cc, pdftosrc.cc, NEWS: remove support of poppler.
-
-2020-05-14 Karl Berry <karl@freefriends.org>
-
- * pdftoepdf-poppler0.68.0.cc,
- * pdftoepdf-poppler0.69.0.cc,
- * pdftoepdf-poppler0.70.0.cc,
- * pdftoepdf-poppler0.71.0.cc,
- * pdftoepdf-poppler0.72.0.cc,
- * pdftoepdf-poppler0.75.0.cc,
- * pdftoepdf-poppler0.76.0.cc,
- * pdftoepdf-poppler0.83.0.cc,
- * pdftoepdf-poppler0.86.0.cc,
- * pdftosrc-newpoppler.cc,
- * pdftosrc-poppler0.71.0.cc,
- * pdftosrc-poppler0.72.0.cc,
- * pdftosrc-poppler0.76.0.cc,
- * pdftosrc-poppler0.83.0.cc: remove these interim stabs at poppler
- support; now poppler is not supported in TL.
- See source/m4/kpse-xpdf-flags.m4 for some discussion.
-
-2020-03-28 Thanh Han The <hanthethanh@gmail.com>
-
- * pdftex.web (load_expand_font, vf_def_font): do not call
- copy_expand_params on null_font. pdftex r823.
- Original report from Robert Schlicht,
- https://tug.org/pipermail/tex-live/2020-March/045099.html
- https://mailman.ntg.nl/pipermail/ntg-pdftex/2020-March/004307.html
-
-2020-03-27 Karl Berry <karl@tug.org>
-
- * TeX Live 2020, pdftex 1.40.21.
-
-2020-02-29 Akira Kakuto <kakuto@w32tex.org>
-
- Add pdftoepdf-poppler0.86.0.cc to support system poppler 0.86.0.
-
-2019-12-30 Akira Kakuto <kakuto@w32tex.org>
-
- * utils.c: Not include poppler-config.h, by assuming that
- POPPLER_VERSION is defined properly.
-
-2019-12-10 Hironori Kitagawa <h_kitagawa2001@yahoo.co.jp>
-
- * am/pdftex.am (pdftex_ch_srcs): add zlib-fmt.ch.
-
-2019-11-25 Joseph Wright <joseph.wright@morningstar2.co.uk>
-
- * pdftex.web: New primitive \pdfmajorversion.
- (pdf_major_version_code, pdf_major_version, print_param,
- <Put each...>): housekeeping.
- (<Initialize table entries...>): default 1.
- (<Glob...>): fixed_pdf_major_version.
- (pdf_version_written, <Set init...>): rename from
- pdf_minor_version_written.
- (check_pdfversion): rename from check_pdfminorversion,
- and also check pdf_major_version for sanity, and set the fixed_ value,
- and use pdf_major_version in the %PDF- line.
- (pdf_begin_obj, pdf_begin_dict, <Initialize variables ...>,
- <Implement \.{\\pdfximage}>): change call to check_pdfversion.
- <Undump pdftex data>: undump pdf_major_version.
- (scan_image): include pdf_major_version in call to read_image.
- * pdftoepdf.cc (read_pdf_info): new arg major_pdf_version_wanted,
- and check it when including PDF.
- * ptexlib.h (readimage, undumpimagemeta): new integer args in decl.
- * writeimg.c (readimage, undumpimagemeta): new arg
- pdfmajorversion, and check it.
- * writepng.c (read_png_info): check fixedpdfmajorversion
- along with fixedpdfminorversion for various png color attributes.
-
-2019-08-06 Karl Berry <karl@freefriends.org>
-
- * tests/cnfline.test,
- * tests/cnfline.tex: new files.
- * am/pdftex.am (pdftex_tests): add pdftexdir/tests/cnfline.test.
- (cnfline.log): depend on pdftex$(EXEEXT).
-
-2019-05-08 Akira Kakuto <kakuto@w32tex.org>
-
- * writeimg.c: Use a new function find_input_file() to find
- an image file.
- A report in tex-k list:
- https://tug.org/pipermail/tex-k/2019-May/003014.html
-
-2019-05-03 Akira Kakuto <kakuto@w32tex.org>
-
- * pdftosrc-poppler0.76.0.cc, pdftoepdf-poppler0.76.0.cc:
- Added to support system poppler 0.76.[01].
-
-2019-04-07 Karl Berry <karl@freefriends.org>
-
- * TeX Live 2019.
-
-2019-03-30 Akira Kakuto <kakuto@w32tex.org>
-
- * epdf.c: Allow spaces in CharSet.
- Reported by Robert:
- https://tug.org/pipermail/pdftex/2019-March/009146.html
-
-2019-03-21 Akira Kakuto <kakuto@w32tex.org>
-
- * pdftoepdf-poppler0.75.0.cc: Support poppler-0.75.0.
-
-2019-01-27 Karl Berry <karl@gnu.org>
-
- * pdftex.web (pdf_omit_charset_code, pdf_omit_charset
- print_param,
- <Put each...>,
- get_pdf_omit_charset)
- * writefont.c (write_fontdescriptor): reverse sense and name
- to \pdfomitcharset.
-
-2019-01-27 Karl Berry <karl@gnu.org>
-
- * pdftex.web (pdf_include_charset_code, pdf_include_charset):
- new primitive parameter \pdfincludecharset.
- (print_param): print_esc it.
- (Put each...): insert in hash table.
- (get_pdf_include_charset): new fn to get its value.
- * writefont.c (write_fontdescriptor): check it before outputting
- CharSet.
-
-2019-01-19 Karl Berry <karl@tug.org>
-
- * NEWS,
- * pdftex_version.h,
- * pdftex.web (pdftex_revision, pdftex_version_string):
- version [1.40.]20 for TL19.
-
-2019-01-08 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftosrc-poppler0.72.0.cc: Support poppler-0.73.0.
-
-2019-01-07 Hironobu Yamashita <h.y.acetaminophen@gmail.com>
-
- * tounicode.c (deftounicode): suppress a compiler warning:
- format specifies type 'unsigned int' but the argument has
- type 'long' [-Wformat]
- * writet3.c (writet3): suppress a compiler warning:
- add explicit braces to avoid dangling else [-Wdangling-else]
-
-2018-12-07 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftosrc-poppler0.72.0.cc, pdftoepdf-poppler0.72.0.cc:
- Add to support system poppler-0.72.0.
- * NEWS: Change comments on system poppler.
-
-2018-11-01 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftosrc-poppler0.71.0.cc, pdftoepdf-poppler0.71.0.cc:
- Add to support system poppler-0.71.0.
- * NEWS: Change comments on system poppler.
-
-2018-10-24 Karl Berry <karl@tug.org>
-
- * writet1.c (t1_check_unusual_charstring): don't call
- strlen(t1_buf_array) if it is null.
- From Luigi, 22 Oct 2018 22:43:03.
-
-2018-10-22 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftosrc-newpoppler.cc: Add a comment that it works upto
- the poppler 0.70.0.
- * pdftoepdf-poppler0.70.0.cc: A new file for poppler-0.70.0
- and newer.
-
-2018-10-02 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftoepdf.cc: Remove changes for w32.
-
-2018-09-23 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftosrc-newpoppler.cc: Add a comment that it works upto
- the poppler 0.69.0.
- * pdftoepdf-poppler0.68.0.cc: Rename pdftoepdf-newpoppler.cc
- and add comments.
- * pdftoepdf-poppler0.69.0.cc: A new file for poppler-0.69.0
- and newer.
-
-2018-09-18 Nick Roessler <nicholas.e.roessler@gmail.com>
-
- * writet1.c (t1_check_unusual_charstring): protect against buffer
- overflow.
-
-2018-09-09 Karl Berry <karl@tug.org>
-
- * expanded.test,
- * ttf2afm.test: LC_ALL=LANGUAGE=C.
-
-2018-07-09 Karl Berry <karl@freefriends.org>
-
- * writefont.c (write_fontdescriptor) [ENABLE_PDF_CHARSET]:
- compile-time conditional for re-enabling output of PDF /CharSet,
- which is now disabled by default.
-
-2018-06-13 TANAKA Takuji <ttk@t-lab.opal.ne.jp>
-
- * ptexlib.h: Output correct Unicode strings on console
- (w32 only).
-
-2018-06-12 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftoepdf.cc: Free unused memory (w32 only).
-
-2018-06-11 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftoepdf.cc: Remove xfree(file_name) in order to avoid
- to output garbage.
- * pdftoepdf-newpoppler.cc: Remove _WIN32 changes, since
- utf-8 names are transformed to Unicode and _wopened
- in poppler.
-
-2018-06-10 TANAKA Takuji <ttk@t-lab.opal.ne.jp>
-
- * ptexlib.h, pdftoepdf.cc, pdftoepdf-newpoppler.cc:
- Allow non-ascii file names for pdfTeX with UTF-8 source files
- (w32 only). The function is enabled by setting
- 'command_line_encoding=utf-8' in texmf.cnf.
-
-2018-05-29 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * ptexlib.h: Discard the changes on 2018-05-11, since
- 'command_line_encoding=utf-8' is not so natural for
- pdfTeX (w32 only).
-
-2018-05-13 Joseph Wright <joseph.wright@morningstar2.co.uk>
-
- * pdftex.web: New primitive \expanded based on original
- suggestion by Heiko Oberdiek, and with work by
- Bruno Le Floch and David Carlisle (on behalf of The LaTeX Project).
- (expanded_code): new @d, new cases.
- https://mailman.ntg.nl/pipermail/ntg-pdftex/2018-May/004233.html
-
-2018-05-11 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * ptexlib.h: Allow non-ascii file names in pdfTeX (w32 only).
-
-2018-04-28 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftoepdf-newpoppler.cc, pdftosrc-newpoppler.cc:
- Support poppler 0.64.0.
-
-2018-04-14 Karl Berry <karl@tug.org>
-
- * TeX Live 2018 release, pdftex 1.40.19.
-
-2018-04-04 Jerry James <loganjerry@gmail.com>
-
- * pdftoepdf-newpoppler.cc: Do not copy a Dict, get a reference instead.
-
-2018-03-24 Hironobu Yamashita <h.y.acetaminophen@gmail.com>
- Hironori Kitagawa <h_kitagawa2001@yahoo.co.jp>
-
- * pdftex.ch: Recover the right \lastnodetype initialization
- value ignored by tex.ch.
-
-2018-03-20 Hans Hagen <pragma@wxs.nl>
-
- * pdftex.web (Glob...): defined saved_pdf_cur_form.
- (Write out pending forms): save and restore the form.
- Original report from Alexander Grahn,
- http://tug.org/pipermail/tex-live/2018-March/041210.html.
-
-2018-03-06 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftex.web: pdftex_revision=="19".
- Reported by Uwe Siart, 2018-03-06.
-
-2018-01-25 Hironobu Yamashita <h.y.acetaminophen@gmail.com>
- and Karl Berry <karl@freefriends.org>
-
- * writefont.c (font_is_used): import LuaTeX's font_has_subset
- with different name.
- (dopdffont): call it, to avoid failed assertion. (tests/09-fontobjnum)
- Original report from Enrico Gregorio,
- tug.org/pipermail/tex-live/2018-January/040966.html
- followup with patch at
- mailman.ntg.nl/pipermail/ntg-pdftex/2018-January/004209.html
-
-2018-01-06 Karl Berry <karl@freefriends.org>
-
- * pdftex.web (literal): if a non-PDF special is ignored,
- also output "<special> " and the first 64 characters of the special.
- (slow_print_substr): new procedure, although surely there's
- already a way to print a substring of a pool string.
-
-2018-01-01 Pali Roh\'ar <pali.rohar@gmail.com>
-
- Patch 1: explicitly detect bitmap PK font in fm_scan_line,
- instead of the implicit check of ps_name and ff_name being NULL.
- * ptexmac.h (F_PK, set_pk, unset_pk, is_pk): new macros.
- * writefont.c (dopdffont): call writet3 if is_pk.
- * mapfile.c (fm_scan_line): call set_pk if no fontfile
- and no ps_name on encoding line.
-
- Patch 2: Always embed bitmap fonts with different sizes
- separately, even if it has a fontmap entry; i.e., no geometric
- scaling in the generated PDF.
- * pdftex.defines (isscalable),
- * ptexlib.h (isscalable),
- * mapfile.c (isscalable): new fn.
- * pdftex.web: call isscalable instead of hasfmentry
- in all cases except @<Output fonts definition@>.
-
- Patch 3: Allow .enc files for bitmap PK fonts.
- * ptexlib.h (writet3): take additional fm_entry* parameter.
- * writefont.c (dopdffont): change call.
- * writet3.c (writet3): change definition;
- write_tounicode and encoding vector if we can.
- (remove_duplicate_glyph_names): new fn.
-
- Patch 4: Additional checks for PK fonts in map file.
- * mapfile.c (check_fm_entry):
-
- ChangeLog entry, some comments, error messages written or tweaked
- by Karl Berry; all substantive code by Pali. Patch posted at
- https://mailman.ntg.nl/pipermail/ntg-pdftex/2017-August/004183.html.
- See test-pkmap.tex for more references and some tests.
-
-2017-12-16 Hironori Kitagawa <h_kitagawa2001@yahoo.co.jp>
-
- * pdftex.web (compare_strings): Fix \pdfstrcmp error message
- "! File ended while ..." to report control sequence correctly.
- http://tug.org/pipermail/tex-k/2017-December/002838.html
-
-2017-12-15 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * tounicode.c (deftounicode): check that value is in range [0,10FFFF].
- Original report from Ross Moore, ntg-pdftex 30 May 2017 06:03:04.
-
-2017-12-02 Karl Berry <karl@tug.org>
-
- * am/pdftex.am (pdftex.pdf, pdftex.tex): new convenience targets
- for simple weave && pdftex to generate typeset output.
-
-2017-11-28 Hironori KITAGAWA <h_kitagawa2001@yahoo.co.jp>
-
- Stop \pdfprimitive\vrule\q from swallowing q, by moving prim_eqtb
- into the end of region 2 of eqtb instead of being a separate table.
- * pdftex.ch (frozen_null_font): add prim_size.
- * pdftex.web (prim_size): move to other region 2 definitions.
- (prim_eqtb_base): new constant.
- (prim_eq_level, prim_eq_type, prim_equiv): use prim_eqtb_base.
- (prim_eqtb): remove array.
- (Set init...): remove initializations.
- (Basic printing...),
- (Basic printing procedures): handle primitives after prim_eqtb_base.
- (Implement \.{\\pdfprimitive}): do not give error if argument is
- not a primitive, just do nothing.
- (Reset |cur_tok| for unexpandable primitives, goto restart):
- handle primitive lookups via prim_eqtb_base instead of cur_cmd*@'400.
- (Cases of |main_control| that are not part of the inner loop):
- <not undefined_primitive>: also set cur_tok.
- (Dump the hash table): do not dump prim_eqtb.
- (Undump the hash table): do not undump prim_eqtb.
-
-2017-11-14 Anders Kaseorg <andersk@mit.edu>
-
- * utils.c (printID): Do not hash the current directory name into
- the PDF ID field, since any variability in it leads to
- non-reproducible builds.
- pdftex mailing list, 2 Sep 2017 01:52:43
- https://bugs.debian.org/874102
-
-2017-10-17 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftosrc.cc: Support also xpdf-3.04 if XPDF304 is defined.
- * pdftoepdf-newpoppler.cc, pdftosrc-newpoppler.cc: New files
- added in order to support poppler 0.59.0 or newer versions.
- POPPLER_VERSION should be defined. At present, simply overwrite
- pdftoepdf.cc and pdftosrc.cc by pdftoepdf-newpoppler.cc and
- pdftosrc-newpoppler.cc, respectively, in order to use these
- files.
- The current pdftoepdf.cc and pdftosrc.cc support
- xpdf-4.00 or newer by default, xpdf-3.04 if XPDF304 is
- defined, and poppler 0.57.0 or older versions if
- POPPLER_VERSION is defined.
-
-2017-10-10 Shreevatsa R <shreevatsa.public@gmail.com>
-
- * pdftex.web: formatting-only fixes to make weave-able.
- Posted to ntg-pdftex, 15 Aug 2017 09:49:59.
-
-2017-09-24 Hironori Kitagawa <h_kitagawa2001@yahoo.co.jp>
-
- * pdftex.web: Avoid overwriting prim_* entries by primitive().
-
-2017-09-14 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftosrc.cc: Fix a potential bug which I introduced on
- 2017-08-13.
-
-2017-08-13 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftosrc.cc: Remove a line, which I believe is not necessary,
- to avoid a crash for xpdf-4.00.
-
-2017-04-19 Karl Berry <karl@freefriends.org>
-
- * mapfile.c (read_field): new parameter buf_size,
- and check buffer for overflow, as in append_char_to_buf.
- (fm_scan_line): change read_field calls;
- set tfm_name to empty string instead of leaving NULL.
- (check_fm_entry): remove checks of tfm_name on every print;
- check for empty tfm_name rather than lack of ps_name and font file;
- check for non-empty tfm_name on slant/extend warnings.
-
-2017-04-12 Karl Berry <karl@freefriends.org>
-
- * mapfile.c (check_fm_entry): do not try to print fm->tfm_name,
- etc., in warnings if null.
- (fm_scan_line): goto bad_line if a null tfm_name,
- even if check_fm_entry returns true.
-
-2017-04-12 Pali Roh\'ar <pali.rohar@gmail.com>
-
- * ptexmac.h (set_subfont, unset_subfont, is_subfont): remove
- these duplicate macros.
-
-2017-03-29 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * writepng.c: Fix the size of memory to allocate when writing
- SMask in write_png_rgb_alpha. Reported by David Fifield:
- http://tug.org/pipermail/pdftex/2017-March/009100.html
-
-2017-03-18 Karl Berry <karl@tug.org>
-
- * NEWS,
- * pdftex_version.h,
- * pdftex.web (pdftex_revision, pdftex_version_string):
- version [1.40.]18 for TL17.
-
-2017-02-18 Heiko Oberdiek <heiko.oberdiek@googlemail.com>
-
- * pdftex.web (substr_of_str): move earlier.
- (Write out page object): if \MediaBox was given in \pdfpageattr,
- do not output our own.
- Mail from Michael Altmann to pdftex, 9 Feb 2017 13:19:05.
- http://tug.org/pipermail/pdftex/2017-February/009097.html
-
-2017-02-16 Karl Berry <karl@freefriends.org>
-
- * regex/regex_internal.h (alloca) [!alloca]: do not try
- to #define if already #defined.
- Report from Vincent Torri on tex-live list, 7 Jul 2016 10:48:15.
- (pdftex r765)
-
-2016-11-05 Karl Berry <karl@tug.org>
-
- * pdftoepdf.cc: doc fix.
-
-2016-07-16 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftoepdf.cc: Use zround(stemV->getNum()) instead of stemV->getInt()
- in epdf_create_fontdescriptor(), since the value of stemV may be real
- in general.
-
-2016-06-12 Karl Berry <karl@freefriends.org>
- and Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * utils.c (last_match_succeeded): new static boolean.
- (matchstrings): set it.
- (getmatch): use it, plus check for non-NULL match_string sooner,
- plus check that rm_eo >= rm_so.
- Original bug report from David Carlisle,
- http://tug.org/pipermail/tex-live/2016-June/038664.html
- (pdftex r759)
-
-2016-06-12 Karl Berry <karl@freefriends.org>
- and Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * utils.c (last_match_succeeded): new static boolean.
- (matchstrings): set it.
- (getmatch): use it, plus check for non-NULL match_string sooner,
- plus check that rm_eo >= rm_so.
- Original bug report from David Carlisle,
- http://tug.org/pipermail/tex-live/2016-June/038664.html
-
-2016-05-20 Karl Berry <karl@tug.org>
-
- * TeX Live 2016 release.
-
-2016-04-06 Karl Berry <karl@tug.org>
-
- * pdftexextra.h (COPYRIGHT_HOLDER): don't specifically mention peb
- and e-TeX, as there are many other copyright holders of other pieces
- anyway, and Peter passed away in 2015.
-
-2016-03-24 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * writet1.c: Fix one-byte buffer overflow bug reported by Hanno Boeck:
- http://tug.org/pipermail/tex-live/2016-January/037686.html.
-
-2016-03-21 Karl Berry <karl@tug.org>
-
- * NEWS,
- * pdftex_version.h,
- * pdftex.web (pdftex_revision, pdftex_version_string): [1.40.]17
- for TL'16.
-
-2016-02-15 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftex.web, pdftoepdf.cc: Add \pdfsuppressptexinfo, imported from
- the upstream.
-
-2016-01-19 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftex.web: Avoid to crash for unusual virtual fonts which lead to
- font size >= 2048pt.
-
-2015-08-27 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/libpdftex.am, am/pdftosrc.am: Enable g++ warnings.
- * pdftoepdf.cc, pdftosrc.cc: Avoid g++ warnings.
- * tounicode.c: Avoid gcc warnings.
-
-2015-07-28 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * ptexmac.h: Avoid possible integer overflow.
- * writettf.h: No reason to use 'long' for 32-bit integers.
- * writettf.c: No reason to use the (possibly 64-bit) 'integer'.
-
-2015-07-10 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am, am/pdftosrc.am, am/ttf2afm.am: Dependencies for
- 'make check'.
-
-2015-07-02 Hironori Kitagawa <h_kitagawa2001@yahoo.co.jp>
-
- * utils.c: Moved convertStringToHexString() and getmd5sum()
- from here to ../lib/texmfmp.c.
-
-2015-06-30 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.defines, ptexlib.h, pdftex.web, utils.c: Sync with
- upstream r724.
-
-2015-06-22 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am: Use $(tie_c).
-
-2015-03-07 Karl Berry <karl@tug.org>
-
- * NEWS,
- * pdftex_version.h,
- * pdftex.web (pdftex_revision, pdftex_version_string): [1.40.]16
- for TL'15.
-
-2015-02-16 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * writejpg.c: support JPEG Exif in addition to JFIF.
- (borrowed from dvipdfm-x).
-
-2014-12-12 Karl Berry <karl@gnu.org>
-
- * pdftoepdf.cc (read_pdf_info): do not even warn if
- pdf_inclusion_errorlevel (aka \pdfinclusionerrorlevel) is negative.
- Discussed with Thanh, 31 May 2011 10:17:35.
-
-2014-11-06 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * regex/regcomp.c [WIN64]: Use __int64 (not long) as intptr_t.
-
-2014-08-19 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writepng.c: Avoid PNG warnings.
-
-2014-06-26 Thanh Han The <thanh@river-valley.org>
-
- * pdftoepdf.cc: Put a line-ending character after writing a group dict.
- (Report from Ross Moore on pdftex list,
- http://tug.org/pipermail/pdftex/2014-June/008911.html)
-
-2014-06-19 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * mapfile.c, tounicode.c, writet1.c, writettf: Avoid undefined
- behaviour when char is signed.
-
-2014-06-18 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * ttf2afm.c: Avoid undefined behaviour when char is signed.
-
-2014-06-16 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftosrc.cc: Adapt to xpdf-3.04.
-
-2012-05-20 Thanh Han The <thanh@river-valley.org>
-
- * pdftex.web: do not try to avoid printing 0 0 Td.
- E.g., \rlap fails.
- (Report from Heiko on pdftex list, 21 May 2014 22:11:21.)
-
-2014-05-06 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- Update to e-pTeX and e-upTeX from Akira Kakuto.
- * ptexlib.h (getfiledump): Move declaration also used by
- e-(u)pTeX from here to ../texmfmp.h.
- * utils.c (getfiledump): Move definition also used by
- e-(u)pTeX from here to ../lib/texmfmp.c.
-
-2014-03-18 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftex.web and writefont.c: Import from r704.
-
-2014-03-17 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftoepdf.cc, pdftosrc.cc: Kpathsea headers and <w2c/config.h>
- are now C++ safe.
-
-2014-03-07 Karl Berry <karl@tug.org>
-
- * pdftex_version.h,
- * pdftex.web (pdftex_revision, pdftex_version_string): [1.40.]15.
-
-2014-02-14 Karl Berry <karl@gnu.org>
-
- * pdftex.web (pdf_suppress_warning_page_group): new primitive
- parameter \pdfsuppresswarningpagegroup.
- (get_pdf_suppress_warning_page_group): new fn to get its value.
- * pdftoepdf.cc (write_epdf): check it before issuing warning.
-
-2014-01-20 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- TeX tuneup of 2014.
- * pdftex.web, tex.ch0: Adapt to TeX Version 3.14159265.
-
-2014-01-09 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftoepdf.cc (copyObject): Always write "\nendstream" for
- PDF/A-1b compliance.
-
-2014-01-02 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writepng.c: Allow libpng >= 1.6.3 to read images with
- incorrect CMF bytes.
-
-2014-01-01 Karl Berry <karl@tug.org>
-
- * All source files: update copyright years to include 2014.
-
-2013-12-23 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web (pdf_end_stream): Always write "\nendstream" for
- PDF/A-1b compliance.
-
-2013-12-17 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Always write "\n" after "obj" and before "endobj".
- Suggested by Vincent Immler (http://sarovar.org/tracker/#4341).
-
-2013-12-04 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- Update to e-TeX Version 2.6 [2013-11-21].
- * etex_version.h, pdftex.web: Enable hyphenation of text between
- \beginL and \endL or between \beginR and \endR.
-
-2013-09-27 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * writet1.c (t1_subset_ascii_part): Remove UniqueID in subsets.
- Report from Christian Zietz (czietz/gmx/net),
- tex-k 01 Sep 2013 11:25:47 and previous.
- (Imported from dvipsk.)
-
-2013-08-02 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * ttf2afm.test, tests/postV[37].{afm.ttf}: New test and data.
- * am/ttf2afm.am: Add the new test.
-
-2013-07-30 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * ttf2afm.c, writettf.c: Treat unknown 'post' table versions
- (found in some broken fonts) as 3.0, i.e., no Glyph names.
-
-2013-07-12 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am, tests/pdfimage.tex: Add a .pdf image.
-
-2013-07-04 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdfimage.test, tests/pdfimage.tex: New test and data.
- * am/pdftex.am: Add the new test.
-
-2013-06-28 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * mapfile.c: First #include <w2c/config.h> via "ptexlib.h".
- * pdftosrc.cc: First #include <w2c/config.h>.
-
-2013-06-12 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- Update to e-pTeX and e-upTeX 130605 from Hironori Kitagawa.
- * ptexlib.h (initstarttime, makecstring, makecfilename,
- getcreationdate, getfilemoddate, getfilesize): Move declarations
- of functions also used by e-(u)pTeX from here to ../texmfmp.h.
- * utils.c (initstarttime, makecstring, makecfilename,
- getcreationdate, getfilemoddate, getfilesize): Move definition
- of these functions from here to ../lib/texmfmp.c.
-
-2013-04-22 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftex.web: pdftex_revision = "14"
-
-2013-04-09 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: 1.40.13 ---> 1.40.14 for TL 2013.
-
-2013-03-06 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Typos.
-
-2013-03-04 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am: Better rules for {pdf,e}tex_version.h.
-
-2013-02-28 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Adapt to e-TeX 2.5.
-
-2013-02-23 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * etex_version.h: New file extracted from pdftex.web.
- * am/pdftex.am, pdftexextra.h: Adjust.
-
-2013-01-28 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * utils.c: Include <w2c/config.h> first for large file support.
-
-2013-01-24 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * wprob.test: Avoid spurious failure of parallel-tests.
- * am/pdftex.am: Renamed wprob.{tex,log} => pwprob.{tex,log}.
-
-2013-01-10 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * macnames.c, pdftex-common.h, pdftoepdf.cc, ttf2afm.c,
- writet1.c: Change 'const char notdef[]' -> 'char notdef[]' and
- remove casts (const char *) -> (char *).
-
- * mapfile.c (dummy_fm_entry): Delare const_fm_entry as non-const
- and remove the cast.
-
- * utils.c (writestreamlength): Cast length for printing.
-
-2012-12-16 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am (pdftex_version.h): Enable silent rules.
-
-2012-11-05 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Change program name into PDFTEX (not ETEX).
- * pdftex.ch: Remove the contents of ../tex-binpool.ch.
- * am/pdftex.am (pdftex_ch_srcs): Add tex-binpool.ch.
-
-2012-10-19 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftoepdf.cc: In MSVC 5.0 getNewObjectNumber() requires an int
- return value.
-
-2012-10-18 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftoepdf.cc: #include <w2c/config.h> early to avoid problems
- with the definition of boolean in <rpcndr.h> for MINGW32.
-
-2012-10-09 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- The openbsd compat library is no longer used.
- * pdftoepdf.cc, ptexlib.h, utils.c:
- Drop #include "openbsd-compat.h".
- * am/pdftex.am, am/pdftosrc.am: Remove OBSDCOMPAT_*.
-
-2012-10-02 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- Avoid (most) MinGW compiler warnings from regex code.
- * regcomp.c, regexec.c: ANSI C function definitions.
- * regcomp.c (init_dfa): Declare codeset_name as const.
- * regex_internal.c (re_string_reconstruct, re_dfa_add_node):
- Avoid unused variables (for !RE_ENABLE_I18N).
- * regexec.c (regexec, re_search_stub, prune_impossible_nodes):
- Avoid unused variables (for !_LIBC or !RE_ENABLE_I18N).
- (re_search_2_stub): Avoid cast const => non-const.
-
-2012-09-03 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * utils.c [WIN32] (printID): Convert file names '\\' -> '/'.
-
-2012-08-25 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * ttf2afm.c: Drop '#include <libgen.h>', we use xbasename().
- * ptexmac.h: Avoid C++ style comment.
-
-2012-08-10 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * ptexmac.h: Drop unused definition of M_PI & Co.
-
-2012-08-08 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * ptexlib.h: extern void writestreamlength(longinteger, longinteger);
- for largefile.
- extern void storepacket(internalfontnumber, integer, strnumber); to
- avoid a compiler warning.
- * utils.c: void writestreamlength(longinteger length, longinteger offset)
- for largefile.
- * vfpacket.c: void storepacket(internalfontnumber f, integer c, strnumber s)
- to avoid a compiler warning.
-
-2012-08-03 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftex.web: Update eTeX_revision and eTeX_version_string.
-
-2012-08-02 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Adapt to e-TeX Version 2.5.
- * am/pdftex.am: Clarify *tex_version.h dependencies.
-
-2012-07-28 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * utils.c (initversionstring): Avoid using asprintf().
-
-2012-07-19 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am: Distribute pdftex_version.h.
- * pdftexextra.h: Use ../etexdir/etex_version.h.
-
-2012-07-19 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writejbig2.c: Use LONGINTEGER_PRI instead of LONGINTEGER_PRId.
-
-2012-07-15 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * ttf2afm.c: Pass program name string to kpse_set_program_name.
-
-2012-07-15 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
-
- * pdftexextra.c: Must #define DLLPROC before reading pdftexd.h.
-
-2012-07-14 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * utils.c: Use EXIT_FAILURE instead of EX_SOFTWARE.
-
-2012-07-13 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writejbig2.c: Cast xfseeko() arg2 to avoid MSVC warning.
-
-2012-06-30 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftexextra.c [W32TeX]: #define DLLPROC for pdftex.dll.
-
-2012-06-29 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * utils.c [__MINGW32__]: #include <regex.h> as for Unix instead
- of <regex/regex.h>.
- * am/libpdftex.am (libpdftex_a_CPPFLAGS): Change accordingly.
-
-2012-06-21 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftosrc.cc: Use XRef::getNumObjects instead of XRef::getSize,
- required for poppler >= 0.19.0.
-
-2012-05-20 Thanh Han The <thanh@river-valley.org>
-
- * pdftex.defines (get/setimagegroupref): these replace imagegroupref.
- * ptexlib.h: likewise.
- * writeimg.c: define them, and check for page group
- without object number.
- * pdftex.web: change calls.
- * pdftoepdf.cc: more page-group changes.
- This is all related to http://bugs.debian.org/672951.
-
-2012-05-11 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Adapted to e-TeX Version 2.4.
-
-2012-04-15 Karl Berry <karl@tug.org>
-
- * pdftex.web (pdftex_revision, pdftex_version_string): 1.40.13.
-
-2012-04-12 Thanh Han The <thanh@river-valley.org>
-
- * ttf2afm.c (print_str): new macro, replacing function.
- (escape_eol): new fn, replacing print_str, now returning a string.
-
- * writettf.c (ttf_reindex_glyphs): use %n to sscanf forms
- uniABCD and index123.
-
- * mapfile.c (suppress_warn): way to avoid dup warnings.
-
- * pdftex.web (pdf_suppress_warning_dup_dest_code,
- pdf_suppress_warning_dup_dest_code): new primitives
- \pdfsuppresswarningdupdest and \pdfsuppresswarningdupmap.
- (get_pdf_suppress_warning_dup_map): new fn.
- (warn_dest_dup): check pdf_suppress_warning_dup_dest.
-
-2012-04-11 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Fixed a typo in TeX text (for e-TeX).
-
-2012-01-18 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writejbig2.c (getstreamlen): Change type to `off_t'.
- Use LONGINTEGER_TYPE and LONGINTEGER_PRId for printing.
-
-2012-01-11 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- Consistent support for large JBIG2 files.
- * writejbig2.c: Change type of various struct members, local
- variables and findstreamstart() from `long' or `unsigned long'
- to `off_t'. Do not use xfseek and xfseeko for the same file.
-
-2011-12-16 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Change type of pdf_ptr: longinteger => integer.
- * pdftex-common.h: Change type of pdfptr accordingly.
-
-2011-12-15 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * utils.c (getfiledump): Drop `off_t' cast from arg2 of fseek().
- * ttf2afm.c, writettf.c: Typo in comment.
-
-2011-12-12 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writejbig2.h (removed): Declarations moved ...
- * writejbig2.c: ... to here. Declare most functions as static.
- * am/libpdftex.am (libpdftex_a_SOURCES): Remove writejbig2.h.
-
-2011-10-11 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftosrc.cc: Always use new logic for Object Streams
- (for xpdf without patch-40-objectStream-support-for-pdftosrc).
-
-2011-09-30 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * wprob.test: New shell script to test for uninitialized line.
- * am/pdftex.am: Add the new test.
-
-2011-09-30 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftosrc.test: Shell script for a new test.
- * tests/test-{13,15}.{pdf,xref} (new): Test input and expected
- output (from Hartmut Henkel <hartmut_henkel@gmx,de>).
- * am/pdftosrc.am: Adjust.
-
-2011-07-25 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftoepdf.cc, pdftosrc.cc: #include <assert.h> for both xpdf
- and poppler.
-
-2011-07-11 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftosrc.cc: Rewrite the Object Stream handling for poppler
- (or xpdf without patch-40-objectStream-support-for-pdftosrc).
-
- * pdftoepdf.cc: Replace `#ifdef HAVE_GETPDFMAJORVERSION' by
- '#ifdef POPPLER_VERSION' for poppler >= 0.12.
-
-2011-05-12 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writepng.c: #define PNG_FP_1 for libpng < 1.5.0.
-
-2011-05-11 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writepng.c: Fix for 16bit images in pdf 1.4 (8bit) mode,
- from Hartmut Henkel. Expand the png_* macros introduced for
- libpng-1.2.x => 1.4.x => 1.5.x.
-
-2011-05-09 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writepng.c: Fixes for libpng 1.5.2 copied/adapted from luaTeX.
-
-2011-05-05 Karl Berry <karl@tug.org>
-
- * pdftex.web (pdfTeX_banner): etex version before pdftex version.
- (pdftex_revision, pdftex_version_string): bump to 12.
- * pdftexextra.h (BANNER): change redundantly-specified banner
- again and again.
- (These changes approved by Thanh.)
-
-2011-05-03 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web, tex.ch0: Remove pdfeTeX_banner, no more pdfeTeX.
-
-2011-05-02 Akira Kakuto <kakuto@fuk.kindai.ac.jp> <peb@mppmu.mpg.de>
-
- * pdftex.web: Append eTeX_version_string to pdfTeX_banner.
-
-2011-05-02 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- Avoid "deprecated conversion from string constant to 'char*'"
- warnings from g++-4.4.
- Unfortunately both xpdf and poppler declare lots of function
- parameters as 'char *' that should actually be 'const char *'.
- Compiling just the parts required for TeX Live with g++-4.4
- yields >10000 such warnings for each of xpdf and poppler.
-
- * pdftoepdf.cc, pdftosrc.cc: Cast string constants to 'char *'
- in order to avoid more such warnings when compiling pdfTeX.
-
-2011-04-29 Karl Berry <karl@tug.org>
-
- * all files: update copyright notices.
-
-2011-04-07 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Adapted to e-TeX Version 2.3.
-
-2011-04-03 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Adapt to ../etexdir/etex.ch: simplify e-pTeX.
-
- * am/pdftex.am (etex_version.h): Derive from pdftex.web instead
- of ../etexdir/etex.ch.
-
-2011-03-28 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/libpdftex.am: Use AM_CFLAGS instead of libpdftex_a_CFLAGS.
- * am/pdftex.am: Use AM_CFLAGS instead of pdftex_CFLAGS.
- * am/ttf2afm.am: Use AM_CFLAGS instead of ttf2afm_CFLAGS.
-
-2011-03-07 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * utils.c (pdftex_fail, pdftex_warn): `program_invocation_name'
- has been renamed into `kpse_invocation_name'.
-
-2011-01-31 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writepng.c: Remove png-1.2 cruft.
-
-2011-01-31 Thomas Klausner <tk@giga.or.at>
-
- * writepng.c: Fix to build with png-1.5 (and avoid `deprecated'
- warnings with png-1.4). The transformations part is removed on
- recommendation by John Bowler (a png developer).
-
-2011-01-14 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Adapt to ../etexdir/etex.ch:
- Mention \protected in error and help messages only when in
- in extended mode.
-
-2011-01-11 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.mak, pdftex.mk (removed): Obsolete.
-
-2011-01-08 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am (pdftex_ch_srcs): Added enctex.ch.
-
-2011-01-01 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftexextra.in: Renamed ...
- * pdftexextra.h: ... into this; #include {e,pdf}tex_version.h
- for {E,PDF}TEX_VERSION.
-
- * pdftexextra.c (new): #include <pdftexd.h> and <lib/texmfmp.c>.
-
- * am/pdftex.am: pdftexextra.[ch] are now distributed;
- create {e,pdf}tex_version.h instead of {e,pdf}tex.version.
-
-2010-12-01 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writet1.c: Drop unreachable code (after pdftex_fail).
- Drop unused free_glyph_names() function.
-
-2010-11-29 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writet1.c (t1_check_unusual_charstring): Drop unused variable.
-
-2010-11-26 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writet1.c: Still more minor tweaks.
-
-2010-11-26 Thanh Han The <thanh@river-valley.org>
-
- * writet1.c (t1_check_unusual_charstring): switch EOL to space
- before appending.
-
-2010-11-26 Heiko Oberdiek <heiko.oberdiek@googlemail.com>
-
- * pdftex.web (Display the whatsit...): avoid erroneous return.
- http://sarovar.org/tracker/?func=detail&group_id=106&aid=4317&atid=493
-
-2010-11-16 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web (pdf_out_colorstack): There are no 'othercases'.
- Fix from Heiko Oberdiek <heiko.oberdiek@googlemail.com>.
-
-2010-11-14 Karl Berry <karl@tug.org>
-
- * writet1.c: endless formatting tweaks.
-
-2010-11-12 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writet1.c (load_enc_file): Bug fix (using glyph_names[256]).
-
- * writet1.c: Formatting and other trivial changes, to reduce
- diffs against dvipsk's writet1.c.
-
-2010-11-11 Thanh Han The <thanh@river-valley.org>
-
- * writet1.c (t1_check_unusual_charstring): new fn.
- (t1_subset_charstrings): call it. This resolves a bug reported by
- Knuth when there is a newline between the /CharStrings and the
- following number (dict size).
-
-2010-09-29 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writeimg.c: Use png_get_*() instead of directly accessing
- fields of the png_info and png_ptr structs.
-
-2010-09-28 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.test (new): Just testing 'pdftex -version'.
- * pdftexdir/am/pdftex.am: Adjusted.
-
-2010-06-22 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- Prepare for libpng-1.4.x.
- * writepng.c: Define and use macros to access bit_depth and the
- other fields of the png_info and png_ptr structs.
-
-2010-06-10 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am (pdftex_cppflags): Add $(AM_CPPFLAGS).
- * am/ttf2afm.am (ttf2afm_CPPFLAGS): Add $(AM_CPPFLAGS).
-
-2010-06-10 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- Reorganize web2c headers.
- * pdftoepdf.cc: #include <w2c/c-auto.h> instead of <c-auto.h>
- and <w2c/config.h> instead of "../config.h".
-
-2010-06-07 Karl Berry <karl@tug.org>
-
- * pdftex.web: (pdftex_version_string): let's be optimistic and
- drop the -beta.
-
-2010-05-20 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftoepdf.cc: #include "../config.h" instead of <config.h>,
- required for Mac OS X Leopard.
-
-2010-05-18 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Adapt to ../etexdir/etex.ch:
- More error message with \protected, from Heiko.
-
-2010-04-30 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex-common.h (xstrdup): Remove decl (in <kpathsea/lib.h>).
- (pdfosmode): Declare as boolean as generated by Web2C.
- * pdftoepdf.h (deleted): Moved contents ...
- * pdftoepdf.cc: ... to here.
- #include "openbsd-compat.h" as early as possible.
- Add #include <kpathsea/lib.h> and drop decl of const_string.
- Avoid MINGW32's typedef of boolean, conflicting with the
- definition in <kpathsea/types.h>.
- * am/libpdftex.am: Adjusted.
-
- * pdftex-common.h, writeimg.c (epdf_selected_page,
- epdf_num_pages, epdf_page_box): Change from integer to int.
- * pdftoepdf.cc: Remove '(int)' casts.
-
-2010-04-29 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * epdf.c, pdftoepdf.cc, writeenc.c: Change various function
- params, return values, and struct members from integer to int.
-
- Avoid duplicate function prototypes in different headers.
- * epdf.c: Drop #include "inc-epdf.h".
- * inc-extra.h (deleted): Move prototypes ...
- * ptexlib.h: #include "pdftex-common.h", move some prototypes ...
- * epdf.h: #include "pdftex-common.h" instead of "inc-epdf.h" and
- "inc-extra.h", move some prototypes ...
- * image.h: Move some prototypes ...
- * pdftex-common.h (new): ... to here.
-
- * epdf.h (deleted): Renamed ...
- * pdftoepdf.h (new): ... into this.
- * pdftex.web (pdf_last_byte): Changed type to eight_bits.
- * pdftoepdf.cc (notdef): Added (char *) cast.
- * pdftoepdf.h, ptexlib.h: Moved declarations from here ...
- * pdftex-common.h: ... to here, dropped a few unused ones.
- * am/libpdftex.am: Adjusted.
-
- * pdftex-common.h: #define pdfosgetosbuf and pdfbeginobj as
- in pdftexcoerce.h (generated by Web2C).
- * pdftoepdf.cc: Use pdfbeginobj instead of zpdfbeginobj.
- * ptexmac.h: Use pdfosgetosbuf instead of zpdfosgetosbuf.
-
-2010-04-28 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.web: Adapt to ../etexdir/etex.ch:
- Fixed the error message for improper use of \protected,
- reported by Heiko Oberdiek <heiko.oberdiek@googlemail.com>.
-
-2010-04-23 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * epdf.h: #include <c-auto.h> instead of <web2c/c-auto.h> etc.
-
-2010-04-22 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am (EXTRA_DIST): Add etexdir/etex.ch.
- Use pdftexdir/etex.version instead of etexdir/etex.version.
-
-2010-04-20 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * ptexlib.h: Move extern declaration of ptexbanner to here
- from ../lib/lib.h (instatiated in ../lib/texmfmp.c).
-
-2010-03-09 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * ttf2afm.c: Use kpse_set_program_name(argv[0], NULL) instead of
- kpse_set_progname(argv[0]).
-
-2010-02-14 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * writet1.c (append_cs_return): Cast to byte * to avoid warning.
-
-2010-02-01 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/libpdftex.am (libpdftex_a_OBJECTS): Add dependency on
- $(ZLIB_DEPEND) and $(LIBPNG_DEPEND).
- * am/pdftex.am (pdftex_OBJECTS): Remove explicit dependency on
- $(ZLIB_DEPEND) alread implied by libpdftex.a.
-
-2010-01-27 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * avl.c (avl_copy): Proper handling of const.
-
-2010-01-25 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/libpdftex.am (libpdftex_a_CFLAGS): Enable compiler warnings.
-
- Avoid most compiler warnings:
-
- * ptexlib.h, writejbig2.h: ANSI C function prototypes.
- * avlstuff.c, mapfile.c, utils.c, vfpacket.c, writeenc.c,
- writefont.c, writeimg.c, writejbig2.c, writet1.c, writettf.c:
- ANSI C function definitions.
-
- * avlstuff.c, mapfile.c, utils.c, writeenc.c, writefont.c,
- writejbig2.c, writepng.c, writet1.c, writettf.c: Declare
- functions as static.
-
- * ptexlib.h: Add prototype for imagecolor().
- * inc-epdf.h: New file with prototypes for is_subsetable(),
- epdf_check_mem(), epdf_create_fontdescriptor(),
- epdf_mark_glyphs(), get_fd_objnum(), get_fn_objnum(), and
- embed_whole_font() ...
- * epdf.[ch]: ... removed from here.
- * epdf.[ch]: #include "inc-epdf.h".
- * inc-extra.h: New file with prototypes for stripzeros() and
- epdf_write_enc() ...
- * epdf.h: ... removed from here.
- * epdf.c, utils.c, writeenc.c: #include "inc-extra.h".
- * am/libpdftex.am (libpdftex_a_SOURCES): Add the new files.
-
- * writejbig2.c: Avoid use of possibly uninitialized variables.
-
- * utils.c, writefont.c, writet1.c, writettf.c:
- Declare various function params and args, local vars, and struct
- members as const.
-
- * writet1.c (append_cs_return): Drop unused local variable 'k'.
-
- * avlstuff.c (destroy_oentry, PdfObjTree_free),
- writet1.c (free_glyph_names):
- Skip unused static functions (via #if 0 ... #endif).
-
- * utils.c (newcolorstack): Don't use value of xretalloc(),
- xretalloc(addr, n, t) already assigns the new pointer to addr.
-
- * avl.c (avl_delete): Don't reuse const input param for
- non-const return value.
-
-2010-01-19 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/libpdftex.am: Add dependency on $(XPDF_DEPEND).
- * am/pdftosrc.am: Remove dependency on libpdftex.a.
-
-2010-01-18 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * epdf.c: Remove extern delaration of register_fd_entry().
- * pkin.c: Remove extern delaration of t3_file.
- * writet1.c: Remove extern delaration of fb_array.
- * writettf.c: Remove extern delarations of fb_array and
- charsetstr.
- * ptexlib.h: Add extern delarations of fb_array, t3_file, and
- register_fd_entry().
-
-2009-12-12 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am: Replace the obsolete $(mkdir_p) by $(MKDIR_P).
-
-2009-12-06 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * utils.c: Drop #ifdef HAVE_ASPRINTF and #include <stdio.h>.
-
-2009-12-01 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * NEWS, README: Update to version 3.1415926-1.40.10.
-
-2009-10-07 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftoepdf.cc: Adapt to poppler-0.12.
-
- * FIXME: epdf.h, ptexlib.h: Multiple prototypes for pdftex_fail,
- pdftex_warn, and probably others.
-
-2009-10-07 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am, am/ttf2afm.am: Enable compiler warnings.
-
- * mapfile.c, ptexlib.h: Declare pdfinitmapfile() param string
- as const.
- * pdftex.ch (get_strings_started): Drop unused variables.
- * ttf2afm.c: All functions: ANSI C definition, declare as static.
- (ttf_fail): Declare as noreturn.
- (ttf_fail, ttf_warn, name_lookup, ttf_seek_tab, ttf_seek_off):
- Declare param strings as const.
- (get_kern_value): Comment out unused function.
-
-2009-10-04 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftex.ch (do_extension): Recover variables unused by TeX.
-
-2009-09-16 Han The Thanh <hanthethanh@gmail.com>
-
- * writettf.c: patch for TTC from Liu Yubao <yubao.liu@gmail.com>
-
-2009-09-06 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am: Adapt to new makecpool with one argument.
-
-2009-09-02 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/libpdftex.am, am/pdftosrc.am: Prepare compiler warnings.
-
-2009-08-20 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * utils.c: #include <kpathsea/version.h> and drop extern decls.
-
-2009-08-19 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/ttf2afm.am (ttf2afm_DEPENDENCIES): Use default_dependencies.
-
-2009-08-18 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am: SyncTeX now integrated into ../texmfmp.h.
-
-2009-08-16 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am (pdf_tangle): Use tangle-sh.
- Adapt to tangle-sh and web2c-sh.
-
-2009-08-13 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * am/pdftex.am (pdftex_c_h): avoid to split the C code.
-
-2009-08-12 Karl Berry <karl@tug.org>
-
- * pdftex.web (sup_dest_names_size): increase to 500000;
- test document from Peter Abbott to Karl, 12 Aug 2009 12:24:43.
-
-2009-07-13 Han The Thanh <hanthethanh@gmail.com>
-
- * mapfile.c: treat TTC fonts as TTF
- * writejpg.c: fix bitmap resolution
- * writettf.c: fix segfault for certain TTF fonts
- * pdftex.web: enable pk generation by default
-
-2009-06-26 Han The Thanh <hanthethanh@gmail.com>
-
- * pdftex.web: bugfix from Hartmut: fix \pdfobj file {foo} for files
- foo that don't end with '\n'
-
-2009-06-25 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * epdf.h, ttf2afm.c, writet1.c:
- removed #include <kpathsea/c-proto.h>.
- * avlstuff.c, epdf.c: removed #include <kpathsea/c-proto.h> and
- #include <stdarg.h>.
-
-2009-06-23 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * avlstuff.c, epdf.c, ttf2afm.c, writet1.c: #include <stdarg.h>,
- not <kpathsea/c-vararg.h>.
-
-2009-06-04 Karl Berry <karl@tug.org>
-
- * am/pdftex.am (pdftex_LDADD): add libpdftex.a here.
- (pdftex_ldadd): remove it from here, so we do not try
- to link pdftosrc with it.
- Report from vvv, tlbuild mail 03 Jun 2009 21:45:00.
-
-2009-05-07 Norbert Preining <preining@logic.at>
-
- * pdftosrc.cc: add warning that poppler version doesn't support
- object streams.
-
-2009-05-05 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftoepdf.cc, pdftosrc.cc, utils.c: adapt for poppler.
-
- patches from Norbert Preining <preining@logic.at>
-
-2009-02-18 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdftoepdf.cc: Uninclude <config.h>, included later by "epdf.h".
-
-2004-08-21 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdfetex.ch2: Adapted to e-TeX version 2.2.
-
-2004-08-26 Olaf Weber <olaf@infovore.xs4all.nl>
-
- * pdfetexextra.in: File was renamed from pdftexextra.h; the
- current pdfTeX and e-TeX versions are substituted from
- ../pdftexdir/pdftex.version and ../etexdir/etex.version. Variant
- of code supplied by Peter Breitenlohner <peb@mppmu.mpg.de>.
-
- * pdfetex.mk: Added rule to insert pdfTeX and e-TeX versions into
- pdfetexextra.h. Variant of code supplied by Peter Breitenlohner
- <peb@mppmu.mpg.de>.
-
-2004-08-25 Olaf Weber <olaf@infovore.xs4all.nl>
-
- * pdfetex.mk: vadjust.ch moved from pdfxtexdir to pdftexdir.
-
-2004-08-17 Olaf Weber <olaf@infovore.xs4all.nl>
-
- * pdfetex.mk: Resurrected etex.fix, there is again a need to
- include late-breaking changes.
-
-2004-07-29 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdfetex.ch[12]: Somewhat rearrange handling of kern and math
- nodes in order to reduce interference between eTeX and pdfTeX
- change files.
-
- * pdfetex.ch1 (hlist_out): Keep full mixed direction typesetting
- code.
-
-2004-07-25 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdfetex.ch[12]: Reorganize additional command codes for convert
- and last_item in order to reduce interference between eTeX and
- pdfTeX change files.
-
-2004-07-23 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdfetex.ch[12], tex.ch[01]: Reorganize handling of banner
- string in order to reduce interference between eTeX, pdfTeX,
- and web2c change files.
-
-2004-07-22 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdfetex.ch[12]: Removed unused token types for pdfTeX's
- additional token list parameters.
-
-2004-07-19 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdfetex.ch[12], tex.ch0: Reorganize handling of additional
- token list and integer parameters and e-TeX's additional
- penalties in order to reduce interference between eTeX, pdfTeX,
- and web2c change files.
-
- * pdfetex.mk (pdfetex.ch): Remove tex.ch2 from build rules.
-
- * tex.ch2: Removed.
-
-2004-07-17 Peter Breitenlohner <peb@mppmu.mpg.de>
-
- * pdfetex.mk: Rewrite build rules for pdfetex.{web,ch},
- remove etex.{ch0,ch1,fix}, tex.ch2, and several non-dependencies.
-
- * pdfetex.ch2: Adapt to eTeX changes.
-
- * ChangeLog: New file.
-
-(This file public domain.)
diff --git a/Build/source/texk/web2c/pdftexdir/NEWS b/Build/source/texk/web2c/pdftexdir/NEWS
deleted file mode 100644
index 13b154cdefd..00000000000
--- a/Build/source/texk/web2c/pdftexdir/NEWS
+++ /dev/null
@@ -1,774 +0,0 @@
-- changes:
- - new primitives \pdfrunninglinkoff and \pdfrunninglinkon; e.g., for
- turning off generation of links in headers and footers.
- - warn instead of aborting when "\pdfendlink ended up in
- different nesting level than \pdfstartlink".
- - dump \pdfglyphtounicode assignments in fmt file.
- - ttf2afm outputs name information.
-
-- bugfixes:
- - avoid crash in unusual autoexpand cases.
-
-- source: poppler support removed, as it was too hard to keep in sync
- with upstream. For native TL, pdftex has always used libs/xpdf,
- which is cut-down and adapted code from xpdf.
-
-pdfTeX 3.14159265-2.6-1.40.21 (TeX Live 2020) (March 27, 2020)
-- changes:
- - new primitive \pdfmajorversion; this merely changes the version
- number in the PDF output, has no effect on PDF content.
- - have \pdfximage etc. do same search for image files as for input files,
- - new \input{...} group-delimited syntax (cross-engine).
- - new option --cnf-line (cross-engine).
- - (un)compress .fmt files with zlib (cross-engine).
-
-pdfTeX 3.14159265-2.6-1.40.20 (TeX Live 2019)
-- changes:
- - new primitive \expanded (from unreleased pdftex 1.50 branch + luatex).
- - new primitive parameter \pdfmajorversion; 1 by default, but can be
- set to any positive integer; affects only the %PDF- line.
- - new primitive parameter \pdfomitcharset; zero by default to include
- the /CharSet value from the PDF output as usual; setting to 1 omits
- it, since it cannot feasibly be guaranteed correct as the PDF/A-2
- and /A-3 standards require.
-
-pdfTeX 3.14159265-2.6-1.40.19 (TeX Live 2018) (April 14, 2018)
-- changes:
- - do not hash current directory into PDF ID, for more reproducible builds
- (pdftex r782).
- - allow encoding vectors for bitmap PK fonts (r790).
- - when a non-PDF special is ignored, output a (leading substring of the)
- special, preceded by "<special> ".
-
-- bugfixes:
- - \pdfprimitive does nothing, rather than give an error, when given a
- non-primitive (pdftex r784).
- - \pdfprimitive does not swallow a following control sequence (pdftex r784).
- - \ifpdfprimitive now correctly returns true for "\ " (TL r45394).
- - \pdfglyphtounicode now warns if the argument is outside the valid
- range for Unicode; the implication is that multiple code points must
- now be separated by spaces (as has always been documented).
-
-- source: support xpdf-4 by default, or xpdf-3.04, via #defines.
-
----------------------------------------------------------------
-pdfTeX 3.14159265-2.6-1.40.18 (TeX Live 2017) (April 27, 2017)
-- changes:
- - rename envvar SOURCE_DATE_EPOCH_TEX_PRIMITIVES to FORCE_SOURCE_DATE;
- no changes in functionality.
- - if the \pdfpageattr token list contains the string "/MediaBox",
- omitting output of the default /MediaBox.
-
-- bugfixes:
- - \pdflastmatch more reliable when there was no match.
-
--------------------------------------------------------------
-pdfTeX 3.14159265-2.6-1.40.17 (TeX Live 2016) (May 20, 2016)
-- changes:
- - if the environment variable SOURCE_DATE_EPOCH is set, use its value for
- the PDF CreationDate and ModDate values, and to seed the trailer /ID.
- This by itself should suffice to create reproducible PDFs. The
- new primitives below support more granular output tweaks with the
- same intent.
- - if the environment variable SOURCE_DATE_EPOCH_TEX_PRIMITIVES is set
- to 1, the \year, \day, and \time primitives are also initialized
- from the SOURCE_DATE_EPOCH value, instead of the current time.
-
- - new primitive \pdfinfoomitdate to omit CreationDate and ModDate keys.
- - new primitive \pdftrailerid to set seed for the trailer /ID
- computation; with an empty argument \pdftrailerid{}, the /ID is omitted.
- - new primitive \pdfsuppressptexinfo to omit PTEX.* keys from output;
- the value is a bitmask:
- % 1 -> PTEX.Fullbanner
- % 2 -> PTEX.FileName
- % 4 -> PTEX.PageNumber
- % 8 -> PTEX.InfoDict (/Producer /Creator /CreationDate /ModDate /Trapped)
-
-- bugfixes:
- - do not crash if font size of a vf >= 2048pt.
-
----------------------------------------------
-pdfTeX 3.14159265-2.6-1.40.16 (TeX Live 2015)
-- changes:
- - support JPEG Exif as well as JFIF.
- - do not even warn if \pdfinclusionerrorlevel is negative.
- - sync with xpdf 3.04.
-
-- bugfixes:
- - ensure line-ending after a group dict in the output.
-
----------------------------------------------
-pdfTeX 3.14159265-2.6-1.40.15 (TeX Live 2014)
-- changes:
- - sync with Knuth TeX 3.14159265, e-TeX 2.6
- - new warning-suppression parameter \pdfsuppresswarningpagegroup
- - new primitives for fake interword spaces:
- \pdfinterwordspaceon, \pdfinterwordspaceoff, \pdffakespace
-
--------------------------------------------------------------------
-pdfTeX 3.1415926-1.40.14 was released on 2013-05-30 (TeX Live 2013)
-- changes:
- - sync with e-TeX 2.5
- - better largefile support
-
-- bugfixes:
- - inclusion of particular pdf's failed (http://bugs.debian.org/672951)
-
--------------------------------------------------------------------
-pdfTeX 3.1415926-1.40.13 was released on 2012-04-21 (TeX Live 2012)
-- changes:
- - new warning-suppression parameters
- \pdfsuppresswarningdupdest and \pdfsuppresswarningdupmap
-
-- bugfixes:
- - better support for uniABCD and indexXYZ glyph names
- - large-file support (from peb)
-
--------------------------------------------------------------------
-pdfTeX 3.1415926-1.40.12 was released on 2011-06-20 (TeX Live 2011)
-- bugfixes:
- - for 16-bit images in PDF 1.4 mode
-
----------------------------------------------------
-pdfTeX 3.1415926-1.40.11 was released on 2010-07-28
-- bugfixes:
- - ttf2afm reported wrong ItalicAngle for some fonts
- - detect/prevent wrong arguments of \pdfsetmatrix [#4301]
- - check for pdf nodes in dvi mode
- - whitespace should be inserted when concatenating contents stream [#4307]
- - pdftex fails to include seemingly good PDF [#4309]
- - wrong description of \pdfelapsedtime in manual [#4300]
- - \pdfgentounicode conflicts with cmap+\pdffontattr [#4291]
- - \rightmarginkern doesn't work for last lines [#4292]
- - \pdfximagebbox wrong for PDF files with /Rotate != 0 [#939]
- - \leftmarginkern & \rightmarginkern doesn't work with box registers > 255 [#4312]
-
-- changes:
- - pdf inclusion: removed the requirement that named resources must be indirect (#4299)
- - added debug messages for pdftex_fail()
-
----------------------------------------------------
-pdfTeX 3.1415926-1.40.10 was released on 2009-11-30
-- sync with TL09
-- changes:
- - increased sup_dest_names_size
- - partial support for TTC
- - enable mktexpk by default
- - patch #2087: Support for CMap namespace
- - \pdfshellescape is 2 if restricted shell escapes are enabled.
-- bugfixes:
- - segfault when processing certain TTF fonts
- - jpg image resolution not set in some cases
- - \pdfobj file {foo} for files foo that don't end with '\n'
- - bugfix #4289: \primitive\pdfoutput cannot be queried
- - bugfix #4288: character width mismatch in font XY.vf ignored
- - bugfix #993: "/Names array not sorted correctly"
- - bugfix #606: "Forbidden ... while scanning ???"
- - bugfix #3253: Bug in Type1 font subsetting
- - \show\pdfstartlink is wrong
- - pdf_set_rule() uses incorrect variables
- - bugfix #2090: enabling LFS breaks PDF inclusion on some systems (warning: not heavily-tested yet)
- - t1_log() macro caused problem with some compilers
-
---------------------------------------------------
-pdfTeX 3.1415926-1.40.9 was released on 2008-08-16
-- bugfixes:
- - pdf inclusion (inconsistent use of -DDISABLE_OUTLINE)
- - bug #2068 (cross-platform format dumping/undumping)
- - bug #2082 (font_dim[FONTNAME_CODE] not initialized)
- - bug #2083 (unchecked assignment)
-
---------------------------------------------------
-pdfTeX 3.1415926-1.40.8 was released on 2008-07-10
-- Incorporated synctex
-- Incorporated the new version of TeX: 3.1415926
-- The pool file is now compiled in
-- Bugfix:
- - some large TrueType fonts caused pdftex to segfault (1866)
- - fix for copying contents streams of included pdf (1751)
- - Fonts from included PDFs for which maplines existed missed their /StemV
- values
- - \pdflastximagepages was broken for JBIG2 images
- - included PDFs with a negative lly in the MediaBox with a depth != 0 with
- \pdfximage were wrongly vertically diplaces (936)
- - PDF inclusion was broken on ppc-darwin (941)
-- pdfTeX uses libpng 1.2.29
-
--------------------------------------------------
-pdfTeX 3.141592-1.40.7 was released on 2008-02-17
-- Bugfix:
- - PDFs > 2GiB (LFS) were still broken on 32-bit systems
-
--------------------------------------------------
-pdfTeX 3.141592-1.40.6 was released on 2008-02-04
-- Bugfixes:
- - inclusion of encrypted PDFs was broken (861)
- - PDFs > 2GiB (LFS) would be broken, even on 64-bit systems. Now the basic
- support for LFS is there, you only need to supply the right compiler flags
- (this is not yet done automatically). See build.sh for hints on compiling.
- - Page groups in pdfs (see the discussion in the notes vor v1.10a) are now
- handled correctly (741)
- - When including transparent PNGs pdftex now automatically adds a Page Group
- (896)
- - broken map files would lead to core dumps
- - unusual TrueType fonts would lead to an assertion error (874)
- - the null object in the object table was never initialized
- - included PDFs with /PieceInfo lost their /LastModified date
- - an empty colorstack crashed pdftex (897)
-- pdfTeX uses libpng 1.2.24
-- pdfTeX uses xpdf 3.02pl2
-
--------------------------------------------------
-pdfTeX 3.141592-1.40.5 was released on 2007-07-31
-- Bugfixes:
- - calling 'pdftex %' would crash (830)
- - fflush the recorder file
-- pdfTeX uses xpdf 3.02pl1
-
--------------------------------------------------
-pdfTeX 3.141592-1.40.4 was released on 2007-07-11
-- Bugfixes:
- - It was impossible to set the font Flags to 4 in map entries (762)
- - The font Flags of non-embedded fonts were wrong (794)
- Now pdfTeX uses the Flags from map entries (if found) or guesses values for
- the base14 fonts. It also warns when you not-embedd a font without Flags
- - Subsetted fonts still had their private UniqueID copied (774)
- - \pdfunescapehex returned a wrong result if the last character was not a
- hexadecimal digit and the last hex pair was incomplete (777)
- - Copying a box with \pdfstartlink inside produced the same /Link annotation
- object multiply, with same object number and identical coordinates on the
- page (799)
- - When trying to use a font without TFM, without map entry, and no PK font
- available, a broken PDF was produced. Now no PDF is generated and the error
- messages have been improved (721)
- - Problems with vf fonts (722)
- - With pdf inclusion the font descriptor could get mixed up and miss some
- required keys (810)
- - Font expansion led to wrong log output of \kerns (736)
- - \pdfprimitive was broken (see
- http://www.ntg.nl/pipermail/ntg-pdftex/2007-April/002860.html)
- - The -recorder option of web2c didn't record fonts, included images and some
- other files (772)
- - Using \pdfximage in IniTeX before \dump caused a crash when the format was
- used (824)
- - \letterspacefont had some problems (712)
- - \letterspacefont and \pdffontexpand had some problems (747)
-- Improvements:
- - pdf compression is now a bit faster (patch 726)
- - the behaviour of TeX when it asks for a file name has been improved (756)
-- pdfTeX uses libpng 1.2.18
-- pdfTeX uses xpdf 3.02
-
--------------------------------------------------
-pdfTeX 3.141592-1.40.3 was released on 2007-02-04
-- bugfix: documents which used type 1 and truetype or opentype fonts resulted in
- broken pdfs (729)
-
--------------------------------------------------
-pdfTeX 3.141592-1.40.2 was released on 2007-01-31
-- bugfix: maplines starting with = would not work as advertised
-- bugfix: xpdf would complain that PDF 1.7 is too new
-
--------------------------------------------------
-pdfTeX 3.141592-1.40.1 was released on 2007-01-08
-- bugfix: the shell escape function was a bit broken
-- bugfix: \pdffontattr gave confusing warnings
-- allow JBIG2 images only with PDF >= 1.4
-- allow \pdfglyphtounicode in dvi mode for format generation
-- pdfTeX uses libpng 1.2.15
-
--------------------------------------------------
-pdfTeX 3.141592-1.40.0 was released on 2007-01-01
-- pdfetex (as a separate binary/program) is gone; all extensions are now in
- pdftex. The make files still know about the target pdfetex, but it's just a
- copy of pdftex
-- The sources of TeX, eTeX and pdfTeX have been merged into one file pdftex.web
- and one change file pdftex.ch. The sources of TeX and eTeX distributed are
- just there for reference
-- New features:
- - pdfTeX can now generate PDF 1.5 object streams, which leads to smaller
- PDFs. This is controlled by setting \pdfobjcompresslevel to a value >0 (3
- compress everything, 2 don't compress /Info, 1 also don't compress embedded
- PDFs) and works only with PDF >=1.5
- - pdfTeX now supports another image file format: JBIG2 files (.jbig2)
- - the memory allocated for objects and destination names now grows
- dynamically
- - pdfTeX now generates smaller PDFs since for char positioning the width of
- chars (/Widths) is stored with more precision and so the chars must rarely
- be positioned separately
- - the PK resolution is now taken from the "pk_dpi" parameter in texmf.cnf if
- it has not been set in the format file or by the user
- - pdfTeX now removes the generated pdf in case of a fatal error
- - pdfTeX now sets /ModDate and /Trapped in the InfoDict by default (the
- values can be overridden with \pdfinfo)
- - the format of warnings and errors issued by pdfTeX has been changed and
- unified
- - the output of -version has been extended and now includes information about
- the libraries actually used, which can be handy when using shared libraries
- - rules and their positioning on the page are now inside a qQ group
-- New primitives:
- - pdfTeX can now handle colourstacks.
- - \pdfcolorstackinit
- A stack is initialized by \pdfcolorstackinit. It expands to the number of
- the new stack. The common case, the traditinal color stack is already
- initialized as first stack: \pdfcolorstackinit page direct {0 g 0 G}
- The keyword "page" means that this stack is page based. At the start of
- the new page, the current stack value is automatically set.
- - \pdfcolorstack
- \pdfcolorstack <stack number> push {<new color>}
- pushes the current value on the stack and sets the <new color>.
- \pdfcolorstack <stack number> pop
- pops and sets the current stack value.
- \pdfcolorstack <stack number> current
- sets the current stack value without changing the stack. This is useful
- for stacks that are initialized without keyword "page". Thus the page
- start setting can be set manually.
- \pdfcolorstack <stack number> set {<new color>}
- The current value is set to <new color>.
- - Transformation matrices can now be manipulated more cleanly:
- Currently matrix changes are done and hidden inside \pdfliteral nodes;
- pdfTeX doesn't parse its contents and does not know the new settings of the
- transform matrix. Thus the new primitives to save pdfTeX from parsing
- \pdfliteral contents and to notify pdfTeX about matrix changes to use them
- in calculating link and anchor positions.
- - \pdfsetmatrix{<a> <b> <c> <d>}
- is the equivalent to \pdfliteral{<a> <b> <c> <d> 0 0 cm}
- - \pdfsave is the equivalent to \pdfliteral{q}
- - \pdfrestore is the equivalent to \pdfliteral{Q}
- - \pdfprimitive\TeX-primitive executes the original \TeX-primitive even if
- the command has been redefined since. E.g.
- \let\relax\undefined\pdfprimitive\relax
- expands to \relax.
- \ifpdfprimitive\TeX-primitive is true if \TeX-primitive has its original
- meaning
- - \ifpdfabsnum and \ifpdfabsdim are like \ifnum and \ifdim, but don't care
- about negative numbers
- - shell escape: if the first character of a filename for \openin, \openout
- \input is a pipe symbol (|), the filename is assumed to be a request for a
- pipe to a command line that is given in the rest of the filename
- - draftmode: With \pdfdraftmode=1 or the commandline switch -draftmode pdfTeX
- doesn't write the output pdf and doesn't actually read any images, thus
- speeding up compilations when you know you need an extra run but don't care
- about the output, e.g. just to get the BibTeX references right
- - \pdfpxdimen (introduced in 1.30) is now a real dimension parameter. It
- allows one base dimensions on pixels. 1px defaults to 1bp (or 72dpi), but
- can be changed with the \pdfpxdimen primitive:
- \pdfpxdimen=1in % 1 dpi
- \divide\pdfpxdimen by 96 % 96 dpi
- \hsize=1200px
- Now \hsize is (1in/96)*1200
- - \pdflastlink returns the object number of the last \pdfstartlink
- - \pdfsavepos now works in DVI mode
-- Fonts:
- - support for subfonts: This creates all needed map entries for subfonts
- automatically and handles Unicode mappings
- - ToUnicode entries for Type1 fonts (patch 580)
-- HZ:
- - added patch 462: HZ font expansion in autoexpand mode now produces smaller
- pdf files, as it works by modififying the text matrix for single fonts
- instead of embedding many expanded font versions. Therefore HZ now can be
- used also for TrueType fonts and even for non-embedded fonts (e.g.
- Times-Roman)
-- Bugfixes:
- - the PDF statistics in the log are now correct
- - added JFIF detection patch to writejpg.c (bug 548)
- - bugfix: invalid pdf created if font name contains space (509)
- - bugfix: truetype OS/2 v3 fonts (594)
- - bugfix: Type1C (CFF) fonts of embedded pdfs didn't get replaced
-- pdfTeX uses libpng 1.2.14
-
--------------------------------------------------
-pdfTeX 3.141592-1.30.6 was released on 2006-02-16
-- bugfix: updated xpdf to 3.01pl2
-
--------------------------------------------------
-pdfTeX 3.141592-1.30.5 was released on 2005-12-04
-- bugfix: \pdfximage prints the file name twice (bug 441)
-- bugfix: buffer overflow with \pdfmatch (bug 444)
-- bugfix: updated xpdf to 3.01pl1
-
--------------------------------------------------
-pdfTeX 3.141592-1.30.4 was released on 2005-10-17
-- bugfix: whitespaces in filenames didn't work on Unix anymore (bug 377)
-- bugfix: two \immediates cancel themselves (bug 437)
-- bugfix: wrong file name in error messages of image inclusion (bug 435)
-
--------------------------------------------------
-pdfTeX 3.141592-1.30.3 was released on 2005-09-04
-- bugfix: \write18
-
--------------------------------------------------
-pdfTeX 3.141592-1.30.2 was released on 2005-08-25
-- fixed some build problems and minor bugs introduced in 1.30.1
-
--------------------------------------------------
-pdfTeX 3.141592-1.30.1 was released on 2005-08-21
-- the eTeX extensions can now be enabled with the cmdline switch -etex
-- pdfTeX uses xpdf 3.01
-
--------------------------------------------------
-pdfTeX 3.141592-1.30.0 was released on 2005-08-01
-- pdfxtex (introduced with 1.20a) is gone; all extensions are now in pdf(e)tex.
-- Some primitives have been renamed; the old names will still work, but are
- deprecated and some give a warning that they are obsolete:
- \pdfoptionpdfminorversion -> \pdfminorversion
- \pdfoptionalwaysusepdfpagebox -> \pdfforcepagebox
- \pdfoptionpdfinclusionerrorlevel -> \pdfinclusionerrorlevel
-- pdftex knows two new units:
- - new Didot (1nd=0.375mm)
- - new Cicero (1nc=12nd)
-- New primitives:
- - Inclusion of pngs has been greatly improved: It now does
- - alpha channel and transparency (only if %!PDF >=1.4)
- - 16-bit colour (only if %!PDF >=1.5); this must be enabled by setting
- \pdfimagehicolor to 1.
- - gamma correction; this must be enabled by setting \pdfimageapplygamma to
- 1. The device gamma is taken from \pdfgamma. If no embedded value can be
- found in the png image, then the value of \pdfimagegamma is used instead.
- - fast direct embedding of png streams, if their structure allows this; the
- automatic fall-back is to decompress and re-compress as before.
- - pdfTeX now has an interface to the precise system time (if available) as an
- aid in benchmarking TeX macro code.
- - \pdfelapsedtime is a read-only integer that (initially) returns the
- amount of time passed since the start of this run. This amount is given
- in `scaled seconds': the value 65536 counts as one second. If more time
- has passed than 32767 seconds, (2^31)-1 will be returned.
- - \pdfresettimer updates the internal timer, such that subsequent calls to
- \pdfelapsedtime will restart from 0.
- - pdfTeX can now generate random numbers:
- - \pdfuniformdeviate <count> generates a uniformly distributed random
- integer value between 0 (inclusive) and <count> (exclusive).
- - \pdfnormaldeviate expands to a random integer value with a mean of 0 and
- a unit of 65536.
- - \pdfrandomseed allows access to the current seed value.
- - \pdfsetrandomseed <count> sets the random seed to a specific value.
- - \pdfnoligatures\f disables ligatures for the loaded font \f.
- - Escaping strings:
- - \pdfescapestring{<a>} escapes the string <a> so that it can be used as
- PDF string.
- - \pdfescapename{<a>} escapes the string <a> so that it can be used as PDF
- name.
- - \pdfescapehex{<a>} converts the string <a> to uppercase hexadecimal
- representation.
- - \pdfunescapehex{<b>} reverses the effect of \pdfescapehex
- - \pdfcreationdate expands to the date string that pdfTeX uses in the info
- dict as default.
- - \pdffilemoddate{<file>} expands to the modification date of <file> in the
- same format as \pdfcreationdate (PDF date format).
- - \pdffilesize{<file>} expands to the size of <file> as string.
- - \pdfmdfivesum{<abc>} or \pdfmdfivesum file {<file>} calculates the md5
- sum (of a string or a file) and converts it to uppercase hexadecimal format
- (same as \pdfescapehex).
- - \pdffiledump [offset <int>] [length <int>] <general text>
- Expands to a hex dump of the file given in <general text>, starting at
- given offset or 0 with given length.
- - \pdfshellescape is a read-only integer that is 1 if \write18 is enabled, 0
- otherwise.
- - \pdfxformname <object number>, which expands to the number in the
- corresponding form XObject name.
- - \leftmarginkern <box number> and \rightmarginkern <box number> tell the
- margin kern at the left and right side of the horizontal list stored in box
- <box number>.
- - \pdfpkmode is a token register that sets the MF mode for pixel font
- generation. The contents of this register is dumped into the format, so one
- can (optionally) preset it e.g. in part of pdftexconfig.tex.
- - \pdftracingfonts: An integer variable controlling the tracing of font
- expansion. It is zero by default; then we get a log (with fontexpansion)
- like this
- ...\tenrm t
- ...\tenrm (+20) e
- Without font expansion, this default should be compatible with TeX's
- original log output.
- If \pdftracingfonts is set to 1 (or greater), we get a more verbose log:
- ...\xivtt (cmtt10@14.0pt) t
- ...\xivtt (cmtt10+20@14.0pt) e
- See also bug 304.
-- New experimental primitives:
- - \pdfmatch [icase] [subcount <number>}] {<pattern>}{<string>}
- Implements pattern matching using the POSIX regex.
- It returns the same values as \pdfstrcmp, but with the following semantics:
- -1: error case (invalid pattern, ...)
- 0: no match
- 1: match found
- Options:
- * icase: case insensitive matching
- * subcount: it sets the table size for found subpatterns.
- A number "-1" resets the table size to the start default.
- - \pdflastmatch <number>
- The result of \pdfmatch is stored in an array. The entry "0" contains the
- match, the following entries submatches. The positions of the matches are
- also available. They are encoded:
- <position> "->" <match string>
- The position "-1" with an empty string indicates that this entry is not
- set.
- - \pdfstrcmp{<a>}{<b>} compares two strings and returns the strings "0" if
- <a> equals <b>, "-1" if <a> is less than <b>, "1" if <a> is greater than
- <b>
-- The primitive \pdfmovechars has been removed (bug 294)
-- Bugfixes:
- - empty strings are not supressed anymore (bug 335)
- - \unhboxing and character protusion didn't work well together (bug 292)
- - --jobname didn't work if there was no filename at all (bug 302)
- - Some problem with fonts on solaris (bug 315)
- - Dangling font objects with non-replacable fonts (bug 311).
- - \pdfxform didn't work with box>255 (bug 310)
- - cmap: unicode ???? is mapped to multiple glyphs (bug 306).
-- pdfTeX uses zlib 1.2.3
-
-------------------------------------------------
-pdfTeX 3.141592-1.21a was released on 2005-02-04
-- ttf2afm 1.0:
- - added support for refering to glyphs via unicode in encoding files (ie 'uniXXX')
- - added some more info to the AFM output
- - some minor bug fixes
- - a short documentation available
-- pdftex now understand forms 'uniXXXX' in encoding files (only makes sense
- with TrueType fonts)
-- added subset tag for TrueType fonts
-- PDF strings are now printed as following:
- (This is a string) -> (This is a string)
- This is a string -> (This is a string)
- <a1b245c1a2...> -> <a1b245c1a2...>
-- check for double newline char to get rid of empty lines in PDF output
-- Fixed a bug in the scanning of map lines introduced in the fix of bug #242 in
- 1.20b.
-- Fixed three problems in xpdf; xpdf is now 3.00pl3
-- \ifeof18 is a simple method to test if \write18 is enabled.
-- a few extensions in pdfxtex:
- - \pdflastximagecolordepth returns the last color depth
- - \pdfximage supports a keyword "colorspace" following an object number
- representing a ColorSpace object
- - \pdfstrcmp compares two strings
- - \pdfescapestring/\pdflastescapedstring provide a way to escape string
- - \pdffirstlineheight/\pdflastlinedepth/\pdfeachlineheight/\pdfeachlinedepth
- allow fixing line dimen
- - patches from Taco
- - px dimen unit
- - tagcode patch
- - quitvmode patch
-
-------------------------------------------------
-pdfTeX 3.141592-1.20b was released on 2004-12-22
-- Fixed some minor bugs, mostly with hz
-- The info line "output format initialized to PDF/DVI" isn't shown anymore, as
- this info wasn't reliable (bug 112).
-- Now the PDF-related statistics (PDF objects...) in the .log file is only
- shown in PDF output mode. It start with a line "PDF statistics:".
-- \pdfimageresolution is not limited to 2400 [dpi] anymore, can now be between
- 0 and 65535 [dpi].
-- pdfTeX uses xpdf 3.00pl2
-- pdfTeX uses libpng 1.2.8, which fixes some png-related bugs.
-
-------------------------------------------------
-pdfTeX 3.141592-1.20a was released on 2004-09-06
-- There is a new program pdfxtex, which contains experimental features which
- might end up in pdftex in the future.
-- Most distributions now use eTeX as the default engine, so when you call
- pdftex you will get pdfeTeX. Most distributions now also use pdfTeX as the
- default engine, so when you call latex you will get pdfeTeX running LaTeX.:-)
-- We are setting up pdfTeX as a project at sarovar
- (http://sarovar.org/projects/pdftex/). Please report bugs etc. through the
- site.
-- Support for the file pdftex.cfg is gone completely. All parameters that had
- previously been set by it can be set through primitives; their values are
- dumped to the format file.
-- The searchpath for encoding and mapfiles has been changed.
- See http://tug.org/pipermail/tex-live/2004-January/004734.html and
- http://tug.org/pipermail/tex-live/2004-January/004791.html
-- eTeX is now version 2.2, incorporating the last changes to TeX (3.141592).
-- New options for \pdfmapfile:
- General functionality: Map items (map files, new: also single map lines; see
- \pdfmapline) are put in list of pending map items. During the next shipout,
- pending map items are sequentially scanned for their map entries, and an
- internal map entry database is updated, using the modes below. Then the list
- of pending map items is cleared. Map entries of fonts already in use are left
- untouched. New: All \pdfmapfile and \pdfmapline commands can also be given
- after shipout of the first page.
- - \pdfmapfile {foo.map} clears the list of pending map items and starts a new
- list with the only pending file foo.map. When the map entry lines of
- foo.map are scanned, duplicate map entries are ignored and a warning is
- issued. This is the old behaviour.
- - \pdfmapfile {+foo.map} puts foo.map in the list of pending map items. When
- the map entry lines of foo.map are scanned, duplicate map entries are
- ignored and a warning is issued.
- - \pdfmapfile {=foo.map} puts foo.map in the list of pending map items. When
- foo.map is scanned, matching map entries in database are replaced by new
- entries from foo.map.
- - \pdfmapfile {-foo.map} puts foo.map in the list of pending map items. When
- foo.map is scanned, matching map entries are deleted from database.
- - \pdfmapfile {} clears the list of pending map items. It does not affect map
- entries already registered into the database. This is the old behaviour.
-- New command \pdfmapline {line}. It's like \pdfmapfile but here you can set
- single map lines like in the map files directly. The modifiers (+-=) have the
- same effect as with \pdfmapfile.
-- Simplified the handling of the 14 Type 1 "standard fonts" (Times,
- Helvetica...): They are now more or less handled like any other Type 1 font.
- See http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000648.html
-- hz: So far the font expansion feature required that the user must be able to
- create expanded tfms (eg cmr10+10.tfm). Now font expansion can be used
- without creating these tfms.
- See http://www.ntg.nl/pipermail/ntg-pdftex/2004-May/000504.html
-- hz: Changed \pdffontexpand primitive --> the expand factor is now fixed to
- 1000 and the argument is ignored. This will lead to spurious texts of "1000"
- in your output if you compile old documents.
-- New command \pdftexbanner which returns a string with the full banner of the
- current binary (e.g. "This is pdfTeX, Version 3.141592-1.20a (Web2C 7.5.3)
- kpathsea version 3.5.3")
-- The PTEX.FullBanner key is now inserted in the document info dict instead of
- the catalog. Newer versions of Acrobat display it.
-- Now includes support for encTeX.
-- Extended \pdfannot to use reserveobjnum/useobjnum
- See http://www.ntg.nl/pipermail/ntg-pdftex/2004-March/000424.html
-- Bugfix: pdfTeX would read an .xpdfrc when including pdfs.
- See http://tug.org/pipermail/pdftex/2004-March/004835.html
-- Bugfix: The strings in /ID would sometimes be empty.
-- Bugfix: Even when mapfiles or encodings or PostScript font files were
- missing, pdfTeX still produced a (most often corrupt) pdf. Now it aborts with
- an error in these cases.
-- numerous small bugfixes.
-- pdfTeX now uses the GNU libavl from Ben Pfaff for managing of fontmap
- entries.
-- pdfTeX uses zlib 1.2.1
-- pdfTeX uses xpdf 3.00
-- pdfTeX uses libpng 1.2.7
-
-------------------------------------------------
-pdfTeX 3.141592-1.11b was released on 2003-10-06
-- Bugfix: The handling of /Rotate produced displaced images when /Rotate was 90
- or 270.
-
-------------------------------------------------
-pdfTeX 3.141592-1.11a was released on 2003-08-02
-- New command \pdftrailer analogue to \pdfcatalog whose argument ends up in the
- trailer dictionary.
-- The behaviour when an included pdf has a newer version than the one specified
- with \pdfoptionpdfminorversion can be controlled by the new internal integer
- \pdfoptionpdfinclusionerrorlevel: If it's 0, pdfTeX gives only a warning; if
- it's 1, it raises an error.
- This can also be set in pdftex.cfg with pdf_inclusion_errorlevel
-- The syntax for outlines has been extended to allow attributes:
- <outline spec> --> <attr spec> <action spec> [count <number>] <general text>
- See http://www.ntg.nl/pipermail/ntg-pdftex/2003-June/000165.html
-- The syntax of \pdfobj has been extended:
- \pdfobj <object type spec> (h, v, m)
- <object type spec> --> reserveobjnum
- | [useobjnum <number>] [<attr spec>] [stream [<attr spec>]] <object contents>
- <object contents> --> <file spec>
- | <general text>
- When the optional keyword `reserveobjnum' and `useobjnum' is not given, the
- behaviour is unchanged.
- See also http://tug.org/mailman/htdig/pdftex/2003-March/003814.html
-- Bugfix: /CreationDate didn't care for the timezone and could be fooled.
- See http://www.ntg.nl/pipermail/ntg-pdftex/2003-July/000223.html
-- Bugfix: The translation of 8-bit characters in included pdfs that had their
- eighth bit set sometimes got wrong because of a missing typecast.
- See http://www.ntg.nl/pipermail/ntg-pdftex/2003-July/000216.html
-- Bugfix: pdfTeX -ini would crash with a minimal file because it didn't read
- it's config and so didn't know anything about fonts.
- See http://tug.org/pipermail/pdftex/2003-July/004262.html
-- Bugfix: \pdfstartlink would produce spurious /NewWindow entries. Also the
- syntax of <action spec> and <goto-action spec> has been cleaned up.
- See http://www.ntg.nl/pipermail/ntg-pdftex/2003-June/000167.html
-- Bugfix: \pdffontattr was not used for T3 fonts.
- See http://tug.org/pipermail/pdftex/2003-June/004127.html
-- Bugfix: The cropbox of an included pdf would sometimes not be used.
- See http://tug.org/pipermail/pdftex/2003-May/004037.html
-- pdfTeX uses xpdf 2.02
-
-------------------------------------------------
-pdfTeX 3.141592-1.10b was released on 2003-02-26
-- The numbers in transformation matrices are allways written with maximum
- precision (see http://tug.org/pipermail/pdftex/2003-February/003596.html).
-- Incorporated the new version of TeX: 3.141592
-- Bugfix: Numbers in pdfs would sometimes be just a wee bit of (changed
- implementation of pdftoepdf.convertNumToPDF).
-- Bugfix: When setting the /Producer, /Creator or /CreationDate keys with
- \pdfinfo pdfTeX would also insert default values which caused duplicate keys
- in the info dict (see
- http://tug.org/pipermail/pdftex/2003-February/003524.html).
-- The reading of mapfiles is much faster (see
- http://tug.org/pipermail/pdftex/2002-July/002843.html).
-- Bugfix: AR5 had problems with the CTM when displaying in "fit visible" mode
- (see http://tug.org/pipermail/pdftex/2002-May/002688.html).
-- Bugfix: str_in_str had wrong indices (see
- http://tug.org/pipermail/pdftex/2002-March/002367.html).
-- Bugfix: decimal_digits defaulted to 0, which caused problems with included
- images when including pdfs (see
- http://tug.org/pipermail/pdftex/2003-February/003518.html).
- It now defaults to 4.
-- Bugfix: the type of included images was decided based only on the extensions;
- now pdfTeX looks for magic bytes at the start of files (see
- http://tug.org/pipermail/pdftex/2003-February/003519.html)
-
------------------------------------------------
-pdfTeX 3.14159-1.10a was released on 2003-01-16
-- pdfTeX is now able to produce pdf1.4 (which is also the default) and has
- almost complete support for including pdf1.4 files:
- - Additional attributes like MetaData are copied from included pdfs.
- - Currently the Page Group attribute (see sections 7.3.6 and 7.5.5 of the pdf
- 1.4 reference) of included pdfs is NOT copied (as we don't know how to
- handle this when imposing pdfs).
- This means including pdfs with transparency features will work as long as
- the included pdf doesn't use Page Groups; if it does, the result might not
- be what is expected (One application known to use Page Groups is Adobe
- Illustrator v9++). The distributed pdfTeX binaries will give a warning
- about any occurance of a Page Group in an included pdf and ignore the Page
- Group (thus producing syntactically correct pdfs but probably not the
- intended output).
- Acrobat 5++ and newer versions of Jaws display files without Page Groups
- correctly, so this might not really be a problem.
- See pdftoepdf.cc for preprocessor flags which allow this behaviour to be
- changed (copying the Page Group (most likely producing incorrect pdf) or
- treating Page Groups as errors).
-- The new primitive \pdfoptionpdfminorversion sets the pdf version of the
- generated file and the latest allowed pdf version of included pdfs:
- \pdfoptionpdfminorversion=3
- tells pdfTeX to set the pdf version to 1.3 and allows only included pdfs with
- versions <= 1.3 .
- The default for \pdfoptionpdfminorversion is 4 for pdf 1.4
- This must appear before any data is written to the generated pdf file, so
- you should put it at the very start of your files.
- This can also be set in pdftex.cfg with pdf_minorversion
-- It is now possible to specify the pdf page box to use when including pdfs.
- The syntax has been extended:
- \pdfximage [<image attr spec>] <general text> (h, v, m)
- <image attr spec> --> [<rule spec>] [<attr spec>] [<page spec>] [<pdf box spec>]
- <pdf box spec> --> mediabox|cropbox|bleedbox|trimbox|artbox
- The default is cropbox (which defaults to mediabox), to be compatible with
- previous versions of pdfTeX.
- The page box specified at \pdfximage can be globally overridden with the
- config parameter always_use_pdfpagebox and the command
- \pdfoptionalwaysusepdfpagebox <integer>, where 0 is the default (use whatever
- is specified with \pdfximage), 1 is media, 2 is crop, 3 is bleed, 4 is trim
- and 5 is artbox. This can only be set once per object, i.e. the value used at
- \pdfximage is remembered.
- See the pdf reference for an explanation of the boxes.
-- The support for the inclusion of jpeg images has been extended to allow the
- inclusion of JPEG/Exif files which are produced by digital photo cameras
- (thanks to Hartmut Henkel).
-- The support for the inclusion of tif images has been removed as it was of
- limited use (it worked only for gray-scale and rgb images) and produced wrong
- results (all other images types where treated as rgb images).
- Tif images can be converted on *nix on-the-fly to pngs with the help of
- ImageMagick, epstopdf.sty or pdftex.def v0.4 or newer, and this rule:
- \DeclareGraphicsRule{.tif}{png}{.png}{`convert #1 `basename #1 .tif`.png}
-- The extensions for pdf encryption have been removed, since they make the
- pdfTeX code overly complex. Those needing pdf encryption are encouraged to
- produce a standalone program for encrypting pdfs.
-- pdfTeX now writes a usage statistic about the pdfTeX specific memory to the
- log.
-- numerous bugfixes, most of them in the inclusion of pdfs.
-- pdfTeX uses xpdf 2.01
-- pdfTeX uses libpng 1.2.5
-
----------------------------------------------------------------------
-pdfTeX 3.14159-1.00a-pretest-20011127-ojmw was released on 2002-01-29
-
-----------------------------------------------------------------
-pdfTeX 3.14159-1.00a-pretest-20010806 was released on 2001-08-06
-
-----------------------------------------------------------------
-pdfTeX 3.14159-1.00a-pretest-20010804 was released on 2001-08-04
-
-(This file public domain.)
-// vim: tw=79:ts=2:expandtab:autoindent
diff --git a/Build/source/texk/web2c/pdftexdir/README b/Build/source/texk/web2c/pdftexdir/README
deleted file mode 100644
index 785ab5b4595..00000000000
--- a/Build/source/texk/web2c/pdftexdir/README
+++ /dev/null
@@ -1,60 +0,0 @@
-pdfTeX is an extended version of eTeX that can create PDF directly from
-TeX source files and enhance the result of TeX typesetting with the help
-of PDF. When PDF output is not selected, pdfTeX produces normal DVI
-output, otherwise it produces PDF output that looks essentially
-identical to the DVI output
-
-An important aspect of this project was to investigate alternative
-justification algorithms, resulting in the "microtypography" features of
-margin kerning and font expansion. This was inspired by Peter Karow's
-and Hermann Zapf's work.
-
-pdfTeX is integrated with the original e-TeX sources and Web2c. It is
-actively maintained, but stability is paramount now; only bug fixes and
-small enhancements are expected. Releases are made through TeX Live.
-
-See the file NEWS for changes to the program.
-Documentation about pdfTeX can be found at http://www.pdftex.org.
-Mailing lists:
-http://lists.tug.org/pdftex - help requests, general user discussion
-http://www.ntg.nl/mailman/listinfo/ntg-pdftex - bug reports, development
-
-
-LEGAL ISSUES
-============
-
-pdfTeX is free software; you can redistribute it and/or modify it under the
-terms of the GNU General Public License as published by the Free Software
-Foundation; either version 2 of the License, or (at your option) any later
-version.
-
-pdfTeX is distributed in the hope that it will be useful, but WITHOUT ANY
-WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
-details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-
-pdfTeX uses code from TeX; for these parts the original copyright by Don
-Knuth applies. See the source files for details.
-
-pdfeTeX uses code from eTeX; for these parts the original copyright by
-Peter Breitenlohner applies. See the source files for details.
-
-CONTRIBUTORS
-============
-
-Karl Berry, Peter Breitenlohner, Ricardo Sanchez Carmenes, Otfried
-Cheong, Thomas Esser, Hans Hagen, Hartmut Henkel, Taco Hoekwater, Pawel
-Jackowski, Pavel Janik, Tom Kacvinsky, Akira Kakuto, Reinhard Kotucha,
-Derek B. Noonburg, Heiko Oberdiek, Jiri Osoba, Fabrice Popineau,
-Sebastian Rahtz, Bernd Raichle, Tomas Rokicki, Leonard Rosenthol, Martin
-Schröder, Petr Sojka, Ralf Utermann, Olaf Weber, Jiri Zlatuska.
-
-Some companies have supported the developement of pdfTeX: Adobe Systems
-Inc., ArtCom GmbH, Pragma ADE, QuinScape GmbH.
-
-pdfTeX is built on top of TeX, written by Donald Knuth cum suis (Frank
-Liang et al.), and e-TeX, written by Peter Breitenlohner cum suis;
-the advanced paragraph optimization is inspired by the work of Hermann Zapf.
diff --git a/Build/source/texk/web2c/pdftexdir/am/libpdftex.am b/Build/source/texk/web2c/pdftexdir/am/libpdftex.am
deleted file mode 100644
index f31df2abf3a..00000000000
--- a/Build/source/texk/web2c/pdftexdir/am/libpdftex.am
+++ /dev/null
@@ -1,65 +0,0 @@
-## texk/web2c/pdftexdir/am/libpdftex.am: Makefile fragment for libpdftex.
-##
-## Copyright (C) 2009-2015 Peter Breitenlohner <tex-live@tug.org>
-## You may freely use, modify and/or distribute this file.
-
-## libpdftex
-##
-EXTRA_LIBRARIES += libpdftex.a
-
-libpdftex_a_CPPFLAGS = $(REGEX_INCLUDES) $(pdftex_cppflags)
-libpdftex_a_CXXFLAGS = $(WARNING_CXXFLAGS)
-
-libpdftex_a_SOURCES = \
- pdftexdir/avl.c \
- pdftexdir/avl.h \
- pdftexdir/avlstuff.c \
- pdftexdir/avlstuff.h \
- pdftexdir/epdf.c \
- pdftexdir/image.h \
- pdftexdir/mapfile.c \
- pdftexdir/pdftex.h \
- pdftexdir/pdftex-common.h \
- pdftexdir/pdftoepdf.cc \
- pdftexdir/pkin.c \
- pdftexdir/ptexlib.h \
- pdftexdir/ptexmac.h \
- pdftexdir/subfont.c \
- pdftexdir/tounicode.c \
- pdftexdir/utils.c \
- pdftexdir/vfpacket.c \
- pdftexdir/writeenc.c \
- pdftexdir/writefont.c \
- pdftexdir/writeimg.c \
- pdftexdir/writejbig2.c \
- pdftexdir/writejpg.c \
- pdftexdir/writepng.c \
- pdftexdir/writet1.c \
- pdftexdir/writet3.c \
- pdftexdir/writettf.c \
- pdftexdir/writettf.h \
- pdftexdir/writezip.c
-
-if MINGW32
-REGEX_INCLUDES = -I$(srcdir)/pdftexdir/regex
-libpdftex_a_SOURCES += \
- pdftexdir/regex/regex.c \
- pdftexdir/regex/regex.h
-endif MINGW32
-
-# We must create pdftexd.h (and xpdf...) before building the libpdftex_a_OBJECTS.
-$(libpdftex_a_OBJECTS): pdftexd.h $(XPDF_DEPEND) $(ZLIB_DEPEND) $(LIBPNG_DEPEND)
-
-## included by pdftexdir/writettf.c
-EXTRA_libpdftex_a_SOURCES = pdftexdir/macnames.c
-
-## included by pdftexdir/regex/regex.c
-EXTRA_libpdftex_a_SOURCES += \
- pdftexdir/regex/regcomp.c \
- pdftexdir/regex/regex_internal.c \
- pdftexdir/regex/regex_internal.h \
- pdftexdir/regex/regexec.c
-
-EXTRA_DIST += \
- pdftexdir/regex/COPYING.LIB \
- pdftexdir/regex/README
diff --git a/Build/source/texk/web2c/pdftexdir/am/pdftex.am b/Build/source/texk/web2c/pdftexdir/am/pdftex.am
deleted file mode 100644
index 39dd3179400..00000000000
--- a/Build/source/texk/web2c/pdftexdir/am/pdftex.am
+++ /dev/null
@@ -1,132 +0,0 @@
-## $Id$
-## texk/web2c/pdftexdir/am/pdftex.am: Makefile fragment for pdfTeX.
-##
-## Copyright 2016-2021 Karl Berry <tex-live@tug.org>
-## Copyright 2009-2015 Peter Breitenlohner <tex-live@tug.org>
-## You may freely use, modify and/or distribute this file.
-
-pdftex_cppflags = $(AM_CPPFLAGS) $(ZLIB_INCLUDES) $(LIBPNG_INCLUDES) $(XPDF_INCLUDES)
-pdftex_cppflags += -I$(srcdir)/libmd5 -I$(srcdir)/pdftexdir
-
-# used for both pdftex and pdftosrc.
-pdftex_ldadd = $(LIBPNG_LIBS) $(ZLIB_LIBS) $(XPDF_LIBS) libmd5.a
-
-pdftex_dependencies = $(proglib) $(KPATHSEA_DEPEND)
-pdftex_dependencies += $(LIBPNG_DEPEND) $(ZLIB_DEPEND) $(XPDF_DEPEND) libmd5.a
-
-## pdfTeX
-##
-if PDFTEX
-bin_PROGRAMS += pdftex
-endif PDFTEX
-EXTRA_PROGRAMS += pdftex
-
-# Force Automake to use CXXLD for linking
-nodist_EXTRA_pdftex_SOURCES = dummy.cxx
-
-pdf_tangle = WEBINPUTS=.:$(srcdir)/pdftexdir AM_V_P=$(AM_V_P) $(SHELL) ./tangle-sh $@ $(TANGLE)
-
-pdftex_CPPFLAGS = $(pdftex_cppflags)
-pdftex_CXXFLAGS = $(WARNING_CXXFLAGS)
-
-# With --enable-ipc, pdfTeX may need to link with -lsocket.
-pdftex_LDADD = libpdftex.a $(pdftex_ldadd) $(LDADD) $(ipc_socketlibs)
-
-pdftex_DEPENDENCIES = $(pdftex_dependencies) libpdftex.a
-
-# We must create libpdftex.a etc before building the pdftex_OBJECTS.
-pdftex_prereq = libpdftex.a pdftexdir/etex_version.h pdftexdir/pdftex_version.h
-$(pdftex_OBJECTS): $(pdftex_prereq)
-
-pdftex_c_h = pdftexini.c pdftex0.c pdftexcoerce.h pdftexd.h
-nodist_pdftex_SOURCES = $(pdftex_c_h) pdftex-pool.c
-dist_pdftex_SOURCES = pdftexdir/pdftexextra.c pdftexdir/pdftexextra.h \
- pdftexdir/pdftex_version.h pdftexdir/etex_version.h
-$(pdftex_c_h): pdftex-web2c
- @$(web2c) pdftex
-pdftex-web2c: pdftex.p $(web2c_texmf) pdftexdir/pdftex.defines
- @$(web2c) pdftex
-pdftex.p pdftex.pool: pdftex-tangle
- @$(pdf_tangle) pdftex pdftex-final
-pdftex-tangle: tangle$(EXEEXT) pdftexdir/pdftex.web pdftex-final.ch tangle-sh
- @$(pdf_tangle) pdftex pdftex-final
-pdftex-pool.c: pdftex.pool pdftexd.h $(makecpool_stamp)
- $(makecpool) pdftex >$@ || rm -f $@
-
-# Extract pdftex version
-$(srcdir)/pdftexdir/pdftex_version.h: @MAINTAINER_MODE_TRUE@ pdftexdir/pdftex.web
- $(AM_V_GEN)grep '^@d pdftex_version_string==' $(srcdir)/pdftexdir/pdftex.web \
- | sed "s/^.*'-/#define PDFTEX_VERSION \"/;s/'.*$$/\"/" >$@
-
-# Extract etex version
-$(srcdir)/pdftexdir/etex_version.h: @MAINTAINER_MODE_TRUE@ pdftexdir/pdftex.web
- $(AM_V_GEN)grep '^@d eTeX_version_string==' $(srcdir)/pdftexdir/pdftex.web \
- | sed "s/^.*'-/#define ETEX_VERSION \"/;s/'.*$$/\"/" >$@
-
-# Generate pdftex-final.ch
-pdftex-final.ch: tie$(EXEEXT) $(pdftex_ch_srcs)
- $(tie_c) $(pdftex_ch_srcs)
-pdftex_ch_srcs = \
- pdftexdir/pdftex.web \
- pdftexdir/tex.ch0 \
- tex.ch \
- tracingstacklevels.ch \
- zlib-fmt.ch \
- enctexdir/enctex1.ch \
- enctexdir/enctex-pdftex.ch \
- enctexdir/enctex2.ch \
- $(pdftex_ch_synctex) \
- pdftexdir/pdftex.ch \
- pdftexdir/char-warning-pdftex.ch \
- tex-binpool.ch
-
-# Convenience target for making the typeset output; not invoked automatically
-pdftex.pdf: pdftex.tex
- env MKTEXFMT=0 pdftex '\nonstopmode\input pdftex.tex'
-pdftex.tex: $(srcdir)/pdftexdir/pdftex.web
- weave $(srcdir)/pdftexdir/pdftex.web
-
-##
-EXTRA_DIST += $(pdftex_ch_srcs) pdftexdir/pdftex.defines
-
-DISTCLEANFILES += $(nodist_pdftex_SOURCES) pdftex-final.ch pdftex-web2c \
- pdftex.p pdftex.pool pdftex-tangle
-
-EXTRA_DIST += \
- pdftexdir/ChangeLog \
- pdftexdir/NEWS \
- pdftexdir/README \
- pdftexdir/change-files.txt
-
-# pdfTeX tests
-#
-pdftex_tests = pdftexdir/wprob.test pdftexdir/pdftex.test \
- pdftexdir/pdfimage.test pdftexdir/expanded.test \
- pdftexdir/tests/cnfline.test
-
-pdftexdir/wprob.log pdftexdir/pdftex.log \
- pdftexdir/pdfimage.log pdftexdir/expanded.log \
- pdftexdir/cnfline.log: pdftex$(EXEEXT)
-
-EXTRA_DIST += $(pdftex_tests)
-
-if PDFTEX
-TESTS += $(pdftex_tests)
-endif PDFTEX
-
-## wprob.test
-EXTRA_DIST += tests/wprob.tex
-DISTCLEANFILES += pwprob.log pwprob.tex
-
-## pdfimage.test
-EXTRA_DIST += pdftexdir/tests/pdfimage.tex \
- tests/1-4.jpg tests/B.pdf tests/basic.tex tests/lily-ledger-broken.png
-DISTCLEANFILES += pdfimage.fmt pdfimage.log pdfimage.pdf
-
-## expanded.test
-EXTRA_DIST += tests/expanded.tex tests/expanded.txt
-DISTCLEANFILES += expanded.log
-
-## cnfline.test
-EXTRA_DIST += tests/cnfline.tex
-DISTCLEANFILES += cnfline.log
diff --git a/Build/source/texk/web2c/pdftexdir/am/pdftosrc.am b/Build/source/texk/web2c/pdftexdir/am/pdftosrc.am
deleted file mode 100644
index 1e70468d801..00000000000
--- a/Build/source/texk/web2c/pdftexdir/am/pdftosrc.am
+++ /dev/null
@@ -1,42 +0,0 @@
-## texk/web2c/pdftexdir/am/pdftosrc.am: Makefile fragment for pdftosrc.
-##
-## Copyright (C) 2009-2015 Peter Breitenlohner <tex-live@tug.org>
-## You may freely use, modify and/or distribute this file.
-
-## pdftosrc
-##
-if PDFTEX
-bin_PROGRAMS += pdftosrc
-endif PDFTEX
-EXTRA_PROGRAMS += pdftosrc
-
-# Force Automake to use CXXLD for linking
-nodist_EXTRA_pdftosrc_SOURCES = dummy.cxx
-
-pdftosrc_CPPFLAGS = $(pdftex_cppflags)
-pdftosrc_CXXFLAGS = $(WARNING_CXXFLAGS)
-
-pdftosrc_SOURCES = pdftexdir/pdftosrc.cc
-
-pdftosrc_LDADD = $(pdftex_ldadd) $(LDADD)
-
-pdftosrc_DEPENDENCIES = $(pdftex_dependencies)
-
-$(pdftosrc_OBJECTS): $(ZLIB_DEPEND) $(LIBPNG_DEPEND) $(XPDF_DEPEND)
-
-## Tests
-##
-pdftosrc_tests = pdftexdir/pdftosrc.test
-pdftexdir/pdftosrc.log: pdftosrc$(EXEEXT)
-
-EXTRA_DIST += $(pdftosrc_tests)
-
-## pdftexdir/pdftosrc.test
-EXTRA_DIST += pdftexdir/tests/test-13.pdf pdftexdir/tests/test-13.xref \
- pdftexdir/tests/test-15.pdf pdftexdir/tests/test-15.xref
-DISTCLEANFILES += test-13.pdf test-13.xref test-15.pdf test-15.xref
-
-if PDFTEX
-TESTS += $(pdftosrc_tests)
-endif PDFTEX
-
diff --git a/Build/source/texk/web2c/pdftexdir/am/ttf2afm.am b/Build/source/texk/web2c/pdftexdir/am/ttf2afm.am
deleted file mode 100644
index 1eae9016737..00000000000
--- a/Build/source/texk/web2c/pdftexdir/am/ttf2afm.am
+++ /dev/null
@@ -1,37 +0,0 @@
-## texk/web2c/pdftexdir/am/ttf2afm.am: Makefile fragment for ttf2afm.
-##
-## Copyright (C) 2009-2015 Peter Breitenlohner <tex-live@tug.org>
-## You may freely use, modify and/or distribute this file.
-
-## ttf2afm
-##
-if PDFTEX
-bin_PROGRAMS += ttf2afm
-endif PDFTEX
-EXTRA_PROGRAMS += ttf2afm
-
-ttf2afm_CPPFLAGS = $(AM_CPPFLAGS) -I$(srcdir)/pdftexdir
-
-ttf2afm_SOURCES = pdftexdir/ttf2afm.c
-
-ttf2afm_DEPENDENCIES = $(default_dependencies)
-
-## included by pdftexdir/ttf2afm.c
-EXTRA_ttf2afm_SOURCES = pdftexdir/macnames.c
-
-## Tests
-##
-ttf2afm_tests = pdftexdir/ttf2afm.test
-pdftexdir/ttf2afm.log: ttf2afm$(EXEEXT)
-
-EXTRA_DIST += $(ttf2afm_tests)
-
-## pdftexdir/ttf1afm.test
-EXTRA_DIST += pdftexdir/tests/postV3.afm pdftexdir/tests/postV3.ttf
-EXTRA_DIST += pdftexdir/tests/postV7.afm pdftexdir/tests/postV7.ttf
-DISTCLEANFILES += postV3.afm postV7.afm
-
-if PDFTEX
-TESTS += $(ttf2afm_tests)
-endif PDFTEX
-
diff --git a/Build/source/texk/web2c/pdftexdir/avl.c b/Build/source/texk/web2c/pdftexdir/avl.c
deleted file mode 100644
index fcb629acd55..00000000000
--- a/Build/source/texk/web2c/pdftexdir/avl.c
+++ /dev/null
@@ -1,796 +0,0 @@
-/* Produced by texiweb from libavl.w. */
-
-/* libavl - library for manipulation of binary trees.
- Copyright (C) 2004-2014 Han The Thanh, <thanh@pdftex.org>
- Modified for pdfTeX, contact pdfTeX maintainers with any problems or
- questions, not the original authors.
-
- Copyright (C) 1998-2002, 2004 Free Software Foundation, Inc.
-
- This program is free software; you can redistribute it and/or
- modify it under the terms of the GNU General Public License as
- published by the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- See the GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
-
- Original author: Ben Pfaff.
-*/
-
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include "avl.h"
-
-/* Creates and returns a new table
- with comparison function |compare| using parameter |param|
- and memory allocator |allocator|.
- Returns |NULL| if memory allocation failed. */
-struct avl_table *avl_create(avl_comparison_func * compare, void *param,
- struct libavl_allocator *allocator)
-{
- struct avl_table *tree;
-
- assert(compare != NULL);
-
- if (allocator == NULL)
- allocator = &avl_allocator_default;
-
- tree = allocator->libavl_malloc(allocator, sizeof *tree);
- if (tree == NULL)
- return NULL;
-
- tree->avl_root = NULL;
- tree->avl_compare = compare;
- tree->avl_param = param;
- tree->avl_alloc = allocator;
- tree->avl_count = 0;
- tree->avl_generation = 0;
-
- return tree;
-}
-
-/* Search |tree| for an item matching |item|, and return it if found.
- Otherwise return |NULL|. */
-void *avl_find(const struct avl_table *tree, const void *item)
-{
- const struct avl_node *p;
-
- assert(tree != NULL && item != NULL);
- for (p = tree->avl_root; p != NULL;) {
- int cmp = tree->avl_compare(item, p->avl_data, tree->avl_param);
-
- if (cmp < 0)
- p = p->avl_link[0];
- else if (cmp > 0)
- p = p->avl_link[1];
- else /* |cmp == 0| */
- return p->avl_data;
- }
-
- return NULL;
-}
-
-/* Inserts |item| into |tree| and returns a pointer to |item|'s address.
- If a duplicate item is found in the tree,
- returns a pointer to the duplicate without inserting |item|.
- Returns |NULL| in case of memory allocation failure. */
-void **avl_probe(struct avl_table *tree, void *item)
-{
- struct avl_node *y, *z; /* Top node to update balance factor, and parent. */
- struct avl_node *p, *q; /* Iterator, and parent. */
- struct avl_node *n; /* Newly inserted node. */
- struct avl_node *w; /* New root of rebalanced subtree. */
- int dir; /* Direction to descend. */
-
- unsigned char da[AVL_MAX_HEIGHT]; /* Cached comparison results. */
- int k = 0; /* Number of cached results. */
-
- assert(tree != NULL && item != NULL);
-
- z = (struct avl_node *) &tree->avl_root;
- y = tree->avl_root;
- dir = 0;
- for (q = z, p = y; p != NULL; q = p, p = p->avl_link[dir]) {
- int cmp = tree->avl_compare(item, p->avl_data, tree->avl_param);
- if (cmp == 0)
- return &p->avl_data;
-
- if (p->avl_balance != 0)
- z = q, y = p, k = 0;
- da[k++] = dir = cmp > 0;
- }
-
- n = q->avl_link[dir] =
- tree->avl_alloc->libavl_malloc(tree->avl_alloc, sizeof *n);
- if (n == NULL)
- return NULL;
-
- tree->avl_count++;
- n->avl_data = item;
- n->avl_link[0] = n->avl_link[1] = NULL;
- n->avl_balance = 0;
- if (y == NULL)
- return &n->avl_data;
-
- for (p = y, k = 0; p != n; p = p->avl_link[da[k]], k++)
- if (da[k] == 0)
- p->avl_balance--;
- else
- p->avl_balance++;
-
- if (y->avl_balance == -2) {
- struct avl_node *x = y->avl_link[0];
- if (x->avl_balance == -1) {
- w = x;
- y->avl_link[0] = x->avl_link[1];
- x->avl_link[1] = y;
- x->avl_balance = y->avl_balance = 0;
- } else {
- assert(x->avl_balance == +1);
- w = x->avl_link[1];
- x->avl_link[1] = w->avl_link[0];
- w->avl_link[0] = x;
- y->avl_link[0] = w->avl_link[1];
- w->avl_link[1] = y;
- if (w->avl_balance == -1)
- x->avl_balance = 0, y->avl_balance = +1;
- else if (w->avl_balance == 0)
- x->avl_balance = y->avl_balance = 0;
- else /* |w->avl_balance == +1| */
- x->avl_balance = -1, y->avl_balance = 0;
- w->avl_balance = 0;
- }
- } else if (y->avl_balance == +2) {
- struct avl_node *x = y->avl_link[1];
- if (x->avl_balance == +1) {
- w = x;
- y->avl_link[1] = x->avl_link[0];
- x->avl_link[0] = y;
- x->avl_balance = y->avl_balance = 0;
- } else {
- assert(x->avl_balance == -1);
- w = x->avl_link[0];
- x->avl_link[0] = w->avl_link[1];
- w->avl_link[1] = x;
- y->avl_link[1] = w->avl_link[0];
- w->avl_link[0] = y;
- if (w->avl_balance == +1)
- x->avl_balance = 0, y->avl_balance = -1;
- else if (w->avl_balance == 0)
- x->avl_balance = y->avl_balance = 0;
- else /* |w->avl_balance == -1| */
- x->avl_balance = +1, y->avl_balance = 0;
- w->avl_balance = 0;
- }
- } else
- return &n->avl_data;
- z->avl_link[y != z->avl_link[0]] = w;
-
- tree->avl_generation++;
- return &n->avl_data;
-}
-
-/* Inserts |item| into |table|.
- Returns |NULL| if |item| was successfully inserted
- or if a memory allocation error occurred.
- Otherwise, returns the duplicate item. */
-void *avl_insert(struct avl_table *table, void *item)
-{
- void **p = avl_probe(table, item);
- return p == NULL || *p == item ? NULL : *p;
-}
-
-/* Inserts |item| into |table|, replacing any duplicate item.
- Returns |NULL| if |item| was inserted without replacing a duplicate,
- or if a memory allocation error occurred.
- Otherwise, returns the item that was replaced. */
-void *avl_replace(struct avl_table *table, void *item)
-{
- void **p = avl_probe(table, item);
- if (p == NULL || *p == item)
- return NULL;
- else {
- void *r = *p;
- *p = item;
- return r;
- }
-}
-
-/* Deletes from |tree| and returns an item matching |item|.
- Returns a null pointer if no matching item found. */
-void *avl_delete(struct avl_table *tree, const void *item)
-{
- /* Stack of nodes. */
- struct avl_node *pa[AVL_MAX_HEIGHT]; /* Nodes. */
- unsigned char da[AVL_MAX_HEIGHT]; /* |avl_link[]| indexes. */
- int k; /* Stack pointer. */
-
- struct avl_node *p; /* Traverses tree to find node to delete. */
- int cmp; /* Result of comparison between |item| and |p|. */
-
- void *res;
-
- assert(tree != NULL && item != NULL);
-
- k = 0;
- p = (struct avl_node *) &tree->avl_root;
- for (cmp = -1; cmp != 0;
- cmp = tree->avl_compare(item, p->avl_data, tree->avl_param)) {
- int dir = cmp > 0;
-
- pa[k] = p;
- da[k++] = dir;
-
- p = p->avl_link[dir];
- if (p == NULL)
- return NULL;
- }
- res = p->avl_data;
-
- if (p->avl_link[1] == NULL)
- pa[k - 1]->avl_link[da[k - 1]] = p->avl_link[0];
- else {
- struct avl_node *r = p->avl_link[1];
- if (r->avl_link[0] == NULL) {
- r->avl_link[0] = p->avl_link[0];
- r->avl_balance = p->avl_balance;
- pa[k - 1]->avl_link[da[k - 1]] = r;
- da[k] = 1;
- pa[k++] = r;
- } else {
- struct avl_node *s;
- int j = k++;
-
- for (;;) {
- da[k] = 0;
- pa[k++] = r;
- s = r->avl_link[0];
- if (s->avl_link[0] == NULL)
- break;
-
- r = s;
- }
-
- s->avl_link[0] = p->avl_link[0];
- r->avl_link[0] = s->avl_link[1];
- s->avl_link[1] = p->avl_link[1];
- s->avl_balance = p->avl_balance;
-
- pa[j - 1]->avl_link[da[j - 1]] = s;
- da[j] = 1;
- pa[j] = s;
- }
- }
-
- tree->avl_alloc->libavl_free(tree->avl_alloc, p);
-
- assert(k > 0);
- while (--k > 0) {
- struct avl_node *y = pa[k];
-
- if (da[k] == 0) {
- y->avl_balance++;
- if (y->avl_balance == +1)
- break;
- else if (y->avl_balance == +2) {
- struct avl_node *x = y->avl_link[1];
- if (x->avl_balance == -1) {
- struct avl_node *w;
- assert(x->avl_balance == -1);
- w = x->avl_link[0];
- x->avl_link[0] = w->avl_link[1];
- w->avl_link[1] = x;
- y->avl_link[1] = w->avl_link[0];
- w->avl_link[0] = y;
- if (w->avl_balance == +1)
- x->avl_balance = 0, y->avl_balance = -1;
- else if (w->avl_balance == 0)
- x->avl_balance = y->avl_balance = 0;
- else /* |w->avl_balance == -1| */
- x->avl_balance = +1, y->avl_balance = 0;
- w->avl_balance = 0;
- pa[k - 1]->avl_link[da[k - 1]] = w;
- } else {
- y->avl_link[1] = x->avl_link[0];
- x->avl_link[0] = y;
- pa[k - 1]->avl_link[da[k - 1]] = x;
- if (x->avl_balance == 0) {
- x->avl_balance = -1;
- y->avl_balance = +1;
- break;
- } else
- x->avl_balance = y->avl_balance = 0;
- }
- }
- } else {
- y->avl_balance--;
- if (y->avl_balance == -1)
- break;
- else if (y->avl_balance == -2) {
- struct avl_node *x = y->avl_link[0];
- if (x->avl_balance == +1) {
- struct avl_node *w;
- assert(x->avl_balance == +1);
- w = x->avl_link[1];
- x->avl_link[1] = w->avl_link[0];
- w->avl_link[0] = x;
- y->avl_link[0] = w->avl_link[1];
- w->avl_link[1] = y;
- if (w->avl_balance == -1)
- x->avl_balance = 0, y->avl_balance = +1;
- else if (w->avl_balance == 0)
- x->avl_balance = y->avl_balance = 0;
- else /* |w->avl_balance == +1| */
- x->avl_balance = -1, y->avl_balance = 0;
- w->avl_balance = 0;
- pa[k - 1]->avl_link[da[k - 1]] = w;
- } else {
- y->avl_link[0] = x->avl_link[1];
- x->avl_link[1] = y;
- pa[k - 1]->avl_link[da[k - 1]] = x;
- if (x->avl_balance == 0) {
- x->avl_balance = +1;
- y->avl_balance = -1;
- break;
- } else
- x->avl_balance = y->avl_balance = 0;
- }
- }
- }
- }
-
- tree->avl_count--;
- tree->avl_generation++;
- return res;
-}
-
-/* Refreshes the stack of parent pointers in |trav|
- and updates its generation number. */
-static void trav_refresh(struct avl_traverser *trav)
-{
- assert(trav != NULL);
-
- trav->avl_generation = trav->avl_table->avl_generation;
-
- if (trav->avl_node != NULL) {
- avl_comparison_func *cmp = trav->avl_table->avl_compare;
- void *param = trav->avl_table->avl_param;
- struct avl_node *node = trav->avl_node;
- struct avl_node *i;
-
- trav->avl_height = 0;
- for (i = trav->avl_table->avl_root; i != node;) {
- assert(trav->avl_height < AVL_MAX_HEIGHT);
- assert(i != NULL);
-
- trav->avl_stack[trav->avl_height++] = i;
- i = i->avl_link[cmp(node->avl_data, i->avl_data, param) > 0];
- }
- }
-}
-
-/* Initializes |trav| for use with |tree|
- and selects the null node. */
-void avl_t_init(struct avl_traverser *trav, struct avl_table *tree)
-{
- trav->avl_table = tree;
- trav->avl_node = NULL;
- trav->avl_height = 0;
- trav->avl_generation = tree->avl_generation;
-}
-
-/* Initializes |trav| for |tree|
- and selects and returns a pointer to its least-valued item.
- Returns |NULL| if |tree| contains no nodes. */
-void *avl_t_first(struct avl_traverser *trav, struct avl_table *tree)
-{
- struct avl_node *x;
-
- assert(tree != NULL && trav != NULL);
-
- trav->avl_table = tree;
- trav->avl_height = 0;
- trav->avl_generation = tree->avl_generation;
-
- x = tree->avl_root;
- if (x != NULL)
- while (x->avl_link[0] != NULL) {
- assert(trav->avl_height < AVL_MAX_HEIGHT);
- trav->avl_stack[trav->avl_height++] = x;
- x = x->avl_link[0];
- }
- trav->avl_node = x;
-
- return x != NULL ? x->avl_data : NULL;
-}
-
-/* Initializes |trav| for |tree|
- and selects and returns a pointer to its greatest-valued item.
- Returns |NULL| if |tree| contains no nodes. */
-void *avl_t_last(struct avl_traverser *trav, struct avl_table *tree)
-{
- struct avl_node *x;
-
- assert(tree != NULL && trav != NULL);
-
- trav->avl_table = tree;
- trav->avl_height = 0;
- trav->avl_generation = tree->avl_generation;
-
- x = tree->avl_root;
- if (x != NULL)
- while (x->avl_link[1] != NULL) {
- assert(trav->avl_height < AVL_MAX_HEIGHT);
- trav->avl_stack[trav->avl_height++] = x;
- x = x->avl_link[1];
- }
- trav->avl_node = x;
-
- return x != NULL ? x->avl_data : NULL;
-}
-
-/* Searches for |item| in |tree|.
- If found, initializes |trav| to the item found and returns the item
- as well.
- If there is no matching item, initializes |trav| to the null item
- and returns |NULL|. */
-void *avl_t_find(struct avl_traverser *trav, struct avl_table *tree, void *item)
-{
- struct avl_node *p, *q;
-
- assert(trav != NULL && tree != NULL && item != NULL);
- trav->avl_table = tree;
- trav->avl_height = 0;
- trav->avl_generation = tree->avl_generation;
- for (p = tree->avl_root; p != NULL; p = q) {
- int cmp = tree->avl_compare(item, p->avl_data, tree->avl_param);
-
- if (cmp < 0)
- q = p->avl_link[0];
- else if (cmp > 0)
- q = p->avl_link[1];
- else { /* |cmp == 0| */
-
- trav->avl_node = p;
- return p->avl_data;
- }
-
- assert(trav->avl_height < AVL_MAX_HEIGHT);
- trav->avl_stack[trav->avl_height++] = p;
- }
-
- trav->avl_height = 0;
- trav->avl_node = NULL;
- return NULL;
-}
-
-/* Attempts to insert |item| into |tree|.
- If |item| is inserted successfully, it is returned and |trav| is
- initialized to its location.
- If a duplicate is found, it is returned and |trav| is initialized to
- its location. No replacement of the item occurs.
- If a memory allocation failure occurs, |NULL| is returned and |trav|
- is initialized to the null item. */
-void *avl_t_insert(struct avl_traverser *trav, struct avl_table *tree,
- void *item)
-{
- void **p;
-
- assert(trav != NULL && tree != NULL && item != NULL);
-
- p = avl_probe(tree, item);
- if (p != NULL) {
- trav->avl_table = tree;
- trav->avl_node = ((struct avl_node *)
- ((char *) p - offsetof(struct avl_node, avl_data)));
- trav->avl_generation = tree->avl_generation - 1;
- return *p;
- } else {
- avl_t_init(trav, tree);
- return NULL;
- }
-}
-
-/* Initializes |trav| to have the same current node as |src|. */
-void *avl_t_copy(struct avl_traverser *trav, const struct avl_traverser *src)
-{
- assert(trav != NULL && src != NULL);
-
- if (trav != src) {
- trav->avl_table = src->avl_table;
- trav->avl_node = src->avl_node;
- trav->avl_generation = src->avl_generation;
- if (trav->avl_generation == trav->avl_table->avl_generation) {
- trav->avl_height = src->avl_height;
- memcpy(trav->avl_stack, (const void *) src->avl_stack,
- sizeof *trav->avl_stack * trav->avl_height);
- }
- }
-
- return trav->avl_node != NULL ? trav->avl_node->avl_data : NULL;
-}
-
-/* Returns the next data item in inorder
- within the tree being traversed with |trav|,
- or if there are no more data items returns |NULL|. */
-void *avl_t_next(struct avl_traverser *trav)
-{
- struct avl_node *x;
-
- assert(trav != NULL);
-
- if (trav->avl_generation != trav->avl_table->avl_generation)
- trav_refresh(trav);
-
- x = trav->avl_node;
- if (x == NULL) {
- return avl_t_first(trav, trav->avl_table);
- } else if (x->avl_link[1] != NULL) {
- assert(trav->avl_height < AVL_MAX_HEIGHT);
- trav->avl_stack[trav->avl_height++] = x;
- x = x->avl_link[1];
-
- while (x->avl_link[0] != NULL) {
- assert(trav->avl_height < AVL_MAX_HEIGHT);
- trav->avl_stack[trav->avl_height++] = x;
- x = x->avl_link[0];
- }
- } else {
- struct avl_node *y;
-
- do {
- if (trav->avl_height == 0) {
- trav->avl_node = NULL;
- return NULL;
- }
-
- y = x;
- x = trav->avl_stack[--trav->avl_height];
- }
- while (y == x->avl_link[1]);
- }
- trav->avl_node = x;
-
- return x->avl_data;
-}
-
-/* Returns the previous data item in inorder
- within the tree being traversed with |trav|,
- or if there are no more data items returns |NULL|. */
-void *avl_t_prev(struct avl_traverser *trav)
-{
- struct avl_node *x;
-
- assert(trav != NULL);
-
- if (trav->avl_generation != trav->avl_table->avl_generation)
- trav_refresh(trav);
-
- x = trav->avl_node;
- if (x == NULL) {
- return avl_t_last(trav, trav->avl_table);
- } else if (x->avl_link[0] != NULL) {
- assert(trav->avl_height < AVL_MAX_HEIGHT);
- trav->avl_stack[trav->avl_height++] = x;
- x = x->avl_link[0];
-
- while (x->avl_link[1] != NULL) {
- assert(trav->avl_height < AVL_MAX_HEIGHT);
- trav->avl_stack[trav->avl_height++] = x;
- x = x->avl_link[1];
- }
- } else {
- struct avl_node *y;
-
- do {
- if (trav->avl_height == 0) {
- trav->avl_node = NULL;
- return NULL;
- }
-
- y = x;
- x = trav->avl_stack[--trav->avl_height];
- }
- while (y == x->avl_link[0]);
- }
- trav->avl_node = x;
-
- return x->avl_data;
-}
-
-/* Returns |trav|'s current item. */
-void *avl_t_cur(struct avl_traverser *trav)
-{
- assert(trav != NULL);
-
- return trav->avl_node != NULL ? trav->avl_node->avl_data : NULL;
-}
-
-/* Replaces the current item in |trav| by |new| and returns the item replaced.
- |trav| must not have the null item selected.
- The new item must not upset the ordering of the tree. */
-void *avl_t_replace(struct avl_traverser *trav, void *new)
-{
- void *old;
-
- assert(trav != NULL && trav->avl_node != NULL && new != NULL);
- old = trav->avl_node->avl_data;
- trav->avl_node->avl_data = new;
- return old;
-}
-
-/* Destroys |new| with |avl_destroy (new, destroy)|,
- first setting right links of nodes in |stack| within |new|
- to null pointers to avoid touching uninitialized data. */
-static void
-copy_error_recovery(struct avl_node **stack, int height,
- struct avl_table *new, avl_item_func * destroy)
-{
- assert(stack != NULL && height >= 0 && new != NULL);
-
- for (; height > 2; height -= 2)
- stack[height - 1]->avl_link[1] = NULL;
- avl_destroy(new, destroy);
-}
-
-/* Copies |org| to a newly created tree, which is returned.
- If |copy != NULL|, each data item in |org| is first passed to |copy|,
- and the return values are inserted into the tree,
- with |NULL| return values taken as indications of failure.
- On failure, destroys the partially created new tree,
- applying |destroy|, if non-null, to each item in the new tree so far,
- and returns |NULL|.
- If |allocator != NULL|, it is used for allocation in the new tree.
- Otherwise, the same allocator used for |org| is used. */
-struct avl_table *avl_copy(const struct avl_table *org, avl_copy_func * copy,
- avl_item_func * destroy,
- struct libavl_allocator *allocator)
-{
- struct avl_node *stack[2 * (AVL_MAX_HEIGHT + 1)];
- int height = 0;
-
- struct avl_table *new;
- struct avl_node org_head, *x, *y;
-
- assert(org != NULL);
- new = avl_create(org->avl_compare, org->avl_param,
- allocator != NULL ? allocator : org->avl_alloc);
- if (new == NULL)
- return NULL;
- new->avl_count = org->avl_count;
- if (new->avl_count == 0)
- return new;
-
- org_head.avl_link[0] = (struct avl_node *) org->avl_root;
- x = &org_head;
- y = (struct avl_node *) &new->avl_root;
- for (;;) {
- while (x->avl_link[0] != NULL) {
- assert(height < 2 * (AVL_MAX_HEIGHT + 1));
-
- y->avl_link[0] =
- new->avl_alloc->libavl_malloc(new->avl_alloc,
- sizeof *y->avl_link[0]);
- if (y->avl_link[0] == NULL) {
- if (y != (struct avl_node *) &new->avl_root) {
- y->avl_data = NULL;
- y->avl_link[1] = NULL;
- }
-
- copy_error_recovery(stack, height, new, destroy);
- return NULL;
- }
-
- stack[height++] = x;
- stack[height++] = y;
- x = x->avl_link[0];
- y = y->avl_link[0];
- }
- y->avl_link[0] = NULL;
-
- for (;;) {
- y->avl_balance = x->avl_balance;
- if (copy == NULL)
- y->avl_data = x->avl_data;
- else {
- y->avl_data = copy(x->avl_data, org->avl_param);
- if (y->avl_data == NULL) {
- y->avl_link[1] = NULL;
- copy_error_recovery(stack, height, new, destroy);
- return NULL;
- }
- }
-
- if (x->avl_link[1] != NULL) {
- y->avl_link[1] =
- new->avl_alloc->libavl_malloc(new->avl_alloc,
- sizeof *y->avl_link[1]);
- if (y->avl_link[1] == NULL) {
- copy_error_recovery(stack, height, new, destroy);
- return NULL;
- }
-
- x = x->avl_link[1];
- y = y->avl_link[1];
- break;
- } else
- y->avl_link[1] = NULL;
-
- if (height <= 2)
- return new;
-
- y = stack[--height];
- x = stack[--height];
- }
- }
-}
-
-/* Frees storage allocated for |tree|.
- If |destroy != NULL|, applies it to each data item in inorder. */
-void avl_destroy(struct avl_table *tree, avl_item_func * destroy)
-{
- struct avl_node *p, *q;
-
- assert(tree != NULL);
-
- for (p = tree->avl_root; p != NULL; p = q)
- if (p->avl_link[0] == NULL) {
- q = p->avl_link[1];
- if (destroy != NULL && p->avl_data != NULL)
- destroy(p->avl_data, tree->avl_param);
- tree->avl_alloc->libavl_free(tree->avl_alloc, p);
- } else {
- q = p->avl_link[0];
- p->avl_link[0] = q->avl_link[1];
- q->avl_link[1] = p;
- }
-
- tree->avl_alloc->libavl_free(tree->avl_alloc, tree);
-}
-
-/* Allocates |size| bytes of space using |malloc()|.
- Returns a null pointer if allocation fails. */
-void *avl_malloc(struct libavl_allocator *allocator, size_t size)
-{
- assert(allocator != NULL && size > 0);
- return malloc(size);
-}
-
-/* Frees |block|. */
-void avl_free(struct libavl_allocator *allocator, void *block)
-{
- assert(allocator != NULL && block != NULL);
- free(block);
-}
-
-/* Default memory allocator that uses |malloc()| and |free()|. */
-struct libavl_allocator avl_allocator_default = {
- avl_malloc,
- avl_free
-};
-
-#undef NDEBUG
-#include <assert.h>
-
-/* Asserts that |avl_insert()| succeeds at inserting |item| into |table|. */
-void
- (avl_assert_insert) (struct avl_table * table, void *item) {
- void **p = avl_probe(table, item);
- assert(p != NULL && *p == item);
-}
-
-/* Asserts that |avl_delete()| really removes |item| from |table|,
- and returns the removed item. */
-void *(avl_assert_delete) (struct avl_table * table, void *item) {
- void *p = avl_delete(table, item);
- assert(p != NULL);
- return p;
-}
diff --git a/Build/source/texk/web2c/pdftexdir/avl.h b/Build/source/texk/web2c/pdftexdir/avl.h
deleted file mode 100644
index 5989ebd7d8e..00000000000
--- a/Build/source/texk/web2c/pdftexdir/avl.h
+++ /dev/null
@@ -1,117 +0,0 @@
-/* Produced by texiweb from libavl.w. */
-
-/* libavl - library for manipulation of binary trees.
- Copyright (C) 2004-2014 Han The Thanh, <thanh@pdftex.org>
- Modified for pdfTeX, contact pdfTeX maintainers with any problems or
- questions, not the original authors.
-
- Copyright (C) 1998-2002, 2004 Free Software Foundation, Inc.
-
- This program is free software; you can redistribute it and/or
- modify it under the terms of the GNU General Public License as
- published by the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- See the GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
- 02111-1307, USA.
-
- Original author: Ben Pfaff.
-*/
-
-#ifndef AVL_H
-#define AVL_H 1
-
-#include <stddef.h>
-
-/* Function types. */
-typedef int avl_comparison_func (const void *avl_a, const void *avl_b,
- void *avl_param);
-typedef void avl_item_func (void *avl_item, void *avl_param);
-typedef void *avl_copy_func (void *avl_item, void *avl_param);
-
-#ifndef LIBAVL_ALLOCATOR
-#define LIBAVL_ALLOCATOR
-/* Memory allocator. */
-struct libavl_allocator
- {
- void *(*libavl_malloc) (struct libavl_allocator *, size_t libavl_size);
- void (*libavl_free) (struct libavl_allocator *, void *libavl_block);
- };
-#endif
-
-/* Default memory allocator. */
-extern struct libavl_allocator avl_allocator_default;
-void *avl_malloc (struct libavl_allocator *, size_t);
-void avl_free (struct libavl_allocator *, void *);
-
-/* Maximum AVL height. */
-#ifndef AVL_MAX_HEIGHT
-#define AVL_MAX_HEIGHT 32
-#endif
-
-/* Tree data structure. */
-struct avl_table
- {
- struct avl_node *avl_root; /* Tree's root. */
- avl_comparison_func *avl_compare; /* Comparison function. */
- void *avl_param; /* Extra argument to |avl_compare|. */
- struct libavl_allocator *avl_alloc; /* Memory allocator. */
- size_t avl_count; /* Number of items in tree. */
- unsigned long avl_generation; /* Generation number. */
- };
-
-/* An AVL tree node. */
-struct avl_node
- {
- struct avl_node *avl_link[2]; /* Subtrees. */
- void *avl_data; /* Pointer to data. */
- signed char avl_balance; /* Balance factor. */
- };
-
-/* AVL traverser structure. */
-struct avl_traverser
- {
- struct avl_table *avl_table; /* Tree being traversed. */
- struct avl_node *avl_node; /* Current node in tree. */
- struct avl_node *avl_stack[AVL_MAX_HEIGHT];
- /* All the nodes above |avl_node|. */
- size_t avl_height; /* Number of nodes in |avl_parent|. */
- unsigned long avl_generation; /* Generation number. */
- };
-
-/* Table functions. */
-struct avl_table *avl_create (avl_comparison_func *, void *,
- struct libavl_allocator *);
-struct avl_table *avl_copy (const struct avl_table *, avl_copy_func *,
- avl_item_func *, struct libavl_allocator *);
-void avl_destroy (struct avl_table *, avl_item_func *);
-void **avl_probe (struct avl_table *, void *);
-void *avl_insert (struct avl_table *, void *);
-void *avl_replace (struct avl_table *, void *);
-void *avl_delete (struct avl_table *, const void *);
-void *avl_find (const struct avl_table *, const void *);
-void avl_assert_insert (struct avl_table *, void *);
-void *avl_assert_delete (struct avl_table *, void *);
-
-#define avl_count(table) ((size_t) (table)->avl_count)
-
-/* Table traverser functions. */
-void avl_t_init (struct avl_traverser *, struct avl_table *);
-void *avl_t_first (struct avl_traverser *, struct avl_table *);
-void *avl_t_last (struct avl_traverser *, struct avl_table *);
-void *avl_t_find (struct avl_traverser *, struct avl_table *, void *);
-void *avl_t_insert (struct avl_traverser *, struct avl_table *, void *);
-void *avl_t_copy (struct avl_traverser *, const struct avl_traverser *);
-void *avl_t_next (struct avl_traverser *);
-void *avl_t_prev (struct avl_traverser *);
-void *avl_t_cur (struct avl_traverser *);
-void *avl_t_replace (struct avl_traverser *, void *);
-
-#endif /* avl.h */
diff --git a/Build/source/texk/web2c/pdftexdir/avlstuff.c b/Build/source/texk/web2c/pdftexdir/avlstuff.c
deleted file mode 100644
index 73b836ff961..00000000000
--- a/Build/source/texk/web2c/pdftexdir/avlstuff.c
+++ /dev/null
@@ -1,172 +0,0 @@
-/*
-Copyright 2004-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by Free
-Software Foundation; either version 2 of the License, or (at your option)
-any later version.
-
-This file is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-*/
-
-#include "ptexlib.h"
-#include "avl.h"
-
-static struct avl_table *PdfObjTree[pdfobjtypemax + 1] =
- { NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL };
-
-/**********************************************************************/
-/* memory management functions for AVL */
-
-static void *avl_xmalloc(struct libavl_allocator *allocator, size_t size)
-{
- assert(allocator != NULL && size > 0);
- return xmalloc(size);
-}
-
-static void avl_xfree(struct libavl_allocator *allocator, void *block)
-{
- assert(allocator != NULL && block != NULL);
- xfree(block);
-}
-
-struct libavl_allocator avl_xallocator = {
- avl_xmalloc,
- avl_xfree
-};
-
-/**********************************************************************/
-/* general AVL comparison functions */
-
-int comp_int_entry(const void *pa, const void *pb, void *p)
-{
- cmp_return(*(const int *) pa, *(const int *) pb);
- return 0;
-}
-
-int comp_string_entry(const void *pa, const void *pb, void *p)
-{
- return strcmp((const char *) pa, (const char *) pb);
-}
-
-/**********************************************************************/
-/* One AVL tree for each obj_type 0...pdfobjtypemax */
-
-
-typedef struct oentry_ {
- integer int0;
- integer objptr;
-} oentry;
-
-/* AVL sort oentry into avl_table[] */
-
-static int compare_info(const void *pa, const void *pb, void *param)
-{
- integer a, b;
- int as, ae, bs, be, al, bl;
-
- a = ((const oentry *) pa)->int0;
- b = ((const oentry *) pb)->int0;
- if (a < 0 && b < 0) { /* string comparison */
- as = strstart[-a];
- ae = strstart[-a + 1]; /* start of next string in pool */
- bs = strstart[-b];
- be = strstart[-b + 1];
- al = ae - as;
- bl = be - bs;
- if (al < bl) /* compare first by string length */
- return -1;
- if (al > bl)
- return 1;
- for (; as < ae; as++, bs++) {
- if (strpool[as] < strpool[bs])
- return -1;
- if (strpool[as] > strpool[bs])
- return 1;
- }
- } else { /* integer comparison */
- if (a < b)
- return -1;
- if (a > b)
- return 1;
- }
- return 0;
-}
-
-void avlputobj(integer objptr, integer t)
-{
- static void **pp;
- static oentry *oe;
-
- if (PdfObjTree[t] == NULL) {
- PdfObjTree[t] = avl_create(compare_info, NULL, &avl_xallocator);
- if (PdfObjTree[t] == NULL)
- pdftex_fail("avlstuff.c: avl_create() PdfObjTree failed");
- }
- oe = xtalloc(1, oentry);
- oe->int0 = objtab[objptr].int0;
- oe->objptr = objptr; /* allows to relocate objtab */
- pp = avl_probe(PdfObjTree[t], oe);
- if (pp == NULL)
- pdftex_fail("avlstuff.c: avl_probe() out of memory in insertion");
-}
-
-
-/* replacement for linear search pascal function "find_obj()" */
-
-integer avlfindobj(integer t, integer i, integer byname)
-{
- static oentry *p;
- static oentry tmp;
-
- if (byname > 0)
- tmp.int0 = -i;
- else
- tmp.int0 = i;
- if (PdfObjTree[t] == NULL)
- return 0;
- p = (oentry *) avl_find(PdfObjTree[t], &tmp);
- if (p == NULL)
- return 0;
- return p->objptr;
-}
-
-/**********************************************************************/
-
-struct avl_table *mf_tree = NULL;
-
-typedef struct {
- char *tfm_name;
- internalfontnumber fontnum;
-} mf_entry;
-
-/**********************************************************************/
-/* cleaning up... */
-
-#if 0 /* unused */
-static void destroy_oentry(void *pa, void *pb)
-{
- oentry *p = (oentry *) pa;
- xfree(p);
-}
-
-static void PdfObjTree_free(void)
-{
- int i;
-
- for (i = 0; i <= pdfobjtypemax; i++) {
- if (PdfObjTree[i] != NULL)
- avl_destroy(PdfObjTree[i], destroy_oentry);
- }
-}
-#endif
-
-/**********************************************************************/
diff --git a/Build/source/texk/web2c/pdftexdir/avlstuff.h b/Build/source/texk/web2c/pdftexdir/avlstuff.h
deleted file mode 100644
index eda5bb51316..00000000000
--- a/Build/source/texk/web2c/pdftexdir/avlstuff.h
+++ /dev/null
@@ -1,24 +0,0 @@
-/*
-Copyright 2004-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by Free
-Software Foundation; either version 2 of the License, or (at your option)
-any later version.
-
-This file is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "avl.h"
-
-/* memory management functions for avl */
-
-extern struct libavl_allocator avl_xallocator;
-
-/* end of file avlstuff.h */
diff --git a/Build/source/texk/web2c/pdftexdir/change-files.txt b/Build/source/texk/web2c/pdftexdir/change-files.txt
deleted file mode 100644
index a435369d052..00000000000
--- a/Build/source/texk/web2c/pdftexdir/change-files.txt
+++ /dev/null
@@ -1,41 +0,0 @@
-$Id$
-Public domain.
-How change files are applied for pdftex/pdfetex?
-
-============================= pdftex =============================
-
-2) pdftex.ch is essentially generated from (see pdftexdir/am/pdftex.am)
- ./tie -c pdftex.ch pdftex.web \
- $(srcdir)/pdftexdir/tex.ch0 \
- $(srcdir)/tex.ch \
- $(srcdir)/pdftexdir/tex.ch1 \
- $(srcdir)/pdftexdir/tex.pch
-
-There are more feature-specific change files, for synctex, including the
-pool in the binary, etc., many of which are shared between engines. They
-don't alter the basic process described here.
-
-Input:
- pdftex.web:
- pdftex without system-dependent changes
-
- pdftexdir/tex.ch0:
- % Change file to assist in creating the web2c-specific change file.
- % This one comes first, resolves inconsistencies between the
- % generated pdftex.web and tex.ch
-
- change the pdftex banner to tex banner, so tex.ch can be applied
-
- tex.ch:
- the main web2c-specific (or other system-dependent) change file
-
- pdftexdir/pdftex.ch:
-
- % Change file to assist in creating the web2c-specific change file.
- % This one resolves inconsistencies between tex.ch and tex.pch.
-
- change the tex banner to pdftex banner (reverse tex.ch0)
-
-Output:
- pdftex.ch (in the build dir, not pdftexdir/pdftex.ch):
- additional & system-dependent changes
diff --git a/Build/source/texk/web2c/pdftexdir/char-warning-pdftex.ch b/Build/source/texk/web2c/pdftexdir/char-warning-pdftex.ch
deleted file mode 100644
index 4772d29494b..00000000000
--- a/Build/source/texk/web2c/pdftexdir/char-warning-pdftex.ch
+++ /dev/null
@@ -1,62 +0,0 @@
-% $Id$
-% Public domain (from David Jones, tex-implementors 30jun2020).
-% Unfortunately this cannot be in pdftex.ch since the ordering
-% of changes gets messed up.
-%
-% If \tracinglostchars >= 3, then making missing characters from a font
-% be an error, not just a log message, and always report the character
-% code in hex as well as a character.
-%
-% Simple example test:
-% pdftex -ini
-% \font\x=/usr/local/texlive/2020/texmf-dist/fonts/tfm/public/knuth-lib/logo10.tfm
-% \tracinglostchars=3 \x \char99\end
-% should get:
-% ! Missing character: There is no c ("63) in font logo10.
-
-@x [30] If \tracinglostchars > 2, then promote to full error.
-@p procedure char_warning(@!f:internal_font_number;@!c:eight_bits);
-var old_setting: integer; {saved value of |tracing_online|}
-begin if tracing_lost_chars>0 then
- begin old_setting:=tracing_online;
- if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
- begin begin_diagnostic;
- print_nl("Missing character: There is no ");
-@.Missing character@>
- print_ASCII(c); print(" in font ");
- slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
- end;
- tracing_online:=old_setting;
- end;
-end;
-@y
-@p procedure char_warning(@!f:internal_font_number;@!c:eight_bits);
-var old_setting: integer; {saved value of |tracing_online|}
-begin if tracing_lost_chars>0 then
- begin old_setting:=tracing_online;
- if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
- if tracing_lost_chars > 2 then
- print_err("Missing character: There is no ")
- else begin
- begin_diagnostic;
- print_nl("Missing character: There is no ")
- end;
-@.Missing character@>
- print_ASCII(c);
- if tracing_lost_chars > 2 then begin
- print(" (");
- print_hex(c);
- print(")");
- end;
- print(" in font ");
- slow_print(font_name[f]);
- if tracing_lost_chars < 3 then print_char("!");
- tracing_online:=old_setting;
- if tracing_lost_chars > 2 then begin
- help0;
- error;
- end else end_diagnostic(false);
- end; {of |tracing_lost_chars>0|}
-end; {of procedure}
-@z
-
diff --git a/Build/source/texk/web2c/pdftexdir/epdf.c b/Build/source/texk/web2c/pdftexdir/epdf.c
deleted file mode 100644
index 4674e97fbd3..00000000000
--- a/Build/source/texk/web2c/pdftexdir/epdf.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/*
-Copyright 1996-2019 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-#include <string.h>
-
-
-int is_subsetable(fm_entry * fm)
-{
- assert(is_included(fm));
- return is_subsetted(fm);
-}
-
-fd_entry *epdf_create_fontdescriptor(fm_entry * fm, int stemV)
-{
- fd_entry *fd;
- if ((fd = lookup_fd_entry(fm->ff_name, fm->slant, fm->extend)) == NULL) {
- fm->in_use = true;
- fd = new_fd_entry();
- fd->fm = fm;
- register_fd_entry(fd);
- fd->fd_objnum = pdfnewobjnum();
- assert(fm->ps_name != NULL);
- fd->fontname = xstrdup(fm->ps_name); /* just fallback */
- // stemV must be copied
- fd->font_dim[STEMV_CODE].val = stemV;
- fd->font_dim[STEMV_CODE].set = true;
- fd->gl_tree = avl_create(comp_string_entry, NULL, &avl_xallocator);
- assert(fd->gl_tree != NULL);
- }
- return fd;
-}
-
-int get_fd_objnum(fd_entry * fd)
-{
- assert(fd->fd_objnum != 0);
- return fd->fd_objnum;
-}
-
-int get_fn_objnum(fd_entry * fd)
-{
- if (fd->fn_objnum == 0)
- fd->fn_objnum = pdfnewobjnum();
- return fd->fn_objnum;
-}
-
-/***********************************************************************
- * Mark glyphs used by embedded PDF file:
- * 1. build fontdescriptor, if not yet existing
- * 2. mark glyphs directly there
- *
- * Input charset from xpdf is a string of glyph names including
- * leading slashes, with optional generic spaces, including tabs,
- * \n, \r, and \f, preceding or between them:
- /a/b/c or /a /b /c or /a/b /c, etc.
-***********************************************************************/
-
-#define Isgenericspace(c) (c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f')
-
-void epdf_mark_glyphs(fd_entry * fd, char *charset)
-{
- char *p, *q, *s;
- char *glyph;
- void **aa;
- if (charset == NULL)
- return;
- assert(fd != NULL);
- while (Isgenericspace(*charset))
- charset++;
- for (s = charset + 1, q = charset + strlen(charset); s < q; s = p + 1) {
- for (p = s; *p != '\0' && *p != '/' && !Isgenericspace(*p); p++);
- if (Isgenericspace(*p)) {
- *p = '\0';
- p++;
- while (Isgenericspace(*p))
- p++;
- }
- *p = '\0';
- if ((char *) avl_find(fd->gl_tree, s) == NULL) {
- glyph = xstrdup(s);
- aa = avl_probe(fd->gl_tree, glyph);
- assert(aa != NULL);
- }
- }
-}
-
-void embed_whole_font(fd_entry * fd)
-{
- fd->all_glyphs = true;
-}
-
-void epdf_free(void)
-{
- epdf_check_mem();
-}
diff --git a/Build/source/texk/web2c/pdftexdir/etex_version.h b/Build/source/texk/web2c/pdftexdir/etex_version.h
deleted file mode 100644
index 13752253536..00000000000
--- a/Build/source/texk/web2c/pdftexdir/etex_version.h
+++ /dev/null
@@ -1 +0,0 @@
-#define ETEX_VERSION "2.6"
diff --git a/Build/source/texk/web2c/pdftexdir/expanded.test b/Build/source/texk/web2c/pdftexdir/expanded.test
deleted file mode 100755
index 86e553c2b27..00000000000
--- a/Build/source/texk/web2c/pdftexdir/expanded.test
+++ /dev/null
@@ -1,19 +0,0 @@
-#! /bin/sh -vx
-# $Id: expanded.test 804 2018-05-17 22:29:15Z karl $
-# Public domain
-# David Carlisle: version for \expanded based on existing test scripts
-# by Peter Breitenlohner and Karl Berry.
-
-LC_ALL=C; export LC_ALL; LANGUAGE=C; export LANGUAGE
-
-TEXMFCNF=$srcdir/../kpathsea; export TEXMFCNF
-TEXINPUTS=$srcdir/pdftexdir/tests:.; export TEXINPUTS
-
-./pdftex -ini -etex --interaction batchmode expanded.tex
-sed -n -e 's/[\\]pdf/\\/g' -e '/START/,/END/p' expanded.log \
- >expanded_pdftex.log || exit 1
-
-diff "$srcdir/pdftexdir/tests/expanded.txt" expanded_pdftex.log || exit 1
-
-exit 0
-
diff --git a/Build/source/texk/web2c/pdftexdir/image.h b/Build/source/texk/web2c/pdftexdir/image.h
deleted file mode 100644
index 1b78fa9eeec..00000000000
--- a/Build/source/texk/web2c/pdftexdir/image.h
+++ /dev/null
@@ -1,111 +0,0 @@
-/*
-Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include <png.h>
-
-/* JPG_IMAGE_INFO is main structure for interchange of image data */
-
-#define JPG_UINT16 unsigned int
-#define JPG_UINT32 unsigned long
-#define JPG_UINT8 unsigned char
-
-typedef struct {
- int color_space; /* used color space. See JPG_ constants */
- JPG_UINT8 bits_per_component; /* bits per component */
- JPG_UINT32 length; /* length of file/data */
- FILE *file; /* jpg file */
-} JPG_IMAGE_INFO;
-
-typedef struct {
- png_structp png_ptr;
- png_infop info_ptr;
-} png_image_struct;
-
-typedef struct {
- integer orig_x;
- integer orig_y;
- integer selected_page;
- integer page_box;
- void *doc;
-} pdf_image_struct;
-
-typedef struct {
- integer selected_page;
- FILE *file;
-} JBIG2_IMAGE_INFO;
-
-typedef struct {
- char *image_name;
- int image_type;
- int color_type;
- integer width;
- integer height;
- integer rotate;
- integer x_res;
- integer y_res;
- integer num_pages;
- integer colorspace_ref;
- integer group_ref; // if it's <=0, the page has no group
- union {
- pdf_image_struct *pdf;
- png_image_struct png;
- JPG_IMAGE_INFO *jpg;
- JBIG2_IMAGE_INFO *jbig2;
- } image_struct;
-} image_entry;
-
-extern image_entry *image_ptr, *image_array;
-extern integer image_max;
-
-#define IMAGE_TYPE_NONE 0
-#define IMAGE_TYPE_PDF 1
-#define IMAGE_TYPE_PNG 2
-#define IMAGE_TYPE_JPG 3
-#define IMAGE_TYPE_TIF 4
-#define IMAGE_TYPE_JBIG2 5
-
-#define IMAGE_COLOR_B 1
-#define IMAGE_COLOR_C 2
-#define IMAGE_COLOR_I 4
-
-#define img_ptr(N) (image_array + (N))
-#define img_name(N) (img_ptr(N)->image_name)
-#define img_type(N) (img_ptr(N)->image_type)
-#define img_color(N) (img_ptr(N)->color_type)
-#define img_colorspace_ref(N) (img_ptr(N)->colorspace_ref)
-#define img_group_ref(N) (img_ptr(N)->group_ref)
-#define img_pages(N) (img_ptr(N)->num_pages)
-#define img_width(N) (img_ptr(N)->width)
-#define img_height(N) (img_ptr(N)->height)
-#define img_rotate(N) (img_ptr(N)->rotate)
-#define img_xres(N) (img_ptr(N)->x_res)
-#define img_yres(N) (img_ptr(N)->y_res)
-#define png_ptr(N) (img_ptr(N)->image_struct.png.png_ptr)
-#define png_info(N) (img_ptr(N)->image_struct.png.info_ptr)
-#define pdf_ptr(N) (img_ptr(N)->image_struct.pdf)
-#define jpg_ptr(N) (img_ptr(N)->image_struct.jpg)
-#define jbig2_ptr(N) (img_ptr(N)->image_struct.jbig2)
-#define tif_ptr(N) (img_ptr(N)->image_struct.tif)
-
-extern void read_png_info(integer);
-extern void write_png(integer);
-extern void read_jpg_info(integer);
-extern void write_jpg(integer);
-extern void read_jbig2_info(integer);
-extern void write_jbig2(integer);
diff --git a/Build/source/texk/web2c/pdftexdir/macnames.c b/Build/source/texk/web2c/pdftexdir/macnames.c
deleted file mode 100644
index 063b33f72a9..00000000000
--- a/Build/source/texk/web2c/pdftexdir/macnames.c
+++ /dev/null
@@ -1,309 +0,0 @@
-/*
-Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-char notdef[] = ".notdef";
-
-const char *mac_glyph_names[] = {
-/* 0x00 */
- notdef,
- ".null",
- "CR",
- "space",
- "exclam",
- "quotedbl",
- "numbersign",
- "dollar",
- "percent",
- "ampersand",
- "quotesingle",
- "parenleft",
- "parenright",
- "asterisk",
- "plus",
- "comma",
-/* 0x10 */
- "hyphen",
- "period",
- "slash",
- "zero",
- "one",
- "two",
- "three",
- "four",
- "five",
- "six",
- "seven",
- "eight",
- "nine",
- "colon",
- "semicolon",
- "less",
-/* 0x20 */
- "equal",
- "greater",
- "question",
- "at",
- "A",
- "B",
- "C",
- "D",
- "E",
- "F",
- "G",
- "H",
- "I",
- "J",
- "K",
- "L",
-/* 0x30 */
- "M",
- "N",
- "O",
- "P",
- "Q",
- "R",
- "S",
- "T",
- "U",
- "V",
- "W",
- "X",
- "Y",
- "Z",
- "bracketleft",
- "backslash",
-/* 0x40 */
- "bracketright",
- "asciicircum",
- "underscore",
- "grave",
- "a",
- "b",
- "c",
- "d",
- "e",
- "f",
- "g",
- "h",
- "i",
- "j",
- "k",
- "l",
-/* 0x50 */
- "m",
- "n",
- "o",
- "p",
- "q",
- "r",
- "s",
- "t",
- "u",
- "v",
- "w",
- "x",
- "y",
- "z",
- "braceleft",
- "bar",
-/* 0x60 */
- "braceright",
- "asciitilde",
- "Adieresis",
- "Aring",
- "Ccedilla",
- "Eacute",
- "Ntilde",
- "Odieresis",
- "Udieresis",
- "aacute",
- "agrave",
- "acircumflex",
- "adieresis",
- "atilde",
- "aring",
- "ccedilla",
-/* 0x70 */
- "eacute",
- "egrave",
- "ecircumflex",
- "edieresis",
- "iacute",
- "igrave",
- "icircumflex",
- "idieresis",
- "ntilde",
- "oacute",
- "ograve",
- "ocircumflex",
- "odieresis",
- "otilde",
- "uacute",
- "ugrave",
-/* 0x80 */
- "ucircumflex",
- "udieresis",
- "dagger",
- "degree",
- "cent",
- "sterling",
- "section",
- "bullet",
- "paragraph",
- "germandbls",
- "registered",
- "copyright",
- "trademark",
- "acute",
- "dieresis",
- "notequal",
-/* 0x90 */
- "AE",
- "Oslash",
- "infinity",
- "plusminus",
- "lessequal",
- "greaterequal",
- "yen",
- "mu",
- "partialdiff",
- "Sigma",
- "Pi",
- "pi",
- "integral",
- "ordfeminine",
- "ordmasculine",
- "Omega",
-/* 0xa0 */
- "ae",
- "oslash",
- "questiondown",
- "exclamdown",
- "logicalnot",
- "radical",
- "florin",
- "approxequal",
- "Delta",
- "guillemotleft",
- "guillemotright",
- "ellipsis",
- "nbspace",
- "Agrave",
- "Atilde",
- "Otilde",
-/* 0xb0 */
- "OE",
- "oe",
- "endash",
- "emdash",
- "quotedblleft",
- "quotedblright",
- "quoteleft",
- "quoteright",
- "divide",
- "lozenge",
- "ydieresis",
- "Ydieresis",
- "fraction",
- "currency",
- "guilsinglleft",
- "guilsinglright",
-/* 0xc0 */
- "fi",
- "fl",
- "daggerdbl",
- "periodcentered",
- "quotesinglbase",
- "quotedblbase",
- "perthousand",
- "Acircumflex",
- "Ecircumflex",
- "Aacute",
- "Edieresis",
- "Egrave",
- "Iacute",
- "Icircumflex",
- "Idieresis",
- "Igrave",
-/* 0xd0 */
- "Oacute",
- "Ocircumflex",
- "applelogo",
- "Ograve",
- "Uacute",
- "Ucircumflex",
- "Ugrave",
- "dotlessi",
- "circumflex",
- "tilde",
- "macron",
- "breve",
- "dotaccent",
- "ring",
- "cedilla",
- "hungarumlaut",
-/* 0xe0 */
- "ogonek",
- "caron",
- "Lslash",
- "lslash",
- "Scaron",
- "scaron",
- "Zcaron",
- "zcaron",
- "brokenbar",
- "Eth",
- "eth",
- "Yacute",
- "yacute",
- "Thorn",
- "thorn",
- "minus",
-/* 0xf0 */
- "multiply",
- "onesuperior",
- "twosuperior",
- "threesuperior",
- "onehalf",
- "onequarter",
- "threequarters",
- "franc",
- "Gbreve",
- "gbreve",
- "Idot",
- "Scedilla",
- "scedilla",
- "Cacute",
- "cacute",
- "Ccaron",
-/* 0x100 */
- "ccaron",
- "dmacron"
-};
-
-const char *ambiguous_names[] = {
- "Delta", /* increment */
- "Omega", /* Ohm */
- "Pi", /* product */
- "Sigma", /* summation */
- "dmacron", /* dslash */
- "macron", /* overscore */
- "periodcentered", /* middot */
- NULL
-};
diff --git a/Build/source/texk/web2c/pdftexdir/mapfile.c b/Build/source/texk/web2c/pdftexdir/mapfile.c
deleted file mode 100644
index fa153bcb60a..00000000000
--- a/Build/source/texk/web2c/pdftexdir/mapfile.c
+++ /dev/null
@@ -1,933 +0,0 @@
-/* mapfile.c: handling of map files/lines
-
-Copyright 1996-2018 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-#include <kpathsea/c-auto.h>
-#include <kpathsea/c-memstr.h>
-#include <math.h>
-#include <string.h>
-
-#define FM_BUF_SIZE 1024
-
-static FILE *fm_file;
-
-#define fm_open() \
- open_input (&fm_file, kpse_fontmap_format, FOPEN_RBIN_MODE)
-#define fm_close() xfclose(fm_file, cur_file_name)
-#define fm_getchar() xgetc(fm_file)
-#define fm_eof() feof(fm_file)
-
-typedef enum { FM_DUPIGNORE, FM_REPLACE, FM_DELETE } updatemode;
-typedef enum { MAPFILE, MAPLINE } maptype;
-
-typedef struct mitem {
- updatemode mode; /* FM_DUPIGNORE or FM_REPLACE or FM_DELETE */
- maptype type; /* map file or map line */
- char *line; /* pointer to map file name or map line */
- int lineno; /* line number in map file */
-} mapitem;
-mapitem *mitem = NULL;
-
-static const char nontfm[] = "<nontfm>";
-
-#define read_field(r, q, buf, buf_size) do { \
- q = buf; \
- while (*r != ' ' && *r != '<' && *r != '"' && *r != '\0') { \
- check_buf(q - (buf) + 1, (buf_size)); \
- *q++ = *r++; \
- } \
- *q = '\0'; \
- skip (r, ' '); \
-} while (0)
-
-#define set_field(F) do { \
- if (q > buf) \
- fm->F = xstrdup(buf); \
- if (*r == '\0') \
- goto done; \
-} while (0)
-
-fm_entry *new_fm_entry(void)
-{
- fm_entry *fm;
- fm = xtalloc(1, fm_entry);
- fm->tfm_name = NULL;
- fm->sfd_name = NULL;
- fm->ps_name = NULL;
- fm->fd_flags = FD_FLAGS_NOT_SET_IN_MAPLINE;
- fm->ff_name = NULL;
- fm->encname = NULL;
- fm->type = 0;
- fm->slant = 0;
- fm->extend = 0;
- fm->links = 0;
- fm->pid = -1;
- fm->eid = -1;
- fm->subfont = NULL;
- fm->in_use = false;
- return fm;
-}
-
-void delete_fm_entry(fm_entry * fm)
-{
- xfree(fm->tfm_name);
- xfree(fm->sfd_name);
- xfree(fm->ps_name);
- xfree(fm->ff_name);
- xfree(fm);
-}
-
-static ff_entry *new_ff_entry(void)
-{
- ff_entry *ff;
- ff = xtalloc(1, ff_entry);
- ff->ff_name = NULL;
- ff->ff_path = NULL;
- return ff;
-}
-
-static void delete_ff_entry(ff_entry * ff)
-{
- xfree(ff->ff_name);
- xfree(ff->ff_path);
- xfree(ff);
-}
-
-static fm_entry *dummy_fm_entry(void)
-{
- static fm_entry const_fm_entry;
- return & const_fm_entry;
-}
-
-/**********************************************************************/
-
-struct avl_table *tfm_tree = NULL;
-struct avl_table *ps_tree = NULL;
-struct avl_table *ff_tree = NULL;
-struct avl_table *encname_tree = NULL;
-
-/* AVL sort fm_entry into tfm_tree by tfm_name */
-
-static int comp_fm_entry_tfm(const void *pa, const void *pb, void *p)
-{
- return strcmp(((const fm_entry *) pa)->tfm_name,
- ((const fm_entry *) pb)->tfm_name);
-}
-
-/* AVL sort fm_entry into ps_tree by ps_name, slant, and extend */
-
-static int comp_fm_entry_ps(const void *pa, const void *pb, void *p)
-{
- int i;
- const fm_entry *p1 = (const fm_entry *) pa, *p2 = (const fm_entry *) pb;
- assert(p1->ps_name != NULL && p2->ps_name != NULL);
- if ((i = strcmp(p1->ps_name, p2->ps_name)) != 0)
- return i;
- cmp_return(p1->slant, p2->slant);
- cmp_return(p1->extend, p2->extend);
- return 0;
-}
-
-/* AVL sort ff_entry into ff_tree by ff_name */
-
-static int comp_ff_entry(const void *pa, const void *pb, void *p)
-{
- return strcmp(((const ff_entry *) pa)->ff_name,
- ((const ff_entry *) pb)->ff_name);
-}
-
-static void create_avl_trees(void)
-{
- assert(tfm_tree == NULL);
- tfm_tree = avl_create(comp_fm_entry_tfm, NULL, &avl_xallocator);
- assert(tfm_tree != NULL);
- assert(ps_tree == NULL);
- ps_tree = avl_create(comp_fm_entry_ps, NULL, &avl_xallocator);
- assert(ps_tree != NULL);
- assert(ff_tree == NULL);
- ff_tree = avl_create(comp_ff_entry, NULL, &avl_xallocator);
- assert(ff_tree != NULL);
- assert(encname_tree == NULL);
- encname_tree = avl_create(comp_string_entry, NULL, &avl_xallocator);
- assert(encname_tree != NULL);
-}
-
-/**********************************************************************/
-/*
-The function avl_do_entry() is not completely symmetrical with regards
-to tfm_name and ps_name handling, e. g. a duplicate tfm_name gives a
-"goto exit", and no ps_name link is tried. This is to keep it compatible
-with the original version.
-*/
-
-int avl_do_entry(fm_entry * fm, int mode)
-{
- fm_entry *p;
- void *a;
- void **aa;
- boolean suppress_warn = (getpdfsuppresswarningdupmap() > 0);
-
- /* handle tfm_name link */
-
- if (strcmp(fm->tfm_name, nontfm) != 0) {
- p = (fm_entry *) avl_find(tfm_tree, fm);
- if (p != NULL) {
- switch (mode) {
- case FM_DUPIGNORE:
- if (!suppress_warn)
- pdftex_warn
- ("fontmap entry for `%s' already exists, duplicates ignored",
- fm->tfm_name);
- goto exit;
- break;
- case FM_REPLACE:
- case FM_DELETE:
- if (p->in_use) {
- pdftex_warn
- ("fontmap entry for `%s' has been used, replace/delete not allowed",
- fm->tfm_name);
- goto exit;
- }
- a = avl_delete(tfm_tree, p);
- assert(a != NULL);
- unset_tfmlink(p);
- if (!has_pslink(p))
- delete_fm_entry(p);
- break;
- default:
- assert(0);
- }
- }
- if (mode != FM_DELETE) {
- aa = avl_probe(tfm_tree, fm);
- assert(aa != NULL);
- set_tfmlink(fm);
- }
- }
-
- /* handle ps_name link */
-
- if (fm->ps_name != NULL) {
- p = (fm_entry *) avl_find(ps_tree, fm);
- if (p != NULL) {
- switch (mode) {
- case FM_DUPIGNORE:
- goto exit;
- break;
- case FM_REPLACE:
- case FM_DELETE:
- if (p->in_use)
- goto exit;
- a = avl_delete(ps_tree, p);
- assert(a != NULL);
- unset_pslink(p);
- if (!has_tfmlink(p))
- delete_fm_entry(p);
- break;
- default:
- assert(0);
- }
- }
- if (mode != FM_DELETE && is_t1fontfile(fm) && is_included(fm)) {
- aa = avl_probe(ps_tree, fm);
- assert(aa != NULL);
- set_pslink(fm);
- }
- }
- exit:
- if (!has_tfmlink(fm) && !has_pslink(fm)) /* e. g. after FM_DELETE */
- return 1; /* deallocation of fm_entry structure required */
- else
- return 0;
-}
-
-/* add the encoding name to an AVL tree. this has nothing to do with writeenc.c */
-
-static char *add_encname(char *s)
-{
- char *p;
- void **aa;
- assert(s != NULL);
- assert(encname_tree != NULL);
- if ((p = (char *) avl_find(encname_tree, s)) == NULL) { /* encoding name not yet registered */
- p = xstrdup(s);
- aa = avl_probe(encname_tree, p);
- assert(aa != NULL);
- }
- return p;
-}
-
-
-/**********************************************************************/
-/* consistency check for map entry, with warn flag; return zero if ok,
- nonzero bits of warnings otherwise. */
-
-static int check_fm_entry(fm_entry * fm, boolean warn)
-{
- int a = 0;
- assert(fm != NULL);
- assert(fm->tfm_name);
-
- if (is_fontfile(fm) && !is_included(fm)) {
- if (warn)
- pdftex_warn
- ("ambiguous entry for `%s': font file present but not included, "
- "will be treated as font file not present", fm->tfm_name);
- xfree(fm->ff_name);
- /* do not set variable |a| as this entry will still be accepted */
- }
-
- /* if no tfm name, nothing to do here; a bare tfm is ok */
- if (*(fm->tfm_name) == '\0') {
- if (warn)
- pdftex_warn ("invalid map entry: tfm missing");
- a += 1;
- }
-
- /* TrueType fonts cannot be reencoded without subsetting */
- if (is_truetype(fm) && is_reencoded(fm) && !is_subsetted(fm)) {
- if (warn)
- pdftex_warn
- ("invalid entry for `%s': only subsetted TrueType fonts can be reencoded",
- fm->tfm_name);
- a += 2;
- }
-
- /* SlantFont and ExtendFont can be used only with Type1 fonts */
- if ((fm->slant != 0 || fm->extend != 0)
- && (strlen(fm->tfm_name) == 0
- || !(is_t1fontfile(fm) && is_included(fm)))) {
- if (warn)
- pdftex_warn
- ("invalid entry for `%s': SlantFont/ExtendFont can be used only with embedded Type1 fonts",
- fm->tfm_name);
- a += 4;
- }
-
- /* the value of SlantFont and ExtendFont must be reasonable */
- if (abs(fm->slant) > 1000) {
- if (warn)
- pdftex_warn
- ("invalid entry for `%s': SlantFont value too big: %g",
- fm->tfm_name, fm->slant / 1000.0);
- a += 8;
- }
- if (abs(fm->extend) > 2000) {
- if (warn)
- pdftex_warn
- ("invalid entry for `%s': ExtendFont value too big: %g",
- fm->tfm_name, fm->extend / 1000.0);
- a += 16;
- }
-
- /* subfonts must be used with subsetted non-reencoded TrueType fonts */
- if (fm->pid != -1 &&
- !(is_truetype(fm) && is_subsetted(fm) && !is_reencoded(fm))) {
- if (warn)
- pdftex_warn
- ("invalid entry for `%s': PidEid can be used only with subsetted non-reencoded TrueType fonts",
- fm->tfm_name);
- a += 32;
- }
-
- /* font file for bitmap PK fonts is determinated by kpse and depends
- on current font size; writet3.c ignores font file for bitmap PK fonts */
- if (is_fontfile(fm) && is_pk(fm)) {
- if (warn)
- pdftex_warn
- ("invalid entry for `%s': "
- "FontFile cannot be specified for bitmap PK font: %s",
- fm->tfm_name, fm_fontfile(fm));
- a += 64;
- }
-
- /* ps name cannot be stored into PDF file for PDF Type3 fonts */
- if (fm->ps_name != NULL && is_pk(fm)) {
- if (warn)
- pdftex_warn
- ("invalid entry for `%s': "
- "PsName cannot be specified for bitmap PK font: %s",
- fm->tfm_name, fm->ps_name);
- a += 128;
- }
-
- return a;
-}
-
-/**********************************************************************/
-/* returns the font number if s is one of the 14 std. font names, -1 otherwise; speed-trimmed. */
-
-int check_std_t1font(char *s)
-{
- static const char *std_t1font_names[] = {
- "Courier", /* 0:7 */
- "Courier-Bold", /* 1:12 */
- "Courier-Oblique", /* 2:15 */
- "Courier-BoldOblique", /* 3:19 */
- "Helvetica", /* 4:9 */
- "Helvetica-Bold", /* 5:14 */
- "Helvetica-Oblique", /* 6:17 */
- "Helvetica-BoldOblique", /* 7:21 */
- "Symbol", /* 8:6 */
- "Times-Roman", /* 9:11 */
- "Times-Bold", /* 10:10 */
- "Times-Italic", /* 11:12 */
- "Times-BoldItalic", /* 12:16 */
- "ZapfDingbats" /* 13:12 */
- };
- static const int index[] =
- { -1, -1, -1, -1, -1, -1, 8, 0, -1, 4, 10, 9, -1, -1, 5, 2, 12, 6, -1,
- 3, -1, 7
- };
- size_t n;
- int k = -1;
- assert(s != NULL);
- n = strlen(s);
- if (n > 21)
- return -1;
- if (n == 12) { /* three names have length 12 */
- switch (*s) {
- case 'C':
- k = 1; /* Courier-Bold */
- break;
- case 'T':
- k = 11; /* Times-Italic */
- break;
- case 'Z':
- k = 13; /* ZapfDingbats */
- break;
- default:
- return -1;
- }
- } else
- k = index[n];
- if (k > -1 && strcmp(std_t1font_names[k], s) == 0)
- return k;
- return -1;
-};
-
-/**********************************************************************/
-
-static void fm_scan_line(void)
-{
- int a, b, c, j, u = 0, v = 0;
- float d;
- fm_entry *fm;
- char fm_line[FM_BUF_SIZE], buf[FM_BUF_SIZE];
- char *p, *q, *r, *s;
- switch (mitem->type) {
- case MAPFILE:
- p = fm_line;
- do {
- c = fm_getchar();
- append_char_to_buf(c, p, fm_line, FM_BUF_SIZE);
- }
- while (c != 10);
- *(--p) = '\0';
- r = fm_line;
- break;
- case MAPLINE:
- r = mitem->line; /* work on string from makecstring() */
- break;
- default:
- assert(0);
- }
- if (*r == '\0' || is_cfg_comment(*r))
- return;
- fm = new_fm_entry();
- read_field(r, q, buf, FM_BUF_SIZE);
- set_field(tfm_name);
- if (fm->tfm_name == NULL) /* used in messages, so don't let be null */
- fm->tfm_name = xstrdup ("");
- if (!isdigit((unsigned char)*r)) { /* 2nd field ps_name may not start with a digit */
- read_field(r, q, buf, FM_BUF_SIZE);
- set_field(ps_name);
- }
- if (isdigit((unsigned char)*r)) { /* font descriptor /Flags given? */
- for (s = r; isdigit((unsigned char)*s); s++);
- if (*s == ' ' || *s == '"' || *s == '<' || *s == '\0') { /* not e. g. 8r.enc */
- fm->fd_flags = atoi(r);
- while (isdigit((unsigned char)*r))
- r++;
- }
- }
- while (1) { /* loop through "specials", encoding, font file */
- skip(r, ' ');
- switch (*r) {
- case '\0':
- goto done;
- case '"': /* opening quote */
- r++;
- u = v = 0;
- do {
- skip(r, ' ');
- if (sscanf(r, "%f %n", &d, &j) > 0) {
- s = r + j; /* jump behind number, eat also blanks, if any */
- if (*(s - 1) == 'E' || *(s - 1) == 'e')
- s--; /* e. g. 0.5ExtendFont: %f = 0.5E */
- if (str_prefix(s, "SlantFont")) {
- d *= 1000.0; /* correct rounding also for neg. numbers */
- fm->slant = (integer) (d > 0 ? d + 0.5 : d - 0.5);
- r = s + strlen("SlantFont");
- } else if (str_prefix(s, "ExtendFont")) {
- d *= 1000.0;
- fm->extend = (integer) (d > 0 ? d + 0.5 : d - 0.5);
- if (fm->extend == 1000)
- fm->extend = 0;
- r = s + strlen("ExtendFont");
- } else { /* unknown name */
- for (r = s; *r != ' ' && *r != '"' && *r != '\0'; r++); /* jump over name */
- c = *r; /* remember char for temporary end of string */
- *r = '\0';
- pdftex_warn
- ("invalid entry for `%s': unknown name `%s' ignored",
- fm->tfm_name, s);
- *r = c;
- }
- } else
- for (; *r != ' ' && *r != '"' && *r != '\0'; r++);
- }
- while (*r == ' ');
- if (*r == '"') /* closing quote */
- r++;
- else {
- pdftex_warn
- ("invalid entry for `%s': closing quote missing",
- fm->tfm_name);
- goto bad_line;
- }
- break;
- case 'P': /* handle cases for subfonts like 'PidEid=3,1' */
- if (sscanf(r, "PidEid=%i, %i %n", &a, &b, &c) >= 2) {
- fm->pid = a;
- fm->eid = b;
- r += c;
- break;
- }
- default: /* encoding or font file specification */
- a = b = 0;
- if (*r == '<') {
- a = *r++;
- if (*r == '<' || *r == '[')
- b = *r++;
- }
- read_field(r, q, buf, FM_BUF_SIZE);
- /* encoding, formats: '8r.enc' or '<8r.enc' or '<[8r.enc' */
- if (strlen(buf) > 4 && strcasecmp(strend(buf) - 4, ".enc") == 0) {
- fm->encname = add_encname(buf);
- u = v = 0; /* u, v used if intervening blank: "<< foo" */
- } else if (strlen(buf) > 0) { /* file name given */
- /* font file, formats:
- * subsetting: '<cmr10.pfa'
- * no subsetting: '<<cmr10.pfa'
- * no embedding: 'cmr10.pfa'
- */
- if (a == '<' || u == '<') {
- set_included(fm);
- if ((a == '<' && b == 0) || (a == 0 && v == 0))
- set_subsetted(fm);
- /* otherwise b == '<' (or '[') => no subsetting */
- }
- set_field(ff_name);
- u = v = 0;
- } else {
- u = a;
- v = b;
- }
- }
- }
- done:
- if (fm->ps_name != NULL && (check_std_t1font(fm->ps_name) >= 0))
- set_std_t1font(fm);
- if (is_fontfile(fm) && strlen(fm_fontfile(fm)) > 3) {
- if (strcasecmp(strend(fm_fontfile(fm)) - 4, ".ttf") == 0)
- set_truetype(fm);
- else if (strcasecmp(strend(fm_fontfile(fm)) - 4, ".ttc") == 0)
- set_truetype(fm);
- else if (strcasecmp(strend(fm_fontfile(fm)) - 4, ".otf") == 0)
- set_opentype(fm);
- else
- set_type1(fm);
- } else if (fm->ps_name == NULL) {
- set_pk(fm); /* font without ps_name and without fontfile,
- it can be only bitmap PK font */
- } else
- set_type1(fm); /* assume a builtin font is Type1 */
-
- if (check_fm_entry(fm, true) != 0)
- goto bad_line;
- /*
- If we get here, the map line has been completely scanned without errors;
- fm points to a valid, freshly filled-out fm_entry structure.
- Now follows the actual work of registering/deleting.
- */
- if (handle_subfont_fm(fm, mitem->mode)) /* is this a subfont? */
- return;
- if (avl_do_entry(fm, mitem->mode) == 0) /* if success */
- return;
- bad_line:
- delete_fm_entry(fm);
-}
-
-/**********************************************************************/
-
-void fm_read_info(void)
-{
- if (tfm_tree == NULL)
- create_avl_trees();
- if (mitem->line == NULL) /* nothing to do */
- return;
- mitem->lineno = 1;
- switch (mitem->type) {
- case MAPFILE:
- set_cur_file_name(mitem->line);
- if (!fm_open()) {
- pdftex_warn("cannot open font map file");
- } else {
- cur_file_name = (char *) nameoffile + 1;
- tex_printf("{%s", cur_file_name);
- while (!fm_eof()) {
- fm_scan_line();
- mitem->lineno++;
- }
- fm_close();
- tex_printf("}");
- fm_file = NULL;
- }
- break;
- case MAPLINE:
- cur_file_name = NULL; /* makes pdftex_warn() shorter */
- fm_scan_line();
- break;
- default:
- assert(0);
- }
- mitem->line = NULL; /* done with this line */
- cur_file_name = NULL;
- return;
-}
-
-/**********************************************************************/
-
-static fmentryptr fmlookup(internalfontnumber f)
-{
- char *tfm;
- fm_entry *fm;
- fm_entry tmp;
- if (tfm_tree == NULL)
- fm_read_info(); /* only to read default map file */
- tfm = makecstring(fontname[f]);
- assert(strcmp(tfm, nontfm) != 0);
-
- /* Look up for full <tfmname>[+-]<expand> */
- tmp.tfm_name = tfm;
- fm = (fm_entry *) avl_find(tfm_tree, &tmp);
- if (fm != NULL) {
- fm->in_use = true;
- return (fmentryptr) fm;
- }
- return (fmentryptr) dummy_fm_entry();
-}
-
-boolean hasfmentry(internalfontnumber f)
-{
- if (pdffontmap[f] == NULL)
- pdffontmap[f] = fmlookup(f);
- assert(pdffontmap[f] != NULL);
- return pdffontmap[f] != (fmentryptr) dummy_fm_entry();
-}
-
-boolean isscalable(internalfontnumber f)
-{
- return hasfmentry(f) && (!is_pk((fm_entry *)pdffontmap[f]));
-}
-
-/* check whether a map entry is valid for font replacement */
-
-static boolean fm_valid_for_font_replacement(fm_entry * fm)
-{
- ff_entry *ff;
-
- assert(fm != NULL);
- assert(is_fontfile(fm)); /* ps_tree should contain only entries with font file */
- assert(is_type1(fm)); /* ps_tree should contain only Type1 entries */
-
- ff = check_ff_exist(fm->ff_name, false);
- assert(ff != NULL);
- if (ff->ff_path == NULL) /* ...there is no font file available */
- return false;
- return true; /* all tests passed */
-}
-
-/**********************************************************************/
-/*
- * lookup fontmap by ps_name;
- * used for Type1 font replacement when embedding of PDF files
- */
-
-fm_entry *lookup_fontmap(char *ps_name)
-{
- fm_entry *fm, *fm2, tmp;
- char *a, *b, *c, *d, *e, *s;
- int i, sl, ex;
- struct avl_traverser t, t2;
- if (tfm_tree == NULL)
- fm_read_info(); /* only to read default map file */
- assert(ps_name != NULL);
- s = ps_name;
- if (strlen(ps_name) > 7) { /* check for subsetted name tag */
- for (i = 0; i < 6; i++, s++)
- if (*s < 'A' || *s > 'Z')
- break;
- if (i == 6 && *s == '+')
- s++; /* if name tag found, skip behind it */
- else
- s = ps_name;
- }
-
- /*
- * Scan -Slant_<slant> and -Extend_<extend> font name extensions;
- * three valid formats:
- * <fontname>-Slant_<slant>
- * <fontname>-Slant_<slant>-Extend_<extend>
- * <fontname>-Extend_<extend>
- * Slant entry must come _before_ Extend entry
- */
-
- tmp.slant = 0;
- tmp.extend = 0;
- if ((a = strstr(s, "-Slant_")) != NULL) {
- b = a + strlen("-Slant_");
- sl = (int) strtol(b, &e, 10);
- if ((e != b) && (e == strend(b))) {
- tmp.slant = sl;
- *a = '\0'; /* ps_name string ends before "-Slant_" */
- } else {
- if (e != b) { /* only if <slant> is valid number */
- if ((c = strstr(e, "-Extend_")) != NULL) {
- d = c + strlen("-Extend_");
- ex = (int) strtol(d, &e, 10);
- if ((e != d) && (e == strend(d))) {
- tmp.slant = sl;
- tmp.extend = ex;
- *a = '\0'; /* ps_name string ends before "-Slant_" */
- }
- }
- }
- }
- } else {
- if ((a = strstr(s, "-Extend_")) != NULL) {
- b = a + strlen("-Extend_");
- ex = (int) strtol(b, &e, 10);
- if ((e != b) && (e == strend(b))) {
- tmp.extend = ex;
- *a = '\0'; /* ps_name string ends before "-Extend_" */
- }
- }
- }
- tmp.ps_name = s;
-
- fm = (fm_entry *) avl_t_find(&t, ps_tree, &tmp);
- if (fm == NULL)
- return NULL; /* no entry found */
-
- /* at this point we know there is at least one fm_entry with given ps_name;
- * we test all such entries and return the first one that is valid for font
- * replacement */
-
- t2 = t;
- fm2 = (fm_entry *) avl_t_prev(&t2);
-
- /* search forward */
- do {
- if (fm_valid_for_font_replacement(fm))
- return fm;
- fm = (fm_entry *) avl_t_next(&t);
- } while (fm != NULL && comp_fm_entry_ps(fm, &tmp, NULL) == 0);
-
- /* search backward */
- while (fm2 != NULL && comp_fm_entry_ps(fm2, &tmp, NULL) == 0) {
- if (fm_valid_for_font_replacement(fm2))
- return fm2;
- fm2 = (fm_entry *) avl_t_prev(&t2);
- }
-
- return NULL;
-}
-
-/**********************************************************************/
-/*
- * Process map file given by its name or map line contents. Items not
- * beginning with [+-=] flush default map file, if it has not yet been
- * read. Leading blanks and blanks immediately following [+-=] are
- * ignored.
- */
-
-static void process_map_item(char *s, int type)
-{
- char *p;
- int mode;
- if (*s == ' ')
- s++; /* ignore leading blank */
- switch (*s) {
- case '+': /* +mapfile.map, +mapline */
- mode = FM_DUPIGNORE; /* insert entry, if it is not duplicate */
- s++;
- break;
- case '=': /* =mapfile.map, =mapline */
- mode = FM_REPLACE; /* try to replace earlier entry */
- s++;
- break;
- case '-': /* -mapfile.map, -mapline */
- mode = FM_DELETE; /* try to delete entry */
- s++;
- break;
- default:
- mode = FM_DUPIGNORE; /* like +, but also: */
- mitem->line = NULL; /* flush default map file name */
- }
- if (*s == ' ')
- s++; /* ignore blank after [+-=] */
- p = s; /* map item starts here */
- switch (type) {
- case MAPFILE: /* remove blank at end */
- while (*p != '\0' && *p != ' ')
- p++;
- *p = '\0';
- break;
- case MAPLINE: /* blank at end allowed */
- break;
- default:
- assert(0);
- }
- if (mitem->line != NULL) /* read default map file first */
- fm_read_info();
- if (*s != '\0') { /* only if real item to process */
- mitem->mode = mode;
- mitem->type = type;
- mitem->line = s;
- fm_read_info();
- }
-}
-
-void pdfmapfile(integer t)
-{
- process_map_item(makecstring(tokenstostring(t)), MAPFILE);
- flushstr(lasttokensstring);
-}
-
-void pdfmapline(integer t)
-{
- process_map_item(makecstring(tokenstostring(t)), MAPLINE);
- flushstr(lasttokensstring);
-}
-
-void pdfinitmapfile(const_string map_name)
-{
- assert(mitem == NULL);
- mitem = xtalloc(1, mapitem);
- mitem->mode = FM_DUPIGNORE;
- mitem->type = MAPFILE;
- mitem->line = xstrdup(map_name);
-}
-
-/**********************************************************************/
-/*
- * Early check whether a font file exists. Search tree ff_tree is used
- * in 1st instance, as it may be faster than the kpse_find_file(), and
- * kpse_find_file() is called only once per font file name + expansion
- * parameter. This might help keeping speed, if many PDF pages with
- * same fonts are to be embedded.
- *
- * The ff_tree contains only font files, which are actually needed,
- * so this tree typically is much smaller than the tfm_tree or ps_tree.
- */
-
-ff_entry *check_ff_exist(char *ff_name, boolean is_tt)
-{
- ff_entry *ff;
- ff_entry tmp;
- void **aa;
-
- assert(ff_name != NULL);
- tmp.ff_name = ff_name;
- ff = (ff_entry *) avl_find(ff_tree, &tmp);
- if (ff == NULL) { /* not yet in database */
- ff = new_ff_entry();
- ff->ff_name = xstrdup(ff_name);
- if (is_tt)
- ff->ff_path = kpse_find_file(ff_name, kpse_truetype_format, 0);
- else
- ff->ff_path = kpse_find_file(ff_name, kpse_type1_format, 0);
- aa = avl_probe(ff_tree, ff);
- assert(aa != NULL);
- }
- return ff;
-}
-
-/**********************************************************************/
-/* cleaning up... */
-
-static void destroy_fm_entry_tfm(void *pa, void *pb)
-{
- fm_entry *fm;
- fm = (fm_entry *) pa;
- if (!has_pslink(fm))
- delete_fm_entry(fm);
- else
- unset_tfmlink(fm);
-}
-
-static void destroy_fm_entry_ps(void *pa, void *pb)
-{
- fm_entry *fm;
- fm = (fm_entry *) pa;
- if (!has_tfmlink(fm))
- delete_fm_entry(fm);
- else
- unset_pslink(fm);
-}
-
-static void destroy_ff_entry(void *pa, void *pb)
-{
- ff_entry *ff;
- ff = (ff_entry *) pa;
- delete_ff_entry(ff);
-}
-
-void fm_free(void)
-{
- if (tfm_tree != NULL) {
- avl_destroy(tfm_tree, destroy_fm_entry_tfm);
- tfm_tree = NULL;
- }
- if (ps_tree != NULL) {
- avl_destroy(ps_tree, destroy_fm_entry_ps);
- ps_tree = NULL;
- }
- if (ff_tree != NULL) {
- avl_destroy(ff_tree, destroy_ff_entry);
- ff_tree = NULL;
- }
-}
-
-/**********************************************************************/
-/* end of mapfile.c */
-// vim: ts=4
diff --git a/Build/source/texk/web2c/pdftexdir/pdfimage.test b/Build/source/texk/web2c/pdftexdir/pdfimage.test
deleted file mode 100755
index d41d1f6c975..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdfimage.test
+++ /dev/null
@@ -1,15 +0,0 @@
-#! /bin/sh -vx
-# $Id: pdfimage.test 804 2018-05-17 22:29:15Z karl $
-# Copyright 2017-2018 Karl Berry <tex-live@tug.org>#
-# Copyright 2013 Peter Breitenlohner <tex-live@tug.org>
-# You may freely use, modify and/or distribute this file.
-
-TEXMFCNF=$srcdir/../kpathsea; export TEXMFCNF
-TEXINPUTS=$srcdir/pdftexdir/tests:$srcdir/tests; export TEXINPUTS
-TEXFORMATS=.; export TEXFORMATS
-
-./pdftex -ini -interaction=batchmode pdfimage </dev/null || exit 1
-
-./pdftex -fmt=pdfimage -interaction=batchmode pdfimage </dev/null || exit 1
-
-exit 0
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex-common.h b/Build/source/texk/web2c/pdftexdir/pdftex-common.h
deleted file mode 100644
index 494e9f2d08f..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftex-common.h
+++ /dev/null
@@ -1,118 +0,0 @@
-/*
-Copyright 2010-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-/* This file contains declarations used in C code (via ptexlib.h) as
- well as in pdftoepdf.cc (where we can not #include "ptexlib.h").
-*/
-
-#ifndef PDFTEX_COMMON_H
-# define PDFTEX_COMMON_H
-
-/* Declarations generated from pdftex.web are included in ptexlib.h via pdftexd.h,
- we repeat them here for pdftoepdf.cc and as consistency check.
-
- pdftexd.h - generated from pdftex.web */
-#ifdef __cplusplus
-typedef unsigned char eightbits;
-#endif
-
-extern integer pdfboxspecmedia;
-extern integer pdfboxspeccrop;
-extern integer pdfboxspecbleed;
-extern integer pdfboxspectrim;
-extern integer pdfboxspecart;
-
-extern longinteger pdfstreamlength;
-extern integer pdfptr;
-extern integer poolptr;
-extern eightbits *pdfbuf;
-extern integer pdfbufsize;
-extern boolean pdfosmode;
-extern eightbits pdflastbyte;
-extern integer fixedinclusioncopyfont;
-extern integer pdfpagegroupval;
-
-/* pdftexcoerce.h - generated from pdftex.web */
-extern integer pdfnewobjnum(void);
-extern void pdfbeginstream(void);
-extern void pdfendobj(void);
-extern void pdfendstream(void);
-extern void pdfflush(void);
-extern void zpdfosgetosbuf(integer);
-#define pdfosgetosbuf(s) zpdfosgetosbuf((integer) (s))
-extern void zpdfbeginobj(integer, integer);
-#define pdfbeginobj(i, pdfoslevel) zpdfbeginobj((integer) (i), (integer) (pdfoslevel))
-
-/* epdf.c */
-#ifdef __cplusplus
-# define fd_entry struct fd_entry
-# define fm_entry struct fm_entry
-#endif
-extern void embed_whole_font(fd_entry *);
-extern fd_entry *epdf_create_fontdescriptor(fm_entry *, int);
-extern void epdf_free(void);
-extern void epdf_mark_glyphs(fd_entry *, char *);
-extern int get_fd_objnum(fd_entry *);
-extern int get_fn_objnum(fd_entry *);
-extern int is_subsetable(fm_entry *);
-
-/* macnames.c */
-extern char notdef[];
-
-/* mapfile.c */
-extern fm_entry *lookup_fontmap(char *);
-#undef fd_entry
-#undef fm_entry
-
-/* pdftoepdf.cc */
-extern void epdf_check_mem(void);
-extern void epdf_delete(void);
-extern int read_pdf_info(char *, char *, int, int, int, int, int);
-
-/* utils.c */
-extern char *convertStringToPDFString(const char *in, int len);
-extern void pdf_newline(void);
-__attribute__ ((format(printf, 1, 2)))
-extern void pdf_printf(const char *, ...);
-extern void pdf_puts(const char *);
-__attribute__ ((noreturn, format(printf, 1, 2)))
-extern void pdftex_fail(const char *, ...);
-__attribute__ ((format(printf, 1, 2)))
-extern void pdftex_warn(const char *, ...);
-extern char *stripzeros(char *a);
-__attribute__ ((format(printf, 1, 2)))
-extern void tex_printf(const char *, ...);
-extern void write_epdf(void);
-
-/* writeenc.c */
-extern void epdf_write_enc(char **, int);
-
-/* writeimg.c */
-extern float epdf_width;
-extern float epdf_height;
-extern float epdf_orig_x;
-extern float epdf_orig_y;
-extern float epdf_rotate;
-extern int epdf_selected_page;
-extern int epdf_num_pages;
-extern int epdf_page_box;
-extern void *epdf_doc;
-extern int epdf_has_page_group;
-
-#endif /* PDFTEX_COMMON_H */
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex.ch b/Build/source/texk/web2c/pdftexdir/pdftex.ch
deleted file mode 100644
index 02346f324ac..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftex.ch
+++ /dev/null
@@ -1,468 +0,0 @@
-% Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-%
-% This file is part of pdfTeX.
-%
-% pdfTeX is free software; you can redistribute it and/or modify
-% it under the terms of the GNU General Public License as published by
-% the Free Software Foundation; either version 2 of the License, or
-% (at your option) any later version.
-%
-% pdfTeX is distributed in the hope that it will be useful,
-% but WITHOUT ANY WARRANTY; without even the implied warranty of
-% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-% GNU General Public License for more details.
-%
-% You should have received a copy of the GNU General Public License along with
-% this program. If not, see <http://www.gnu.org/licenses/>.
-%
-@x [0.0] l.83 - WEAVE: we want the whole file
-\let\maybe=\iffalse
-@y 83
-\let\maybe=\iftrue
-@z
-
-% Change file to assist in creating the web2c-specific change file.
-% This one resolves inconsistencies between tex.ch and tex.ech.
-% Public domain.
-
-@x [1] m.2 l.188 - banner
-@d banner==TeX_banner
-@d banner_k==TeX_banner_k
-@y
-@d banner==pdfTeX_banner
-@d banner_k==pdfTeX_banner
-@z
-
-@x [16.215] - e-TeX last_node_type
-last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
-@y
-last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
-last_node_type:=-1;
-@z
-
-@x
-@d frozen_null_font=frozen_control_sequence+11
- {permanent `\.{\\nullfont}'}
-@y
-@d frozen_null_font=frozen_control_sequence+12+prim_size
- {permanent `\.{\\nullfont}'}
-@z
-
-@x [17.236] l.4960 - first web2c, then e-TeX additional integer parameters
-@d int_pars=web2c_int_pars {total number of integer parameters}
-@#
-@d etex_int_base=tex_int_pars {base for \eTeX's integer parameters}
-@y
-@d pdftex_first_integer_code = web2c_int_pars {base for \pdfTeX's integer parameters}
-@z
-
-% start of tex.pch
-@x (MLTeX) l. 12945
- begin i := char_tag(char_info(f)(c));
-@y
- begin i := char_tag(orig_char_info(f)(c));
-@z
-
-@x (MLTeX) l. 14640
-@d is_valid_char(#)==((font_bc[f] <= #) and (# <= font_ec[f]) and
- char_exists(char_info(f)(#)))
-@y
-@d is_valid_char(#)==((font_bc[f] <= #) and (# <= font_ec[f]) and
- char_exists(orig_char_info(f)(#)))
-@z
-
-@x (MLTeX) l. 14678
-function get_charwidth(f: internal_font_number; c: eight_bits): scaled;
-begin
- if is_valid_char(c) then
- get_charwidth := char_width(f)(char_info(f)(c))
- else
- get_charwidth := 0;
-end;
-
-function get_charheight(f: internal_font_number; c: eight_bits): scaled;
-begin
- if is_valid_char(c) then
- get_charheight := char_height(f)(height_depth(char_info(f)(c)))
- else
- get_charheight := 0;
-end;
-
-function get_chardepth(f: internal_font_number; c: eight_bits): scaled;
-begin
- if is_valid_char(c) then
- get_chardepth := char_depth(f)(height_depth(char_info(f)(c)))
- else
- get_chardepth := 0;
-end;
-@y
-function get_charwidth(f: internal_font_number; c: eight_bits): scaled;
-begin
- if is_valid_char(c) then
- get_charwidth := char_width(f)(orig_char_info(f)(c))
- else
- get_charwidth := 0;
-end;
-
-function get_charheight(f: internal_font_number; c: eight_bits): scaled;
-begin
- if is_valid_char(c) then
- get_charheight := char_height(f)(height_depth(orig_char_info(f)(c)))
- else
- get_charheight := 0;
-end;
-
-function get_chardepth(f: internal_font_number; c: eight_bits): scaled;
-begin
- if is_valid_char(c) then
- get_chardepth := char_depth(f)(height_depth(orig_char_info(f)(c)))
- else
- get_chardepth := 0;
-end;
-@z
-
-
-@x (MLTeX) l. 17413
-label reswitch, move_past, fin_rule, next_p;
-@y
-label reswitch, move_past, fin_rule, next_p, found, continue;
-@z
-
-@x (MLTeX) l. 17462
- if is_valid_char(c) then
- output_one_char(c)
- else
- char_warning(f, c);
- cur_h:=cur_h+char_width(f)(char_info(f)(c));
-@y
- if is_valid_char(c) then begin
- output_one_char(c);
- cur_h:=cur_h+char_width(f)(char_info(f)(c));
- goto continue;
- end;
- if mltex_enabled_p then
- @<(\pdfTeX) Output a substitution, |goto continue| if not possible@>;
-continue:
-@z
-
-@x [49.1259]
- begin if s>0 then
- begin if s=font_size[f] then goto common_ending;
- end
- else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then
- goto common_ending;
- end
-@y
- begin
- if pdf_font_step[f] = 0 then begin
- if s>0 then
- begin if s=font_size[f] then goto common_ending;
- end
- else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then
- goto common_ending;
- end
- end
-@z
-
-@x (WEB2C!)
-param_base:=xmalloc_array(integer, font_max);
-
-undump_things(font_check[null_font], font_ptr+1-null_font);
-@y
-param_base:=xmalloc_array(integer, font_max);
-
-pdf_char_used:=xmalloc_array(char_used_array, font_max);
-pdf_font_size:=xmalloc_array(scaled, font_max);
-pdf_font_num:=xmalloc_array(integer, font_max);
-pdf_font_map:=xmalloc_array(fm_entry_ptr, font_max);
-pdf_font_type:=xmalloc_array(eight_bits, font_max);
-pdf_font_attr:=xmalloc_array(str_number, font_max);
-pdf_font_blink:=xmalloc_array(internal_font_number, font_max);
-pdf_font_elink:=xmalloc_array(internal_font_number, font_max);
-pdf_font_stretch:=xmalloc_array(integer, font_max);
-pdf_font_shrink:=xmalloc_array(integer, font_max);
-pdf_font_step:=xmalloc_array(integer, font_max);
-pdf_font_expand_ratio:=xmalloc_array(integer, font_max);
-pdf_font_auto_expand:=xmalloc_array(boolean, font_max);
-pdf_font_lp_base:=xmalloc_array(integer, font_max);
-pdf_font_rp_base:=xmalloc_array(integer, font_max);
-pdf_font_ef_base:=xmalloc_array(integer, font_max);
-pdf_font_kn_bs_base:=xmalloc_array(integer, font_max);
-pdf_font_st_bs_base:=xmalloc_array(integer, font_max);
-pdf_font_sh_bs_base:=xmalloc_array(integer, font_max);
-pdf_font_kn_bc_base:=xmalloc_array(integer, font_max);
-pdf_font_kn_ac_base:=xmalloc_array(integer, font_max);
-vf_packet_base:=xmalloc_array(integer, font_max);
-vf_default_font:=xmalloc_array(internal_font_number, font_max);
-vf_local_font_num:=xmalloc_array(internal_font_number, font_max);
-vf_e_fnts:=xmalloc_array(integer, font_max);
-vf_i_fnts:=xmalloc_array(internal_font_number, font_max);
-pdf_font_nobuiltin_tounicode:=xmalloc_array(boolean, font_max);
-
-for font_k := font_base to font_max do begin
- for k := 0 to 31 do
- pdf_char_used[font_k, k] := 0;
- pdf_font_size[font_k] := 0;
- pdf_font_num[font_k] := 0;
- pdf_font_map[font_k] := 0;
- pdf_font_type[font_k] := new_font_type;
- pdf_font_attr[font_k] := "";
- pdf_font_blink[font_k] := null_font;
- pdf_font_elink[font_k] := null_font;
- pdf_font_stretch[font_k] := null_font;
- pdf_font_shrink[font_k] := null_font;
- pdf_font_step[font_k] := 0;
- pdf_font_expand_ratio[font_k] := 0;
- pdf_font_auto_expand[font_k] := false;
- pdf_font_lp_base[font_k] := 0;
- pdf_font_rp_base[font_k] := 0;
- pdf_font_ef_base[font_k] := 0;
- pdf_font_kn_bs_base[font_k] := 0;
- pdf_font_st_bs_base[font_k] := 0;
- pdf_font_sh_bs_base[font_k] := 0;
- pdf_font_kn_bc_base[font_k] := 0;
- pdf_font_kn_ac_base[font_k] := 0;
- pdf_font_nobuiltin_tounicode[font_k] := false;
-end;
-
-make_pdftex_banner;
-undump_things(font_check[null_font], font_ptr+1-null_font);
-@z
-
-@x [51.1]
- setup_bound_var (0)('hash_extra')(hash_extra);
- setup_bound_var (10000)('expand_depth')(expand_depth);
-
-@y
- setup_bound_var (0)('hash_extra')(hash_extra);
- setup_bound_var (10000)('expand_depth')(expand_depth);
- setup_bound_var (72)('pk_dpi')(pk_dpi);
-@z
-
-@x [51.2]
- const_chk (hash_extra);
- if error_line > ssup_error_line then error_line := ssup_error_line;
-@y
- const_chk (hash_extra);
- const_chk (obj_tab_size);
- const_chk (pdf_mem_size);
- const_chk (dest_names_size);
- const_chk (pk_dpi);
- if error_line > ssup_error_line then error_line := ssup_error_line;
-@z
-
-@x [51.1332] l.24203 (ca.) texarray
- line_stack:=xmalloc_array (integer, max_in_open);
-@y
- line_stack:=xmalloc_array (integer, max_in_open);
- eof_seen:=xmalloc_array (boolean, max_in_open);
- grp_stack:=xmalloc_array (save_pointer, max_in_open);
- if_stack:=xmalloc_array (pointer, max_in_open);
-@z
-
-@x [51.3]
- hyph_link :=xmalloc_array (hyph_pointer, hyph_size);
-@y
- hyph_link :=xmalloc_array (hyph_pointer, hyph_size);
- obj_tab:=xmalloc_array (obj_entry, inf_obj_tab_size); {will grow dynamically}
- pdf_mem:=xmalloc_array (integer, inf_pdf_mem_size); {will grow dynamically}
- dest_names:=xmalloc_array (dest_name_entry, inf_dest_names_size); {will grow dynamically}
- pdf_op_buf:=xmalloc_array (eight_bits, pdf_op_buf_size);
- pdf_os_buf:=xmalloc_array (eight_bits, inf_pdf_os_buf_size); {will grow dynamically}
- pdf_os_objnum:=xmalloc_array (integer, pdf_os_max_objs);
- pdf_os_objoff:=xmalloc_array (integer, pdf_os_max_objs);
-@z
-
-@x [51.1337] l.24371 (ca.) texarray
- trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
-@y
- trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
- hyph_root:=0; hyph_start:=0;
-@z
-
-
-@x (WEB2C!)
- param_base:=xmalloc_array(integer, font_max);
-
- font_ptr:=null_font; fmem_ptr:=7;
-@y
-param_base:=xmalloc_array(integer, font_max);
-
-pdf_char_used:=xmalloc_array(char_used_array,font_max);
-pdf_font_size:=xmalloc_array(scaled,font_max);
-pdf_font_num:=xmalloc_array(integer,font_max);
-pdf_font_map:=xmalloc_array(fm_entry_ptr,font_max);
-pdf_font_type:=xmalloc_array(eight_bits,font_max);
-pdf_font_attr:=xmalloc_array(str_number,font_max);
-pdf_font_blink:=xmalloc_array(internal_font_number,font_max);
-pdf_font_elink:=xmalloc_array(internal_font_number,font_max);
-pdf_font_stretch:=xmalloc_array(integer,font_max);
-pdf_font_shrink:=xmalloc_array(integer,font_max);
-pdf_font_step:=xmalloc_array(integer,font_max);
-pdf_font_expand_ratio:=xmalloc_array(integer,font_max);
-pdf_font_auto_expand:=xmalloc_array(boolean,font_max);
-pdf_font_lp_base:=xmalloc_array(integer,font_max);
-pdf_font_rp_base:=xmalloc_array(integer,font_max);
-pdf_font_ef_base:=xmalloc_array(integer,font_max);
-pdf_font_kn_bs_base:=xmalloc_array(integer, font_max);
-pdf_font_st_bs_base:=xmalloc_array(integer, font_max);
-pdf_font_sh_bs_base:=xmalloc_array(integer, font_max);
-pdf_font_kn_bc_base:=xmalloc_array(integer, font_max);
-pdf_font_kn_ac_base:=xmalloc_array(integer, font_max);
-vf_packet_base:=xmalloc_array(integer,font_max);
-vf_default_font:=xmalloc_array(internal_font_number,font_max);
-vf_local_font_num:=xmalloc_array(internal_font_number,font_max);
-vf_e_fnts:=xmalloc_array(integer,font_max);
-vf_i_fnts:=xmalloc_array(internal_font_number,font_max);
-pdf_font_nobuiltin_tounicode:=xmalloc_array(boolean,font_max);
-
-for font_k := font_base to font_max do begin
- for k := 0 to 31 do
- pdf_char_used[font_k, k] := 0;
- pdf_font_size[font_k] := 0;
- pdf_font_num[font_k] := 0;
- pdf_font_map[font_k] := 0;
- pdf_font_type[font_k] := new_font_type;
- pdf_font_attr[font_k] := "";
- pdf_font_blink[font_k] := null_font;
- pdf_font_elink[font_k] := null_font;
- pdf_font_stretch[font_k] := null_font;
- pdf_font_shrink[font_k] := null_font;
- pdf_font_step[font_k] := 0;
- pdf_font_expand_ratio[font_k] := 0;
- pdf_font_auto_expand[font_k] := false;
- pdf_font_lp_base[font_k] := 0;
- pdf_font_rp_base[font_k] := 0;
- pdf_font_ef_base[font_k] := 0;
- pdf_font_kn_bs_base[font_k] := 0;
- pdf_font_st_bs_base[font_k] := 0;
- pdf_font_sh_bs_base[font_k] := 0;
- pdf_font_kn_bc_base[font_k] := 0;
- pdf_font_kn_ac_base[font_k] := 0;
- pdf_font_nobuiltin_tounicode[font_k] := false;
-end;
-
-font_ptr:=null_font; fmem_ptr:=7;
-make_pdftex_banner;
-@z
-
-% i, j, q, and r are unused by TeX but required for pdfTeX
-@x [53.1348] (do_extension)
-var k:integer; {all-purpose integers}
-@!p:pointer; {all-purpose pointers}
-@y
-var i,@!j,@!k:integer; {all-purpose integers}
-@!p,@!q,@!r:pointer; {all-purpose pointers}
-@z
-
-@x [53a.1379] l.??? -etex command line switch
-@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
-@y
-@!init if (etex_p or(buffer[loc]="*"))and(format_ident=" (INITEX)") then
-@z
-
-@x [53a.1379] l.??? -etex command line switch
- incr(loc); eTeX_mode:=1; {enter extended mode}
-@y
- if (buffer[loc]="*") then incr(loc);
- eTeX_mode:=1; {enter extended mode}
-@z
-
-@x [53a.1383] l.??? -etex command line switch
-@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
-@y
-@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
-@!etex_p: boolean; {was the -etex option specified}
-@z
-
-@x [53a.1391] l.??? texarray
-@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
-@y
-@!eof_seen : ^boolean; {has eof been seen?}
-@z
-
-@x [53a.1506] l.??? texarray
-@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
-@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
-@y
-@!grp_stack : ^save_pointer; {initial |cur_boundary|}
-@!if_stack : ^pointer; {initial |cond_ptr|}
-@z
-
-@x [53a.1587] l.??? texarray
-hyph_root:=0; hyph_start:=0;
-@y
-@z
-
-@x [54/web2c.???] l.??? needed earlier
-replacement, but always existing character |font_bc[f]|.
-@^inner loop@>
-
-@<Declare additional functions for ML\TeX@>=
-function effective_char(@!err_p:boolean;
-@y
-replacement, but always existing character |font_bc[f]|.
-@^inner loop@>
-
-@<Declare \eTeX\ procedures for sc...@>=
-function effective_char(@!err_p:boolean;
-@z
-
-@x
-@ The global variables for the code to substitute a virtual character
-@y
-@ \pdfTeX's |pdf_hlist_out| uses a similar, but slightly modified code
-section of the (almost) same name.
-
-@<(\pdfTeX) Output a substitution, |goto continue| if not possible@>=
- begin
- @<Get substitution information, check it, goto |found|
- if all is ok, otherwise goto |continue|@>;
-found: @<Print character substitution tracing log@>;
- @<(\pdfTeX) Rebuild character using substitution information@>;
- end
-
-@ The global variables for the code to substitute a virtual character
-@z
-
-@x
-@ Dumping ML\TeX-related material. This is just the flag in the
-@y
-@ \pdfTeX's |pdf_hlist_out| uses a similar, but slightly modified code
-section of the (almost) same name.
-
-@<(\pdfTeX) Rebuild character using substitution information@>=
- base_x_height:=x_height(f);
- base_slant:=slant(f)/float_constant(65536);
-@^real division@>
- accent_slant:=base_slant; {slant of accent character font}
- base_width:=char_width(f)(ib_c);
- base_height:=char_height(f)(height_depth(ib_c));
- accent_width:=char_width(f)(ia_c);
- accent_height:=char_height(f)(height_depth(ia_c));
- @/{compute necessary horizontal shift (don't forget slant)}@/
- delta:=round((base_width-accent_width)/float_constant(2)+
- base_height*base_slant-base_x_height*accent_slant);
-@^real multiplication@>
-@^real addition@>
- @/{1. For centering/horizontal shifting insert a kern node.}@/
- cur_h:=cur_h+delta;
- @/{2. Then insert the accent character possibly shifted up or down.}@/
- if ((base_height<>base_x_height) and (accent_height>0)) then
- begin {the accent must be shifted up or down}
- cur_v:=base_line+(base_x_height-base_height);
- output_one_char(accent_c);
- cur_v:=base_line;
- end
- else begin
- output_one_char(accent_c);
- end;
- cur_h:=cur_h+accent_width;
- @/{3. For centering/horizontal shifting insert another kern node.}@/
- cur_h:=cur_h+(-accent_width-delta);
- @/{4. Output the base character.}@/
- output_one_char(base_c);
- cur_h:=cur_h+base_width;
-
-@ Dumping ML\TeX-related material. This is just the flag in the
-@z
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex.defines b/Build/source/texk/web2c/pdftexdir/pdftex.defines
deleted file mode 100644
index ae42355c27e..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftex.defines
+++ /dev/null
@@ -1,148 +0,0 @@
-{ pdftex.defines: Web2C pseudo-Pascal identifiers for pdfTeX.
-Copyright 1996-2018 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-
-}
-
-{ pdftex.defines: additions for pdfTeX }
-
-{ macros from pdftex.h }
-@define function pdfcharmarked();
-@define function getlpcode();
-@define function getrpcode();
-@define function getefcode();
-@define function getknbscode();
-@define function getstbscode();
-@define function getshbscode();
-@define function getknbccode();
-@define function getknaccode();
-@define function texbopenin();
-@define function vfbopenin ();
-@define procedure pdfmarkchar();
-@define procedure writepdf();
-@define procedure pdfassert();
-
-{ functions from mapfile.c }
-@define function hasfmentry();
-@define function isscalable();
-@define procedure checkextfm();
-@define procedure pdfmapfile();
-@define procedure pdfmapline();
-@define procedure pdfinitmapfile();
-
-{ functions from utils.c }
-@define procedure escapehex();
-@define procedure escapename();
-@define procedure escapestring();
-@define function extxnoverd();
-@define procedure getcreationdate;
-@define procedure getfiledump();
-@define procedure getfilemoddate();
-@define procedure getfilesize();
-@define procedure getmatch();
-@define procedure getmd5sum();
-@define function getresnameprefix;
-@define procedure initstarttime;
-@define function isquotebad;
-@define function makecstring();
-@define procedure matchstrings();
-@define procedure libpdffinish;
-@define procedure makepdftexbanner;
-@define procedure printcreationdate;
-@define procedure printmoddate;
-@define procedure printID();
-@define procedure printIDalt();
-@define procedure setjobid();
-@define procedure unescapehex();
-@define procedure writestreamlength();
-@define procedure removepdffile;
-@define procedure garbagewarning;
-@define function newcolorstack();
-@define function colorstackset();
-@define function colorstackpush();
-@define function colorstackpop();
-@define function colorstackcurrent();
-@define function colorstackused;
-@define function colorstackskippagestart();
-@define procedure checkpdfsave();
-@define procedure checkpdfrestore();
-@define procedure pdfshipoutbegin();
-@define procedure pdfshipoutend();
-@define function pdfsetmatrix();
-@define procedure matrixtransformpoint();
-@define procedure matrixtransformrect();
-@define function matrixused;
-@define procedure matrixrecalculate();
-@define function getllx;
-@define function getlly;
-@define function geturx;
-@define function getury;
-@define procedure allocvffnts;
-
-{ functions from vfpacket.c }
-@define function newvfpacket();
-@define function packetbyte;
-@define procedure startpacket();
-@define procedure storepacket();
-
-{ functions from writefont.c }
-@define procedure dopdffont();
-@define procedure writefontstuff;
-
-{ functions from writeimg.c }
-@define function checkimageb();
-@define function checkimagec();
-@define function checkimagei();
-@define function epdforigx();
-@define function epdforigy();
-@define function imageheight();
-@define function imagerotate();
-@define function imagepages();
-@define function imagecolordepth();
-@define function getimagegroupref();
-@define procedure setimagegroupref();
-@define function imagewidth();
-@define function imagexres();
-@define function imageyres();
-@define function ispdfimage();
-@define function ispngimage();
-@define function readimage();
-@define procedure deleteimage();
-@define procedure updateimageprocset();
-@define procedure writeimage();
-
-@define procedure dumpimagemeta;
-@define procedure undumpimagemeta();
-
-{ functions from writet3.c }
-@define function getpkcharwidth();
-
-{ functions from writezip.c }
-@define procedure writezip();
-
-{ functions from avlstuff.c }
-@define procedure avlputobj();
-@define function avlfindobj();
-
-{ functions from tounicode.c }
-@define procedure deftounicode();
-
-{ functions from pdftex.web (thanks Taco for the trick) }
-@define function autoexpandvf();
-
-{ end of pdftex.defines }
-{ vim: set syntax=web : }
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex.h b/Build/source/texk/web2c/pdftexdir/pdftex.h
deleted file mode 100644
index d1c629f8198..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftex.h
+++ /dev/null
@@ -1,64 +0,0 @@
-/*
-Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-/* Additions to texmfmp.h for pdfTeX */
-
-/* mark a char in font */
-#define pdfmarkchar(f, c) pdfcharused[f][c/8] |= (1<<(c%8))
-
-/* test whether a char in font is marked */
-#define pdfcharmarked(f, c) (boolean)(pdfcharused[f][c/8] & (1<<(c%8)))
-
-/* writepdf() always writes by fwrite() */
-#define writepdf(a, b) \
- (void) fwrite ((char *) &pdfbuf[a], sizeof (pdfbuf[a]), \
- (int) ((b) - (a) + 1), pdffile)
-
-#define getlpcode(f, c) \
- (pdffontlpbase[f] == 0 ? 0 : pdfmem[pdffontlpbase[f] + c])
-
-#define getrpcode(f, c) \
- (pdffontrpbase[f] == 0 ? 0 : pdfmem[pdffontrpbase[f] + c])
-
-#define getefcode(f, c) \
- (pdffontefbase[f] == 0 ? 1000 : pdfmem[pdffontefbase[f] + c])
-
-#define getknbscode(f, c) \
- (pdffontknbsbase[f] == 0 ? 0 : pdfmem[pdffontknbsbase[f] + c])
-
-#define getstbscode(f, c) \
- (pdffontstbsbase[f] == 0 ? 0 : pdfmem[pdffontstbsbase[f] + c])
-
-#define getshbscode(f, c) \
- (pdffontshbsbase[f] == 0 ? 0 : pdfmem[pdffontshbsbase[f] + c])
-
-#define getknbccode(f, c) \
- (pdffontknbcbase[f] == 0 ? 0 : pdfmem[pdffontknbcbase[f] + c])
-
-#define getknaccode(f, c) \
- (pdffontknacbase[f] == 0 ? 0 : pdfmem[pdffontknacbase[f] + c])
-
-#define texbopenin(f) \
- open_input (&(f), kpse_tex_format, FOPEN_RBIN_MODE)
-#define vfbopenin(f) \
- open_input (&(f), kpse_vf_format, FOPEN_RBIN_MODE)
-
-#define pdfassert assert
-
-#include <pdftexdir/ptexlib.h>
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex.test b/Build/source/texk/web2c/pdftexdir/pdftex.test
deleted file mode 100755
index 0bd27896d0b..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftex.test
+++ /dev/null
@@ -1,11 +0,0 @@
-#! /bin/sh -vx
-# $Id: pdftex.test 804 2018-05-17 22:29:15Z karl $
-# Copyright 2017-2018 Karl Berry <tex-live@tug.org>
-# Copyright 2010 Peter Breitenlohner <tex-live@tug.org>
-# You may freely use, modify and/or distribute this file.
-
-# Make sure the program executes.
-
-./pdftex --version || exit 1
-./pdftex --help || exit 1
-exit 0
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex.web b/Build/source/texk/web2c/pdftexdir/pdftex.web
deleted file mode 100644
index 4ae1f20716f..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftex.web
+++ /dev/null
@@ -1,39995 +0,0 @@
-% Copyright 1996-2021 Han Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh,
-% <thanh@@pdftex.org>
-
-% This file is part of pdfTeX.
-
-% pdfTeX is free software; you can redistribute it and/or modify it under the
-% terms of the GNU General Public License as published by the Free Software
-% Foundation; either version 2 of the License, or (at your option) any later
-% version.
-
-% pdfTeX is distributed in the hope that it will be useful, but WITHOUT ANY
-% WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-% A PARTICULAR PURPOSE. See the GNU General Public License for more details.
-
-% You should have received a copy of the GNU General Public License along with
-% this program. If not, see <http://www.gnu.org/licenses/>.
-
-% e-TeX is copyright (C) 1999-2015 by P. Breitenlohner (1994,98 by the NTS
-% team); all rights are reserved. Copying of this file is authorized only if
-% (1) you are P. Breitenlohner, or if (2) you make absolutely no changes to
-% your copy. (Programs such as TIE allow the application of several change
-% files to tex.web; the master files tex.web and etex.ch should stay intact.)
-
-% See etex_gen.tex for hints on how to install this program.
-% And see etripman.tex for details about how to validate it.
-
-% This program is directly derived from Donald E. Knuth's TeX;
-% the change history which follows and the reward offered for finders of
-% bugs refer specifically to TeX; they should not be taken as referring
-% to e-TeX, although the change history is relevant in that it
-% demonstrates the evolutionary path followed. This program is not TeX;
-% that name is reserved strictly for the program which is the creation
-% and sole responsibility of Professor Knuth.
-
-% Version 0 was released in September 1982 after it passed a variety of tests.
-% Version 1 was released in November 1983 after thorough testing.
-% Version 1.1 fixed ``disappearing font identifiers'' et alia (July 1984).
-% Version 1.2 allowed `0' in response to an error, et alia (October 1984).
-% Version 1.3 made memory allocation more flexible and local (November 1984).
-% Version 1.4 fixed accents right after line breaks, et alia (April 1985).
-% Version 1.5 fixed \the\toks after other expansion in \edefs (August 1985).
-% Version 2.0 (almost identical to 1.5) corresponds to "Volume B" (April 1986).
-% Version 2.1 corrected anomalies in discretionary breaks (January 1987).
-% Version 2.2 corrected "(Please type...)" with null \endlinechar (April 1987).
-% Version 2.3 avoided incomplete page in premature termination (August 1987).
-% Version 2.4 fixed \noaligned rules in indented displays (August 1987).
-% Version 2.5 saved cur_order when expanding tokens (September 1987).
-% Version 2.6 added 10sp slop when shipping leaders (November 1987).
-% Version 2.7 improved rounding of negative-width characters (November 1987).
-% Version 2.8 fixed weird bug if no \patterns are used (December 1987).
-% Version 2.9 made \csname\endcsname's "relax" local (December 1987).
-% Version 2.91 fixed \outer\def\a0{}\a\a bug (April 1988).
-% Version 2.92 fixed \patterns, also file names with complex macros (May 1988).
-% Version 2.93 fixed negative halving in allocator when mem_min<0 (June 1988).
-% Version 2.94 kept open_log_file from calling fatal_error (November 1988).
-% Version 2.95 solved that problem a better way (December 1988).
-% Version 2.96 corrected bug in "Infinite shrinkage" recovery (January 1989).
-% Version 2.97 corrected blunder in creating 2.95 (February 1989).
-% Version 2.98 omitted save_for_after at outer level (March 1989).
-% Version 2.99 caught $$\begingroup\halign..$$ (June 1989).
-% Version 2.991 caught .5\ifdim.6... (June 1989).
-% Version 2.992 introduced major changes for 8-bit extensions (September 1989).
-% Version 2.993 fixed a save_stack synchronization bug et alia (December 1989).
-% Version 3.0 fixed unusual displays; was more \output robust (March 1990).
-% Version 3.1 fixed nullfont, disabled \write{\the\prevgraf} (September 1990).
-% Version 3.14 fixed unprintable font names and corrected typos (March 1991).
-% Version 3.141 more of same; reconstituted ligatures better (March 1992).
-% Version 3.1415 preserved nonexplicit kerns, tidied up (February 1993).
-% Version 3.14159 allowed fontmemsize to change; bulletproofing (March 1995).
-% Version 3.141592 fixed \xleaders, glueset, weird alignments (December 2002).
-% Version 3.1415926 was a general cleanup with minor fixes (February 2008).
-% Version 3.14159265 was similar (January 2014).
-% Version 3.141592653 was similar but more extensive (January 2021).
-
-% A preliminary version of TeX--XeT was released in April 1992.
-% TeX--XeT version 1.0 was released in June 1992,
-% version 1.1 prevented arith overflow in glue computation (Oct 1992).
-% A preliminary e-TeX version 0.95 was operational in March 1994.
-% Version 1.0beta was released in May 1995.
-% Version 1.01beta fixed bugs in just_copy and every_eof (December 1995).
-% Version 1.02beta allowed 256 mark classes (March 1996).
-% Version 1.1 changed \group{type,level} -> \currentgroup{type,level},
-% first public release (October 1996).
-% Version 2.0 development was started in March 1997;
-% fixed a ligature-\beginR bug in January 1998;
-% was released in March 1998.
-% Version 2.1 fixed a \marks bug (when min_halfword<>0) (January 1999).
-% Version 2.2 development was started in Feb 2003; released in Oct 2004.
-% fixed a bug in sparse array handling (0=>null), Jun 2002;
-% fixed a bug in \lastnodetype (cur_val=>cur_val_level)
-% reported by Hartmut Henkel <hartmut_henkel@@gmx.de>,
-% fix by Fabrice Popineau <Fabrice.Popineau@@supelec.fr>,
-% Jan 2004;
-% another bug in sparse array handling (cur_ptr=>cur_chr)
-% reported by Taco Hoekwater <taco@@elvenkind.com>, Jul 2004;
-% fixed a sparse array reference count bug (\let,\futurelet),
-% fix by Bernd Raichle <berd@@dante.de>, Aug 2004;
-% reorganized handling of banner, additional token list and
-% integer parameters, and similar in order to reduce the
-% interference between eTeX, pdfTeX, and web2c change files.
-% adapted to tex.web 3.141592, revised glue rounding for mixed
-% direction typesetting;
-% fixed a bug in the revised glue rounding code, detected by
-% Tigran Aivazian <tigran@@aivazian.fsnet.co.uk>, Oct 2004.
-% Version 2.3 development was started in Feb 2008; released in Apr 2011.
-% fixed a bug in hyph_code handling (\savinghyphcodes)
-% reported by Vladimir Volovich <vvv@@vsu.ru>, Feb 2008.
-% fixed the error messages for improper use of \protected,
-% reported by Heiko Oberdiek
-% <heiko.oberdiek@@googlemail.com>, May 2010.
-% some rearrangements to reduce interferences between
-% e-TeX and pTeX, in part suggested by Hironori Kitagawa
-% <h_kitagawa2001@@yahoo.co.jp>, Mar 2011.
-% Version 2.4 fixed an uninitialized line number bug, released in May 2012.
-% Version 2.5 development was started in Aug 2012; released in Feb 2013.
-% better tracing of font definitions, reported by
-% Bruno Le Floch <blflatex@@gmail.com>, Jul 2012.
-% Version 2.6 development was started in Mar 2013; released in ??? 201?.
-% enable hyphenation of text between \beginL and \endL or
-% between \beginR and \endR, problem reported by
-% Vafa Khalighi <vafalgk@@gmail.com>, Nov 2013.
-% better handling of right-to-left text -- to be done.
-
-% Although considerable effort has been expended to make the e-TeX program
-% correct and reliable, no warranty is implied; the author disclaims any
-% obligation or liability for damages, including but not limited to
-% special, indirect, or consequential damages arising out of or in
-% connection with the use or performance of this software. This work has
-% been a ``labor of love'' and the author hopes that users enjoy it.
-
-% Here is TeX material that gets inserted after \input webmac
-\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\eTeX{$\varepsilon$-\TeX}
-\font\revrm=xbmc10 % for right-to-left text
-% to generate xbmc10 (i.e., reflected cmbx10) use a file
-% xbmc10.mf containing:
-%+++++++++++++++++++++++++++++++++++++++++++++++++
-% if unknown cmbase: input cmbase fi
-% extra_endchar := extra_endchar &
-% "currentpicture:=currentpicture " &
-% "reflectedabout((.5[l,r],0),(.5[l,r],1));";
-% input cmbx10
-%+++++++++++++++++++++++++++++++++++++++++++++++++
-\ifx\beginL\undefined % this is TeX
- \def\XeT{X\kern-.125em\lower.5ex\hbox{E}\kern-.1667emT}
- \def\TeXeT{\TeX-\hbox{\revrm \XeT}} % for TeX-XeT
- \def\TeXXeT{\TeX-\hbox{\revrm -\XeT}} % for TeX--XeT
-\else
- \ifx\eTeXversion\undefined % this is \TeXeT
- \def\TeXeT{\TeX-{\revrm\beginR\TeX\endR}} % for TeX-XeT
- \def\TeXXeT{\TeX-{\revrm\beginR\TeX-\endR}} % for TeX--XeT
- \else % this is \eTeX
- \def\TeXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX\endR}} % for TeX-XeT
- \def\TeXXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX-\endR}} % for TeX--XeT
- \fi
-\fi
-\def\PASCAL{Pascal}
-\def\pdfTeX{pdf\TeX}
-\def\pdfeTeX{pdf\eTeX}
-\def\PDF{PDF}
-\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{\pdfTeX}
-% system dependent redefinitions of \title should come later
-% and should use:
-% \toks0=\expandafter{\title}
-% \edef\title{...\the\toks0...}
-\let\maybe=\iftrue % 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 \eTeX, a program derived from and extending the capabilities of
-\TeX, a document compiler intended to produce typesetting of high
-quality.
-The \PASCAL\ program that follows is the definition of \TeX82, a standard
-@:PASCAL}{\PASCAL@>
-@!@:TeX82}{\TeX82@>
-version of \TeX\ that is designed to be highly portable so that identical output
-will be obtainable on a great variety of computers.
-
-The main purpose of the following program is to explain the algorithms of \TeX\
-as clearly as possible. As a result, the program will not necessarily be very
-efficient when a particular \PASCAL\ compiler has translated it into a
-particular machine language. However, the program has been written so that it
-can be tuned to run efficiently in a wide variety of operating environments
-by making comparatively few changes. Such flexibility is possible because
-the documentation that follows is written in the \.{WEB} language, which is
-at a higher level than \PASCAL; the preprocessing step that converts \.{WEB}
-to \PASCAL\ is able to introduce most of the necessary refinements.
-Semi-automatic translation to other languages is also feasible, because the
-program below does not make extensive use of features that are peculiar to
-\PASCAL.
-
-A large piece of software like \TeX\ has inherent complexity that cannot
-be reduced below a certain level of difficulty, although each individual
-part is fairly simple by itself. The \.{WEB} language is intended to make
-the algorithms as readable as possible, by reflecting the way the
-individual program pieces fit together and by providing the
-cross-references that connect different parts. Detailed comments about
-what is going on, and about why things were done in certain ways, have
-been liberally sprinkled throughout the program. These comments explain
-features of the implementation, but they rarely attempt to explain the
-\TeX\ language itself, since the reader is supposed to be familiar with
-{\sl The \TeX book}.
-@.WEB@>
-@:TeXbook}{\sl The \TeX book@>
-
-@ The present implementation has a long ancestry, beginning in the summer
-of~1977, when Michael~F. Plass and Frank~M. Liang designed and coded
-a prototype
-@^Plass, Michael Frederick@>
-@^Liang, Franklin Mark@>
-@^Knuth, Donald Ervin@>
-based on some specifications that the author had made in May of that year.
-This original proto\TeX\ included macro definitions and elementary
-manipulations on boxes and glue, but it did not have line-breaking,
-page-breaking, mathematical formulas, alignment routines, error recovery,
-or the present semantic nest; furthermore,
-it used character lists instead of token lists, so that a control sequence
-like \.{\\halign} was represented by a list of seven characters. A
-complete version of \TeX\ was designed and coded by the author in late
-1977 and early 1978; that program, like its prototype, was written in the
-{\mc SAIL} language, for which an excellent debugging system was
-available. Preliminary plans to convert the {\mc SAIL} code into a form
-somewhat like the present ``web'' were developed by Luis Trabb~Pardo and
-@^Trabb Pardo, Luis Isidoro@>
-the author at the beginning of 1979, and a complete implementation was
-created by Ignacio~A. Zabala in 1979 and 1980. The \TeX82 program, which
-@^Zabala Salelles, Ignacio Andr\'es@>
-was written by the author during the latter part of 1981 and the early
-part of 1982, also incorporates ideas from the 1979 implementation of
-@^Guibas, Leonidas Ioannis@>
-@^Sedgewick, Robert@>
-@^Wyatt, Douglas Kirk@>
-\TeX\ in {\mc MESA} that was written by Leonidas Guibas, Robert Sedgewick,
-and Douglas Wyatt at the Xerox Palo Alto Research Center. Several hundred
-refinements were introduced into \TeX82 based on the experiences gained with
-the original implementations, so that essentially every part of the system
-has been substantially improved. After the appearance of ``Version 0'' in
-September 1982, this program benefited greatly from the comments of
-many other people, notably David~R. Fuchs and Howard~W. Trickey.
-A final revision in September 1989 extended the input character set to
-eight-bit codes and introduced the ability to hyphenate words from
-different languages, based on some ideas of Michael~J. Ferguson.
-@^Fuchs, David Raymond@>
-@^Trickey, Howard Wellington@>
-@^Ferguson, Michael John@>
-
-No doubt there still is plenty of room for improvement, but the author
-is firmly committed to keeping \TeX82 ``frozen'' from now on; stability
-and reliability are to be its main virtues.
-
-On the other hand, the \.{WEB} description can be extended without changing
-the core of \TeX82 itself, and the program has been designed so that such
-extensions are not extremely difficult to make.
-The |banner| string defined here should be changed whenever \TeX\
-undergoes any modifications, so that it will be clear which version of
-\TeX\ might be the guilty party when a problem arises.
-@^extensions to \TeX@>
-@^system dependencies@>
-
-This program contains code for various features extending \TeX,
-therefore this program is called `\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=2 { \.{\\eTeXversion} }
-@d eTeX_revision==".6" { \.{\\eTeXrevision} }
-@d eTeX_version_string=='-2.6' {current \eTeX\ version}
-@#
-@d eTeX_banner=='This is e-TeX, Version 3.141592653',eTeX_version_string
- {printed when \eTeX\ starts}
-@#
-@d pdftex_version==140 { \.{\\pdftexversion} }
-@d pdftex_revision=="22" { \.{\\pdftexrevision} }
-@d pdftex_version_string=='-1.40.22' {current \pdfTeX\ version}
-@#
-@d pdfTeX_banner=='This is pdfTeX, Version 3.141592653',eTeX_version_string,pdftex_version_string
- {printed when \pdfTeX\ starts}
-@#
-@d TeX_banner=='This is TeX, Version 3.141592653' {printed when \TeX\ starts}
-@#
-@d banner==pdfTeX_banner
-@#
-@d TEX==PDFTEX {change program name into |PDFTEX|}
-@#
-@d TeXXeT_code=0 {the \TeXXeT\ feature is optional}
-@#
-@d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|}
-
-@ Different \PASCAL s have slightly different conventions, and the present
-@!@:PASCAL H}{\ph@>
-program expresses \TeX\ in terms of the \PASCAL\ that was
-available to the author in 1982. Constructions that apply to
-this particular compiler, which we shall call \ph, should help the
-reader see how to make an appropriate interface for other systems
-if necessary. (\ph\ is Charles Hedrick's modification of a compiler
-@^Hedrick, Charles Locke@>
-for the DECsystem-10 that was originally developed at the University of
-Hamburg; cf.\ {\sl Software---Practice and Experience \bf6} (1976),
-29--42. The \TeX\ program below is intended to be adaptable, without
-extensive changes, to most other versions of \PASCAL, so it does not fully
-use the admirable features of \ph. Indeed, a conscious effort has been
-made here to avoid using several idiosyncratic features of standard
-\PASCAL\ itself, so that most of the code can be translated mechanically
-into other high-level languages. For example, the `\&{with}' and `\\{new}'
-features are not used, nor are pointer types, set types, or enumerated
-scalar types; there are no `\&{var}' parameters, except in the case of files
---- \eTeX, however, does use `\&{var}' parameters for the |reverse| function;
-there are no tag fields on variant records; there are no assignments
-|real:=integer|; no procedures are declared local to other procedures.)
-
-The portions of this program that involve system-dependent code, where
-changes might be necessary because of differences between \PASCAL\ compilers
-and/or differences between
-operating systems, can be identified by looking at the sections whose
-numbers are listed under `system dependencies' in the index. Furthermore,
-the index entries for `dirty \PASCAL' list all places where the restrictions
-of \PASCAL\ have not been followed perfectly, for one reason or another.
-@!@^system dependencies@>
-@!@^dirty \PASCAL@>
-
-Incidentally, \PASCAL's standard |round| function can be problematical,
-because it disagrees with the IEEE floating-point standard.
-Many implementors have
-therefore chosen to substitute their own home-grown rounding procedure.
-
-@ The program begins with a normal \PASCAL\ program heading, whose
-components will be filled in later, using the conventions of \.{WEB}.
-@.WEB@>
-For example, the portion of the program called `\X\glob:Global
-variables\X' below will be replaced by a sequence of variable declarations
-that starts in $\section\glob$ of this documentation. In this way, we are able
-to define each individual global variable when we are prepared to
-understand what it means; we do not have to define all of the globals at
-once. Cross references in $\section\glob$, where it says ``See also
-sections \gglob, \dots,'' also make it possible to look at the set of
-all global variables, if desired. Similar remarks apply to the other
-portions of the program heading.
-
-Actually the heading shown here is not quite normal: The |program| line
-does not mention any |output| file, because \ph\ would ask the \TeX\ user
-to specify a file name if |output| were specified here.
-@:PASCAL H}{\ph@>
-@^system dependencies@>
-
-@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:}
-@f mtype==type {`\&{mtype}' will be equivalent to `\&{type}'}
-@f type==true {but `|type|' will not be treated as a reserved word}
-
-@p @t\4@>@<Compiler directives@>@/
-program TEX; {all file names are defined dynamically}
-label @<Labels in the outer block@>@/
-const @<Constants in the outer block@>@/
-mtype @<Types in the outer block@>@/
-var @<Global variables@>@/
-@#
-procedure initialize; {this procedure gets things started properly}
- var @<Local variables for initialization@>@/
- begin @<Initialize whatever \TeX\ might access@>@;
- end;@#
-@t\4@>@<Basic printing procedures@>@/
-@t\4@>@<Error handling procedures@>@/
-
-@ The overall \TeX\ program begins with the heading just shown, after which
-comes a bunch of procedure declarations and function declarations.
-Finally we will get to the main program, which begins with the
-comment `|start_here|'. If you want to skip down to the
-main program now, you can look up `|start_here|' in the index.
-But the author suggests that the best way to understand this program
-is to follow pretty much the order of \TeX's components as they appear in the
-\.{WEB} description you are now reading, since the present ordering is
-intended to combine the advantages of the ``bottom up'' and ``top down''
-approaches to the problem of understanding a somewhat complicated system.
-
-@ Three labels must be declared in the main program, so we give them
-symbolic names.
-
-@d start_of_TEX=1 {go here when \TeX's variables are initialized}
-@d end_of_TEX=9998 {go here to close files and terminate gracefully}
-@d final_end=9999 {this label marks the ending of the program}
-
-@<Labels in the out...@>=
-start_of_TEX@t\hskip-2pt@>, end_of_TEX@t\hskip-2pt@>,@,final_end;
- {key control points}
-
-@ Some of the code below is intended to be used only when diagnosing the
-strange behavior that sometimes occurs when \TeX\ is being installed or
-when system wizards are fooling around with \TeX\ without quite knowing
-what they are doing. Such code will not normally be compiled; it is
-delimited by the codewords `$|debug|\ldots|gubed|$', with apologies
-to people who wish to preserve the purity of English.
-
-Similarly, there is some conditional code delimited by
-`$|stat|\ldots|tats|$' that is intended for use when statistics are to be
-kept about \TeX's memory usage. The |stat| $\ldots$ |tats| code also
-implements diagnostic information for \.{\\tracingparagraphs},
-\.{\\tracingpages}, and \.{\\tracingrestores}.
-@^debugging@>
-
-@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
-@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
-@f debug==begin
-@f gubed==end
-@#
-@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
- usage statistics}
-@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
- usage statistics}
-@f stat==begin
-@f tats==end
-
-@ This program has two important variations: (1) There is a long and slow
-version called \.{INITEX}, which does the extra calculations needed to
-@.INITEX@>
-initialize \TeX's internal tables; and (2)~there is a shorter and faster
-production version, which cuts the initialization to a bare minimum.
-Parts of the program that are needed in (1) but not in (2) are delimited by
-the codewords `$|init|\ldots|tini|$'.
-
-@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
-@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
-@f init==begin
-@f tini==end
-
-@<Initialize whatever...@>=
-@<Set initial values of key variables@>@/
-@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini
-
-@ If the first character of a \PASCAL\ comment is a dollar sign,
-\ph\ treats the comment as a list of ``compiler directives'' that will
-affect the translation of this program into machine language. The
-directives shown below specify full checking and inclusion of the \PASCAL\
-debugger when \TeX\ is being debugged, but they cause range checking and other
-redundant code to be eliminated when the production system is being generated.
-Arithmetic overflow will be detected in all cases.
-@:PASCAL H}{\ph@>
-@^system dependencies@>
-@^overflow in arithmetic@>
-
-@<Compiler directives@>=
-@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
-@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
-
-@ This \TeX\ implementation conforms to the rules of the {\sl Pascal User
-@:PASCAL}{\PASCAL@>
-@^system dependencies@>
-Manual} published by Jensen and Wirth in 1975, except where system-dependent
-@^Wirth, Niklaus@>
-@^Jensen, Kathleen@>
-code is necessary to make a useful system program, and except in another
-respect where such conformity would unnecessarily obscure the meaning
-and clutter up the code: We assume that |case| statements may include a
-default case that applies if no matching label is found. Thus, we shall use
-constructions like
-$$\vbox{\halign{\ignorespaces#\hfil\cr
-|case x of|\cr
-1: $\langle\,$code for $x=1\,\rangle$;\cr
-3: $\langle\,$code for $x=3\,\rangle$;\cr
-|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
-|endcases|\cr}}$$
-since most \PASCAL\ compilers have plugged this hole in the language by
-incorporating some sort of default mechanism. For example, the \ph\
-compiler allows `|others|:' as a default label, and other \PASCAL s allow
-syntaxes like `\&{else}' or `\&{otherwise}' or `\\{otherwise}:', etc. The
-definitions of |othercases| and |endcases| should be changed to agree with
-local conventions. Note that no semicolon appears before |endcases| in
-this program, so the definition of |endcases| should include a semicolon
-if the compiler wants one. (Of course, if no default mechanism is
-available, the |case| statements of \TeX\ will have to be laboriously
-extended by listing all remaining cases. People who are stuck with such
-\PASCAL s have, in fact, done this, successfully but not happily!)
-@:PASCAL H}{\ph@>
-
-@d othercases == others: {default for cases not listed explicitly}
-@d endcases == @+end {follows the default case in an extended |case| statement}
-@f othercases == else
-@f endcases == end
-
-@ The following parameters can be changed at compile time to extend or
-reduce \TeX's capacity. They may have different values in \.{INITEX} and
-in production versions of \TeX.
-@.INITEX@>
-@^system dependencies@>
-
-@<Constants...@>=
-@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
- must be strictly less than |max_halfword|;
- must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
-@!mem_min=0; {smallest index in \TeX's internal |mem| array;
- must be |min_halfword| or more;
- must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
-@!buf_size=500; {maximum number of characters simultaneously present in
- current lines of open files and in control sequences between
- \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
-@!error_line=72; {width of context lines on terminal error messages}
-@!half_error_line=42; {width of first lines of contexts in terminal
- error messages; should be between 30 and |error_line-15|}
-@!max_print_line=79; {width of longest text lines output; should be at least 60}
-@!stack_size=200; {maximum number of simultaneous input sources}
-@!max_in_open=6; {maximum number of input files and error insertions that
- can be going on simultaneously}
-@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
- and must be at most |font_base+256|}
-@!font_mem_size=20000; {number of words of |font_info| for all fonts}
-@!param_size=60; {maximum number of simultaneous macro parameters}
-@!nest_size=40; {maximum number of semantic levels simultaneously active}
-@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
-@!string_vacancies=8000; {the minimum number of characters that should be
- available for the user's control sequences and font names,
- after \TeX's own error messages are stored}
-@!pool_size=32000; {maximum number of characters in strings, including all
- error messages and help texts, and the names of all fonts and
- control sequences; must exceed |string_vacancies| by the total
- length of \TeX's own strings, which is currently about 23000}
-@!save_size=600; {space for saving values outside of current group; must be
- at most |max_halfword|}
-@!trie_size=8000; {space for hyphenation patterns; should be larger for
- \.{INITEX} than it is in production versions of \TeX}
-@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns}
-@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
-@!file_name_size=40; {file names shouldn't be longer than this}
-@!pool_name='TeXformats:TEX.POOL ';
- {string of length |file_name_size|; tells where the string pool appears}
-@.TeXformats@>
-
-@ Like the preceding parameters, the following quantities can be changed
-at compile time to extend or reduce \TeX's capacity. But if they are changed,
-it is necessary to rerun the initialization program \.{INITEX}
-@.INITEX@>
-to generate new tables for the production \TeX\ program.
-One can't simply make helter-skelter changes to the following constants,
-since certain rather complex initialization
-numbers are computed from them. They are defined here using
-\.{WEB} macros, instead of being put into \PASCAL's |const| list, in order to
-emphasize this distinction.
-
-@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
- must not be less than |mem_min|}
-@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
- must be substantially larger than |mem_bot|
- and not greater than |mem_max|}
-@d font_base=0 {smallest internal font number; must not be less
- than |min_quarterword|}
-@d hash_size=2100 {maximum number of control sequences; it should be at most
- about |(mem_max-mem_min)/10|}
-@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
-@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
-@^system dependencies@>
-
-@ In case somebody has inadvertently made bad settings of the ``constants,''
-\TeX\ checks them using a global variable called |bad|.
-
-This is the first of many sections of \TeX\ where global variables are
-defined.
-
-@<Glob...@>=
-@!bad:integer; {is some ``constant'' wrong?}
-
-@ Later on we will say `\ignorespaces|if mem_max>=max_halfword then bad:=14|',
-or something similar. (We can't do that until |max_halfword| has been defined.)
-
-@<Check the ``constant'' values for consistency@>=
-bad:=0;
-if (half_error_line<30)or(half_error_line>error_line-15) then bad:=1;
-if max_print_line<60 then bad:=2;
-if dvi_buf_size mod 8<>0 then bad:=3;
-if mem_bot+1100>mem_top then bad:=4;
-if hash_prime>hash_size then bad:=5;
-if max_in_open>=128 then bad:=6;
-if mem_top<256+11 then bad:=7; {we will want |null_list>255|}
-
-@ Labels are given symbolic names by the following definitions, so that
-occasional |goto| statements will be meaningful. We insert the label
-`|exit|' just before the `\ignorespaces|end|\unskip' of a procedure in
-which we have used the `|return|' statement defined below; the label
-`|restart|' is occasionally used at the very beginning of a procedure; and
-the label `|reswitch|' is occasionally used just prior to a |case|
-statement in which some cases change the conditions and we wish to branch
-to the newly applicable case. Loops that are set up with the |loop|
-construction defined below are commonly exited by going to `|done|' or to
-`|found|' or to `|not_found|', and they are sometimes repeated by going to
-`|continue|'. If two or more parts of a subroutine start differently but
-end up the same, the shared code may be gathered together at
-`|common_ending|'.
-
-Incidentally, this program never declares a label that isn't actually used,
-because some fussy \PASCAL\ compilers will complain about redundant labels.
-
-@d exit=10 {go here to leave a procedure}
-@d restart=20 {go here to start a procedure again}
-@d reswitch=21 {go here to start a case statement again}
-@d continue=22 {go here to resume a loop}
-@d done=30 {go here to exit a loop}
-@d done1=31 {like |done|, when there is more than one loop}
-@d done2=32 {for exiting the second loop in a long block}
-@d done3=33 {for exiting the third loop in a very long block}
-@d done4=34 {for exiting the fourth loop in an extremely long block}
-@d done5=35 {for exiting the fifth loop in an immense block}
-@d done6=36 {for exiting the sixth loop in a block}
-@d found=40 {go here when you've found it}
-@d found1=41 {like |found|, when there's more than one per routine}
-@d found2=42 {like |found|, when there's more than two per routine}
-@d not_found=45 {go here when you've found nothing}
-@d not_found1=46 {like |not_found|, when there's more than one}
-@d not_found2=47 {like |not_found|, when there's more than two}
-@d not_found3=48 {like |not_found|, when there's more than three}
-@d not_found4=49 {like |not_found|, when there's more than four}
-@d common_ending=50 {go here when you want to merge with another branch}
-
-@ Here are some macros for common programming idioms.
-
-@d incr(#) == #:=#+1 {increase a variable by unity}
-@d decr(#) == #:=#-1 {decrease a variable by unity}
-@d negate(#) == #:=-# {change the sign of a variable}
-@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
-@f loop == xclause
- {\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'}
-@d do_nothing == {empty statement}
-@d return == goto exit {terminate a procedure call}
-@f return == nil
-@d empty=0 {symbolic name for a null constant}
-
-@* \[2] The character set.
-In order to make \TeX\ readily portable to a wide variety of
-computers, all of its input text is converted to an internal eight-bit
-code that includes standard ASCII, the ``American Standard Code for
-Information Interchange.'' This conversion is done immediately when each
-character is read in. Conversely, characters are converted from ASCII to
-the user's external representation just before they are output to a
-text file.
-
-Such an internal code is relevant to users of \TeX\ primarily because it
-governs the positions of characters in the fonts. For example, the
-character `\.A' has ASCII code $65=@'101$, and when \TeX\ typesets
-this letter it specifies character number 65 in the current font.
-If that font actually has `\.A' in a different position, \TeX\ doesn't
-know what the real position is; the program that does the actual printing from
-\TeX's device-independent files is responsible for converting from ASCII to
-a particular font encoding.
-@^ASCII code@>
-
-\TeX's internal code also defines the value of constants
-that begin with a reverse apostrophe; and it provides an index to the
-\.{\\catcode}, \.{\\mathcode}, \.{\\uccode}, \.{\\lccode}, and \.{\\delcode}
-tables.
-
-@ Characters of text that have been converted to \TeX's internal form
-are said to be of type |ASCII_code|, which is a subrange of the integers.
-
-@<Types...@>=
-@!ASCII_code=0..255; {eight-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...@>=
-@!xord: array [text_char] of ASCII_code;
- {specifies conversion of input characters}
-@!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 @'37 do xchr[i]:=' ';
-for i:=@'177 to @'377 do xchr[i]:=' ';
-
-@ The following system-independent code makes the |xord| array contain a
-suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
-where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
-|j| or more; hence, standard ASCII code numbers will be used instead of
-codes below @'40 in case there is a coincidence.
-
-@<Set init...@>=
-for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code;
-for i:=@'200 to @'377 do xord[xchr[i]]:=i;
-for i:=0 to @'176 do xord[xchr[i]]:=i;
-
-@* \[3] Input and output.
-The bane of portability is the fact that different operating systems treat
-input and output quite differently, perhaps because computer scientists
-have not given sufficient attention to this problem. People have felt somehow
-that input and output are not part of ``real'' programming. Well, it is true
-that some kinds of programming are more fun than others. With existing
-input/output conventions being so diverse and so messy, the only sources of
-joy in such parts of the code are the rare occasions when one can find a
-way to make the program a little less bad than it might have been. We have
-two choices, either to attack I/O now and get it over with, or to postpone
-I/O until near the end. Neither prospect is very attractive, so let's
-get it over with.
-
-The basic operations we need to do are (1)~inputting and outputting of
-text, to or from a file or the user's terminal; (2)~inputting and
-outputting of eight-bit bytes, to or from a file; (3)~instructing the
-operating system to initiate (``open'') or to terminate (``close'') input or
-output from a specified file; (4)~testing whether the end of an input
-file has been reached.
-
-\TeX\ needs to deal with two kinds of files.
-We shall use the term |alpha_file| for a file that contains textual data,
-and the term |byte_file| for a file that contains eight-bit binary information.
-These two types turn out to be the same on many computers, but
-sometimes there is a significant distinction, so we shall be careful to
-distinguish between them. Standard protocols for transferring
-such files from computer to computer, via high-speed networks, are
-now becoming available to more and more communities of users.
-
-The program actually makes use also of a third kind of file, called a
-|word_file|, when dumping and reloading base information for its own
-initialization. We shall define a word file later; but it will be possible
-for us to specify simple operations on word files before they are defined.
-
-@<Types...@>=
-@!eight_bits=0..255; {unsigned one-byte quantity}
-@!alpha_file=packed file of text_char; {files that contain textual data}
-@!byte_file=packed file of eight_bits; {files that contain binary data}
-
-@ Most of what we need to do with respect to input and output can be handled
-by the I/O facilities that are standard in \PASCAL, i.e., the routines
-called |get|, |put|, |eof|, and so on. But
-standard \PASCAL\ does not allow file variables to be associated with file
-names that are determined at run time, so it cannot be used to implement
-\TeX; some sort of extension to \PASCAL's ordinary |reset| and |rewrite|
-is crucial for our purposes. We shall assume that |name_of_file| is a variable
-of an appropriate type such that the \PASCAL\ run-time system being used to
-implement \TeX\ can open a file whose external name is specified by
-|name_of_file|.
-@^system dependencies@>
-
-@<Glob...@>=
-@!name_of_file:packed array[1..file_name_size] of char;@;@/
- {on some systems this may be a \&{record} variable}
-@!name_length:0..file_name_size;@/{this many characters are actually
- relevant in |name_of_file| (the rest are blank)}
-
-@ The \ph\ compiler with which the present version of \TeX\ was prepared has
-extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
-we can write
-$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
-|reset(f,@t\\{name}@>,'/O')|&for input;\cr
-|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
-The `\\{name}' parameter, which is of type `{\bf packed array
-$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of
-the external file that is being opened for input or output.
-Blank spaces that might appear in \\{name} are ignored.
-
-The `\.{/O}' parameter tells the operating system not to issue its own
-error messages if something goes wrong. If a file of the specified name
-cannot be found, or if such a file cannot be opened for some other reason
-(e.g., someone may already be trying to write the same file), we will have
-|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows
-\TeX\ to undertake appropriate corrective action.
-@:PASCAL H}{\ph@>
-@^system dependencies@>
-
-\TeX's file-opening procedures return |false| if no file identified by
-|name_of_file| could be opened.
-
-@d reset_OK(#)==erstat(#)=0
-@d rewrite_OK(#)==erstat(#)=0
-
-@p function a_open_in(var f:alpha_file):boolean;
- {open a text file for input}
-begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
-end;
-@#
-function a_open_out(var f:alpha_file):boolean;
- {open a text file for output}
-begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
-end;
-@#
-function b_open_in(var f:byte_file):boolean;
- {open a binary file for input}
-begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
-end;
-@#
-function b_open_out(var f:byte_file):boolean;
- {open a binary file for output}
-begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
-end;
-@#
-function w_open_in(var f:word_file):boolean;
- {open a word file for input}
-begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
-end;
-@#
-function w_open_out(var f:word_file):boolean;
- {open a word file for output}
-begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
-end;
-
-@ Files can be closed with the \ph\ routine `|close(f)|', which
-@:PASCAL H}{\ph@>
-@^system dependencies@>
-should be used when all input or output with respect to |f| has been completed.
-This makes |f| available to be opened again, if desired; and if |f| was used for
-output, the |close| operation makes the corresponding external file appear
-on the user's area, ready to be read.
-
-These procedures should not generate error messages if a file is
-being closed before it has been successfully opened.
-
-@p procedure a_close(var f:alpha_file); {close a text file}
-begin close(f);
-end;
-@#
-procedure b_close(var f:byte_file); {close a binary file}
-begin close(f);
-end;
-@#
-procedure w_close(var f:word_file); {close a word file}
-begin close(f);
-end;
-
-@ Binary input and output are done with \PASCAL's ordinary |get| and |put|
-procedures, so we don't have to make any other special arrangements for
-binary~I/O. Text output is also easy to do with standard \PASCAL\ routines.
-The treatment of text input is more difficult, however, because
-of the necessary translation to |ASCII_code| values.
-\TeX's conventions should be efficient, and they should
-blend nicely with the user's operating environment.
-
-@ Input from text files is read one line at a time, using a routine called
-|input_ln|. This function is defined in terms of global variables called
-|buffer|, |first|, and |last| that will be described in detail later; for
-now, it suffices for us to know that |buffer| is an array of |ASCII_code|
-values, and that |first| and |last| are indices into this array
-representing the beginning and ending of a line of text.
-
-@<Glob...@>=
-@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
-@!first:0..buf_size; {the first unused position in |buffer|}
-@!last:0..buf_size; {end of the line just input to |buffer|}
-@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
-
-@ The |input_ln| function brings the next line of input from the specified
-file into available positions of the buffer array and returns the value
-|true|, unless the file has already been entirely read, in which case it
-returns |false| and sets |last:=first|. In general, the |ASCII_code|
-numbers that represent the next line of the file are input into
-|buffer[first]|, |buffer[first+1]|, \dots, |buffer[last-1]|; and the
-global variable |last| is set equal to |first| plus the length of the
-line. Trailing blanks are removed from the line; thus, either |last=first|
-(in which case the line was entirely blank) or |buffer[last-1]<>" "|.
-
-An overflow error is given, however, if the normal actions of |input_ln|
-would make |last>=buf_size|; this is done so that other parts of \TeX\
-can safely look at the contents of |buffer[last+1]| without overstepping
-the bounds of the |buffer| array. Upon entry to |input_ln|, the condition
-|first<buf_size| will always hold, so that there is always room for an
-``empty'' line.
-
-The variable |max_buf_stack|, which is used to keep track of how large
-the |buf_size| parameter must be to accommodate the present job, is
-also kept up to date by |input_ln|.
-
-If the |bypass_eoln| parameter is |true|, |input_ln| will do a |get|
-before looking at the first character of the line; this skips over
-an |eoln| that was in |f^|. The procedure does not do a |get| when it
-reaches the end of the line; therefore it can be used to acquire input
-from the user's terminal as well as from ordinary text files.
-
-Standard \PASCAL\ says that a file should have |eoln| immediately
-before |eof|, but \TeX\ needs only a weaker restriction: If |eof|
-occurs in the middle of a line, the system function |eoln| should return
-a |true| result (even though |f^| will be undefined).
-
-Since the inner loop of |input_ln| is part of \TeX's ``inner loop''---each
-character of input comes in at this place---it is wise to reduce system
-overhead by making use of special routines that read in an entire array
-of characters at once, if such routines are available. The following
-code uses standard \PASCAL\ to illustrate what needs to be done, but
-finer tuning is often possible at well-developed \PASCAL\ sites.
-@^inner loop@>
-
-@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
- {inputs the next line or returns |false|}
-var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
-begin if bypass_eoln then if not eof(f) then get(f);
- {input the first character of the line into |f^|}
-last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
-if eof(f) then input_ln:=false
-else begin last_nonblank:=first;
- while not eoln(f) do
- begin if last>=max_buf_stack then
- begin max_buf_stack:=last+1;
- if max_buf_stack=buf_size then
- @<Report overflow of the input buffer, and abort@>;
- end;
- buffer[last]:=xord[f^]; get(f); incr(last);
- if buffer[last-1]<>" " then last_nonblank:=last;
- end;
- last:=last_nonblank; input_ln:=true;
- end;
-end;
-
-@ The user's terminal acts essentially like other files of text, except
-that it is used both for input and for output. When the terminal is
-considered an input file, the file variable is called |term_in|, and when it
-is considered an output file the file variable is |term_out|.
-@^system dependencies@>
-
-@<Glob...@>=
-@!term_in:alpha_file; {the terminal as an input file}
-@!term_out:alpha_file; {the terminal as an output file}
-
-@ Here is how to open the terminal files
-in \ph. The `\.{/I}' switch suppresses the first |get|.
-@:PASCAL H}{\ph@>
-@^system dependencies@>
-
-@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
-@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
-
-@ Sometimes it is necessary to synchronize the input/output mixture that
-happens on the user's terminal, and three system-dependent
-procedures are used for this
-purpose. The first of these, |update_terminal|, is called when we want
-to make sure that everything we have output to the terminal so far has
-actually left the computer's internal buffers and been sent.
-The second, |clear_terminal|, is called when we wish to cancel any
-input that the user may have typed ahead (since we are about to
-issue an unexpected error message). The third, |wake_up_terminal|,
-is supposed to revive the terminal if the user has disabled it by
-some instruction to the operating system. The following macros show how
-these operations can be specified in \ph:
-@:PASCAL H}{\ph@>
-@^system dependencies@>
-
-@d update_terminal == break(term_out) {empty the terminal output buffer}
-@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
-@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
-
-@ We need a special routine to read the first line of \TeX\ input from
-the user's terminal. This line is different because it is read before we
-have opened the transcript file; there is sort of a ``chicken and
-egg'' problem here. If the user types `\.{\\input paper}' on the first
-line, or if some macro invoked by that line does such an \.{\\input},
-the transcript file will be named `\.{paper.log}'; but if no \.{\\input}
-commands are performed during the first line of terminal input, the transcript
-file will acquire its default name `\.{texput.log}'. (The transcript file
-will not contain error messages generated by the first line before the
-first \.{\\input} command.)
-@.texput@>
-
-The first line is even more special if we are lucky enough to have an operating
-system that treats \TeX\ differently from a run-of-the-mill \PASCAL\ object
-program. It's nice to let the user start running a \TeX\ job by typing
-a command line like `\.{tex paper}'; in such a case, \TeX\ will operate
-as if the first line of input were `\.{paper}', i.e., the first line will
-consist of the remainder of the command line, after the part that invoked
-\TeX.
-
-The first line is special also because it may be read before \TeX\ has
-input a format file. In such cases, normal error messages cannot yet
-be given. The following code uses concepts that will be explained later.
-(If the \PASCAL\ compiler does not support non-local |@!goto|\unskip, the
-@^system dependencies@>
-statement `|goto final_end|' should be replaced by something that
-quietly terminates the program.)
-
-@<Report overflow of the input buffer, and abort@>=
-if format_ident=0 then
- begin write_ln(term_out,'Buffer size exceeded!'); goto final_end;
-@.Buffer size exceeded@>
- end
-else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
- overflow("buffer size",buf_size);
-@:TeX capacity exceeded buffer size}{\quad buffer size@>
- end
-
-@ Different systems have different ways to get started. But regardless of
-what conventions are adopted, the routine that initializes the terminal
-should satisfy the following specifications:
-
-\yskip\textindent{1)}It should open file |term_in| for input from the
- terminal. (The file |term_out| will already be open for output to the
- terminal.)
-
-\textindent{2)}If the user has given a command line, this line should be
- considered the first line of terminal input. Otherwise the
- user should be prompted with `\.{**}', and the first line of input
- should be whatever is typed in response.
-
-\textindent{3)}The first line of input, which might or might not be a
- command line, should appear in locations |first| to |last-1| of the
- |buffer| array.
-
-\textindent{4)}The global variable |loc| should be set so that the
- character to be read next by \TeX\ is in |buffer[loc]|. This
- character should not be blank, and we should have |loc<last|.
-
-\yskip\noindent(It may be necessary to prompt the user several times
-before a non-blank line comes in. The prompt is `\.{**}' instead of the
-later `\.*' because the meaning is slightly different: `\.{\\input}' need
-not be typed immediately after~`\.{**}'.)
-
-@d loc==cur_input.loc_field {location of first unread character in |buffer|}
-
-@ The following program does the required initialization
-without retrieving a possible command line.
-It should be clear how to modify this routine to deal with command lines,
-if the system permits them.
-@^system dependencies@>
-
-@p function init_terminal:boolean; {gets the terminal input started}
-label exit;
-begin t_open_in;
-loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
-@.**@>
- if not input_ln(term_in,true) then {this shouldn't happen}
- begin write_ln(term_out);
- write(term_out,'! End of file on the terminal... why?');
-@.End of file on the terminal@>
- init_terminal:=false; return;
- end;
- loc:=first;
- while (loc<last)and(buffer[loc]=" ") do incr(loc);
- if loc<last then
- begin init_terminal:=true;
- return; {return unless the line was all blank}
- end;
- write_ln(term_out,'Please type the name of your input file.');
- end;
-exit:end;
-
-@* \[4] String handling.
-Control sequence names and diagnostic messages are variable-length strings
-of eight-bit characters. Since \PASCAL\ does not have a well-developed string
-mechanism, \TeX\ does all of its string processing by homegrown methods.
-
-Elaborate facilities for dynamic strings are not needed, so all of the
-necessary operations can be handled with a simple data structure.
-The array |str_pool| contains all of the (eight-bit) ASCII codes in all
-of the strings, and the array |str_start| contains indices of the starting
-points of each string. Strings are referred to by integer numbers, so that
-string number |s| comprises the characters |str_pool[j]| for
-|str_start[s]<=j<str_start[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[str_ptr]| are
-ready for the next string to be allocated.
-
-String numbers 0 to 255 are reserved for strings that correspond to single
-ASCII characters. This is in accordance with the conventions of \.{WEB},
-@.WEB@>
-which converts single-character strings into the ASCII code number of the
-single character involved, while it converts other strings into integers
-and builds a string pool file. Thus, when the string constant \.{"."} appears
-in the program below, \.{WEB} converts it into the integer 46, which is the
-ASCII code for a period, while \.{WEB} will convert a string like \.{"hello"}
-into some integer greater than~255. String number 46 will presumably be the
-single character `\..'; but some ASCII codes have no standard visible
-representation, and \TeX\ sometimes needs to be able to print an arbitrary
-ASCII character, so the first 256 strings are used to specify exactly what
-should be printed for each of the 256 possibilities.
-
-Elements of the |str_pool| array must be ASCII codes that can actually
-be printed; i.e., they must have an |xchr| equivalent in the local
-character set. (This restriction applies only to preloaded strings,
-not to those generated dynamically by the user.)
-
-Some \PASCAL\ compilers won't pack integers into a single byte unless the
-integers lie in the range |-128..127|. To accommodate such systems
-we access the string pool only via macros that can easily be redefined.
-@^system dependencies@>
-
-@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
-@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
-
-@<Types...@>=
-@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
-@!str_number = 0..max_strings; {for variables that point into |str_start|}
-@!packed_ASCII_code = 0..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[#+1]-str_start[#]) {the number of characters
- in string number \#}
-
-@ The length of the current string is called |cur_length|:
-
-@d cur_length == (pool_ptr - str_start[str_ptr])
-
-@ Strings are created by appending character codes to |str_pool|.
-The |append_char| macro, defined here, does not check to see if the
-value of |pool_ptr| has gotten too high; this test is supposed to be
-made before |append_char| is used. There is also a |flush_char|
-macro, which erases the last character appended.
-
-To test if there is room to append |l| more characters to |str_pool|,
-we shall write |str_room(l)|, which aborts \TeX\ and gives an
-apologetic error message if there isn't enough room.
-
-@d append_char(#) == {put |ASCII_code| \# at the end of |str_pool|}
-begin str_pool[pool_ptr]:=si(#); incr(pool_ptr);
-end
-@d flush_char == decr(pool_ptr) {forget the last character in the pool}
-@d str_room(#) == {make sure that the pool hasn't overflowed}
- begin if pool_ptr+# > pool_size then
- overflow("pool size",pool_size-init_pool_ptr);
-@:TeX capacity exceeded pool size}{\quad pool size@>
- end
-
-@ Once a sequence of characters has been appended to |str_pool|, it
-officially becomes a string when the function |make_string| is called.
-This function returns the identification number of the new string as its
-value.
-
-@p function make_string : str_number; {current string enters the pool}
-begin if str_ptr=max_strings then
- overflow("number of strings",max_strings-init_str_ptr);
-@:TeX capacity exceeded number of strings}{\quad number of strings@>
-incr(str_ptr); str_start[str_ptr]:=pool_ptr;
-make_string:=str_ptr-1;
-end;
-
-@ To destroy the most recently made string, we say |flush_string|.
-
-@d flush_string==begin decr(str_ptr); pool_ptr:=str_start[str_ptr];
- end
-
-@ The following subroutine compares string |s| with another string of the
-same length that appears in |buffer| starting at position |k|;
-the result is |true| if and only if the strings are equal.
-Empirical tests indicate that |str_eq_buf| is used in such a way that
-it tends to return |true| about 80 percent of the time.
-
-@p function str_eq_buf(@!s:str_number;@!k:integer):boolean;
- {test equality of strings}
-label not_found; {loop exit}
-var j: pool_pointer; {running index}
-@!result: boolean; {result of comparison}
-begin j:=str_start[s];
-while j<str_start[s+1] do
- begin if so(str_pool[j])<>buffer[k] then
- begin result:=false; goto not_found;
- end;
- incr(j); incr(k);
- end;
-result:=true;
-not_found: str_eq_buf:=result;
-end;
-
-@ Here is a similar routine, but it compares two strings in the string pool,
-and it does not assume that they have the same length.
-
-@p function str_eq_str(@!s,@!t:str_number):boolean;
- {test equality of strings}
-label not_found; {loop exit}
-var j,@!k: pool_pointer; {running indices}
-@!result: boolean; {result of comparison}
-begin result:=false;
-if length(s)<>length(t) then goto not_found;
-j:=str_start[s]; k:=str_start[t];
-while j<str_start[s+1] do
- begin if str_pool[j]<>str_pool[k] then goto not_found;
- incr(j); incr(k);
- end;
-result:=true;
-not_found: str_eq_str:=result;
-end;
-
-@ The initial values of |str_pool|, |str_start|, |pool_ptr|,
-and |str_ptr| are computed by the \.{INITEX} program, based in part
-on the information that \.{WEB} has output while processing \TeX.
-@.INITEX@>
-@^string pool@>
-
-@p @!init function get_strings_started:boolean; {initializes the string pool,
- but returns |false| if something goes wrong}
-label done,exit;
-var k,@!l:0..255; {small indices or counters}
-@!m,@!n:text_char; {characters input from |pool_file|}
-@!g:str_number; {garbage}
-@!a:integer; {accumulator for check sum}
-@!c:boolean; {check sum has been checked}
-begin pool_ptr:=0; str_ptr:=0; str_start[0]:=0;
-@<Make the first 256 strings@>;
-@<Read the other strings from the \.{TEX.POOL} file and return |true|,
- or give an error message and return |false|@>;
-exit:end;
-tini
-
-@ @d app_lc_hex(#)==l:=#;
- if l<10 then append_char(l+"0")@+else append_char(l-10+"a")
-
-@<Make the first 256...@>=
-for k:=0 to 255 do
- begin if (@<Character |k| cannot be printed@>) then
- begin append_char("^"); append_char("^");
- if k<@'100 then append_char(k+@'100)
- else if k<@'200 then append_char(k-@'100)
- else begin app_lc_hex(k div 16); app_lc_hex(k mod 16);
- end;
- end
- else append_char(k);
- g:=make_string;
- end
-
-@ The first 128 strings will contain 95 standard ASCII characters, and the
-other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
-unless a system-dependent change is made here. Installations that have
-an extended character set, where for example |xchr[@'32]=@t\.{\'^^Z\'}@>|,
-would like string @'32 to be the single character @'32 instead of the
-three characters @'136, @'136, @'132 (\.{\^\^Z}). On the other hand,
-even people with an extended character set will want to represent string
-@'15 by \.{\^\^M}, since @'15 is |carriage_return|; the idea is to
-produce visible strings instead of tabs or line-feeds or carriage-returns
-or bell-rings or characters that are treated anomalously in text files.
-
-Unprintable characters of codes 128--255 are, similarly, rendered
-\.{\^\^80}--\.{\^\^ff}.
-
-The boolean expression defined here should be |true| unless \TeX\
-internal code number~|k| corresponds to a non-troublesome visible
-symbol in the local character set. An appropriate formula for the
-extended character set recommended in {\sl The \TeX book\/} would, for
-example, be `|k in [0,@'10..@'12,@'14,@'15,@'33,@'177..@'377]|'.
-If character |k| cannot be printed, and |k<@'200|, then character |k+@'100| or
-|k-@'100| must be printable; moreover, ASCII codes |[@'41..@'46,
-@'60..@'71, @'136, @'141..@'146, @'160..@'171]| must be printable.
-Thus, at least 80 printable characters are needed.
-@:TeXbook}{\sl The \TeX book@>
-@^character set dependencies@>
-@^system dependencies@>
-
-@<Character |k| cannot be printed@>=
- (k<" ")or(k>"~")
-
-@ When the \.{WEB} system program called \.{TANGLE} processes the \.{TEX.WEB}
-description that you are now reading, it outputs the \PASCAL\ program
-\.{TEX.PAS} and also a string pool file called \.{TEX.POOL}. The \.{INITEX}
-@.WEB@>@.INITEX@>
-program reads the latter file, where each string appears as a two-digit decimal
-length followed by the string itself, and the information is recorded in
-\TeX's string memory.
-
-@<Glob...@>=
-@!init @!pool_file:alpha_file; {the string-pool file output by \.{TANGLE}}
-tini
-
-@ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#);
- a_close(pool_file); get_strings_started:=false; return;
- end
-@<Read the other strings...@>=
-name_of_file:=pool_name; {we needn't set |name_length|}
-if a_open_in(pool_file) then
- begin c:=false;
- repeat @<Read one string, but return |false| if the
- string memory space is getting too tight for comfort@>;
- until c;
- a_close(pool_file); get_strings_started:=true;
- end
-else bad_pool('! I can''t read TEX.POOL.')
-@.I can't read TEX.POOL@>
-
-@ @<Read one string...@>=
-begin if eof(pool_file) then bad_pool('! TEX.POOL has no check sum.');
-@.TEX.POOL has no check sum@>
-read(pool_file,m,n); {read two digits of string length}
-if m='*' then @<Check the pool check sum@>
-else begin if (xord[m]<"0")or(xord[m]>"9")or@|
- (xord[n]<"0")or(xord[n]>"9") then
- bad_pool('! TEX.POOL line doesn''t begin with two digits.');
-@.TEX.POOL line doesn't...@>
- l:=xord[m]*10+xord[n]-"0"*11; {compute the length}
- if pool_ptr+l+string_vacancies>pool_size then
- bad_pool('! You have to increase POOLSIZE.');
-@.You have to increase POOLSIZE@>
- for k:=1 to l do
- begin if eoln(pool_file) then m:=' '@+else read(pool_file,m);
- append_char(xord[m]);
- end;
- read_ln(pool_file); g:=make_string;
- end;
-end
-
-@ The \.{WEB} operation \.{@@\$} denotes the value that should be at the
-end of this \.{TEX.POOL} file; any other value means that the wrong pool
-file has been loaded.
-@^check sum@>
-
-@<Check the pool check sum@>=
-begin a:=0; k:=1;
-loop@+ begin if (xord[n]<"0")or(xord[n]>"9") then
- bad_pool('! TEX.POOL check sum doesn''t have nine digits.');
-@.TEX.POOL check sum...@>
- a:=10*a+xord[n]-"0";
- if k=9 then goto done;
- incr(k); read(pool_file,n);
- end;
-done: if a<>@$ then bad_pool('! TEX.POOL doesn''t match; TANGLE me again.');
-@.TEX.POOL doesn't match@>
-c:=true;
-end
-
-@* \[5] On-line and off-line printing.
-Messages that are sent to a user's terminal and to the transcript-log file
-are produced by several `|print|' procedures. These procedures will
-direct their output to a variety of places, based on the setting of
-the global variable |selector|, which has the following possible
-values:
-
-\yskip
-\hang |term_and_log|, the normal setting, prints on the terminal and on the
- transcript file.
-
-\hang |log_only|, prints only on the transcript file.
-
-\hang |term_only|, prints only on the terminal.
-
-\hang |no_print|, doesn't print at all. This is used only in rare cases
- before the transcript file is open.
-
-\hang |pseudo|, puts output into a cyclic buffer that is used
- by the |show_context| routine; when we get to that routine we shall discuss
- the reasoning behind this curious mode.
-
-\hang |new_string|, appends the output to the current string in the
- string pool.
-
-\hang 0 to 15, prints on one of the sixteen files for \.{\\write} output.
-
-\yskip
-\noindent The symbolic names `|term_and_log|', etc., have been assigned
-numeric codes that satisfy the convenient relations |no_print+1=term_only|,
-|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|.
-
-Three additional global variables, |tally| and |term_offset| and
-|file_offset|, record the number of characters that have been printed
-since they were most recently cleared to zero. We use |tally| to record
-the length of (possibly very long) stretches of printing; |term_offset|
-and |file_offset|, on the other hand, keep track of how many characters
-have appeared so far on the current line that has been output to the
-terminal or to the transcript file, respectively.
-
-@d no_print=16 {|selector| setting that makes data disappear}
-@d term_only=17 {printing is destined for the terminal only}
-@d log_only=18 {printing is destined for the transcript file only}
-@d term_and_log=19 {normal |selector| setting}
-@d pseudo=20 {special |selector| setting for |show_context|}
-@d new_string=21 {printing is deflected to the string pool}
-@d max_selector=21 {highest selector setting}
-
-@<Glob...@>=
-@!log_file : alpha_file; {transcript of \TeX\ session}
-@!selector : 0..max_selector; {where to print a message}
-@!dig : array[0..22] of 0..15; {digits in a number being output}
-@!tally : integer; {the number of characters recently printed}
-@!term_offset : 0..max_print_line;
- {the number of characters on the current terminal line}
-@!file_offset : 0..max_print_line;
- {the number of characters on the current file line}
-@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for
- pseudoprinting}
-@!trick_count: integer; {threshold for pseudoprinting, explained later}
-@!first_count: integer; {another variable for pseudoprinting}
-
-@ @<Initialize the output routines@>=
-selector:=term_only; tally:=0; term_offset:=0; file_offset:=0;
-
-@ Macro abbreviations for output to the terminal and to the log file are
-defined here for convenience. Some systems need special conventions
-for terminal output, and it is possible to adhere to those conventions
-by changing |wterm|, |wterm_ln|, and |wterm_cr| in this section.
-@^system dependencies@>
-
-@d wterm(#)==write(term_out,#)
-@d wterm_ln(#)==write_ln(term_out,#)
-@d wterm_cr==write_ln(term_out)
-@d wlog(#)==write(log_file,#)
-@d wlog_ln(#)==write_ln(log_file,#)
-@d wlog_cr==write_ln(log_file)
-
-@ To end a line of text output, we call |print_ln|.
-
-@<Basic print...@>=
-procedure print_ln; {prints an end-of-line}
-begin case selector of
-term_and_log: begin wterm_cr; wlog_cr;
- term_offset:=0; file_offset:=0;
- end;
-log_only: begin wlog_cr; file_offset:=0;
- end;
-term_only: begin wterm_cr; term_offset:=0;
- end;
-no_print,pseudo,new_string: do_nothing;
-othercases write_ln(write_file[selector])
-endcases;@/
-end; {|tally| is not affected}
-
-@ The |print_char| procedure sends one character to the desired destination,
-using the |xchr| array to map it into an external character compatible with
-|input_ln|. All printing comes through |print_ln| or |print_char|.
-
-@<Basic printing...@>=
-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 wterm(xchr[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 wlog(xchr[s]); incr(file_offset);
- if file_offset=max_print_line then print_ln;
- end;
-term_only: begin wterm(xchr[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@>
-
-@<Basic print...@>=
-procedure print(@!s:integer); {prints string |s|}
-label exit;
-var j:pool_pointer; {current character code position}
-@!nl:integer; {new-line character to restore}
-begin if s>=str_ptr then s:="???" {this can't happen}
-@.???@>
-else if s<256 then
- if s<0 then s:="???" {can't happen}
- else begin if selector>pseudo then
- begin print_char(s); return; {internal strings are not expanded}
- end;
- if (@<Character |s| is the current new-line character@>) then
- if selector<pseudo then
- begin print_ln; return;
- end;
- nl:=new_line_char; new_line_char:=-1;
- {temporarily disable new-line character}
- j:=str_start[s];
- while j<str_start[s+1] do
- begin print_char(so(str_pool[j])); incr(j);
- end;
- new_line_char:=nl; return;
- end;
-j:=str_start[s];
-while j<str_start[s+1] do
- begin print_char(so(str_pool[j])); incr(j);
- end;
-exit:end;
-
-@ Control sequence names, file names, and strings constructed with
-\.{\\string} might contain |ASCII_code| values that can't
-be printed using |print_char|. Therefore we use |slow_print| for them:
-
-@<Basic print...@>=
-procedure slow_print(@!s:integer); {prints string |s|}
-var j:pool_pointer; {current character code position}
-begin if (s>=str_ptr) or (s<256) then print(s)
-else begin j:=str_start[s];
- while j<str_start[s+1] do
- begin print(so(str_pool[j])); incr(j);
- end;
- end;
-end;
-
-@ Here is the very first thing that \TeX\ prints: a headline that identifies
-the version number and format package. The |term_offset| variable is temporarily
-incorrect, but the discrepancy is not serious since we assume that this
-part of the program is system dependent.
-@^system dependencies@>
-
-@<Initialize the output...@>=
-wterm(banner);
-if format_ident=0 then wterm_ln(' (no format preloaded)')
-else begin slow_print(format_ident); print_ln;
- end;
-update_terminal;
-
-@ The procedure |print_nl| is like |print|, but it makes sure that the
-string appears at the beginning of a new line.
-
-@<Basic print...@>=
-procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
-begin if ((term_offset>0)and(odd(selector)))or@|
- ((file_offset>0)and(selector>=log_only)) then print_ln;
-print(s);
-end;
-
-@ The procedure |print_esc| prints a string that is preceded by
-the user's escape character (which is usually a backslash).
-
-@<Basic print...@>=
-procedure print_esc(@!s:str_number); {prints escape character, then |s|}
-var c:integer; {the escape character code}
-begin @<Set variable |c| to the current escape character@>;
-if c>=0 then if c<256 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 $\vert n\vert<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
-
-@ 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["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[str_ptr];
-while j<pool_ptr do
- begin print_char(so(str_pool[j])); incr(j);
- end;
-end;
-
-@ Here is a procedure that asks the user to type a line of input,
-assuming that the |selector| setting is either |term_only| or |term_and_log|.
-The input is placed into locations |first| through |last-1| of the
-|buffer| array, and echoed on the transcript file if appropriate.
-
-This procedure is never called when |interaction<scroll_mode|.
-
-@d prompt_input(#)==begin wake_up_terminal; print(#); term_input;
- end {prints a string and gets a line of input}
-
-@p procedure term_input; {gets a line from the terminal}
-var k:0..buf_size; {index into |buffer|}
-begin update_terminal; {now the user sees the prompt for sure}
-if not input_ln(term_in,true) then fatal_error("End of file on the terminal!");
-@.End of file on the terminal@>
-term_offset:=0; {the user's line ended with \<\rm return>}
-decr(selector); {prepare to echo the input}
-if last<>first then for k:=first to last-1 do print(buffer[k]);
-print_ln; incr(selector); {restore previous status}
-end;
-
-@* \[6] Reporting errors.
-When something anomalous is detected, \TeX\ typically does something like this:
-$$\vbox{\halign{#\hfil\cr
-|print_err("Something anomalous has been detected");|\cr
-|help3("This is the first line of my offer to help.")|\cr
-|("This is the second line. I'm trying to")|\cr
-|("explain the best way for you to proceed.");|\cr
-|error;|\cr}}$$
-A two-line help message would be given using |help2|, etc.; these informal
-helps should use simple vocabulary that complements the words used in the
-official error message that was printed. (Outside the U.S.A., the help
-messages should preferably be translated into the local vernacular. Each
-line of help is at most 60 characters long, in the present implementation,
-so that |max_print_line| will not be exceeded.)
-
-The |print_err| procedure supplies a `\.!' before the official message,
-and makes sure that the terminal is awake if a stop is going to occur.
-The |error| procedure supplies a `\..' after the official message, then it
-shows the location of the error; and if |interaction=error_stop_mode|,
-it also enters into a dialog with the user, during which time the help
-message may be printed.
-@^system dependencies@>
-
-@ The global variable |interaction| has four settings, representing increasing
-amounts of user interaction:
-
-@d batch_mode=0 {omits all stops and omits terminal output}
-@d nonstop_mode=1 {omits all stops}
-@d scroll_mode=2 {omits error stops}
-@d error_stop_mode=3 {stops at every opportunity to interact}
-@d print_err(#)==begin if interaction=error_stop_mode then wake_up_terminal;
- print_nl("! "); print(#);
- end
-
-@<Glob...@>=
-@!interaction:batch_mode..error_stop_mode; {current level of interaction}
-
-@ @<Set init...@>=interaction:=error_stop_mode;
-
-@ \TeX\ is careful not to call |error| when the print |selector| setting
-might be unusual. The only possible values of |selector| at the time of
-error messages are
-
-\yskip\hang|no_print| (when |interaction=batch_mode|
- and |log_file| not yet open);
-
-\hang|term_only| (when |interaction>batch_mode| and |log_file| not yet open);
-
-\hang|log_only| (when |interaction=batch_mode| and |log_file| is open);
-
-\hang|term_and_log| (when |interaction>batch_mode| and |log_file| is open).
-
-@<Initialize the print |selector| based on |interaction|@>=
-if interaction=batch_mode then selector:=no_print@+else selector:=term_only
-
-@ A global variable |deletions_allowed| is set |false| if the |get_next|
-routine is active when |error| is called; this ensures that |get_next|
-and related routines like |get_token| will never be called recursively.
-A similar interlock is provided by |set_box_allowed|.
-@^recursion@>
-
-The global variable |history| records the worst level of error that
-has been detected. It has four possible values: |spotless|, |warning_issued|,
-|error_message_issued|, and |fatal_error_stop|.
-
-Another global variable, |error_count|, is increased by one when an
-|error| occurs without an interactive dialog, and it is reset to zero at
-the end of every paragraph. If |error_count| reaches 100, \TeX\ decides
-that there is no point in continuing further.
-
-@d spotless=0 {|history| value when nothing has been amiss yet}
-@d warning_issued=1 {|history| value when |begin_diagnostic| has been called}
-@d error_message_issued=2 {|history| value when |error| has been called}
-@d fatal_error_stop=3 {|history| value when termination was premature}
-
-@<Glob...@>=
-@!deletions_allowed:boolean; {is it safe for |error| to call |get_token|?}
-@!set_box_allowed:boolean; {is it safe to do a \.{\\setbox} assignment?}
-@!history:spotless..fatal_error_stop; {has the source input been clean so far?}
-@!error_count:-1..100; {the number of scrolled errors since the
- last paragraph ended}
-
-@ The value of |history| is initially |fatal_error_stop|, but it will
-be changed to |spotless| if \TeX\ survives the initialization process.
-
-@<Set init...@>=
-deletions_allowed:=true; set_box_allowed:=true;
-error_count:=0; {|history| is initialized elsewhere}
-
-@ Since errors can be detected almost anywhere in \TeX, we want to declare the
-error procedures near the beginning of the program. But the error procedures
-in turn use some other procedures, which need to be declared |forward|
-before we get to |error| itself.
-
-It is possible for |error| to be called recursively if some error arises
-when |get_token| is being used to delete a token, and/or if some fatal error
-occurs while \TeX\ is trying to fix a non-fatal one. But such recursion
-@^recursion@>
-is never more than two levels deep.
-
-@<Error handling...@>=
-procedure@?normalize_selector; forward;@t\2@>@/
-procedure@?get_token; forward;@t\2@>@/
-procedure@?term_input; forward;@t\2@>@/
-procedure@?show_context; forward;@t\2@>@/
-procedure@?begin_file_reading; forward;@t\2@>@/
-procedure@?open_log_file; forward;@t\2@>@/
-procedure@?close_files_and_terminate; forward;@t\2@>@/
-procedure@?clear_for_error_prompt; forward;@t\2@>@/
-procedure@?give_err_help; forward;@t\2@>@/
-@t\4\hskip-\fontdimen2\font@>@;@+@!debug@+procedure@?debug_help;
- forward;@;@+gubed
-
-@ Individual lines of help are recorded in the array |help_line|, which
-contains entries in positions |0..(help_ptr-1)|. They should be printed
-in reverse order, i.e., with |help_line[0]| appearing last.
-
-@d hlp1(#)==help_line[0]:=#;@+end
-@d hlp2(#)==help_line[1]:=#; hlp1
-@d hlp3(#)==help_line[2]:=#; hlp2
-@d hlp4(#)==help_line[3]:=#; hlp3
-@d hlp5(#)==help_line[4]:=#; hlp4
-@d hlp6(#)==help_line[5]:=#; hlp5
-@d help0==help_ptr:=0 {sometimes there might be no help}
-@d help1==@+begin help_ptr:=1; hlp1 {use this with one help line}
-@d help2==@+begin help_ptr:=2; hlp2 {use this with two help lines}
-@d help3==@+begin help_ptr:=3; hlp3 {use this with three help lines}
-@d help4==@+begin help_ptr:=4; hlp4 {use this with four help lines}
-@d help5==@+begin help_ptr:=5; hlp5 {use this with five help lines}
-@d help6==@+begin help_ptr:=6; hlp6 {use this with six help lines}
-
-@<Glob...@>=
-@!help_line:array[0..5] of str_number; {helps for the next |error|}
-@!help_ptr:0..6; {the number of help lines present}
-@!use_err_help:boolean; {should the |err_help| list be shown?}
-
-@ @<Set init...@>=
-help_ptr:=0; use_err_help:=false;
-
-@ The |jump_out| procedure just cuts across all active procedure levels and
-goes to |end_of_TEX|. This is the only nontrivial |@!goto| statement in the
-whole program. It is used when there is no recovery from a particular error.
-
-Some \PASCAL\ compilers do not implement non-local |goto| statements.
-@^system dependencies@>
-In such cases the body of |jump_out| should simply be
-`|close_files_and_terminate|;\thinspace' followed by a call on some system
-procedure that quietly terminates the program.
-
-@<Error hand...@>=
-procedure jump_out;
-begin goto end_of_TEX;
-end;
-
-@ Here now is the general |error| routine.
-
-@<Error hand...@>=
-procedure error; {completes the job of error reporting}
-label continue,exit;
-var c:ASCII_code; {what the user types}
-@!s1,@!s2,@!s3,@!s4:integer;
- {used to save global variables when deleting tokens}
-begin if history<error_message_issued then history:=error_message_issued;
-print_char("."); show_context;
-if interaction=error_stop_mode then
- @<Get user's advice and |return|@>;
-incr(error_count);
-if error_count=100 then
- begin print_nl("(That makes 100 errors; please try again.)");
-@.That makes 100 errors...@>
- history:=fatal_error_stop; jump_out;
- end;
-@<Put help message on the transcript file@>;
-exit:end;
-
-@ @<Get user's advice...@>=
-loop@+begin continue: if interaction<>error_stop_mode then return;
- clear_for_error_prompt; prompt_input("? ");
-@.?\relax@>
- if last=first then return;
- c:=buffer[first];
- if c>="a" then c:=c+"A"-"a"; {convert to uppercase}
- @<Interpret code |c| and |return| if done@>;
- end
-
-@ It is desirable to provide an `\.E' option here that gives the user
-an easy way to return from \TeX\ to the system editor, with the offending
-line ready to be edited. But such an extension requires some system
-wizardry, so the present implementation simply types out the name of the
-file that should be
-edited and the relevant line number.
-@^system dependencies@>
-
-There is a secret `\.D' option available when the debugging routines haven't
-been commented~out.
-@^debugging@>
-
-@<Interpret code |c| and |return| if done@>=
-case c of
-"0","1","2","3","4","5","6","7","8","9": if deletions_allowed then
- @<Delete \(c)|c-"0"| tokens and |goto continue|@>;
-@t\4\4@>@;@+@!debug "D": begin debug_help; goto continue;@+end;@+gubed@/
-"E": if base_ptr>0 then if input_stack[base_ptr].name_field>=256 then
- begin print_nl("You want to edit file ");
-@.You want to edit file x@>
- slow_print(input_stack[base_ptr].name_field);
- print(" at line "); print_int(line);
- interaction:=scroll_mode; jump_out;
- end;
-"H": @<Print the help information and |goto continue|@>;
-"I":@<Introduce new material from the terminal and |return|@>;
-"Q","R","S":@<Change the interaction level and |return|@>;
-"X":begin interaction:=scroll_mode; jump_out;
- end;
-othercases do_nothing
-endcases;@/
-@<Print the menu of available options@>
-
-@ @<Print the menu...@>=
-begin print("Type <return> to proceed, S to scroll future error messages,");@/
-@.Type <return> to proceed...@>
-print_nl("R to run without stopping, Q to run quietly,");@/
-print_nl("I to insert something, ");
-if base_ptr>0 then if input_stack[base_ptr].name_field>=256 then
- print("E to edit your file,");
-if deletions_allowed then
- print_nl("1 or ... or 9 to ignore the next 1 to 9 tokens of input,");
-print_nl("H for help, X to quit.");
-end
-
-@ Here the author of \TeX\ apologizes for making use of the numerical
-relation between |"Q"|, |"R"|, |"S"|, and the desired interaction settings
-|batch_mode|, |nonstop_mode|, |scroll_mode|.
-@^Knuth, Donald Ervin@>
-
-@<Change the interaction...@>=
-begin error_count:=0; interaction:=batch_mode+c-"Q";
-print("OK, entering ");
-case c of
-"Q":begin print_esc("batchmode"); decr(selector);
- end;
-"R":print_esc("nonstopmode");
-"S":print_esc("scrollmode");
-end; {there are no other cases}
-print("..."); print_ln; update_terminal; return;
-end
-
-@ When the following code is executed, |buffer[(first+1)..(last-1)]| may
-contain the material inserted by the user; otherwise another prompt will
-be given. In order to understand this part of the program fully, you need
-to be familiar with \TeX's input stacks.
-
-@<Introduce new material...@>=
-begin begin_file_reading; {enter a new syntactic level for terminal input}
-{now |state=mid_line|, so an initial blank space will count as a blank}
-if last>first+1 then
- begin loc:=first+1; buffer[first]:=" ";
- end
-else begin prompt_input("insert>"); loc:=first;
-@.insert>@>
- end;
-first:=last;
-cur_input.limit_field:=last-1; {no |end_line_char| ends this line}
-return;
-end
-
-@ We allow deletion of up to 99 tokens at a time.
-
-@<Delete \(c)|c-"0"| tokens...@>=
-begin s1:=cur_tok; s2:=cur_cmd; s3:=cur_chr; s4:=align_state;
-align_state:=1000000; OK_to_interrupt:=false;
-if (last>first+1) and (buffer[first+1]>="0")and(buffer[first+1]<="9") then
- c:=c*10+buffer[first+1]-"0"*11
-else c:=c-"0";
-while c>0 do
- begin get_token; {one-level recursive call of |error| is possible}
- decr(c);
- end;
-cur_tok:=s1; cur_cmd:=s2; cur_chr:=s3; align_state:=s4; OK_to_interrupt:=true;
-help2("I have just deleted some text, as you asked.")@/
-("You can now delete more, or insert, or whatever.");
-show_context; goto continue;
-end
-
-@ @<Print the help info...@>=
-begin if use_err_help then
- begin give_err_help; use_err_help:=false;
- end
-else begin if help_ptr=0 then
- help2("Sorry, I don't know how to help in this situation.")@/
- @t\kern1em@>("Maybe you should try asking a human?");
- repeat decr(help_ptr); print(help_line[help_ptr]); print_ln;
- until help_ptr=0;
- end;
-help4("Sorry, I already gave what help I could...")@/
- ("Maybe you should try asking a human?")@/
- ("An error might have occurred before I noticed any problems.")@/
- ("``If all else fails, read the instructions.''");@/
-goto continue;
-end
-
-@ @<Put help message on the transcript file@>=
-if interaction>batch_mode then decr(selector); {avoid terminal output}
-if use_err_help then
- begin print_ln; give_err_help;
- end
-else while help_ptr>0 do
- begin decr(help_ptr); print_nl(help_line[help_ptr]);
- end;
-print_ln;
-if interaction>batch_mode then incr(selector); {re-enable terminal output}
-print_ln
-
-@ A dozen or so error messages end with a parenthesized integer, so we
-save a teeny bit of program space by declaring the following procedure:
-
-@p procedure int_error(@!n:integer);
-begin print(" ("); print_int(n); print_char(")"); error;
-end;
-
-@ In anomalous cases, the print selector might be in an unknown state;
-the following subroutine is called to fix things just enough to keep
-running a bit longer.
-
-@p procedure normalize_selector;
-begin if log_opened then selector:=term_and_log
-else selector:=term_only;
-if job_name=0 then open_log_file;
-if interaction=batch_mode then decr(selector);
-end;
-
-@ The following procedure prints \TeX's last words before dying.
-
-@d succumb==begin if interaction=error_stop_mode then
- interaction:=scroll_mode; {no more interaction}
- if log_opened then error;
- @!debug if interaction>batch_mode then debug_help;@+gubed@;@/
- history:=fatal_error_stop; jump_out; {irrecoverable error}
- end
-
-@<Error hand...@>=
-procedure fatal_error(@!s:str_number); {prints |s|, and that's it}
-begin normalize_selector;@/
-print_err("Emergency stop"); help1(s); succumb;
-@.Emergency stop@>
-end;
-
-@ Here is the most dreaded error message.
-
-@<Error hand...@>=
-procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
-begin normalize_selector;
-print_err("TeX capacity exceeded, sorry [");
-@.TeX capacity exceeded ...@>
-print(s); print_char("="); print_int(n); print_char("]");
-help2("If you really absolutely need more capacity,")@/
- ("you can ask a wizard to enlarge me.");
-succumb;
-end;
-
-@ The program might sometime run completely amok, at which point there is
-no choice but to stop. If no previous error has been detected, that's bad
-news; a message is printed that is really intended for the \TeX\
-maintenance person instead of the user (unless the user has been
-particularly diabolical). The index entries for `this can't happen' may
-help to pinpoint the problem.
-@^dry rot@>
-
-@<Error hand...@>=
-procedure confusion(@!s:str_number);
- {consistency check violated; |s| tells where}
-begin normalize_selector;
-if history<error_message_issued then
- begin print_err("This can't happen ("); print(s); print_char(")");
-@.This can't happen@>
- help1("I'm broken. Please show this to someone who can fix can fix");
- end
-else begin print_err("I can't go on meeting you like this");
-@.I can't go on...@>
- help2("One of your faux pas seems to have wounded me deeply...")@/
- ("in fact, I'm barely conscious. Please fix it and try again.");
- end;
-succumb;
-end;
-
-@ Users occasionally want to interrupt \TeX\ while it's running.
-If the \PASCAL\ runtime system allows this, one can implement
-a routine that sets the global variable |interrupt| to some nonzero value
-when such an interrupt is signalled. Otherwise there is probably at least
-a way to make |interrupt| nonzero using the \PASCAL\ debugger.
-@^system dependencies@>
-@^debugging@>
-
-@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
- end
-
-@<Global...@>=
-@!interrupt:integer; {should \TeX\ pause for instructions?}
-@!OK_to_interrupt:boolean; {should interrupts be observed?}
-
-@ @<Set init...@>=
-interrupt:=0; OK_to_interrupt:=true;
-
-@ When an interrupt has been detected, the program goes into its
-highest interaction level and lets the user have nearly the full flexibility of
-the |error| routine. \TeX\ checks for interrupts only at times when it is
-safe to do this.
-
-@p procedure pause_for_instructions;
-begin if OK_to_interrupt then
- begin interaction:=error_stop_mode;
- if (selector=log_only)or(selector=no_print) then
- incr(selector);
- print_err("Interruption");
-@.Interruption@>
- help3("You rang?")@/
- ("Try to insert an instruction for me (e.g., `I\showlists'),")@/
- ("unless you just want to quit by typing `X'.");
- deletions_allowed:=false; error; deletions_allowed:=true;
- interrupt:=0;
- end;
-end;
-
-@* \[7] Arithmetic with scaled dimensions.
-The principal computations performed by \TeX\ are done entirely in terms of
-integers less than $2^{31}$ in magnitude; and divisions are done only when both
-dividend and divisor are nonnegative. Thus, the arithmetic specified in this
-program can be carried out in exactly the same way on a wide variety of
-computers, including some small ones. Why? Because the arithmetic
-calculations need to be spelled out precisely in order to guarantee that
-\TeX\ will produce identical output on different machines. If some
-quantities were rounded differently in different implementations, we would
-find that line breaks and even page breaks might occur in different places.
-Hence the arithmetic of \TeX\ has been designed with care, and systems that
-claim to be implementations of \TeX82 should follow precisely the
-@:TeX82}{\TeX82@>
-calculations as they appear in the present program.
-
-(Actually there are three places where \TeX\ uses |div| with a possibly negative
-numerator. These are harmless; see |div| in the index. Also if the user
-sets the \.{\\time} or the \.{\\year} to a negative value, some diagnostic
-information will involve negative-numerator division. The same remarks
-apply for |mod| as well as for |div|.)
-
-@ Here is a routine that calculates half of an integer, using an
-unambiguous convention with respect to signed odd numbers.
-
-@p function half(@!x:integer):integer;
-begin if odd(x) then half:=(x+1) div 2
-else half:=x @!div 2;
-end;
-
-@ Fixed-point arithmetic is done on {\sl scaled integers\/} that are multiples
-of $2^{-16}$. In other words, a binary point is assumed to be sixteen bit
-positions from the right end of a binary computer word.
-
-@d unity == @'200000 {$2^{16}$, represents 1.00000}
-@d two == @'400000 {$2^{17}$, represents 2.00000}
-
-@<Types...@>=
-@!scaled = integer; {this type is used for scaled integers}
-@!nonnegative_integer=0..@'17777777777; {$0\L x<2^{31}$}
-@!small_number=0..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 \MP. I had to change
-the types (use |integer| instead of |fraction|), but that should
-not have any influence on the actual calculations (the original
-comments refer to quantities like |fraction_four| ($2^{30}$), and
-that is the same as the numeric representation of |maxdimen|).
-
-I've copied the low-level variables and routines that are needed, but
-only those (e.g.~|m_log|), not the accompanying ones like |m_exp|. Most
-of the following low-level numeric routines are only needed within the
-calculation of |norm_rand|. I've been forced to rename |make_fraction|
-to |make_frac| because TeX already has a routine by that name with
-a wholly different function (it creates a |fraction_noad| for math
-typesetting) -- Taco.
-
-And now let's complete our collection of numeric utility routines
-by considering random number generation.
-\MP\ generates pseudo-random numbers with the additive scheme recommended
-in Section 3.6 of {\sl The Art of Computer Programming}; however, the
-results are random fractions between 0 and |fraction_one-1|, inclusive.
-
-There's an auxiliary array |randoms| that contains 55 pseudo-random
-fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-31})\bmod 2^{28}$,
-we generate batches of 55 new $x_n$'s at a time by calling |new_randoms|.
-The global variable |j_random| tells which element has most recently
-been consumed.
-
-@<Glob...@>=
-@!randoms:array[0..54] of integer; {the last 55 random values generated}
-@!j_random:0..54; {the number of unused |randoms|}
-@!random_seed:scaled; {the default random seed}
-
-@ A small bit of \MF\ is needed.
-
-@d fraction_half==@'1000000000 {$2^{27}$, represents 0.50000000}
-@d fraction_one==@'2000000000 {$2^{28}$, represents 1.00000000}
-@d fraction_four==@'10000000000 {$2^{30}$, represents 4.00000000}
-@d el_gordo == @'17777777777 {$2^{31}-1$, the largest value that \MP\ likes}
-@d halfp(#)==(#) div 2
-@d double(#) == #:=#+# {multiply a variable by two}
-
-@ The |make_frac| routine produces the |fraction| equivalent of
-|p/q|, given integers |p| and~|q|; it computes the integer
-$f=\lfloor2^{28}p/q+{1\over2}\rfloor$, when $p$ and $q$ are
-positive. If |p| and |q| are both of the same scaled type |t|,
-the ``type relation'' |make_frac(t,t)=fraction| is valid;
-and it's also possible to use the subroutine ``backwards,'' using
-the relation |make_frac(t,fraction)=t| between scaled types.
-
-If the result would have magnitude $2^{31}$ or more, |make_frac|
-sets |arith_error:=true|. Most of \MP's internal computations have
-been designed to avoid this sort of error.
-
-If this subroutine were programmed in assembly language on a typical
-machine, we could simply compute |(@t$2^{28}$@>*p)div q|, since a
-double-precision product can often be input to a fixed-point division
-instruction. But when we are restricted to \PASCAL\ arithmetic it
-is necessary either to resort to multiple-precision maneuvering
-or to use a simple but slow iteration. The multiple-precision technique
-would be about three times faster than the code adopted here, but it
-would be comparatively long and tricky, involving about sixteen
-additional multiplications and divisions.
-
-This operation is part of \MP's ``inner loop''; indeed, it will
-consume nearly 10\pct! of the running time (exclusive of input and output)
-if the code below is left unchanged. A machine-dependent recoding
-will therefore make \MP\ run faster. The present implementation
-is highly portable, but slow; it avoids multiplication and division
-except in the initial stage. System wizards should be careful to
-replace it with a routine that is guaranteed to produce identical
-results in all cases.
-@^system dependencies@>
-
-As noted below, a few more routines should also be replaced by machine-dependent
-code, for efficiency. But when a procedure is not part of the ``inner loop,''
-such changes aren't advisable; simplicity and robustness are
-preferable to trickery, unless the cost is too high.
-@^inner loop@>
-
-@p function make_frac(@!p,@!q:integer):integer;
-var @!f:integer; {the fraction bits, with a leading 1 bit}
-@!n:integer; {the integer part of $\vert p/q\vert$}
-@!negative:boolean; {should the result be negated?}
-@!be_careful:integer; {disables certain compiler optimizations}
-begin if p>=0 then negative:=false
-else begin negate(p); negative:=true;
- end;
-if q<=0 then
- begin debug if q=0 then confusion("/");@;@+gubed@;@/
-@:this can't happen /}{\quad \./@>
- negate(q); negative:=not negative;
- end;
-n:=p div q; p:=p mod q;
-if n>=8 then
- begin arith_error:=true;
- if negative then make_frac:=-el_gordo@+else make_frac:=el_gordo;
- end
-else begin n:=(n-1)*fraction_one;
- @<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>;
- if negative then make_frac:=-(f+n)@+else make_frac:=f+n;
- end;
-end;
-
-@ The |repeat| loop here preserves the following invariant relations
-between |f|, |p|, and~|q|:
-(i)~|0<=p<q|; (ii)~$fq+p=2^k(q+p_0)$, where $k$ is an integer and
-$p_0$ is the original value of~$p$.
-
-Notice that the computation specifies
-|(p-q)+p| instead of |(p+p)-q|, because the latter could overflow.
-Let us hope that optimizing compilers do not miss this point; a
-special variable |be_careful| is used to emphasize the necessary
-order of computation. Optimizing compilers should keep |be_careful|
-in a register, not store it in memory.
-@^inner loop@>
-
-@<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>=
-f:=1;
-repeat be_careful:=p-q; p:=be_careful+p;
-if p>=0 then f:=f+f+1
-else begin double(f); p:=p+q;
- end;
-until f>=fraction_one;
-be_careful:=p-q;
-if be_careful+p>=0 then incr(f)
-
-@
-
-@p function take_frac(@!q:integer;@!f:integer):integer;
-var @!p:integer; {the fraction so far}
-@!negative:boolean; {should the result be negated?}
-@!n:integer; {additional multiple of $q$}
-@!be_careful:integer; {disables certain compiler optimizations}
-begin @<Reduce to the case that |f>=0| and |q>0|@>;
-if f<fraction_one then n:=0
-else begin n:=f div fraction_one; f:=f mod fraction_one;
- if q<=el_gordo div n then n:=n*q
- else begin arith_error:=true; n:=el_gordo;
- end;
- end;
-f:=f+fraction_one;
-@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>;
-be_careful:=n-el_gordo;
-if be_careful+p>0 then
- begin arith_error:=true; n:=el_gordo-p;
- end;
-if negative then take_frac:=-(n+p)
-else take_frac:=n+p;
-end;
-
-@ @<Reduce to the case that |f>=0| and |q>0|@>=
-if f>=0 then negative:=false
-else begin negate(f); negative:=true;
- end;
-if q<0 then
- begin negate(q); negative:=not negative;
- end;
-
-@ The invariant relations in this case are (i)~$\lfloor(qf+p)/2^k\rfloor
-=\lfloor qf_0/2^{28}+{1\over2}\rfloor$, where $k$ is an integer and
-$f_0$ is the original value of~$f$; (ii)~$2^k\L f<2^{k+1}$.
-@^inner loop@>
-
-@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>=
-p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$}
-if q<fraction_four then
- repeat if odd(f) then p:=halfp(p+q)@+else p:=halfp(p);
- f:=halfp(f);
- until f=1
-else repeat if odd(f) then p:=p+halfp(q-p)@+else p:=halfp(p);
- f:=halfp(f);
- until f=1
-
-@ The subroutines for logarithm and exponential involve two tables.
-The first is simple: |two_to_the[k]| equals $2^k$. The second involves
-a bit more calculation, which the author claims to have done correctly:
-|spec_log[k]| is $2^{27}$ times $\ln\bigl(1/(1-2^{-k})\bigr)=
-2^{-k}+{1\over2}2^{-2k}+{1\over3}2^{-3k}+\cdots\,$, rounded to the
-nearest integer.
-
-@<Glob...@>=
-@!two_to_the:array[0..30] of integer; {powers of two}
-@!spec_log:array[1..28] of integer; {special logarithms}
-
-
-@ @<Set init...@>=
-two_to_the[0]:=1;
-for k:=1 to 30 do two_to_the[k]:=2*two_to_the[k-1];
-spec_log[1]:=93032640;
-spec_log[2]:=38612034;
-spec_log[3]:=17922280;
-spec_log[4]:=8662214;
-spec_log[5]:=4261238;
-spec_log[6]:=2113709;
-spec_log[7]:=1052693;
-spec_log[8]:=525315;
-spec_log[9]:=262400;
-spec_log[10]:=131136;
-spec_log[11]:=65552;
-spec_log[12]:=32772;
-spec_log[13]:=16385;
-for k:=14 to 27 do spec_log[k]:=two_to_the[27-k];
-spec_log[28]:=1;
-
-@
-
-@p function m_log(@!x:integer):integer;
-var @!y,@!z:integer; {auxiliary registers}
-@!k:integer; {iteration counter}
-begin if x<=0 then @<Handle non-positive logarithm@>
-else begin y:=1302456956+4-100; {$14\times2^{27}\ln2\approx1302456956.421063$}
- z:=27595+6553600; {and $2^{16}\times .421063\approx 27595$}
- while x<fraction_four do
- begin double(x); y:=y-93032639; z:=z-48782;
- end; {$2^{27}\ln2\approx 93032639.74436163$
- and $2^{16}\times.74436163\approx 48782$}
- y:=y+(z div unity); k:=2;
- while x>fraction_four+4 do
- @<Increase |k| until |x| can be multiplied by a
- factor of $2^{-k}$, and adjust $y$ accordingly@>;
- m_log:=y div 8;
- end;
-end;
-
-@ @<Increase |k| until |x| can...@>=
-begin z:=((x-1) div two_to_the[k])+1; {$z=\lceil x/2^k\rceil$}
-while x<fraction_four+z do
- begin z:=halfp(z+1); k:=k+1;
- end;
-y:=y+spec_log[k]; x:=x-z;
-end
-
-@ @<Handle non-positive logarithm@>=
-begin print_err("Logarithm of ");
-@.Logarithm...replaced by 0@>
-print_scaled(x); print(" has been replaced by 0");
-help2("Since I don't take logs of non-positive numbers,")@/
- ("I'm zeroing this one. Proceed, with fingers crossed.");
-error; m_log:=0;
-end
-
-@ The following somewhat different subroutine tests rigorously if $ab$ is
-greater than, equal to, or less than~$cd$,
-given integers $(a,b,c,d)$. In most cases a quick decision is reached.
-The result is $+1$, 0, or~$-1$ in the three respective cases.
-
-@d return_sign(#)==begin ab_vs_cd:=#; return;
- end
-
-@p function ab_vs_cd(@!a,b,c,d:integer):integer;
-label exit;
-var @!q,@!r:integer; {temporary registers}
-begin @<Reduce to the case that |a,c>=0|, |b,d>0|@>;
-loop@+ begin q := a div d; r := c div b;
- if q<>r then
- if q>r then return_sign(1)@+else return_sign(-1);
- q := a mod d; r := c mod b;
- if r=0 then
- if q=0 then return_sign(0)@+else return_sign(1);
- if q=0 then return_sign(-1);
- a:=b; b:=q; c:=d; d:=r;
- end; {now |a>d>0| and |c>b>0|}
-exit:end;
-
-@ @<Reduce to the case that |a...@>=
-if a<0 then
- begin negate(a); negate(b);
- end;
-if c<0 then
- begin negate(c); negate(d);
- end;
-if d<=0 then
- begin if b>=0 then
- if ((a=0)or(b=0))and((c=0)or(d=0)) then return_sign(0)
- else return_sign(1);
- if d=0 then
- if a=0 then return_sign(0)@+else return_sign(-1);
- q:=a; a:=c; c:=q; q:=-b; b:=-d; d:=q;
- end
-else if b<=0 then
- begin if b<0 then if a>0 then return_sign(-1);
- if c=0 then return_sign(0) else return_sign(-1);
- end
-
-@ To consume a random integer, the program below will say `|next_random|'
-and then it will fetch |randoms[j_random]|.
-
-@d next_random==if j_random=0 then new_randoms
- else decr(j_random)
-
-@p procedure new_randoms;
-var @!k:0..54; {index into |randoms|}
-@!x:integer; {accumulator}
-begin for k:=0 to 23 do
- begin x:=randoms[k]-randoms[k+31];
- if x<0 then x:=x+fraction_one;
- randoms[k]:=x;
- end;
-for k:=24 to 54 do
- begin x:=randoms[k]-randoms[k-24];
- if x<0 then x:=x+fraction_one;
- randoms[k]:=x;
- end;
-j_random:=54;
-end;
-
-@ To initialize the |randoms| table, we call the following routine.
-
-@p procedure init_randoms(@!seed:integer);
-var @!j,@!jj,@!k:integer; {more or less random integers}
-@!i:0..54; {index into |randoms|}
-begin j:=abs(seed);
-while j>=fraction_one do j:=halfp(j);
-k:=1;
-for i:=0 to 54 do
- begin jj:=k; k:=j-k; j:=jj;
- if k<0 then k:=k+fraction_one;
- randoms[(i*21)mod 55]:=j;
- end;
-new_randoms; new_randoms; new_randoms; {``warm up'' the array}
-end;
-
-@ To produce a uniform random number in the range |0<=u<x| or |0>=u>x|
-or |0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
-
-Note that the call of |take_frac| will produce the values 0 and~|x|
-with about half the probability that it will produce any other particular
-values between 0 and~|x|, because it rounds its answers.
-
-@p function unif_rand(@!x:integer):integer;
-var @!y:integer; {trial value}
-begin next_random; y:=take_frac(abs(x),randoms[j_random]);
-if y=abs(x) then unif_rand:=0
-else if x>0 then unif_rand:=y
-else unif_rand:=-y;
-end;
-
-@ Finally, a normal deviate with mean zero and unit standard deviation
-can readily be obtained with the ratio method (Algorithm 3.4.1R in
-{\sl The Art of Computer Programming\/}).
-
-@p function norm_rand:integer;
-var @!x,@!u,@!l:integer; {what the book would call $2^{16}X$, $2^{28}U$,
- and $-2^{24}\ln U$}
-begin repeat
- repeat next_random;
- x:=take_frac(112429,randoms[j_random]-fraction_half);
- {$2^{16}\sqrt{8/e}\approx 112428.82793$}
- next_random; u:=randoms[j_random];
- until abs(x)<u;
-x:=make_frac(x,u);
-l:=139548960-m_log(u); {$2^{24}\cdot12\ln2\approx139548959.6165$}
-until ab_vs_cd(1024,l,x,x)>=0;
-norm_rand:=x;
-end;
-
-@* \[8] Packed data.
-In order to make efficient use of storage space, \TeX\ bases its major data
-structures on a |memory_word|, which contains either a (signed) integer,
-possibly scaled, or a (signed) |glue_ratio|, or a small number of
-fields that are one half or one quarter of the size used for storing
-integers.
-
-If |x| is a variable of type |memory_word|, it contains up to four
-fields that can be referred to as follows:
-$$\vbox{\halign{\hfil#&#\hfil&#\hfil\cr
-|x|&.|int|&(an |integer|)\cr
-|x|&.|sc|\qquad&(a |scaled| integer)\cr
-|x|&.|gr|&(a |glue_ratio|)\cr
-|x.hh.lh|, |x.hh|&.|rh|&(two halfword fields)\cr
-|x.hh.b0|, |x.hh.b1|, |x.hh|&.|rh|&(two quarterword fields, one halfword
- field)\cr
-|x.qqqq.b0|, |x.qqqq.b1|, |x.qqqq|&.|b2|, |x.qqqq.b3|\hskip-100pt
- &\qquad\qquad\qquad(four quarterword fields)\cr}}$$
-This is somewhat cumbersome to write, and not very readable either, but
-macros will be used to make the notation shorter and more transparent.
-The \PASCAL\ code below gives a formal definition of |memory_word| and
-its subsidiary types, using packed variant records. \TeX\ makes no
-assumptions about the relative positions of the fields within a word.
-
-Since we are assuming 32-bit integers, a halfword must contain at least
-16 bits, and a quarterword must contain at least 8 bits.
-@^system dependencies@>
-But it doesn't hurt to have more bits; for example, with enough 36-bit
-words you might be able to have |mem_max| as large as 262142, which is
-eight times as much memory as anybody had during the first four years of
-\TeX's existence.
-
-N.B.: Valuable memory space will be dreadfully wasted unless \TeX\ is compiled
-by a \PASCAL\ that packs all of the |memory_word| variants into
-the space of a single integer. This means, for example, that |glue_ratio|
-words should be |short_real| instead of |real| on some computers. Some
-\PASCAL\ compilers will pack an integer whose subrange is `|0..255|' into
-an eight-bit field, but others insist on allocating space for an additional
-sign bit; on such systems you can get 256 values into a quarterword only
-if the subrange is `|-128..127|'.
-
-The present implementation tries to accommodate as many variations as possible,
-so it makes few assumptions. If integers having the subrange
-`|min_quarterword..max_quarterword|' can be packed into a quarterword,
-and if integers having the subrange `|min_halfword..max_halfword|'
-can be packed into a halfword, everything should work satisfactorily.
-
-It is usually most efficient to have |min_quarterword=min_halfword=0|,
-so one should try to achieve this unless it causes a severe problem.
-The values defined here are recommended for most 32-bit computers.
-
-@d min_quarterword=0 {smallest allowable value in a |quarterword|}
-@d max_quarterword=255 {largest allowable value in a |quarterword|}
-@d min_halfword==0 {smallest allowable value in a |halfword|}
-@d max_halfword==65535 {largest allowable value in a |halfword|}
-
-@ Here are the inequalities that the quarterword and halfword values
-must satisfy (or rather, the inequalities that they mustn't satisfy):
-
-@<Check the ``constant''...@>=
-init if (mem_min<>mem_bot)or(mem_max<>mem_top) then bad:=10;@+tini@;@/
-if (mem_min>mem_bot)or(mem_max<mem_top) then bad:=10;
-if (min_quarterword>0)or(max_quarterword<127) then bad:=11;
-if (min_halfword>0)or(max_halfword<32767) then bad:=12;
-if (min_quarterword<min_halfword)or@|
- (max_quarterword>max_halfword) then bad:=13;
-if (mem_min<min_halfword)or(mem_max>=max_halfword)or@|
- (mem_bot-mem_min>max_halfword+1) then bad:=14;
-if (font_base<min_quarterword)or(font_max>max_quarterword) then bad:=15;
-if font_max>font_base+256 then bad:=16;
-if (save_size>max_halfword)or(max_strings>max_halfword) then bad:=17;
-if buf_size>max_halfword then bad:=18;
-if max_quarterword-min_quarterword<255 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 a large array |mem| in
-which consecutive blocks of words are used as nodes by the \TeX\ routines.
-
-Pointer variables are indices into this array, or into another array
-called |eqtb| that will be explained later. A pointer variable might
-also be a special flag that lies outside the bounds of |mem|, so we
-allow pointers to assume any |halfword| value. The minimum halfword
-value represents a null pointer. \TeX\ does not assume that |mem[null]| exists.
-
-@d pointer==halfword {a flag or a location in |mem| or |eqtb|}
-@d null==min_halfword {the null pointer}
-
-@<Glob...@>=
-@!temp_ptr:pointer; {a pointer variable for occasional emergency use}
-
-@ The |mem| array is divided into two regions that are allocated separately,
-but the dividing line between these two regions is not fixed; they grow
-together until finding their ``natural'' size in a particular job.
-Locations less than or equal to |lo_mem_max| are used for storing
-variable-length records consisting of two or more words each. This region
-is maintained using an algorithm similar to the one described in exercise
-2.5--19 of {\sl The Art of Computer Programming}. However, no size field
-appears in the allocated nodes; the program is responsible for knowing the
-relevant size when a node is freed. Locations greater than or equal to
-|hi_mem_min| are used for storing one-word records; a conventional
-\.{AVAIL} stack is used for allocation in this region.
-
-Locations of |mem| between |mem_bot| and |mem_top| may be dumped as part
-of preloaded format files, by the \.{INITEX} preprocessor.
-@.INITEX@>
-Production versions of \TeX\ may extend the memory at both ends in order to
-provide more space; locations between |mem_min| and |mem_bot| are always
-used for variable-size nodes, and locations between |mem_top| and |mem_max|
-are always used for single-word nodes.
-
-The key pointers that govern |mem| allocation have a prescribed order:
-$$\advance\thickmuskip-2mu
-\hbox{|null<=mem_min<=mem_bot<lo_mem_max<
- hi_mem_min<mem_top<=mem_end<=mem_max|.}$$
-
-Empirical tests show that the present implementation of \TeX\ tends to
-spend about 9\pct! of its running time allocating nodes, and about 6\pct!
-deallocating them after their use.
-
-@<Glob...@>=
-@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
-@!lo_mem_max : pointer; {the largest location of variable-size memory in use}
-@!hi_mem_min : pointer; {the smallest location of one-word memory in use}
-
-@ In order to study the memory requirements of particular applications, it
-is possible to prepare a version of \TeX\ that keeps track of current and
-maximum memory usage. When code between the delimiters |@!stat| $\ldots$
-|tats| is not ``commented out,'' \TeX\ will run a bit slower but it will
-report these statistics when |tracing_stats| is sufficiently large.
-
-@<Glob...@>=
-@!var_used, @!dyn_used : integer; {how much memory is in use}
-
-@ Let's consider the one-word memory region first, since it's the
-simplest. The pointer variable |mem_end| holds the highest-numbered location
-of |mem| that has ever been used. The free locations of |mem| that
-occur between |hi_mem_min| and |mem_end|, inclusive, are of type
-|two_halves|, and we write |info(p)| and |link(p)| for the |lh|
-and |rh| fields of |mem[p]| when it is of this type. The single-word
-free locations form a linked list
-$$|avail|,\;\hbox{|link(avail)|},\;\hbox{|link(link(avail))|},\;\ldots$$
-terminated by |null|.
-
-@d link(#) == mem[#].hh.rh {the |link| field of a memory word}
-@d info(#) == mem[#].hh.lh {the |info| field of a memory word}
-
-@<Glob...@>=
-@!avail : pointer; {head of the list of available one-word nodes}
-@!mem_end : pointer; {the last one-word node used in |mem|}
-
-@ If memory is exhausted, it might mean that the user has forgotten
-a right brace. We will define some procedures later that try to help
-pinpoint the trouble.
-
-@p @<Declare the procedure called |show_token_list|@>@/
-@<Declare the procedure called |runaway|@>
-
-@ The function |get_avail| returns a pointer to a new one-word node whose
-|link| field is null. However, \TeX\ will halt if there is no more room left.
-@^inner loop@>
-
-If the available-space list is empty, i.e., if |avail=null|,
-we try first to increase |mem_end|. If that cannot be done, i.e., if
-|mem_end=mem_max|, we try to decrease |hi_mem_min|. If that cannot be
-done, i.e., if |hi_mem_min=lo_mem_max+1|, we have to quit.
-
-@p function get_avail : pointer; {single-word node allocation}
-var p:pointer; {the new node being got}
-begin p:=avail; {get top location in the |avail| stack}
-if p<>null then avail:=link(avail) {and pop it off}
-else if mem_end<mem_max then {or go into virgin territory}
- begin incr(mem_end); p:=mem_end;
- end
-else begin decr(hi_mem_min); p:=hi_mem_min;
- if hi_mem_min<=lo_mem_max then
- begin runaway; {if memory is exhausted, display possible runaway text}
- overflow("main memory size",mem_max+1-mem_min);
- {quit; all one-word nodes are busy}
-@:TeX capacity exceeded main memory size}{\quad main memory size@>
- end;
- end;
-link(p):=null; {provide an oft-desired initialization of the new node}
-@!stat incr(dyn_used);@+tats@;{maintain statistics}
-get_avail:=p;
-end;
-
-@ Conversely, a one-word node is recycled by calling |free_avail|.
-This routine is part of \TeX's ``inner loop,'' so we want it to be fast.
-@^inner loop@>
-
-@d free_avail(#)== {single-word node liberation}
- begin link(#):=avail; avail:=#;
- @!stat decr(dyn_used);@+tats@/
- end
-
-@ There's also a |fast_get_avail| routine, which saves the procedure-call
-overhead at the expense of extra programming. This routine is used in
-the places that would otherwise account for the most calls of |get_avail|.
-@^inner loop@>
-
-@d fast_get_avail(#)==@t@>@;@/
- begin #:=avail; {avoid |get_avail| if possible, to save time}
- if #=null then #:=get_avail
- else begin avail:=link(#); link(#):=null;
- @!stat incr(dyn_used);@+tats@/
- end;
- end
-
-@ The procedure |flush_list(p)| frees an entire linked list of
-one-word nodes that starts at position |p|.
-@^inner loop@>
-
-@p procedure flush_list(@!p:pointer); {makes list of single-word nodes
- available}
-var @!q,@!r:pointer; {list traversers}
-begin if p<>null then
- begin r:=p;
- repeat q:=r; r:=link(r); @!stat decr(dyn_used);@+tats@/
- until r=null; {now |q| is the last node on the list}
- link(q):=avail; avail:=p;
- end;
-end;
-
-@ The available-space list that keeps track of the variable-size portion
-of |mem| is a nonempty, doubly-linked circular list of empty nodes,
-pointed to by the roving pointer |rover|.
-
-Each empty node has size 2 or more; the first word contains the special
-value |max_halfword| in its |link| field and the size in its |info| field;
-the second word contains the two pointers for double linking.
-
-Each nonempty node also has size 2 or more. Its first word is of type
-|two_halves|\kern-1pt, and its |link| field is never equal to |max_halfword|.
-Otherwise there is complete flexibility with respect to the contents
-of its other fields and its other words.
-
-(We require |mem_max<max_halfword| because terrible things can happen
-when |max_halfword| appears in the |link| field of a nonempty node.)
-
-@d empty_flag == max_halfword {the |link| of an empty variable-size node}
-@d is_empty(#) == (link(#)=empty_flag) {tests for empty node}
-@d node_size == info {the size field in empty variable-size nodes}
-@d llink(#) == info(#+1) {left link in doubly-linked list of empty nodes}
-@d rlink(#) == link(#+1) {right link in doubly-linked list of empty nodes}
-
-@<Glob...@>=
-@!rover : pointer; {points to some node in the list of empties}
-
-@ A call to |get_node| with argument |s| returns a pointer to a new node
-of size~|s|, which must be 2~or more. The |link| field of the first word
-of this new node is set to null. An overflow stop occurs if no suitable
-space exists.
-
-If |get_node| is called with $s=2^{30}$, it simply merges adjacent free
-areas and returns the value |max_halfword|.
-
-@p function get_node(@!s:integer):pointer; {variable-size node allocation}
-label found,exit,restart;
-var p:pointer; {the node currently under inspection}
-@!q:pointer; {the node physically after node |p|}
-@!r:integer; {the newly allocated node, or a candidate for this honor}
-@!t:integer; {temporary register}
-begin restart: p:=rover; {start at some free node in the ring}
-repeat @<Try to allocate within node |p| and its physical successors,
- and |goto found| if allocation was possible@>;
-@^inner loop@>
-p:=rlink(p); {move to the next node in the ring}
-until p=rover; {repeat until the whole list has been traversed}
-if s=@'10000000000 then
- begin get_node:=max_halfword; return;
- end;
-if lo_mem_max+2<hi_mem_min then if lo_mem_max+2<=mem_bot+max_halfword then
- @<Grow more variable-size memory and |goto restart|@>;
-overflow("main memory size",mem_max+1-mem_min);
- {sorry, nothing satisfactory is left}
-@:TeX capacity exceeded main memory size}{\quad main memory size@>
-found: link(r):=null; {this node is now nonempty}
-@!stat var_used:=var_used+s; {maintain usage statistics}
-tats@;@/
-get_node:=r;
-exit:end;
-
-@ The lower part of |mem| grows by 1000 words at a time, unless
-we are very close to going under. When it grows, we simply link
-a new node into the available-space list. This method of controlled
-growth helps to keep the |mem| usage consecutive when \TeX\ is
-implemented on ``virtual memory'' systems.
-@^virtual memory@>
-
-@<Grow more variable-size memory and |goto restart|@>=
-begin if hi_mem_min-lo_mem_max>=1998 then t:=lo_mem_max+1000
-else t:=lo_mem_max+1+(hi_mem_min-lo_mem_max) div 2;
- {|lo_mem_max+2<=t<hi_mem_min|}
-p:=llink(rover); q:=lo_mem_max; rlink(p):=q; llink(rover):=q;@/
-if t>mem_bot+max_halfword then t:=mem_bot+max_halfword;
-rlink(q):=rover; llink(q):=p; link(q):=empty_flag; node_size(q):=t-lo_mem_max;@/
-lo_mem_max:=t; link(lo_mem_max):=null; info(lo_mem_max):=null;
-rover:=q; goto restart;
-end
-
-@ Empirical tests show that the routine in this section performs a
-node-merging operation about 0.75 times per allocation, on the average,
-after which it finds that |r>p+1| about 95\pct! of the time.
-
-@<Try to allocate...@>=
-q:=p+node_size(p); {find the physical successor}
-@^inner loop@>
-while is_empty(q) do {merge node |p| with node |q|}
- begin t:=rlink(q);
- if q=rover then rover:=t;
- llink(t):=llink(q); rlink(llink(q)):=t;@/
- q:=q+node_size(q);
- end;
-r:=q-s;
-if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
-if r=p then if rlink(p)<>p then
- @<Allocate entire node |p| and |goto found|@>;
-node_size(p):=q-p {reset the size in case it grew}
-
-@ @<Allocate from the top...@>=
-begin node_size(p):=r-p; {store the remaining size}
-@^inner loop@>
-rover:=p; {start searching here next time}
-goto found;
-end
-
-@ Here we delete node |p| from the ring, and let |rover| rove around.
-
-@<Allocate entire...@>=
-begin rover:=rlink(p); t:=llink(p);
-llink(rover):=t; rlink(t):=rover;
-goto found;
-end
-
-@ Conversely, when some variable-size node |p| of size |s| is no longer needed,
-the operation |free_node(p,s)| will make its words available, by inserting
-|p| as a new empty node just before where |rover| now points.
-@^inner loop@>
-
-@p procedure free_node(@!p:pointer; @!s:halfword); {variable-size node
- liberation}
-var q:pointer; {|llink(rover)|}
-begin node_size(p):=s; link(p):=empty_flag;
-q:=llink(rover); llink(p):=q; rlink(p):=rover; {set both links}
-llink(rover):=p; rlink(q):=p; {insert |p| into the ring}
-@!stat var_used:=var_used-s;@+tats@;{maintain statistics}
-end;
-
-@ Just before \.{INITEX} writes out the memory, it sorts the doubly linked
-available space list. The list is probably very short at such times, so a
-simple insertion sort is used. The smallest available location will be
-pointed to by |rover|, the next-smallest by |rlink(rover)|, etc.
-
-@p @!init procedure sort_avail; {sorts the available variable-size nodes
- by location}
-var p,@!q,@!r: pointer; {indices into |mem|}
-@!old_rover:pointer; {initial |rover| setting}
-begin p:=get_node(@'10000000000); {merge adjacent free areas}
-p:=rlink(rover); rlink(rover):=max_halfword; old_rover:=rover;
-while p<>old_rover do @<Sort \(p)|p| into the list starting at |rover|
- and advance |p| to |rlink(p)|@>;
-p:=rover;
-while rlink(p)<>max_halfword do
- begin llink(rlink(p)):=p; p:=rlink(p);
- end;
-rlink(p):=rover; llink(rover):=p;
-end;
-tini
-
-@ The following |while| loop is guaranteed to
-terminate, since the list that starts at
-|rover| ends with |max_halfword| during the sorting procedure.
-
-@<Sort \(p)|p|...@>=
-if p<rover then
- begin q:=p; p:=rlink(q); rlink(q):=rover; rover:=q;
- end
-else begin q:=rover;
- while rlink(q)<p do q:=rlink(q);
- r:=rlink(p); rlink(p):=rlink(q); rlink(q):=p; p:=r;
- end
-
-@* \[10] Data structures for boxes and their friends.
-From the computer's standpoint, \TeX's chief mission is to create
-horizontal and vertical lists. We shall now investigate how the elements
-of these lists are represented internally as nodes in the dynamic memory.
-
-A horizontal or vertical list is linked together by |link| fields in
-the first word of each node. Individual nodes represent boxes, glue,
-penalties, or special things like discretionary hyphens; because of this
-variety, some nodes are longer than others, and we must distinguish different
-kinds of nodes. We do this by putting a `|type|' field in the first word,
-together with the link and an optional `|subtype|'.
-
-@d type(#) == mem[#].hh.b0 {identifies what kind of node this is}
-@d subtype(#) == mem[#].hh.b1 {secondary identification in some cases}
-
-@ A |@!char_node|, which represents a single character, is the most important
-kind of node because it accounts for the vast majority of all boxes.
-Special precautions are therefore taken to ensure that a |char_node| does
-not take up much memory space. Every such node is one word long, and in fact
-it is identifiable by this property, since other kinds of nodes have at least
-two words, and they appear in |mem| locations less than |hi_mem_min|.
-This makes it possible to omit the |type| field in a |char_node|, leaving
-us room for two bytes that identify a |font| and a |character| within
-that font.
-
-Note that the format of a |char_node| allows for up to 256 different
-fonts and up to 256 characters per font; but most implementations will
-probably limit the total number of fonts to fewer than 75 per job,
-and most fonts will stick to characters whose codes are
-less than 128 (since higher codes
-are more difficult to access on most keyboards).
-
-Extensions of \TeX\ intended for oriental languages will need even more
-than $256\times256$ possible characters, when we consider different sizes
-@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
-and styles of type. It is suggested that Chinese and Japanese fonts be
-handled by representing such characters in two consecutive |char_node|
-entries: The first of these has |font=font_base|, and its |link| points
-to the second;
-the second identifies the font and the character dimensions.
-The saving feature about oriental characters is that most of them have
-the same box dimensions. The |character| field of the first |char_node|
-is a ``\\{charext}'' that distinguishes between graphic symbols whose
-dimensions are identical for typesetting purposes. (See the \MF\ manual.)
-Such an extension of \TeX\ would not be difficult; further details are
-left to the reader.
-
-In order to make sure that the |character| code fits in a quarterword,
-\TeX\ adds the quantity |min_quarterword| to the actual code.
-
-Character nodes appear only in horizontal lists, never in vertical lists.
-
-@d is_char_node(#) == (#>=hi_mem_min)
- {does the argument point to a |char_node|?}
-@d font == type {the font code in a |char_node|}
-@d character == subtype {the character code in a |char_node|}
-
-@ An |hlist_node| stands for a box that was made from a horizontal list.
-Each |hlist_node| is seven words long, and contains the following fields
-(in addition to the mandatory |type| and |link|, which we shall not
-mention explicitly when discussing the other node types): The |height| and
-|width| and |depth| are scaled integers denoting the dimensions of the
-box. There is also a |shift_amount| field, a scaled integer indicating
-how much this box should be lowered (if it appears in a horizontal list),
-or how much it should be moved to the right (if it appears in a vertical
-list). There is a |list_ptr| field, which points to the beginning of the
-list from which this box was fabricated; if |list_ptr| is |null|, the box
-is empty. Finally, there are three fields that represent the setting of
-the glue: |glue_set(p)| is a word of type |glue_ratio| that represents
-the proportionality constant for glue setting; |glue_sign(p)| is
-|stretching| or |shrinking| or |normal| depending on whether or not the
-glue should stretch or shrink or remain rigid; and |glue_order(p)|
-specifies the order of infinity to which glue setting applies (|normal|,
-|fil|, |fill|, or |filll|). The |subtype| field is not used in \TeX.
-In \eTeX\ the |subtype| field records the box direction mode |box_lr|.
-
-@d hlist_node=0 {|type| of hlist nodes}
-@d box_node_size=7 {number of words to allocate for a box node}
-@d width_offset=1 {position of |width| field in a box node}
-@d depth_offset=2 {position of |depth| field in a box node}
-@d height_offset=3 {position of |height| field in a box node}
-@d width(#) == mem[#+width_offset].sc {width of the box, in sp}
-@d depth(#) == mem[#+depth_offset].sc {depth of the box, in sp}
-@d height(#) == mem[#+height_offset].sc {height of the box, in sp}
-@d shift_amount(#) == mem[#+4].sc {repositioning distance, in sp}
-@d list_offset=5 {position of |list_ptr| field in a box node}
-@d list_ptr(#) == link(#+list_offset) {beginning of the list inside the box}
-@d glue_order(#) == subtype(#+list_offset) {applicable order of infinity}
-@d glue_sign(#) == type(#+list_offset) {stretching or shrinking}
-@d normal=0 {the most common case when several cases are named}
-@d stretching = 1 {glue setting applies to the stretch components}
-@d shrinking = 2 {glue setting applies to the shrink components}
-@d glue_offset = 6 {position of |glue_set| in a box node}
-@d glue_set(#) == mem[#+glue_offset].gr
- {a word of type |glue_ratio| for glue setting}
-
-@ The |new_null_box| function returns a pointer to an |hlist_node| in
-which all subfields have the values corresponding to `\.{\\hbox\{\}}'.
-(The |subtype| field is set to |min_quarterword|, for historic reasons
-that are no longer relevant.)
-
-@p function new_null_box:pointer; {creates a new box node}
-var p:pointer; {the new node}
-begin p:=get_node(box_node_size); type(p):=hlist_node;
-subtype(p):=min_quarterword;
-width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
-glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
-new_null_box:=p;
-end;
-
-@ A |vlist_node| is like an |hlist_node| in all respects except that it
-contains a vertical list.
-
-@d vlist_node=1 {|type| of vlist nodes}
-
-@ A |rule_node| stands for a solid black rectangle; it has |width|,
-|depth|, and |height| fields just as in an |hlist_node|. However, if
-any of these dimensions is $-2^{30}$, the actual value will be determined
-by running the rule up to the boundary of the innermost enclosing box.
-This is called a ``running dimension.'' The |width| is never running in
-an hlist; the |height| and |depth| are never running in a~vlist.
-
-@d rule_node=2 {|type| of rule nodes}
-@d rule_node_size=4 {number of words to allocate for a rule node}
-@d null_flag==-@'10000000000 {$-2^{30}$, signifies a missing item}
-@d is_running(#) == (#=null_flag) {tests for a running dimension}
-
-@ A new rule node is delivered by the |new_rule| function. It
-makes all the dimensions ``running,'' so you have to change the
-ones that are not allowed to run.
-
-@p function new_rule:pointer;
-var p:pointer; {the new node}
-begin p:=get_node(rule_node_size); type(p):=rule_node;
-subtype(p):=0; {the |subtype| is not used}
-width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag;
-new_rule:=p;
-end;
-
-@ Insertions are represented by |ins_node| records, where the |subtype|
-indicates the corresponding box number. For example, `\.{\\insert 250}'
-leads to an |ins_node| whose |subtype| is |250+min_quarterword|.
-The |height| field of an |ins_node| is slightly misnamed; it actually holds
-the natural height plus depth of the vertical list being inserted.
-The |depth| field holds the |split_max_depth| to be used in case this
-insertion is split, and the |split_top_ptr| points to the corresponding
-|split_top_skip|. The |float_cost| field holds the |floating_penalty| that
-will be used if this insertion floats to a subsequent page after a
-split insertion of the same class. There is one more field, the
-|ins_ptr|, which points to the beginning of the vlist for the insertion.
-
-@d ins_node=3 {|type| of insertion nodes}
-@d ins_node_size=5 {number of words to allocate for an insertion}
-@d float_cost(#)==mem[#+1].int {the |floating_penalty| to be used}
-@d ins_ptr(#)==info(#+4) {the vertical list to be inserted}
-@d split_top_ptr(#)==link(#+4) {the |split_top_skip| to be used}
-
-@ A |mark_node| has a |mark_ptr| field that points to the reference count
-of a token list that contains the user's \.{\\mark} text.
-In addition there is a |mark_class| field that contains the mark class.
-
-@d mark_node=4 {|type| of a mark node}
-@d small_node_size=2 {number of words to allocate for most node types}
-@d mark_ptr(#)==link(#+1) {head of the token list for a mark}
-@d mark_class(#)==info(#+1) {the mark class}
-
-@ An |adjust_node|, which occurs only in horizontal lists,
-specifies material that will be moved out into the surrounding
-vertical list; i.e., it is used to implement \TeX's `\.{\\vadjust}'
-operation. The |adjust_ptr| field points to the vlist containing this
-material.
-
-@d adjust_node=5 {|type| of an adjust node}
-@d adjust_pre == subtype {<>0 => pre-adjustment}
-@#{|append_list| is used to append a list to |tail|}
-@d append_list(#) == begin link(tail) := link(#); append_list_end
-@d append_list_end(#) == tail := #; end
-
-@d adjust_ptr(#)==mem[#+1].int
- {vertical list to be moved out of horizontal list}
-
-@ A |ligature_node|, which occurs only in horizontal lists, specifies
-a character that was fabricated from the interaction of two or more
-actual characters. The second word of the node, which is called the
-|lig_char| word, contains |font| and |character| fields just as in a
-|char_node|. The characters that generated the ligature have not been
-forgotten, since they are needed for diagnostic messages and for
-hyphenation; the |lig_ptr| field points to a linked list of character
-nodes for all original characters that have been deleted. (This list
-might be empty if the characters that generated the ligature were
-retained in other nodes.)
-
-The |subtype| field is 0, plus 2 and/or 1 if the original source of the
-ligature included implicit left and/or right boundaries.
-
-@d ligature_node=6 {|type| of a ligature node}
-@d lig_char(#)==#+1 {the word where the ligature is to be found}
-@d lig_ptr(#)==link(lig_char(#)) {the list of characters}
-
-@ The |new_ligature| function creates a ligature node having given
-contents of the |font|, |character|, and |lig_ptr| fields. We also have
-a |new_lig_item| function, which returns a two-word node having a given
-|character| field. Such nodes are used for temporary processing as ligatures
-are being created.
-
-@p function new_ligature(@!f,@!c:quarterword; @!q:pointer):pointer;
-var p:pointer; {the new node}
-begin p:=get_node(small_node_size); type(p):=ligature_node;
-font(lig_char(p)):=f; character(lig_char(p)):=c; lig_ptr(p):=q;
-subtype(p):=0; new_ligature:=p;
-end;
-@#
-function new_lig_item(@!c:quarterword):pointer;
-var p:pointer; {the new node}
-begin p:=get_node(small_node_size); character(p):=c; lig_ptr(p):=null;
-new_lig_item:=p;
-end;
-
-@ A |disc_node|, which occurs only in horizontal lists, specifies a
-``dis\-cretion\-ary'' line break. If such a break occurs at node |p|, the text
-that starts at |pre_break(p)| will precede the break, the text that starts at
-|post_break(p)| will follow the break, and text that appears in the next
-|replace_count(p)| nodes will be ignored. For example, an ordinary
-discretionary hyphen, indicated by `\.{\\-}', yields a |disc_node| with
-|pre_break| pointing to a |char_node| containing a hyphen, |post_break=null|,
-and |replace_count=0|. All three of the discretionary texts must be
-lists that consist entirely of character, kern, box, rule, and ligature nodes.
-
-If |pre_break(p)=null|, the |ex_hyphen_penalty| will be charged for this
-break. Otherwise the |hyphen_penalty| will be charged. The texts will
-actually be substituted into the list by the line-breaking algorithm if it
-decides to make the break, and the discretionary node will disappear at
-that time; thus, the output routine sees only discretionaries that were
-not chosen.
-
-@d disc_node=7 {|type| of a discretionary node}
-@d replace_count==subtype {how many subsequent nodes to replace}
-@d pre_break==llink {text that precedes a discretionary break}
-@d post_break==rlink {text that follows a discretionary break}
-
-@p function new_disc:pointer; {creates an empty |disc_node|}
-var p:pointer; {the new node}
-begin p:=get_node(small_node_size); type(p):=disc_node;
-replace_count(p):=0; pre_break(p):=null; post_break(p):=null;
-new_disc:=p;
-end;
-
-@ A |whatsit_node| is a wild card reserved for extensions to \TeX. The
-|subtype| field in its first word says what `\\{whatsit}' it is, and
-implicitly determines the node size (which must be 2 or more) and the
-format of the remaining words. When a |whatsit_node| is encountered
-in a list, special actions are invoked; knowledgeable people who are
-careful not to mess up the rest of \TeX\ are able to make \TeX\ do new
-things by adding code at the end of the program. For example, there
-might be a `\TeX nicolor' extension to specify different colors of ink,
-@^extensions to \TeX@>
-and the whatsit node might contain the desired parameters.
-
-The present implementation of \TeX\ treats the features associated with
-`\.{\\write}' and `\.{\\special}' as if they were extensions, in order to
-illustrate how such routines might be coded. We shall defer further
-discussion of extensions until the end of this program.
-
-@d whatsit_node=8 {|type| of special extension nodes}
-
-@ A |math_node|, which occurs only in horizontal lists, appears before and
-after mathematical formulas. The |subtype| field is |before| before the
-formula and |after| after it. There is a |width| field, which represents
-the amount of surrounding space inserted by \.{\\mathsurround}.
-
-In addition a |math_node| with |subtype>after| and |width=0| will be
-(ab)used to record a regular |math_node| reinserted after being
-discarded at a line break or one of the text direction primitives (
-\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} ).
-
-@d math_node=9 {|type| of a math node}
-@d before=0 {|subtype| for math node that introduces a formula}
-@d after=1 {|subtype| for math node that winds up a formula}
-@#
-@d M_code=2
-@d begin_M_code=M_code+before {|subtype| for \.{\\beginM} node}
-@d end_M_code=M_code+after {|subtype| for \.{\\endM} node}
-@d L_code=4
-@d begin_L_code=L_code+begin_M_code {|subtype| for \.{\\beginL} node}
-@d end_L_code=L_code+end_M_code {|subtype| for \.{\\endL} node}
-@d R_code=L_code+L_code
-@d begin_R_code=R_code+begin_M_code {|subtype| for \.{\\beginR} node}
-@d end_R_code=R_code+end_M_code {|subtype| for \.{\\endR} node}
-@#
-@d end_LR(#)==odd(subtype(#))
-@d end_LR_type(#)==(L_code*(subtype(#) div L_code)+end_M_code)
-@d begin_LR_type(#)==(#-after+before)
-
-@p function new_math(@!w:scaled;@!s:small_number):pointer;
-var p:pointer; {the new node}
-begin p:=get_node(small_node_size); type(p):=math_node;
-subtype(p):=s; width(p):=w; new_math:=p;
-end;
-
-@ \TeX\ makes use of the fact that |hlist_node|, |vlist_node|,
-|rule_node|, |ins_node|, |mark_node|, |adjust_node|, |ligature_node|,
-|disc_node|, |whatsit_node|, and |math_node| are at the low end of the
-type codes, by permitting a break at glue in a list if and only if the
-|type| of the previous node is less than |math_node|. Furthermore, a
-node is discarded after a break if its type is |math_node| or~more.
-
-@d precedes_break(#)==(type(#)<math_node)
-@d non_discardable(#)==(type(#)<math_node)
-
-@ A |glue_node| represents glue in a list. However, it is really only
-a pointer to a separate glue specification, since \TeX\ makes use of the
-fact that many essentially identical nodes of glue are usually present.
-If |p| points to a |glue_node|, |glue_ptr(p)| points to
-another packet of words that specify the stretch and shrink components, etc.
-
-Glue nodes also serve to represent leaders; the |subtype| is used to
-distinguish between ordinary glue (which is called |normal|) and the three
-kinds of leaders (which are called |a_leaders|, |c_leaders|, and |x_leaders|).
-The |leader_ptr| field points to a rule node or to a box node containing the
-leaders; it is set to |null| in ordinary glue nodes.
-
-Many kinds of glue are computed from \TeX's ``skip'' parameters, and
-it is helpful to know which parameter has led to a particular glue node.
-Therefore the |subtype| is set to indicate the source of glue, whenever
-it originated as a parameter. We will be defining symbolic names for the
-parameter numbers later (e.g., |line_skip_code=0|, |baseline_skip_code=1|,
-etc.); it suffices for now to say that the |subtype| of parametric glue
-will be the same as the parameter number, plus~one.
-
-In math formulas there are two more possibilities for the |subtype| in a
-glue node: |mu_glue| denotes an \.{\\mskip} (where the units are scaled \.{mu}
-instead of scaled \.{pt}); and |cond_math_glue| denotes the `\.{\\nonscript}'
-feature that cancels the glue node immediately following if it appears
-in a subscript.
-
-@d glue_node=10 {|type| of node that points to a glue specification}
-@d cond_math_glue=98 {special |subtype| to suppress glue in the next node}
-@d mu_glue=99 {|subtype| for math glue}
-@d a_leaders=100 {|subtype| for aligned leaders}
-@d c_leaders=101 {|subtype| for centered leaders}
-@d x_leaders=102 {|subtype| for expanded leaders}
-@d glue_ptr==llink {pointer to a glue specification}
-@d leader_ptr==rlink {pointer to box or rule node for leaders}
-
-@ A glue specification has a halfword reference count in its first word,
-@^reference counts@>
-representing |null| plus the number of glue nodes that point to it (less one).
-Note that the reference count appears in the same position as
-the |link| field in list nodes; this is the field that is initialized
-to |null| when a node is allocated, and it is also the field that is flagged
-by |empty_flag| in empty nodes.
-
-Glue specifications also contain three |scaled| fields, for the |width|,
-|stretch|, and |shrink| dimensions. Finally, there are two one-byte
-fields called |stretch_order| and |shrink_order|; these contain the
-orders of infinity (|normal|, |fil|, |fill|, or |filll|)
-corresponding to the stretch and shrink values.
-
-@d glue_spec_size=4 {number of words to allocate for a glue specification}
-@d glue_ref_count(#) == link(#) {reference count of a glue specification}
-@d stretch(#) == mem[#+2].sc {the stretchability of this glob of glue}
-@d shrink(#) == mem[#+3].sc {the shrinkability of this glob of glue}
-@d stretch_order == type {order of infinity for stretching}
-@d shrink_order == subtype {order of infinity for shrinking}
-@d fil=1 {first-order infinity}
-@d fill=2 {second-order infinity}
-@d filll=3 {third-order infinity}
-
-@<Types...@>=
-@!glue_ord=normal..filll; {infinity to the 0, 1, 2, or 3 power}
-
-@ Here is a function that returns a pointer to a copy of a glue spec.
-The reference count in the copy is |null|, because there is assumed
-to be exactly one reference to the new specification.
-
-@p function new_spec(@!p:pointer):pointer; {duplicates a glue specification}
-var q:pointer; {the new spec}
-begin q:=get_node(glue_spec_size);@/
-mem[q]:=mem[p]; glue_ref_count(q):=null;@/
-width(q):=width(p); stretch(q):=stretch(p); shrink(q):=shrink(p);
-new_spec:=q;
-end;
-
-@ And here's a function that creates a glue node for a given parameter
-identified by its code number; for example,
-|new_param_glue(line_skip_code)| returns a pointer to a glue node for the
-current \.{\\lineskip}.
-
-@p function new_param_glue(@!n:small_number):pointer;
-var p:pointer; {the new node}
-@!q:pointer; {the glue specification}
-begin p:=get_node(small_node_size); type(p):=glue_node; subtype(p):=n+1;
-leader_ptr(p):=null;@/
-q:=@<Current |mem| equivalent of glue parameter number |n|@>@t@>;
-glue_ptr(p):=q; incr(glue_ref_count(q));
-new_param_glue:=p;
-end;
-
-@ Glue nodes that are more or less anonymous are created by |new_glue|,
-whose argument points to a glue specification.
-
-@p function new_glue(@!q:pointer):pointer;
-var p:pointer; {the new node}
-begin p:=get_node(small_node_size); type(p):=glue_node; subtype(p):=normal;
-leader_ptr(p):=null; glue_ptr(p):=q; incr(glue_ref_count(q));
-new_glue:=p;
-end;
-
-@ Still another subroutine is needed: This one is sort of a combination
-of |new_param_glue| and |new_glue|. It creates a glue node for one of
-the current glue parameters, but it makes a fresh copy of the glue
-specification, since that specification will probably be subject to change,
-while the parameter will stay put. The global variable |temp_ptr| is
-set to the address of the new spec.
-
-@p function new_skip_param(@!n:small_number):pointer;
-var p:pointer; {the new node}
-begin temp_ptr:=new_spec(@<Current |mem| equivalent of glue parameter...@>);
-p:=new_glue(temp_ptr); glue_ref_count(temp_ptr):=null; subtype(p):=n+1;
-new_skip_param:=p;
-end;
-
-@ A |kern_node| has a |width| field to specify a (normally negative)
-amount of spacing. This spacing correction appears in horizontal lists
-between letters like A and V when the font designer said that it looks
-better to move them closer together or further apart. A kern node can
-also appear in a vertical list, when its `|width|' denotes additional
-spacing in the vertical direction. The |subtype| is either |normal| (for
-kerns inserted from font information or math mode calculations) or |explicit|
-(for kerns inserted from \.{\\kern} and \.{\\/} commands) or |acc_kern|
-(for kerns inserted from non-math accents) or |mu_glue| (for kerns
-inserted from \.{\\mkern} specifications in math formulas).
-
-@d kern_node=11 {|type| of a kern node}
-@d explicit=1 {|subtype| of kern nodes from \.{\\kern} and \.{\\/}}
-@d acc_kern=2 {|subtype| of kern nodes from accents}
-@d auto_kern=3 {|subtype| of kern nodes created by |get_auto_kern|}
-
-@# {memory structure for marginal kerns}
-@d margin_kern_node = 40
-@d margin_kern_node_size = 3
-@d margin_char(#) == info(# + 2)
-
-@# {|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 kn_bs_code_base == 7
-@d st_bs_code_base == 8
-@d sh_bs_code_base == 9
-@d kn_bc_code_base == 10
-@d kn_ac_code_base == 11
-
-
-@d no_lig_code == 6
-
-@d max_hlist_stack = 512 {maximum fill level for |hlist_stack|}
-{maybe good if larger than |2 * max_quarterword|, so that box nesting level would overflow first}
-
-@ The |new_kern| function creates a kern node having a given width.
-
-@p function new_kern(@!w:scaled):pointer;
-var p:pointer; {the new node}
-begin p:=get_node(small_node_size); type(p):=kern_node;
-subtype(p):=normal;
-width(p):=w;
-new_kern:=p;
-end;
-
-@ A |penalty_node| specifies the penalty associated with line or page
-breaking, in its |penalty| field. This field is a fullword integer, but
-the full range of integer values is not used: Any penalty |>=10000| is
-treated as infinity, and no break will be allowed for such high values.
-Similarly, any penalty |<=-10000| is treated as negative infinity, and a
-break will be forced.
-
-@d penalty_node=12 {|type| of a penalty node}
-@d inf_penalty=inf_bad {``infinite'' penalty value}
-@d eject_penalty=-inf_penalty {``negatively infinite'' penalty value}
-@d penalty(#) == mem[#+1].int {the added cost of breaking a list here}
-
-@ Anyone who has been reading the last few sections of the program will
-be able to guess what comes next.
-
-@p function new_penalty(@!m:integer):pointer;
-var p:pointer; {the new node}
-begin p:=get_node(small_node_size); type(p):=penalty_node;
-subtype(p):=0; {the |subtype| is not used}
-penalty(p):=m; new_penalty:=p;
-end;
-
-@ You might think that we have introduced enough node types by now. Well,
-almost, but there is one more: An |unset_node| has nearly the same format
-as an |hlist_node| or |vlist_node|; it is used for entries in \.{\\halign}
-or \.{\\valign} that are not yet in their final form, since the box
-dimensions are their ``natural'' sizes before any glue adjustment has been
-made. The |glue_set| word is not present; instead, we have a |glue_stretch|
-field, which contains the total stretch of order |glue_order| that is
-present in the hlist or vlist being boxed.
-Similarly, the |shift_amount| field is replaced by a |glue_shrink| field,
-containing the total shrink of order |glue_sign| that is present.
-The |subtype| field is called |span_count|; an unset box typically
-contains the data for |qo(span_count)+1| columns.
-Unset nodes will be changed to box nodes when alignment is completed.
-
-@d unset_node=13 {|type| for an unset node}
-@d glue_stretch(#)==mem[#+glue_offset].sc {total stretch in an unset node}
-@d glue_shrink==shift_amount {total shrink in an unset node}
-@d span_count==subtype {indicates the number of spanned columns}
-
-@ In fact, there are still more types coming. When we get to math formula
-processing we will see that a |style_node| has |type=14|; and a number
-of larger type codes will also be defined, for use in math mode only.
-
-@ Warning: If any changes are made to these data structure layouts, such as
-changing any of the node sizes or even reordering the words of nodes,
-the |copy_node_list| procedure and the memory initialization code
-below may have to be changed. Such potentially dangerous parts of the
-program are listed in the index under `data structure assumptions'.
-@!@^data structure assumptions@>
-However, other references to the nodes are made symbolically in terms of
-the \.{WEB} macro definitions above, so that format changes will leave
-\TeX's other algorithms intact.
-@^system dependencies@>
-
-@* \[11] Memory layout.
-Some areas of |mem| are dedicated to fixed usage, since static allocation is
-more efficient than dynamic allocation when we can get away with it. For
-example, locations |mem_bot| to |mem_bot+3| are always used to store the
-specification for glue that is `\.{0pt plus 0pt minus 0pt}'. The
-following macro definitions accomplish the static allocation by giving
-symbolic names to the fixed positions. Static variable-size nodes appear
-in locations |mem_bot| through |lo_mem_stat_max|, and static single-word nodes
-appear in locations |hi_mem_stat_min| through |mem_top|, inclusive. It is
-harmless to let |lig_trick| and |garbage| share the same location of |mem|.
-
-@d zero_glue==mem_bot {specification for \.{0pt plus 0pt minus 0pt}}
-@d fil_glue==zero_glue+glue_spec_size {\.{0pt plus 1fil minus 0pt}}
-@d fill_glue==fil_glue+glue_spec_size {\.{0pt plus 1fill minus 0pt}}
-@d ss_glue==fill_glue+glue_spec_size {\.{0pt plus 1fil minus 1fil}}
-@d fil_neg_glue==ss_glue+glue_spec_size {\.{0pt plus -1fil minus 0pt}}
-@d lo_mem_stat_max==fil_neg_glue+glue_spec_size-1 {largest statically
- allocated word in the variable-size |mem|}
-@#
-@d page_ins_head==mem_top {list of insertion data for current page}
-@d contrib_head==mem_top-1 {vlist of items not yet on current page}
-@d page_head==mem_top-2 {vlist for current page}
-@d temp_head==mem_top-3 {head of a temporary list of some kind}
-@d hold_head==mem_top-4 {head of a temporary list of another kind}
-@d adjust_head==mem_top-5 {head of adjustment list returned by |hpack|}
-@d active==mem_top-7 {head of active list in |line_break|, needs two words}
-@d align_head==mem_top-8 {head of preamble list for alignments}
-@d end_span==mem_top-9 {tail of spanned-width lists}
-@d omit_template==mem_top-10 {a constant token list}
-@d null_list==mem_top-11 {permanently empty list}
-@d lig_trick==mem_top-12 {a ligature masquerading as a |char_node|}
-@d garbage==mem_top-12 {used for scrap information}
-@d backup_head==mem_top-13 {head of token list built by |scan_keyword|}
-@d pre_adjust_head==mem_top-14 {head of pre-adjustment list returned by |hpack|}
-@d hi_mem_stat_min==mem_top-14 {smallest statically allocated word in
- the one-word |mem|}
-@d hi_mem_stat_usage=15 {the number of one-word nodes always present}
-
-@ The following code gets |mem| off to a good start, when \TeX\ is
-initializing itself the slow~way.
-
-@<Local variables for init...@>=
-@!k:integer; {index into |mem|, |eqtb|, etc.}
-
-@ @<Initialize table entries...@>=
-for k:=mem_bot+1 to lo_mem_stat_max do mem[k].sc:=0;
- {all glue dimensions are zeroed}
-@^data structure assumptions@>
-k:=mem_bot;@+while k<=lo_mem_stat_max do
- {set first words of glue specifications}
- begin glue_ref_count(k):=null+1;
- stretch_order(k):=normal; shrink_order(k):=normal;
- k:=k+glue_spec_size;
- end;
-stretch(fil_glue):=unity; stretch_order(fil_glue):=fil;@/
-stretch(fill_glue):=unity; stretch_order(fill_glue):=fill;@/
-stretch(ss_glue):=unity; stretch_order(ss_glue):=fil;@/
-shrink(ss_glue):=unity; shrink_order(ss_glue):=fil;@/
-stretch(fil_neg_glue):=-unity; stretch_order(fil_neg_glue):=fil;@/
-rover:=lo_mem_stat_max+1;
-link(rover):=empty_flag; {now initialize the dynamic memory}
-node_size(rover):=1000; {which is a 1000-word available node}
-llink(rover):=rover; rlink(rover):=rover;@/
-lo_mem_max:=rover+1000; link(lo_mem_max):=null; info(lo_mem_max):=null;@/
-for k:=hi_mem_stat_min to mem_top do
- mem[k]:=mem[lo_mem_max]; {clear list heads}
-@<Initialize the special list heads and constant nodes@>;
-avail:=null; mem_end:=mem_top;
-hi_mem_min:=hi_mem_stat_min; {initialize the one-word memory}
-var_used:=lo_mem_stat_max+1-mem_bot; dyn_used:=hi_mem_stat_usage;
- {initialize statistics}
-
-@ If \TeX\ is extended improperly, the |mem| array might get screwed up.
-For example, some pointers might be wrong, or some ``dead'' nodes might not
-have been freed when the last reference to them disappeared. Procedures
-|check_mem| and |search_mem| are available to help diagnose such
-problems. These procedures make use of two arrays called |free| and
-|was_free| that are present only if \TeX's debugging routines have
-been included. (You may want to decrease the size of |mem| while you
-@^debugging@>
-are debugging.)
-
-@<Glob...@>=
-@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
-@t\hskip10pt@>@!was_free: packed array [mem_min..mem_max] of boolean;
- {previously free cells}
-@t\hskip10pt@>@!was_mem_end,@!was_lo_max,@!was_hi_min: pointer;
- {previous |mem_end|, |lo_mem_max|, and |hi_mem_min|}
-@t\hskip10pt@>@!panicking:boolean; {do we want to check memory constantly?}
-gubed
-
-@ @<Set initial...@>=
-@!debug was_mem_end:=mem_min; {indicate that everything was previously free}
-was_lo_max:=mem_min; was_hi_min:=mem_max;
-panicking:=false;
-gubed
-
-@ Procedure |check_mem| makes sure that the available space lists of
-|mem| are well formed, and it optionally prints out all locations
-that are reserved now but were free the last time this procedure was called.
-
-@p @!debug procedure check_mem(@!print_locs : boolean);
-label done1,done2; {loop exits}
-var p,@!q:pointer; {current locations of interest in |mem|}
-@!clobbered:boolean; {is something amiss?}
-begin for p:=mem_min to lo_mem_max do free[p]:=false; {you can probably
- do this faster}
-for p:=hi_mem_min to mem_end do free[p]:=false; {ditto}
-@<Check single-word |avail| list@>;
-@<Check variable-size |avail| list@>;
-@<Check flags of unavailable nodes@>;
-if print_locs then @<Print newly busy locations@>;
-for p:=mem_min to lo_mem_max do was_free[p]:=free[p];
-for p:=hi_mem_min to mem_end do was_free[p]:=free[p];
- {|was_free:=free| might be faster}
-was_mem_end:=mem_end; was_lo_max:=lo_mem_max; was_hi_min:=hi_mem_min;
-end;
-gubed
-
-@ @<Check single-word...@>=
-p:=avail; q:=null; clobbered:=false;
-while p<>null do
- begin if (p>mem_end)or(p<hi_mem_min) then clobbered:=true
- else if free[p] then clobbered:=true;
- if clobbered then
- begin print_nl("AVAIL list clobbered at ");
-@.AVAIL list clobbered...@>
- print_int(q); goto done1;
- end;
- free[p]:=true; q:=p; p:=link(q);
- end;
-done1:
-
-@ @<Check variable-size...@>=
-p:=rover; q:=null; clobbered:=false;
-repeat if (p>=lo_mem_max)or(p<mem_min) then clobbered:=true
- else if (rlink(p)>=lo_mem_max)or(rlink(p)<mem_min) then clobbered:=true
- else if not(is_empty(p))or(node_size(p)<2)or@|
- (p+node_size(p)>lo_mem_max)or@| (llink(rlink(p))<>p) then clobbered:=true;
- if clobbered then
- begin print_nl("Double-AVAIL list clobbered at ");
- print_int(q); goto done2;
- end;
-for q:=p to p+node_size(p)-1 do {mark all locations free}
- begin if free[q] then
- begin print_nl("Doubly free location at ");
-@.Doubly free location...@>
- print_int(q); goto done2;
- end;
- free[q]:=true;
- end;
-q:=p; p:=rlink(p);
-until p=rover;
-done2:
-
-@ @<Check flags...@>=
-p:=mem_min;
-while p<=lo_mem_max do {node |p| should not be empty}
- begin if is_empty(p) then
- begin print_nl("Bad flag at "); print_int(p);
-@.Bad flag...@>
- end;
- while (p<=lo_mem_max) and not free[p] do incr(p);
- while (p<=lo_mem_max) and free[p] do incr(p);
- end
-
-@ @<Print newly busy...@>=
-begin print_nl("New busy locs:");
-for p:=mem_min to lo_mem_max do
- if not free[p] and ((p>was_lo_max) or was_free[p]) then
- begin print_char(" "); print_int(p);
- end;
-for p:=hi_mem_min to mem_end do
- if not free[p] and
- ((p<was_hi_min) or (p>was_mem_end) or was_free[p]) then
- begin print_char(" "); print_int(p);
- end;
-end
-
-@ The |search_mem| procedure attempts to answer the question ``Who points
-to node~|p|?'' In doing so, it fetches |link| and |info| fields of |mem|
-that might not be of type |two_halves|. Strictly speaking, this is
-@^dirty \PASCAL@>
-undefined in \PASCAL, and it can lead to ``false drops'' (words that seem to
-point to |p| purely by coincidence). But for debugging purposes, we want
-to rule out the places that do {\sl not\/} point to |p|, so a few false
-drops are tolerable.
-
-@p @!debug procedure search_mem(@!p:pointer); {look for pointers to |p|}
-var q:integer; {current position being searched}
-begin for q:=mem_min to lo_mem_max do
- begin if link(q)=p then
- begin print_nl("LINK("); print_int(q); print_char(")");
- end;
- if info(q)=p then
- begin print_nl("INFO("); print_int(q); print_char(")");
- end;
- end;
-for q:=hi_mem_min to mem_end do
- begin if link(q)=p then
- begin print_nl("LINK("); print_int(q); print_char(")");
- end;
- if info(q)=p then
- begin print_nl("INFO("); print_int(q); print_char(")");
- end;
- end;
-@<Search |eqtb| for equivalents equal to |p|@>;
-@<Search |save_stack| for equivalents that point to |p|@>;
-@<Search |hyph_list| for pointers to |p|@>;
-end;
-gubed
-
-@<Declare procedures that need to be declared forward for \pdfTeX@>@;
-
-@* \[12] Displaying boxes.
-We can reinforce our knowledge of the data structures just introduced
-by considering two procedures that display a list in symbolic form.
-The first of these, called |short_display|, is used in ``overfull box''
-messages to give the top-level description of a list. The other one,
-called |show_node_list|, prints a detailed description of exactly what
-is in the data structure.
-
-The philosophy of |short_display| is to ignore the fine points about exactly
-what is inside boxes, except that ligatures and discretionary breaks are
-expanded. As a result, |short_display| is a recursive procedure, but the
-recursion is never more than one level deep.
-@^recursion@>
-
-A global variable |font_in_short_display| keeps track of the font code that
-is assumed to be present when |short_display| begins; deviations from this
-font will be printed.
-
-@<Glob...@>=
-@!font_in_short_display:integer; {an internal font number}
-
-@ Boxes, rules, inserts, whatsits, marks, and things in general that are
-sort of ``complicated'' are indicated only by printing `\.{[]}'.
-
-@p
-procedure print_font_identifier(f: internal_font_number);
-begin
- if pdf_font_blink[f] = null_font then
- print_esc(font_id_text(f))
- else
- print_esc(font_id_text(pdf_font_blink[f]));
- if pdf_tracing_fonts > 0 then begin
- print(" (");
- print(font_name[f]);
- if font_size[f] <> font_dsize[f] then begin
- print("@@");
- print_scaled(font_size[f]);
- print("pt");
- end;
- print(")");
- end else
- if pdf_font_expand_ratio[f] <> 0 then begin
- print(" (");
- if pdf_font_expand_ratio[f] > 0 then
- print("+");
- print_int(pdf_font_expand_ratio[f]);
- print(")");
- end;
-end;
-
-procedure short_display(@!p:integer); {prints highlights of list |p|}
-var n:integer; {for replacement counts}
-begin while p>mem_min do
- begin if is_char_node(p) then
- begin if p<=mem_end then
- begin if font(p)<>font_in_short_display then
- begin if (font(p)<font_base)or(font(p)>font_max) then
- print_char("*")
-@.*\relax@>
- else print_font_identifier(font(p));
- print_char(" "); font_in_short_display:=font(p);
- end;
- print_ASCII(qo(character(p)));
- end;
- end
- else @<Print a short indication of the contents of node |p|@>;
- p:=link(p);
- end;
-end;
-
-@ @<Print a short indication of the contents of node |p|@>=
-case type(p) of
-hlist_node,vlist_node,ins_node,whatsit_node,mark_node,adjust_node,
- unset_node: print("[]");
-rule_node: print_char("|");
-glue_node: if glue_ptr(p)<>zero_glue then print_char(" ");
-math_node: if subtype(p)>=L_code then print("[]")
- else print_char("$");
-ligature_node: short_display(lig_ptr(p));
-disc_node: begin short_display(pre_break(p));
- short_display(post_break(p));@/
- n:=replace_count(p);
- while n>0 do
- begin if link(p)<>null then p:=link(p);
- decr(n);
- end;
- end;
-othercases do_nothing
-endcases
-
-@ The |show_node_list| routine requires some auxiliary subroutines: one to
-print a font-and-character combination, one to print a token list without
-its reference count, and one to print a rule dimension.
-
-@p procedure print_font_and_char(@!p:integer); {prints |char_node| data}
-begin if p>mem_end then print_esc("CLOBBERED.")
-else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
-@.*\relax@>
- else print_font_identifier(font(p));
- print_char(" "); print_ASCII(qo(character(p)));
- end;
-end;
-@#
-procedure print_mark(@!p:integer); {prints token list data in braces}
-begin print_char("{");
-if (p<hi_mem_min)or(p>mem_end) then print_esc("CLOBBERED.")
-else show_token_list(link(p),null,max_print_line-10);
-print_char("}");
-end;
-@#
-procedure print_rule_dimen(@!d:scaled); {prints dimension in rule node}
-begin if is_running(d) then print_char("*") else print_scaled(d);
-@.*\relax@>
-end;
-
-@ Then there is a subroutine that prints glue stretch and shrink, possibly
-followed by the name of finite units:
-
-@p procedure print_glue(@!d:scaled;@!order:integer;@!s:str_number);
- {prints a glue component}
-begin print_scaled(d);
-if (order<normal)or(order>filll) then print("foul")
-else if order>normal then
- begin print("fil");
- while order>fil do
- begin print_char("l"); decr(order);
- end;
- end
-else if s<>0 then print(s);
-end;
-
-@ The next subroutine prints a whole glue specification.
-
-@p procedure print_spec(@!p:integer;@!s:str_number);
- {prints a glue specification}
-begin if (p<mem_min)or(p>=lo_mem_max) then print_char("*")
-@.*\relax@>
-else begin print_scaled(width(p));
- if s<>0 then print(s);
- if stretch(p)<>0 then
- begin print(" plus "); print_glue(stretch(p),stretch_order(p),s);
- end;
- if shrink(p)<>0 then
- begin print(" minus "); print_glue(shrink(p),shrink_order(p),s);
- end;
- end;
-end;
-
-@ We also need to declare some procedures that appear later in this
-documentation.
-
-@p @<Declare procedures needed for displaying the elements of mlists@>@;
-@<Declare the procedure called |print_skip_param|@>
-
-@ Since boxes can be inside of boxes, |show_node_list| is inherently recursive,
-@^recursion@>
-up to a given maximum number of levels. The history of nesting is indicated
-by the current string, which will be printed at the beginning of each line;
-the length of this string, namely |cur_length|, is the depth of nesting.
-
-Recursive calls on |show_node_list| therefore use the following pattern:
-
-@d node_list_display(#)==
- begin append_char("."); show_node_list(#); flush_char;
- end {|str_room| need not be checked; see |show_box| below}
-
-@ A global variable called |depth_threshold| is used to record the maximum
-depth of nesting for which |show_node_list| will show information. If we
-have |depth_threshold=0|, for example, only the top level information will
-be given and no sublists will be traversed. Another global variable, called
-|breadth_max|, tells the maximum number of items to show at each level;
-|breadth_max| had better be positive, or you won't see anything.
-
-@<Glob...@>=
-@!depth_threshold : integer; {maximum nesting depth in box displays}
-@!breadth_max : integer; {maximum number of items shown at the same list level}
-
-@ Now we are ready for |show_node_list| itself. This procedure has been
-written to be ``extra robust'' in the sense that it should not crash or get
-into a loop even if the data structures have been messed up by bugs in
-the rest of the program. You can safely call its parent routine
-|show_box(p)| for arbitrary values of |p| when you are debugging \TeX.
-However, in the presence of bad data, the procedure may
-@^dirty \PASCAL@>@^debugging@>
-fetch a |memory_word| whose variant is different from the way it was stored;
-for example, it might try to read |mem[p].hh| when |mem[p]|
-contains a scaled integer, if |p| is a pointer that has been
-clobbered or chosen at random.
-
-@p procedure show_node_list(@!p:integer); {prints a node list symbolically}
-label exit;
-var n:integer; {the number of items already printed at this level}
-@!g:real; {a glue ratio, as a floating point number}
-begin if cur_length>depth_threshold then
- begin if p>null then print(" []");
- {indicate that there's been some truncation}
- return;
- end;
-n:=0;
-while p>mem_min do
- begin print_ln; print_current_string; {display the nesting history}
- if p>mem_end then {pointer out of range}
- begin print("Bad link, display aborted."); return;
-@.Bad link...@>
- end;
- incr(n); if n>breadth_max then {time to stop}
- begin print("etc."); return;
-@.etc@>
- end;
- @<Display node |p|@>;
- p:=link(p);
- end;
-exit:
-end;
-
-@ @<Display node |p|@>=
-if is_char_node(p) then print_font_and_char(p)
-else case type(p) of
- hlist_node,vlist_node,unset_node: @<Display box |p|@>;
- rule_node: @<Display rule |p|@>;
- ins_node: @<Display insertion |p|@>;
- whatsit_node: @<Display the whatsit node |p|@>;
- glue_node: @<Display glue |p|@>;
- margin_kern_node: begin
- print_esc("kern");
- print_scaled(width(p));
- if subtype(p) = left_side then
- print(" (left margin)")
- else
- print(" (right margin)");
- end;
- kern_node: @<Display kern |p|@>;
- math_node: @<Display math node |p|@>;
- ligature_node: @<Display ligature |p|@>;
- penalty_node: @<Display penalty |p|@>;
- disc_node: @<Display discretionary |p|@>;
- mark_node: @<Display mark |p|@>;
- adjust_node: @<Display adjustment |p|@>;
- @t\4@>@<Cases of |show_node_list| that arise in mlists only@>@;
- othercases print("Unknown node type!")
- endcases
-
-@ @<Display box |p|@>=
-begin if type(p)=hlist_node then print_esc("h")
-else if type(p)=vlist_node then print_esc("v")
-else print_esc("unset");
-print("box("); print_scaled(height(p)); print_char("+");
-print_scaled(depth(p)); print(")x"); print_scaled(width(p));
-if type(p)=unset_node then
- @<Display special fields of the unset node |p|@>
-else begin @<Display the value of |glue_set(p)|@>;
- if shift_amount(p)<>0 then
- begin print(", shifted "); print_scaled(shift_amount(p));
- end;
- if eTeX_ex then @<Display if this box is never to be reversed@>;
- end;
-node_list_display(list_ptr(p)); {recursive call}
-end
-
-@ @<Display special fields of the unset node |p|@>=
-begin if span_count(p)<>min_quarterword then
- begin print(" ("); print_int(qo(span_count(p))+1);
- print(" columns)");
- end;
-if glue_stretch(p)<>0 then
- begin print(", stretch "); print_glue(glue_stretch(p),glue_order(p),0);
- end;
-if glue_shrink(p)<>0 then
- begin print(", shrink "); print_glue(glue_shrink(p),glue_sign(p),0);
- end;
-end
-
-@ The code will have to change in this place if |glue_ratio| is
-a structured type instead of an ordinary |real|. Note that this routine
-should avoid arithmetic errors even if the |glue_set| field holds an
-arbitrary random value. The following code assumes that a properly
-formed nonzero |real| number has absolute value $2^{20}$ or more when
-it is regarded as an integer; this precaution was adequate to prevent
-floating point underflow on the author's computer.
-@^system dependencies@>
-@^dirty \PASCAL@>
-
-@<Display the value of |glue_set(p)|@>=
-g:=float(glue_set(p));
-if (g<>float_constant(0))and(glue_sign(p)<>normal) then
- begin print(", glue set ");
- if glue_sign(p)=shrinking then print("- ");
- if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?")
- else if abs(g)>float_constant(20000) then
- begin if g>float_constant(0) then print_char(">")
- else print("< -");
- print_glue(20000*unity,glue_order(p),0);
- end
- else print_glue(round(unity*g),glue_order(p),0);
-@^real multiplication@>
- end
-
-@ @<Display rule |p|@>=
-begin print_esc("rule("); print_rule_dimen(height(p)); print_char("+");
-print_rule_dimen(depth(p)); print(")x"); print_rule_dimen(width(p));
-end
-
-@ @<Display insertion |p|@>=
-begin print_esc("insert"); print_int(qo(subtype(p)));
-print(", natural size "); print_scaled(height(p));
-print("; split("); print_spec(split_top_ptr(p),0);
-print_char(","); print_scaled(depth(p));
-print("); float cost "); print_int(float_cost(p));
-node_list_display(ins_ptr(p)); {recursive call}
-end
-
-@ @<Display glue |p|@>=
-if subtype(p)>=a_leaders then @<Display leaders |p|@>
-else begin print_esc("glue");
- if subtype(p)<>normal then
- begin print_char("(");
- if subtype(p)<cond_math_glue then
- print_skip_param(subtype(p)-1)
- else if subtype(p)=cond_math_glue then print_esc("nonscript")
- else print_esc("mskip");
- print_char(")");
- end;
- if subtype(p)<>cond_math_glue then
- begin print_char(" ");
- if subtype(p)<cond_math_glue then print_spec(glue_ptr(p),0)
- else print_spec(glue_ptr(p),"mu");
- end;
- end
-
-@ @<Display leaders |p|@>=
-begin print_esc("");
-if subtype(p)=c_leaders then print_char("c")
-else if subtype(p)=x_leaders then print_char("x");
-print("leaders "); print_spec(glue_ptr(p),0);
-node_list_display(leader_ptr(p)); {recursive call}
-end
-
-@ An ``explicit'' kern value is indicated implicitly by an explicit space.
-
-@<Display kern |p|@>=
-if subtype(p)<>mu_glue then
- begin print_esc("kern");
- if subtype(p)<>normal then print_char(" ");
- print_scaled(width(p));
- if subtype(p)=acc_kern then print(" (for accent)");
-@.for accent@>
- if subtype(p)=auto_kern then print(" (for \pdfprependkern/\pdfappendkern)");
- end
-else begin print_esc("mkern"); print_scaled(width(p)); print("mu");
- end
-
-@ @<Display math node |p|@>=
-if subtype(p)>after then
- begin if end_LR(p) then print_esc("end")
- else print_esc("begin");
- if subtype(p)>R_code then print_char("R")
- else if subtype(p)>L_code then print_char("L")
- else print_char("M");
- end else
-begin print_esc("math");
-if subtype(p)=before then print("on")
-else print("off");
-if width(p)<>0 then
- begin print(", surrounded "); print_scaled(width(p));
- end;
-end
-
-@ @<Display ligature |p|@>=
-begin print_font_and_char(lig_char(p)); print(" (ligature ");
-if subtype(p)>1 then print_char("|");
-font_in_short_display:=font(lig_char(p)); short_display(lig_ptr(p));
-if odd(subtype(p)) then print_char("|");
-print_char(")");
-end
-
-@ @<Display penalty |p|@>=
-begin print_esc("penalty "); print_int(penalty(p));
-end
-
-@ The |post_break| list of a discretionary node is indicated by a prefixed
-`\.{\char'174}' instead of the `\..' before the |pre_break| list.
-
-@<Display discretionary |p|@>=
-begin print_esc("discretionary");
-if replace_count(p)>0 then
- begin print(" replacing "); print_int(replace_count(p));
- end;
-node_list_display(pre_break(p)); {recursive call}
-append_char("|"); show_node_list(post_break(p)); flush_char; {recursive call}
-end
-
-@ @<Display mark |p|@>=
-begin print_esc("mark");
-if mark_class(p)<>0 then
- begin print_char("s"); print_int(mark_class(p));
- end;
-print_mark(mark_ptr(p));
-end
-
-@ @<Display adjustment |p|@>=
-begin print_esc("vadjust"); if adjust_pre(p) <> 0 then print(" pre ");
-node_list_display(adjust_ptr(p)); {recursive call}
-end
-
-@ The recursive machinery is started by calling |show_box|.
-@^recursion@>
-
-@p procedure show_box(@!p:pointer);
-begin @<Assign the values |depth_threshold:=show_box_depth| and
- |breadth_max:=show_box_breadth|@>;
-if breadth_max<=0 then breadth_max:=5;
-if pool_ptr+depth_threshold>=pool_size then
- depth_threshold:=pool_size-pool_ptr-1;
- {now there's enough room for prefix string}
-show_node_list(p); {the show starts at |p|}
-print_ln;
-end;
-
-@* \[13] Destroying boxes.
-When we are done with a node list, we are obliged to return it to free
-storage, including all of its sublists. The recursive procedure
-|flush_node_list| does this for us.
-
-@ First, however, we shall consider two non-recursive procedures that do
-simpler tasks. The first of these, |delete_token_ref|, is called when
-a pointer to a token list's reference count is being removed. This means
-that the token list should disappear if the reference count was |null|,
-otherwise the count should be decreased by one.
-@^reference counts@>
-
-@d token_ref_count(#) == info(#) {reference count preceding a token list}
-
-@p procedure delete_token_ref(@!p:pointer); {|p| points to the reference count
- of a token list that is losing one reference}
-begin if token_ref_count(p)=null then flush_list(p)
-else decr(token_ref_count(p));
-end;
-
-@ Similarly, |delete_glue_ref| is called when a pointer to a glue
-specification is being withdrawn.
-@^reference counts@>
-@d fast_delete_glue_ref(#)==@t@>@;@/
- begin if glue_ref_count(#)=null then free_node(#,glue_spec_size)
- else decr(glue_ref_count(#));
- end
-
-@p procedure delete_glue_ref(@!p:pointer); {|p| points to a glue specification}
-fast_delete_glue_ref(p);
-
-@ Now we are ready to delete any node list, recursively.
-In practice, the nodes deleted are usually charnodes (about 2/3 of the time),
-and they are glue nodes in about half of the remaining cases.
-@^recursion@>
-
-@p procedure flush_node_list(@!p:pointer); {erase list of nodes starting at |p|}
-label done; {go here when node |p| has been freed}
-var q:pointer; {successor to node |p|}
-begin while p<>null do
-@^inner loop@>
- begin q:=link(p);
- if is_char_node(p) then free_avail(p)
- else begin case type(p) of
- hlist_node,vlist_node,unset_node: begin flush_node_list(list_ptr(p));
- free_node(p,box_node_size); goto done;
- end;
- rule_node: begin free_node(p,rule_node_size); goto done;
- end;
- ins_node: begin flush_node_list(ins_ptr(p));
- delete_glue_ref(split_top_ptr(p));
- free_node(p,ins_node_size); goto done;
- end;
- whatsit_node: @<Wipe out the whatsit node |p| and |goto done|@>;
- glue_node: begin fast_delete_glue_ref(glue_ptr(p));
- if leader_ptr(p)<>null then flush_node_list(leader_ptr(p));
- end;
- kern_node,math_node,penalty_node: do_nothing;
- margin_kern_node: begin
- free_avail(margin_char(p));
- free_node(p, margin_kern_node_size);
- goto done;
- end;
- ligature_node: flush_node_list(lig_ptr(p));
- mark_node: delete_token_ref(mark_ptr(p));
- disc_node: begin flush_node_list(pre_break(p));
- flush_node_list(post_break(p));
- end;
- adjust_node: flush_node_list(adjust_ptr(p));
- @t\4@>@<Cases of |flush_node_list| that arise in mlists only@>@;
- othercases confusion("flushing")
-@:this can't happen flushing}{\quad flushing@>
- endcases;@/
- free_node(p,small_node_size);
- done:end;
- p:=q;
- end;
-end;
-
-@* \[14] Copying boxes.
-Another recursive operation that acts on boxes is sometimes needed: The
-procedure |copy_node_list| returns a pointer to another node list that has
-the same structure and meaning as the original. Note that since glue
-specifications and token lists have reference counts, we need not make
-copies of them. Reference counts can never get too large to fit in a
-halfword, since each pointer to a node is in a different memory address,
-and the total number of memory addresses fits in a halfword.
-@^recursion@>
-@^reference counts@>
-
-(Well, there actually are also references from outside |mem|; if the
-|save_stack| is made arbitrarily large, it would theoretically be possible
-to break \TeX\ by overflowing a reference count. But who would want to do that?)
-
-@d add_token_ref(#)==incr(token_ref_count(#)) {new reference to a token list}
-@d add_glue_ref(#)==incr(glue_ref_count(#)) {new reference to a glue spec}
-
-@ The copying procedure copies words en masse without bothering
-to look at their individual fields. If the node format changes---for
-example, if the size is altered, or if some link field is moved to another
-relative position---then this code may need to be changed too.
-@^data structure assumptions@>
-
-@p function copy_node_list(@!p:pointer):pointer; {makes a duplicate of the
- node list that starts at |p| and returns a pointer to the new list}
-var h:pointer; {temporary head of copied list}
-@!q:pointer; {previous position in new list}
-@!r:pointer; {current node being fabricated for new list}
-@!words:0..5; {number of words remaining to be copied}
-begin h:=get_avail; q:=h;
-while p<>null do
- begin @<Make a copy of node |p| in node |r|@>;
- link(q):=r; q:=r; p:=link(p);
- end;
-link(q):=null; q:=link(h); free_avail(h);
-copy_node_list:=q;
-end;
-
-@ @<Make a copy of node |p|...@>=
-words:=1; {this setting occurs in more branches than any other}
-if is_char_node(p) then r:=get_avail
-else @<Case statement to copy different types and set |words| to the number
- of initial words not yet copied@>;
-while words>0 do
- begin decr(words); mem[r+words]:=mem[p+words];
- end
-
-@ @<Case statement to copy...@>=
-case type(p) of
-hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size);
- mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
- list_ptr(r):=copy_node_list(list_ptr(p)); {this affects |mem[r+5]|}
- words:=5;
- end;
-rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size;
- end;
-ins_node: begin r:=get_node(ins_node_size); mem[r+4]:=mem[p+4];
- add_glue_ref(split_top_ptr(p));
- ins_ptr(r):=copy_node_list(ins_ptr(p)); {this affects |mem[r+4]|}
- words:=ins_node_size-1;
- end;
-whatsit_node:@<Make a partial copy of the whatsit node |p| and make |r|
- point to it; set |words| to the number of initial words not yet copied@>;
-glue_node: begin r:=get_node(small_node_size); add_glue_ref(glue_ptr(p));
- glue_ptr(r):=glue_ptr(p); leader_ptr(r):=copy_node_list(leader_ptr(p));
- end;
-kern_node,math_node,penalty_node: begin r:=get_node(small_node_size);
- words:=small_node_size;
- end;
-margin_kern_node: begin
- r := get_node(margin_kern_node_size);
- fast_get_avail(margin_char(r));
- font(margin_char(r)) := font(margin_char(p));
- character(margin_char(r)) := character(margin_char(p));
- words := small_node_size;
- end;
-ligature_node: begin r:=get_node(small_node_size);
- mem[lig_char(r)]:=mem[lig_char(p)]; {copy |font| and |character|}
- lig_ptr(r):=copy_node_list(lig_ptr(p));
- end;
-disc_node: begin r:=get_node(small_node_size);
- pre_break(r):=copy_node_list(pre_break(p));
- post_break(r):=copy_node_list(post_break(p));
- end;
-mark_node: begin r:=get_node(small_node_size); add_token_ref(mark_ptr(p));
- words:=small_node_size;
- end;
-adjust_node: begin r:=get_node(small_node_size);
- adjust_ptr(r):=copy_node_list(adjust_ptr(p));
- end; {|words=1=small_node_size-1|}
-othercases confusion("copying")
-@:this can't happen copying}{\quad copying@>
-endcases
-
-@* \[15] The command codes.
-Before we can go any further, we need to define symbolic names for the internal
-code numbers that represent the various commands obeyed by \TeX. These codes
-are somewhat arbitrary, but not completely so. For example, the command
-codes for character types are fixed by the language, since a user says,
-e.g., `\.{\\catcode \`\\\${} = 3}' to make \.{\char'44} a math delimiter,
-and the command code |math_shift| is equal to~3. Some other codes have
-been made adjacent so that |case| statements in the program need not consider
-cases that are widely spaced, or so that |case| statements can be replaced
-by |if| statements.
-
-At any rate, here is the list, for future reference. First come the
-``catcode'' commands, several of which share their numeric codes with
-ordinary commands when the catcode cannot emerge from \TeX's scanning routine.
-
-@d escape=0 {escape delimiter (called \.\\ in {\sl The \TeX book\/})}
-@:TeXbook}{\sl The \TeX book@>
-@d relax=0 {do nothing ( \.{\\relax} )}
-@d left_brace=1 {beginning of a group ( \.\{ )}
-@d right_brace=2 {ending of a group ( \.\} )}
-@d math_shift=3 {mathematics shift character ( \.\$ )}
-@d tab_mark=4 {alignment delimiter ( \.\&, \.{\\span} )}
-@d car_ret=5 {end of line ( |carriage_return|, \.{\\cr}, \.{\\crcr} )}
-@d out_param=5 {output a macro parameter}
-@d mac_param=6 {macro parameter symbol ( \.\# )}
-@d sup_mark=7 {superscript ( \.{\char'136} )}
-@d sub_mark=8 {subscript ( \.{\char'137} )}
-@d ignore=9 {characters to ignore ( \.{\^\^@@} )}
-@d endv=9 {end of \<v_j> list in alignment template}
-@d spacer=10 {characters equivalent to blank space ( \.{\ } )}
-@d letter=11 {characters regarded as letters ( \.{A..Z}, \.{a..z} )}
-@d other_char=12 {none of the special character types}
-@d active_char=13 {characters that invoke macros ( \.{\char`\~} )}
-@d par_end=13 {end of paragraph ( \.{\\par} )}
-@d match=13 {match a macro parameter}
-@d comment=14 {characters that introduce comments ( \.\% )}
-@d end_match=14 {end of parameters to macro}
-@d stop=14 {end of job ( \.{\\end}, \.{\\dump} )}
-@d invalid_char=15 {characters that shouldn't appear ( \.{\^\^?} )}
-@d delim_num=15 {specify delimiter numerically ( \.{\\delimiter} )}
-@d max_char_code=15 {largest catcode for individual characters}
-
-@ Next are the ordinary run-of-the-mill command codes. Codes that are
-|min_internal| or more represent internal quantities that might be
-expanded by `\.{\\the}'.
-
-@d char_num=16 {character specified numerically ( \.{\\char} )}
-@d math_char_num=17 {explicit math code ( \.{\\mathchar} )}
-@d mark=18 {mark definition ( \.{\\mark} )}
-@d xray=19 {peek inside of \TeX\ ( \.{\\show}, \.{\\showbox}, etc.~)}
-@d make_box=20 {make a box ( \.{\\box}, \.{\\copy}, \.{\\hbox}, etc.~)}
-@d hmove=21 {horizontal motion ( \.{\\moveleft}, \.{\\moveright} )}
-@d vmove=22 {vertical motion ( \.{\\raise}, \.{\\lower} )}
-@d un_hbox=23 {unglue a box ( \.{\\unhbox}, \.{\\unhcopy} )}
-@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
- {( or \.{\\pagediscards}, \.{\\splitdiscards} )}
-@d remove_item=25 {nullify last item ( \.{\\unpenalty},
- \.{\\unkern}, \.{\\unskip} )}
-@d hskip=26 {horizontal glue ( \.{\\hskip}, \.{\\hfil}, etc.~)}
-@d vskip=27 {vertical glue ( \.{\\vskip}, \.{\\vfil}, etc.~)}
-@d mskip=28 {math glue ( \.{\\mskip} )}
-@d kern=29 {fixed space ( \.{\\kern} )}
-@d mkern=30 {math kern ( \.{\\mkern} )}
-@d leader_ship=31 {use a box ( \.{\\shipout}, \.{\\leaders}, etc.~)}
-@d halign=32 {horizontal table alignment ( \.{\\halign} )}
-@d valign=33 {vertical table alignment ( \.{\\valign} )}
- {or text direction directives ( \.{\\beginL}, etc.~)}
-@d no_align=34 {temporary escape from alignment ( \.{\\noalign} )}
-@d vrule=35 {vertical rule ( \.{\\vrule} )}
-@d hrule=36 {horizontal rule ( \.{\\hrule} )}
-@d insert=37 {vlist inserted in box ( \.{\\insert} )}
-@d vadjust=38 {vlist inserted in enclosing paragraph ( \.{\\vadjust} )}
-@d ignore_spaces=39 {gobble |spacer| tokens ( \.{\\ignorespaces} )}
-@d after_assignment=40 {save till assignment is done ( \.{\\afterassignment} )}
-@d after_group=41 {save till group is done ( \.{\\aftergroup} )}
-@d break_penalty=42 {additional badness ( \.{\\penalty} )}
-@d start_par=43 {begin paragraph ( \.{\\indent}, \.{\\noindent} )}
-@d ital_corr=44 {italic correction ( \.{\\/} )}
-@d accent=45 {attach accent in text ( \.{\\accent} )}
-@d math_accent=46 {attach accent in math ( \.{\\mathaccent} )}
-@d discretionary=47 {discretionary texts ( \.{\\-}, \.{\\discretionary} )}
-@d eq_no=48 {equation number ( \.{\\eqno}, \.{\\leqno} )}
-@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
- {( or \.{\\middle} )}
-@d math_comp=50 {component of formula ( \.{\\mathbin}, etc.~)}
-@d limit_switch=51 {diddle limit conventions ( \.{\\displaylimits}, etc.~)}
-@d above=52 {generalized fraction ( \.{\\above}, \.{\\atop}, etc.~)}
-@d math_style=53 {style specification ( \.{\\displaystyle}, etc.~)}
-@d math_choice=54 {choice specification ( \.{\\mathchoice} )}
-@d non_script=55 {conditional math glue ( \.{\\nonscript} )}
-@d vcenter=56 {vertically center a vbox ( \.{\\vcenter} )}
-@d case_shift=57 {force specific case ( \.{\\lowercase}, \.{\\uppercase}~)}
-@d message=58 {send to user ( \.{\\message}, \.{\\errmessage} )}
-@d extension=59 {extensions to \TeX\ ( \.{\\write}, \.{\\special}, etc.~)}
-@d in_stream=60 {files for reading ( \.{\\openin}, \.{\\closein} )}
-@d begin_group=61 {begin local grouping ( \.{\\begingroup} )}
-@d end_group=62 {end local grouping ( \.{\\endgroup} )}
-@d omit=63 {omit alignment template ( \.{\\omit} )}
-@d ex_space=64 {explicit space ( \.{\\\ } )}
-@d no_boundary=65 {suppress boundary ligatures ( \.{\\noboundary} )}
-@d radical=66 {square root and similar signs ( \.{\\radical} )}
-@d end_cs_name=67 {end control sequence ( \.{\\endcsname} )}
-@d min_internal=68 {the smallest code that can follow \.{\\the}}
-@d char_given=68 {character code defined by \.{\\chardef}}
-@d math_given=69 {math code defined by \.{\\mathchardef}}
-@d last_item=70 {most recent item ( \.{\\lastpenalty},
- \.{\\lastkern}, \.{\\lastskip} )}
-@d max_non_prefixed_command=70 {largest command code that can't be \.{\\global}}
-
-@ The next codes are special; they all relate to mode-independent
-assignment of values to \TeX's internal registers or tables.
-Codes that are |max_internal| or less represent internal quantities
-that might be expanded by `\.{\\the}'.
-
-@d toks_register=71 {token list register ( \.{\\toks} )}
-@d assign_toks=72 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
-@d assign_int=73 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
-@d assign_dimen=74 {user-defined length ( \.{\\hsize}, etc.~)}
-@d assign_glue=75 {user-defined glue ( \.{\\baselineskip}, etc.~)}
-@d assign_mu_glue=76 {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
-@d assign_font_dimen=77 {user-defined font dimension ( \.{\\fontdimen} )}
-@d assign_font_int=78 {user-defined font integer ( \.{\\hyphenchar},
- \.{\\skewchar} )}
-@d set_aux=79 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
-@d set_prev_graf=80 {specify state info ( \.{\\prevgraf} )}
-@d set_page_dimen=81 {specify state info ( \.{\\pagegoal}, etc.~)}
-@d set_page_int=82 {specify state info ( \.{\\deadcycles},
- \.{\\insertpenalties} )}
- {( or \.{\\interactionmode} )}
-@d set_box_dimen=83 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
-@d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )}
- {(or \.{\\interlinepenalties}, etc.~)}
-@d def_code=85 {define a character code ( \.{\\catcode}, etc.~)}
-@d def_family=86 {declare math fonts ( \.{\\textfont}, etc.~)}
-@d set_font=87 {set current font ( font identifiers )}
-@d def_font=88 {define a font file ( \.{\\font} )}
-@d register=89 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
-@d max_internal=89 {the largest code that can follow \.{\\the}}
-@d advance=90 {advance a register or parameter ( \.{\\advance} )}
-@d multiply=91 {multiply a register or parameter ( \.{\\multiply} )}
-@d divide=92 {divide a register or parameter ( \.{\\divide} )}
-@d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
- {( or \.{\\protected} )}
-@d let=94 {assign a command code ( \.{\\let}, \.{\\futurelet} )}
-@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
-@d read_to_cs=96 {read into a control sequence ( \.{\\read} )}
- {( or \.{\\readline} )}
-@d def=97 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
-@d set_box=98 {set a box ( \.{\\setbox} )}
-@d hyph_data=99 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
-@d set_interaction=100 {define level of interaction ( \.{\\batchmode}, etc.~)}
-@d letterspace_font=101 {letterspace a font ( \.{\\letterspacefont} )}
-@d pdf_copy_font=102 {create a new font instance ( \.{\\pdfcopyfont} )}
-@d max_command=102 {the largest command code seen at |big_switch|}
-
-@ The remaining command codes are extra special, since they cannot get through
-\TeX's scanner to the main control routine. They have been given values higher
-than |max_command| so that their special nature is easily discernible.
-The ``expandable'' commands come first.
-
-@d undefined_cs=max_command+1 {initial state of most |eq_type| fields}
-@d expand_after=max_command+2 {special expansion ( \.{\\expandafter} )}
-@d no_expand=max_command+3 {special nonexpansion ( \.{\\noexpand} )}
-@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
- {( or \.{\\scantokens} )}
-@d if_test=max_command+5 {conditional text ( \.{\\if}, \.{\\ifcase}, etc.~)}
-@d fi_or_else=max_command+6 {delimiters for conditionals ( \.{\\else}, etc.~)}
-@d cs_name=max_command+7 {make a control sequence from tokens ( \.{\\csname} )}
-@d convert=max_command+8 {convert to text ( \.{\\number}, \.{\\string}, etc.~)}
-@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
- {( or \.{\\unexpanded}, \.{\\detokenize} )}
-@d top_bot_mark=max_command+10 {inserted mark ( \.{\\topmark}, etc.~)}
-@d call=max_command+11 {non-long, non-outer control sequence}
-@d long_call=max_command+12 {long, non-outer control sequence}
-@d outer_call=max_command+13 {non-long, outer control sequence}
-@d long_outer_call=max_command+14 {long, outer control sequence}
-@d end_template=max_command+15 {end of an alignment template}
-@d dont_expand=max_command+16 {the following token was marked by \.{\\noexpand}}
-@d glue_ref=max_command+17 {the equivalent points to a glue specification}
-@d shape_ref=max_command+18 {the equivalent points to a parshape specification}
-@d box_ref=max_command+19 {the equivalent points to a box node, or is |null|}
-@d data=max_command+20 {the equivalent is simply a halfword number}
-
-@* \[16] The semantic nest.
-\TeX\ is typically in the midst of building many lists at once. For example,
-when a math formula is being processed, \TeX\ is in math mode and
-working on an mlist; this formula has temporarily interrupted \TeX\ from
-being in horizontal mode and building the hlist of a paragraph; and this
-paragraph has temporarily interrupted \TeX\ from being in vertical mode
-and building the vlist for the next page of a document. Similarly, when a
-\.{\\vbox} occurs inside of an \.{\\hbox}, \TeX\ is temporarily
-interrupted from working in restricted horizontal mode, and it enters
-internal vertical mode. The ``semantic nest'' is a stack that
-keeps track of what lists and modes are currently suspended.
-
-At each level of processing we are in one of six modes:
-
-\yskip\hang|vmode| stands for vertical mode (the page builder);
-
-\hang|hmode| stands for horizontal mode (the paragraph builder);
-
-\hang|mmode| stands for displayed formula mode;
-
-\hang|-vmode| stands for internal vertical mode (e.g., in a \.{\\vbox});
-
-\hang|-hmode| stands for restricted horizontal mode (e.g., in an \.{\\hbox});
-
-\hang|-mmode| stands for math formula mode (not displayed).
-
-\yskip\noindent The mode is temporarily set to zero while processing \.{\\write}
-texts.
-
-Numeric values are assigned to |vmode|, |hmode|, and |mmode| so that
-\TeX's ``big semantic switch'' can select the appropriate thing to
-do by computing the value |abs(mode)+cur_cmd|, where |mode| is the current
-mode and |cur_cmd| is the current command code.
-
-@d vmode=1 {vertical mode}
-@d hmode=vmode+max_command+1 {horizontal mode}
-@d mmode=hmode+max_command+1 {math mode}
-
-@p procedure print_mode(@!m:integer); {prints the mode represented by |m|}
-begin if m>0 then
- case m div (max_command+1) of
- 0:print("vertical");
- 1:print("horizontal");
- 2:print("display math");
- end
-else if m=0 then print("no")
-else case (-m) div (max_command+1) of
- 0:print("internal vertical");
- 1:print("restricted horizontal");
- 2:print("math");
- end;
-print(" mode");
-end;
-
-@ The state of affairs at any semantic level can be represented by
-five values:
-
-\yskip\hang|mode| is the number representing the semantic mode, as
-just explained.
-
-\yskip\hang|head| is a |pointer| to a list head for the list being built;
-|link(head)| therefore points to the first element of the list, or
-to |null| if the list is empty.
-
-\yskip\hang|tail| is a |pointer| to the final node of the list being
-built; thus, |tail=head| if and only if the list is empty.
-
-\yskip\hang|prev_graf| is the number of lines of the current paragraph that
-have already been put into the present vertical list.
-
-\yskip\hang|aux| is an auxiliary |memory_word| that gives further information
-that is needed to characterize the situation.
-
-\yskip\noindent
-In vertical mode, |aux| is also known as |prev_depth|; it is the scaled
-value representing the depth of the previous box, for use in baseline
-calculations, or it is |<=-1000|pt if the next box on the vertical list is to
-be exempt from baseline calculations. In horizontal mode, |aux| is also
-known as |space_factor| and |clang|; it holds the current space factor used in
-spacing calculations, and the current language used for hyphenation.
-(The value of |clang| is undefined in restricted horizontal mode.)
-In math mode, |aux| is also known as |incompleat_noad|; if
-not |null|, it points to a record that represents the numerator of a
-generalized fraction for which the denominator is currently being formed
-in the current list.
-
-There is also a sixth quantity, |mode_line|, which correlates
-the semantic nest with the user's input; |mode_line| contains the source
-line number at which the current level of nesting was entered. The negative
-of this line number is the |mode_line| at the level of the
-user's output routine.
-
-A seventh quantity, |eTeX_aux|, is used by the extended features \eTeX.
-In vertical modes it is known as |LR_save| and holds the LR stack when a
-paragraph is interrupted by a displayed formula. In display math mode
-it is known as |LR_box| and holds a pointer to a prototype box for the
-display. In math mode it is known as |delim_ptr| and points to the most
-recent |left_noad| or |middle_noad| of a |math_left_group|.
-
-In horizontal mode, the |prev_graf| field is used for initial language data.
-
-The semantic nest is an array called |nest| that holds the |mode|, |head|,
-|tail|, |prev_graf|, |aux|, and |mode_line| values for all semantic levels
-below the currently active one. Information about the currently active
-level is kept in the global quantities |mode|, |head|, |tail|, |prev_graf|,
-|aux|, and |mode_line|, which live in a \PASCAL\ record that is ready to
-be pushed onto |nest| if necessary.
-
-@d ignore_depth==-65536000 {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;
- end;
-
-@ @d mode==cur_list.mode_field {current mode}
-@d head==cur_list.head_field {header node of current list}
-@d tail==cur_list.tail_field {final node on current list}
-@d eTeX_aux==cur_list.eTeX_aux_field {auxiliary data for \eTeX}
-@d LR_save==eTeX_aux {LR stack when a paragraph is interrupted}
-@d LR_box==eTeX_aux {prototype box for display}
-@d delim_ptr==eTeX_aux {most recent left or right noad of a math left group}
-@d prev_graf==cur_list.pg_field {number of paragraph lines accumulated}
-@d aux==cur_list.aux_field {auxiliary data about the current list}
-@d prev_depth==aux.sc {the name of |aux| in vertical mode}
-@d space_factor==aux.hh.lh {part of |aux| in horizontal mode}
-@d clang==aux.hh.rh {the other part of |aux| in horizontal mode}
-@d incompleat_noad==aux.int {the name of |aux| in math mode}
-@d mode_line==cur_list.ml_field {source file line number at beginning of list}
-
-@<Glob...@>=
-@!nest:array[0..nest_size] of list_state_record;
-@!nest_ptr:0..nest_size; {first unused location of |nest|}
-@!max_nest_stack:0..nest_size; {maximum of |nest_ptr| when pushing}
-@!cur_list:list_state_record; {the ``top'' semantic state}
-@!shown_mode:-mmode..mmode; {most recent mode shown by \.{\\tracingcommands}}
-@!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:
-
-@d tail_append(#)==begin link(tail):=#; tail:=link(tail);
- end
-
-@ We will see later that the vertical list at the bottom semantic level is split
-into two parts; the ``current page'' runs from |page_head| to |page_tail|,
-and the ``contribution list'' runs from |contrib_head| to |tail| of
-semantic level zero. The idea is that contributions are first formed in
-vertical mode, then ``contributed'' to the current page (during which time
-the page-breaking decisions are made). For now, we don't need to know
-any more details about the page-building process.
-
-@<Set init...@>=
-nest_ptr:=0; max_nest_stack:=0;
-mode:=vmode; head:=contrib_head; tail:=contrib_head;
-eTeX_aux:=null; save_tail:=null;
-prev_depth:=ignore_depth; mode_line:=0;
-prev_graf:=0; shown_mode:=0;
-@<Start a new current page@>;
-
-@ When \TeX's work on one level is interrupted, the state is saved by
-calling |push_nest|. This routine changes |head| and |tail| so that
-a new (empty) list is begun; it does not change |mode| or |aux|.
-
-@p procedure push_nest; {enter a new semantic level, save the old}
-begin if nest_ptr>max_nest_stack then
- begin max_nest_stack:=nest_ptr;
- if nest_ptr=nest_size then overflow("semantic nest size",nest_size);
-@:TeX capacity exceeded semantic nest size}{\quad semantic nest size@>
- end;
-nest[nest_ptr]:=cur_list; {stack the record}
-incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
-eTeX_aux:=null;
-end;
-
-@ Conversely, when \TeX\ is finished on the current level, the former
-state is restored by calling |pop_nest|. This routine will never be
-called at the lowest semantic level, nor will it be called unless |head|
-is a node that should be returned to free memory.
-
-@p procedure pop_nest; {leave a semantic level, re-enter the old}
-begin free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
-end;
-
-@ Here is a procedure that displays what \TeX\ is working on, at all levels.
-
-@p procedure@?print_totals; forward;@t\2@>
-procedure show_activities;
-var p:0..nest_size; {index into |nest|}
-@!m:-mmode..mmode; {mode}
-@!a:memory_word; {auxiliary}
-@!q,@!r:pointer; {for showing the current page}
-@!t:integer; {ditto}
-begin nest[nest_ptr]:=cur_list; {put the top level into the array}
-print_nl(""); print_ln;
-for p:=nest_ptr downto 0 do
- begin m:=nest[p].mode_field; a:=nest[p].aux_field;
- print_nl("### "); print_mode(m);
- print(" entered at line "); print_int(abs(nest[p].ml_field));
- if m=hmode then if nest[p].pg_field <> @'40600000 then
- begin print(" (language"); print_int(nest[p].pg_field mod @'200000);
- print(":hyphenmin"); print_int(nest[p].pg_field div @'20000000);
- print_char(","); print_int((nest[p].pg_field div @'200000) mod @'100);
- print_char(")");
- end;
- if nest[p].ml_field<0 then print(" (\output routine)");
- if p=0 then
- begin @<Show the status of the current page@>;
- if link(contrib_head)<>null then
- print_nl("### recent contributions:");
- end;
- show_box(link(nest[p].head_field));
- @<Show the auxiliary field, |a|@>;
- end;
-end;
-
-@ @<Show the auxiliary...@>=
-case abs(m) div (max_command+1) of
-0: begin print_nl("prevdepth ");
- if a.sc<=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 begin denominator of:"); show_box(a.int);@+
- end;
-end {there are no other cases}
-
-@* \[17] The table of equivalents.
-Now that we have studied the data structures for \TeX's semantic routines,
-we ought to consider the data structures used by its syntactic routines. In
-other words, our next concern will be
-the tables that \TeX\ looks at when it is scanning
-what the user has written.
-
-The biggest and most important such table is called |eqtb|. It holds the
-current ``equivalents'' of things; i.e., it explains what things mean
-or what their current values are, for all quantities that are subject to
-the nesting structure provided by \TeX's grouping mechanism. There are six
-parts to |eqtb|:
-
-\yskip\hangg 1) |eqtb[active_base..(hash_base-1)]| holds the current
-equivalents of single-character control sequences.
-
-\yskip\hangg 2) |eqtb[hash_base..(glue_base-1)]| holds the current
-equivalents of multiletter control sequences.
-
-\yskip\hangg 3) |eqtb[glue_base..(local_base-1)]| holds the current
-equivalents of glue parameters like the current baselineskip.
-
-\yskip\hangg 4) |eqtb[local_base..(int_base-1)]| holds the current
-equivalents of local halfword quantities like the current box registers,
-the current ``catcodes,'' the current font, and a pointer to the current
-paragraph shape.
-
-\yskip\hangg 5) |eqtb[int_base..(dimen_base-1)]| holds the current
-equivalents of fullword integer parameters like the current hyphenation
-penalty.
-
-\yskip\hangg 6) |eqtb[dimen_base..eqtb_size]| holds the current equivalents
-of fullword dimension parameters like the current hsize or amount of
-hanging indentation.
-
-\yskip\noindent Note that, for example, the current amount of
-baselineskip glue is determined by the setting of a particular location
-in region~3 of |eqtb|, while the current meaning of the control sequence
-`\.{\\baselineskip}' (which might have been changed by \.{\\def} or
-\.{\\let}) appears in region~2.
-
-@ Each entry in |eqtb| is a |memory_word|. Most of these words are of type
-|two_halves|, and subdivided into three fields:
-
-\yskip\hangg 1) The |eq_level| (a quarterword) is the level of grouping at
-which this equivalent was defined. If the level is |level_zero|, the
-equivalent has never been defined; |level_one| refers to the outer level
-(outside of all groups), and this level is also used for global
-definitions that never go away. Higher levels are for equivalents that
-will disappear at the end of their group. @^global definitions@>
-
-\yskip\hangg 2) The |eq_type| (another quarterword) specifies what kind of
-entry this is. There are many types, since each \TeX\ primitive like
-\.{\\hbox}, \.{\\def}, etc., has its own special code. The list of
-command codes above includes all possible settings of the |eq_type| field.
-
-\yskip\hangg 3) The |equiv| (a halfword) is the current equivalent value.
-This may be a font number, a pointer into |mem|, or a variety of other
-things.
-
-@d eq_level_field(#)==#.hh.b1
-@d eq_type_field(#)==#.hh.b0
-@d equiv_field(#)==#.hh.rh
-@d eq_level(#)==eq_level_field(eqtb[#]) {level of definition}
-@d eq_type(#)==eq_type_field(eqtb[#]) {command code for equivalent}
-@d equiv(#)==equiv_field(eqtb[#]) {equivalent value}
-@d level_zero=min_quarterword {level for undefined quantities}
-@d level_one=level_zero+1 {outermost level for defined quantities}
-
-@ Many locations in |eqtb| have symbolic names. The purpose of the next
-paragraphs is to define these names, and to set up the initial values of the
-equivalents.
-
-In the first region we have 256 equivalents for ``active characters'' that
-act as control sequences, followed by 256 equivalents for single-character
-control sequences.
-
-Then comes region~2, which corresponds to the hash table that we will
-define later. The maximum address in this region is used for a dummy
-control sequence that is perpetually undefined. There also are several
-locations for control sequences that are perpetually defined
-(since they are used in error recovery).
-
-@d active_base=1 {beginning of region 1, for active character equivalents}
-@d single_base=active_base+256 {equivalents of one-character control sequences}
-@d null_cs=single_base+256 {equivalent of \.{\\csname\\endcsname}}
-@d hash_base=null_cs+1 {beginning of region 2, for the hash table}
-@d frozen_control_sequence=hash_base+hash_size {for error recovery}
-@d frozen_protection=frozen_control_sequence {inaccessible but definable}
-@d frozen_cr=frozen_control_sequence+1 {permanent `\.{\\cr}'}
-@d frozen_end_group=frozen_control_sequence+2 {permanent `\.{\\endgroup}'}
-@d frozen_right=frozen_control_sequence+3 {permanent `\.{\\right}'}
-@d frozen_fi=frozen_control_sequence+4 {permanent `\.{\\fi}'}
-@d frozen_end_template=frozen_control_sequence+5 {permanent `\.{\\endtemplate}'}
-@d frozen_endv=frozen_control_sequence+6 {second permanent `\.{\\endtemplate}'}
-@d frozen_relax=frozen_control_sequence+7 {permanent `\.{\\relax}'}
-@d end_write=frozen_control_sequence+8 {permanent `\.{\\endwrite}'}
-@d frozen_dont_expand=frozen_control_sequence+9
- {permanent `\.{\\notexpanded:}'}
-@d prim_size=2100 {maximum number of primitives }
-@d frozen_null_font=frozen_control_sequence+10
- {permanent `\.{\\nullfont}'}
-@d frozen_primitive=frozen_control_sequence+11
- {permanent `\.{\\pdfprimitive}'}
-@d prim_eqtb_base=frozen_primitive+1
-@d font_id_base=frozen_null_font-font_base
- {begins table of 257 permanent font identifiers}
-@d undefined_control_sequence=frozen_null_font+257 {dummy location}
-@d glue_base=undefined_control_sequence+1 {beginning of region 3}
-
-@<Initialize table entries...@>=
-eq_type(undefined_control_sequence):=undefined_cs;
-equiv(undefined_control_sequence):=null;
-eq_level(undefined_control_sequence):=level_zero;
-for k:=active_base to undefined_control_sequence-1 do
- eqtb[k]:=eqtb[undefined_control_sequence];
-
-@ Here is a routine that displays the current meaning of an |eqtb| entry
-in region 1 or~2. (Similar routines for the other regions will appear
-below.)
-
-@<Show equivalent |n|, in region 1 or 2@>=
-begin sprint_cs(n); print_char("="); print_cmd_chr(eq_type(n),equiv(n));
-if eq_type(n)>=call then
- begin print_char(":"); show_token_list(link(equiv(n)),null,32);
- end;
-end
-
-@ Region 3 of |eqtb| contains the 256 \.{\\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 256 ``skip'' registers}
-@d mu_skip_base=skip_base+256 {table of 256 ``muskip'' registers}
-@d local_base=mu_skip_base+256 {beginning of region 4}
-@#
-@d skip(#)==equiv(skip_base+#) {|mem| location of glue specification}
-@d mu_skip(#)==equiv(mu_skip_base+#) {|mem| location of math glue spec}
-@d glue_par(#)==equiv(glue_base+#) {|mem| location of glue specification}
-@d line_skip==glue_par(line_skip_code)
-@d baseline_skip==glue_par(baseline_skip_code)
-@d par_skip==glue_par(par_skip_code)
-@d above_display_skip==glue_par(above_display_skip_code)
-@d below_display_skip==glue_par(below_display_skip_code)
-@d above_display_short_skip==glue_par(above_display_short_skip_code)
-@d below_display_short_skip==glue_par(below_display_short_skip_code)
-@d left_skip==glue_par(left_skip_code)
-@d right_skip==glue_par(right_skip_code)
-@d top_skip==glue_par(top_skip_code)
-@d split_top_skip==glue_par(split_top_skip_code)
-@d tab_skip==glue_par(tab_skip_code)
-@d space_skip==glue_par(space_skip_code)
-@d xspace_skip==glue_par(xspace_skip_code)
-@d par_fill_skip==glue_par(par_fill_skip_code)
-@d thin_mu_skip==glue_par(thin_mu_skip_code)
-@d med_mu_skip==glue_par(med_mu_skip_code)
-@d thick_mu_skip==glue_par(thick_mu_skip_code)
-
-@<Current |mem| equivalent of glue parameter number |n|@>=glue_par(n)
-
-@ Sometimes we need to convert \TeX's internal code numbers into symbolic
-form. The |print_skip_param| routine gives the symbolic name of a glue
-parameter.
-
-@<Declare the procedure called |print_skip_param|@>=
-procedure print_skip_param(@!n:integer);
-begin case n of
-line_skip_code: print_esc("lineskip");
-baseline_skip_code: print_esc("baselineskip");
-par_skip_code: print_esc("parskip");
-above_display_skip_code: print_esc("abovedisplayskip");
-below_display_skip_code: print_esc("belowdisplayskip");
-above_display_short_skip_code: print_esc("abovedisplayshortskip");
-below_display_short_skip_code: print_esc("belowdisplayshortskip");
-left_skip_code: print_esc("leftskip");
-right_skip_code: print_esc("rightskip");
-top_skip_code: print_esc("topskip");
-split_top_skip_code: print_esc("splittopskip");
-tab_skip_code: print_esc("tabskip");
-space_skip_code: print_esc("spaceskip");
-xspace_skip_code: print_esc("xspaceskip");
-par_fill_skip_code: print_esc("parfillskip");
-thin_mu_skip_code: print_esc("thinmuskip");
-med_mu_skip_code: print_esc("medmuskip");
-thick_mu_skip_code: print_esc("thickmuskip");
-othercases print("[unknown glue parameter!]")
-endcases;
-end;
-
-@ The symbolic names for glue parameters are put into \TeX's hash table
-by using the routine called |primitive|, defined below. Let us enter them
-now, so that we don't have to list all those parameter names anywhere else.
-
-@<Put each of \TeX's primitives into the hash table@>=
-primitive("lineskip",assign_glue,glue_base+line_skip_code);@/
-@!@:line_skip_}{\.{\\lineskip} primitive@>
-primitive("baselineskip",assign_glue,glue_base+baseline_skip_code);@/
-@!@:baseline_skip_}{\.{\\baselineskip} primitive@>
-primitive("parskip",assign_glue,glue_base+par_skip_code);@/
-@!@:par_skip_}{\.{\\parskip} primitive@>
-primitive("abovedisplayskip",assign_glue,glue_base+above_display_skip_code);@/
-@!@:above_display_skip_}{\.{\\abovedisplayskip} primitive@>
-primitive("belowdisplayskip",assign_glue,glue_base+below_display_skip_code);@/
-@!@:below_display_skip_}{\.{\\belowdisplayskip} primitive@>
-primitive("abovedisplayshortskip",
- assign_glue,glue_base+above_display_short_skip_code);@/
-@!@:above_display_short_skip_}{\.{\\abovedisplayshortskip} primitive@>
-primitive("belowdisplayshortskip",
- assign_glue,glue_base+below_display_short_skip_code);@/
-@!@:below_display_short_skip_}{\.{\\belowdisplayshortskip} primitive@>
-primitive("leftskip",assign_glue,glue_base+left_skip_code);@/
-@!@:left_skip_}{\.{\\leftskip} primitive@>
-primitive("rightskip",assign_glue,glue_base+right_skip_code);@/
-@!@:right_skip_}{\.{\\rightskip} primitive@>
-primitive("topskip",assign_glue,glue_base+top_skip_code);@/
-@!@:top_skip_}{\.{\\topskip} primitive@>
-primitive("splittopskip",assign_glue,glue_base+split_top_skip_code);@/
-@!@:split_top_skip_}{\.{\\splittopskip} primitive@>
-primitive("tabskip",assign_glue,glue_base+tab_skip_code);@/
-@!@:tab_skip_}{\.{\\tabskip} primitive@>
-primitive("spaceskip",assign_glue,glue_base+space_skip_code);@/
-@!@:space_skip_}{\.{\\spaceskip} primitive@>
-primitive("xspaceskip",assign_glue,glue_base+xspace_skip_code);@/
-@!@:xspace_skip_}{\.{\\xspaceskip} primitive@>
-primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/
-@!@:par_fill_skip_}{\.{\\parfillskip} primitive@>
-primitive("thinmuskip",assign_mu_glue,glue_base+thin_mu_skip_code);@/
-@!@:thin_mu_skip_}{\.{\\thinmuskip} primitive@>
-primitive("medmuskip",assign_mu_glue,glue_base+med_mu_skip_code);@/
-@!@:med_mu_skip_}{\.{\\medmuskip} primitive@>
-primitive("thickmuskip",assign_mu_glue,glue_base+thick_mu_skip_code);@/
-@!@:thick_mu_skip_}{\.{\\thickmuskip} primitive@>
-
-@ @<Cases of |print_cmd_chr| for symbolic printing of primitives@>=
-assign_glue,assign_mu_glue: if chr_code<skip_base then
- print_skip_param(chr_code-glue_base)
- else if chr_code<mu_skip_base then
- begin print_esc("skip"); print_int(chr_code-skip_base);
- end
- else begin print_esc("muskip"); print_int(chr_code-mu_skip_base);
- end;
-
-@ All glue parameters and registers are initially `\.{0pt plus0pt minus0pt}'.
-
-@<Initialize table entries...@>=
-equiv(glue_base):=zero_glue; eq_level(glue_base):=level_one;
-eq_type(glue_base):=glue_ref;
-for k:=glue_base+1 to local_base-1 do eqtb[k]:=eqtb[glue_base];
-glue_ref_count(zero_glue):=glue_ref_count(zero_glue)+local_base-glue_base;
-
-@ @<Show equivalent |n|, in region 3@>=
-if n<skip_base then
- begin print_skip_param(n-glue_base); print_char("=");
- if n<glue_base+thin_mu_skip_code then print_spec(equiv(n),"pt")
- else print_spec(equiv(n),"mu");
- end
-else if n<mu_skip_base then
- begin print_esc("skip"); print_int(n-skip_base); print_char("=");
- print_spec(equiv(n),"pt");
- end
-else begin print_esc("muskip"); print_int(n-mu_skip_base); print_char("=");
- print_spec(equiv(n),"mu");
- end
-
-@ Region 4 of |eqtb| contains the local quantities defined here. The
-bulk of this region is taken up by five tables that are indexed by eight-bit
-characters; these tables are important to both the syntactic and semantic
-portions of \TeX. There are also a bunch of special things like font and
-token parameters, as well as the tables of \.{\\toks} and \.{\\box}
-registers.
-
-@d par_shape_loc=local_base {specifies paragraph shape}
-@d output_routine_loc=local_base+1 {points to token list for \.{\\output}}
-@d every_par_loc=local_base+2 {points to token list for \.{\\everypar}}
-@d every_math_loc=local_base+3 {points to token list for \.{\\everymath}}
-@d every_display_loc=local_base+4 {points to token list for \.{\\everydisplay}}
-@d every_hbox_loc=local_base+5 {points to token list for \.{\\everyhbox}}
-@d every_vbox_loc=local_base+6 {points to token list for \.{\\everyvbox}}
-@d every_job_loc=local_base+7 {points to token list for \.{\\everyjob}}
-@d every_cr_loc=local_base+8 {points to token list for \.{\\everycr}}
-@d err_help_loc=local_base+9 {points to token list for \.{\\errhelp}}
-@d tex_toks=local_base+10 {end of \TeX's token list parameters}
-@#
-@d pdftex_first_loc = tex_toks {base for \pdfTeX's token list parameters}
-@d pdf_pages_attr_loc = pdftex_first_loc + 0 {points to token list for \.{\\pdfpagesattr}}
-@d pdf_page_attr_loc = pdftex_first_loc + 1 {points to token list for \.{\\pdfpageattr}}
-@d pdf_page_resources_loc = pdftex_first_loc + 2 {points to token list for \.{\\pdfpageresources}}
-@d pdf_pk_mode_loc = pdftex_first_loc + 3 {points to token list for \.{\\pdfpkmode}}
-@d pdf_toks=pdftex_first_loc+4 {end of \pdfTeX's token list parameters}
-@#
-@d etex_toks_base=pdf_toks {base for \eTeX's token list parameters}
-@d every_eof_loc=etex_toks_base {points to token list for \.{\\everyeof}}
-@d etex_toks=etex_toks_base+1 {end of \eTeX's token list parameters}
-@#
-@d toks_base=etex_toks {table of 256 token list registers}
-@#
-@d etex_pen_base=toks_base+256 {start of table of \eTeX's penalties}
-@d inter_line_penalties_loc=etex_pen_base {additional penalties between lines}
-@d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines}
-@d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines}
-@d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display}
-@d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties}
-@#
-@d box_base=etex_pens {table of 256 box registers}
-@d cur_font_loc=box_base+256 {internal font number outside math mode}
-@d math_font_base=cur_font_loc+1 {table of 48 math font numbers}
-@d cat_code_base=math_font_base+48
- {table of 256 command codes (the ``catcodes'')}
-@d lc_code_base=cat_code_base+256 {table of 256 lowercase mappings}
-@d uc_code_base=lc_code_base+256 {table of 256 uppercase mappings}
-@d sf_code_base=uc_code_base+256 {table of 256 spacefactor mappings}
-@d math_code_base=sf_code_base+256 {table of 256 math mode mappings}
-@d int_base=math_code_base+256 {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 box(#)==equiv(box_base+#)
-@d cur_font==equiv(cur_font_loc)
-@d fam_fnt(#)==equiv(math_font_base+#)
-@d cat_code(#)==equiv(cat_code_base+#)
-@d lc_code(#)==equiv(lc_code_base+#)
-@d uc_code(#)==equiv(uc_code_base+#)
-@d sf_code(#)==equiv(sf_code_base+#)
-@d math_code(#)==equiv(math_code_base+#)
- {Note: |math_code(c)| is the true math code plus |min_halfword|}
-
-@<Put each...@>=
-primitive("output",assign_toks,output_routine_loc);
-@!@:output_}{\.{\\output} primitive@>
-primitive("everypar",assign_toks,every_par_loc);
-@!@:every_par_}{\.{\\everypar} primitive@>
-primitive("everymath",assign_toks,every_math_loc);
-@!@:every_math_}{\.{\\everymath} primitive@>
-primitive("everydisplay",assign_toks,every_display_loc);
-@!@:every_display_}{\.{\\everydisplay} primitive@>
-primitive("everyhbox",assign_toks,every_hbox_loc);
-@!@:every_hbox_}{\.{\\everyhbox} primitive@>
-primitive("everyvbox",assign_toks,every_vbox_loc);
-@!@:every_vbox_}{\.{\\everyvbox} primitive@>
-primitive("everyjob",assign_toks,every_job_loc);
-@!@:every_job_}{\.{\\everyjob} primitive@>
-primitive("everycr",assign_toks,every_cr_loc);
-@!@:every_cr_}{\.{\\everycr} primitive@>
-primitive("errhelp",assign_toks,err_help_loc);
-@!@:err_help_}{\.{\\errhelp} primitive@>
-primitive("pdfpagesattr",assign_toks,pdf_pages_attr_loc);
-@!@:pdf_pages_attr_}{\.{\\pdfpagesattr} primitive@>
-primitive("pdfpageattr",assign_toks,pdf_page_attr_loc);
-@!@:pdf_page_attr_}{\.{\\pdfpageattr} primitive@>
-primitive("pdfpageresources",assign_toks,pdf_page_resources_loc);
-@!@:pdf_page_resources_}{\.{\\pdfpageresources} primitive@>
-primitive("pdfpkmode",assign_toks,pdf_pk_mode_loc);
-@!@:pdf_pk_mode_}{\.{\\pdfpkmode} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-assign_toks: if chr_code>=toks_base then
- begin print_esc("toks"); print_int(chr_code-toks_base);
- end
-else case chr_code of
- output_routine_loc: print_esc("output");
- every_par_loc: print_esc("everypar");
- every_math_loc: print_esc("everymath");
- every_display_loc: print_esc("everydisplay");
- every_hbox_loc: print_esc("everyhbox");
- every_vbox_loc: print_esc("everyvbox");
- every_job_loc: print_esc("everyjob");
- every_cr_loc: print_esc("everycr");
- @/@<Cases of |assign_toks| for |print_cmd_chr|@>@/
- pdf_pages_attr_loc: print_esc("pdfpagesattr");
- pdf_page_attr_loc: print_esc("pdfpageattr");
- pdf_page_resources_loc: print_esc("pdfpageresources");
- pdf_pk_mode_loc: print_esc("pdfpkmode");
- othercases print_esc("errhelp")
- endcases;
-
-@ We initialize most things to null or undefined values. An undefined font
-is represented by the internal code |font_base|.
-
-However, the character code tables are given initial values based on the
-conventional interpretation of ASCII code. These initial values should
-not be changed when \TeX\ is adapted for use with non-English languages;
-all changes to the initialization conventions should be made in format
-packages, not in \TeX\ itself, so that global interchange of formats is
-possible.
-
-@d null_font==font_base
-@d var_code==@'70000 {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+255 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+255 do eqtb[k]:=eqtb[box_base];
-cur_font:=null_font; eq_type(cur_font_loc):=data;
-eq_level(cur_font_loc):=level_one;@/
-for k:=math_font_base to math_font_base+47 do eqtb[k]:=eqtb[cur_font_loc];
-equiv(cat_code_base):=0; eq_type(cat_code_base):=data;
-eq_level(cat_code_base):=level_one;@/
-for k:=cat_code_base+1 to int_base-1 do eqtb[k]:=eqtb[cat_code_base];
-for k:=0 to 255 do
- begin cat_code(k):=other_char; math_code(k):=hi(k); sf_code(k):=1000;
- end;
-cat_code(carriage_return):=car_ret; cat_code(" "):=spacer;
-cat_code("\"):=escape; cat_code("%"):=comment;
-cat_code(invalid_code):=invalid_char; cat_code(null_code):=ignore;
-for k:="0" to "9" do math_code(k):=hi(k+var_code);
-for k:="A" to "Z" do
- begin cat_code(k):=letter; cat_code(k+"a"-"A"):=letter;@/
- math_code(k):=hi(k+var_code+@"100);
- math_code(k+"a"-"A"):=hi(k+"a"-"A"+var_code+@"100);@/
- lc_code(k):=k+"a"-"A"; lc_code(k+"a"-"A"):=k+"a"-"A";@/
- uc_code(k):=k; uc_code(k+"a"-"A"):=k;@/
- sf_code(k):=999;
- end;
-
-@ @<Show equivalent |n|, in region 4@>=
-if (n=par_shape_loc) or ((n>=etex_pen_base) and (n<etex_pens)) then
- begin print_cmd_chr(set_shape,n); print_char("=");
- if equiv(n)=null then print_char("0")
- else if n>par_shape_loc then
- begin print_int(penalty(equiv(n))); print_char(" ");
- print_int(penalty(equiv(n)+1));
- if penalty(equiv(n))>1 then print_esc("ETC.");
- end
- else print_int(info(par_shape_ptr));
- end
-else if n<toks_base then
- begin print_cmd_chr(assign_toks,n); print_char("=");
- if equiv(n)<>null then show_token_list(link(equiv(n)),null,32);
- end
-else if n<box_base then
- begin print_esc("toks"); print_int(n-toks_base); print_char("=");
- if equiv(n)<>null then show_token_list(link(equiv(n)),null,32);
- end
-else if n<cur_font_loc then
- begin print_esc("box"); print_int(n-box_base); print_char("=");
- if equiv(n)=null then print("void")
- else begin depth_threshold:=0; breadth_max:=1; show_node_list(equiv(n));
- end;
- end
-else if n<cat_code_base then @<Show the font identifier in |eqtb[n]|@>
-else @<Show the halfword code in |eqtb[n]|@>
-
-@ @<Show the font identifier in |eqtb[n]|@>=
-begin if n=cur_font_loc then print("current font")
-else if n<math_font_base+16 then
- begin print_esc("textfont"); print_int(n-math_font_base);
- end
-else if n<math_font_base+32 then
- begin print_esc("scriptfont"); print_int(n-math_font_base-16);
- end
-else begin print_esc("scriptscriptfont"); print_int(n-math_font_base-32);
- end;
-print_char("=");@/
-print_esc(hash[font_id_base+equiv(n)].rh);
- {that's |font_id_text(equiv(n))|}
-end
-
-@ @<Show the halfword code in |eqtb[n]|@>=
-if n<math_code_base then
- begin if n<lc_code_base then
- begin print_esc("catcode"); print_int(n-cat_code_base);
- end
- else if n<uc_code_base then
- begin print_esc("lccode"); print_int(n-lc_code_base);
- end
- else if n<sf_code_base then
- begin print_esc("uccode"); print_int(n-uc_code_base);
- end
- else begin print_esc("sfcode"); print_int(n-sf_code_base);
- end;
- print_char("="); print_int(equiv(n));
- end
-else begin print_esc("mathcode"); print_int(n-math_code_base);
- print_char("="); print_int(ho(equiv(n)));
- end
-
-@ Region 5 of |eqtb| contains the integer parameters and registers defined
-here, as well as the |del_code| table. The latter table differs from the
-|cat_code..math_code| tables that precede it, since delimiter codes are
-fullword integers while the other kinds of codes occupy at most a
-halfword. This is what makes region~5 different from region~4. We will
-store the |eq_level| information in an auxiliary array of quarterwords
-that will be defined later.
-
-@d pretolerance_code=0 {badness tolerance before hyphenation}
-@d tolerance_code=1 {badness tolerance after hyphenation}
-@d line_penalty_code=2 {added to the badness of every line}
-@d hyphen_penalty_code=3 {penalty for break after discretionary hyphen}
-@d ex_hyphen_penalty_code=4 {penalty for break after explicit hyphen}
-@d club_penalty_code=5 {penalty for creating a club line}
-@d widow_penalty_code=6 {penalty for creating a widow line}
-@d display_widow_penalty_code=7 {ditto, just before a display}
-@d broken_penalty_code=8 {penalty for breaking a page at a broken line}
-@d bin_op_penalty_code=9 {penalty for breaking after a binary operation}
-@d rel_penalty_code=10 {penalty for breaking after a relation}
-@d pre_display_penalty_code=11
- {penalty for breaking just before a displayed formula}
-@d post_display_penalty_code=12
- {penalty for breaking just after a displayed formula}
-@d inter_line_penalty_code=13 {additional penalty between lines}
-@d double_hyphen_demerits_code=14 {demerits for double hyphen break}
-@d final_hyphen_demerits_code=15 {demerits for final hyphen break}
-@d adj_demerits_code=16 {demerits for adjacent incompatible lines}
-@d mag_code=17 {magnification ratio}
-@d delimiter_factor_code=18 {ratio for variable-size delimiters}
-@d looseness_code=19 {change in number of lines for a paragraph}
-@d time_code=20 {current time of day}
-@d day_code=21 {current day of the month}
-@d month_code=22 {current month of the year}
-@d year_code=23 {current year of our Lord}
-@d show_box_breadth_code=24 {nodes per level in |show_box|}
-@d show_box_depth_code=25 {maximum level in |show_box|}
-@d hbadness_code=26 {hboxes exceeding this badness will be shown by |hpack|}
-@d vbadness_code=27 {vboxes exceeding this badness will be shown by |vpack|}
-@d pausing_code=28 {pause after each line is read from a file}
-@d tracing_online_code=29 {show diagnostic output on terminal}
-@d tracing_macros_code=30 {show macros as they are being expanded}
-@d tracing_stats_code=31 {show memory usage if \TeX\ knows it}
-@d tracing_paragraphs_code=32 {show line-break calculations}
-@d tracing_pages_code=33 {show page-break calculations}
-@d tracing_output_code=34 {show boxes when they are shipped out}
-@d tracing_lost_chars_code=35 {show characters that aren't in the font}
-@d tracing_commands_code=36 {show command codes at |big_switch|}
-@d tracing_restores_code=37 {show equivalents when they are restored}
-@d uc_hyph_code=38 {hyphenate words beginning with a capital letter}
-@d output_penalty_code=39 {penalty found at current page break}
-@d max_dead_cycles_code=40 {bound on consecutive dead cycles of output}
-@d hang_after_code=41 {hanging indentation changes after this many lines}
-@d floating_penalty_code=42 {penalty for insertions held over after a split}
-@d global_defs_code=43 {override \.{\\global} specifications}
-@d cur_fam_code=44 {current family}
-@d escape_char_code=45 {escape character for token output}
-@d default_hyphen_char_code=46 {value of \.{\\hyphenchar} when a font is loaded}
-@d default_skew_char_code=47 {value of \.{\\skewchar} when a font is loaded}
-@d end_line_char_code=48 {character placed at the right end of the buffer}
-@d new_line_char_code=49 {character that prints as |print_ln|}
-@d language_code=50 {current hyphenation table}
-@d left_hyphen_min_code=51 {minimum left hyphenation fragment size}
-@d right_hyphen_min_code=52 {minimum right hyphenation fragment size}
-@d holding_inserts_code=53 {do not remove insertion nodes from \.{\\box255}}
-@d error_context_lines_code=54 {maximum intermediate line pairs shown}
-@d tex_int_pars=55 {total number of \TeX's integer parameters}
-@#
-@d pdftex_first_integer_code = tex_int_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_major_version_code = pdftex_first_integer_code + 9 {integer part of the PDF version produced}
-@d pdf_minor_version_code = pdftex_first_integer_code + 10 {fractional part of the PDF version produced}
-@d pdf_force_pagebox_code = pdftex_first_integer_code + 11 {if the PDF inclusion should always use a specific PDF page box}
-@d pdf_pagebox_code = pdftex_first_integer_code + 12 {default pagebox to use for PDF inclusion}
-@d pdf_inclusion_errorlevel_code = pdftex_first_integer_code + 13 {if the PDF inclusion should treat pdfs newer than |pdf_minor_version| as an error}
-@d pdf_gamma_code = pdftex_first_integer_code + 14
-@d pdf_image_gamma_code = pdftex_first_integer_code + 15
-@d pdf_image_hicolor_code = pdftex_first_integer_code + 16
-@d pdf_image_apply_gamma_code = pdftex_first_integer_code + 17
-@d pdf_adjust_spacing_code = pdftex_first_integer_code + 18 {level of spacing adjusting}
-@d pdf_protrude_chars_code = pdftex_first_integer_code + 19 {protrude chars at left/right edge of paragraphs}
-@d pdf_tracing_fonts_code = pdftex_first_integer_code + 20 {level of font detail in log}
-@d pdf_objcompresslevel_code = pdftex_first_integer_code + 21 {activate object streams}
-@d pdf_adjust_interword_glue_code = pdftex_first_integer_code + 22 {adjust interword glue?}
-@d pdf_prepend_kern_code = pdftex_first_integer_code + 23 {prepend kern before certain characters?}
-@d pdf_append_kern_code = pdftex_first_integer_code + 24 {append kern before certain characters?}
-@d pdf_gen_tounicode_code = pdftex_first_integer_code + 25 {generate ToUnicode for fonts?}
-@d pdf_draftmode_code = pdftex_first_integer_code + 26 {switch on draftmode if positive}
-@d pdf_inclusion_copy_font_code = pdftex_first_integer_code + 27 {generate ToUnicode for fonts?}
-@d pdf_suppress_warning_dup_dest_code = pdftex_first_integer_code + 28 {suppress warning about duplicated destinations}
-@d pdf_suppress_warning_dup_map_code = pdftex_first_integer_code + 29 {suppress warning about duplicated map lines}
-@d pdf_suppress_warning_page_group_code = pdftex_first_integer_code + 30 {suppress warning about multiple pdfs with page group}
-@d pdf_info_omit_date_code = pdftex_first_integer_code + 31 {omit generating CreationDate and ModDate}
-@d pdf_suppress_ptex_info_code = pdftex_first_integer_code + 32 {suppress /PTEX.* entries in PDF dictionaries}
-@d pdf_omit_charset_code = pdftex_first_integer_code + 33 {suppress /PTEX.* entries in PDF dictionaries}
-@d pdf_int_pars=pdftex_first_integer_code + 34 {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 eTeX_state_code=etex_int_base+9 {\eTeX\ state variables}
-@d etex_int_pars=eTeX_state_code+eTeX_states {total number of \eTeX's integer parameters}
-@#
-@d int_pars=etex_int_pars {total number of integer parameters}
-@d count_base=int_base+int_pars {256 user \.{\\count} registers}
-@d del_code_base=count_base+256 {256 delimiter code mappings}
-@d dimen_base=del_code_base+256 {beginning of region 6}
-@#
-@d del_code(#)==eqtb[del_code_base+#].int
-@d count(#)==eqtb[count_base+#].int
-@d int_par(#)==eqtb[int_base+#].int {an integer parameter}
-@d pretolerance==int_par(pretolerance_code)
-@d tolerance==int_par(tolerance_code)
-@d line_penalty==int_par(line_penalty_code)
-@d hyphen_penalty==int_par(hyphen_penalty_code)
-@d ex_hyphen_penalty==int_par(ex_hyphen_penalty_code)
-@d club_penalty==int_par(club_penalty_code)
-@d widow_penalty==int_par(widow_penalty_code)
-@d display_widow_penalty==int_par(display_widow_penalty_code)
-@d broken_penalty==int_par(broken_penalty_code)
-@d bin_op_penalty==int_par(bin_op_penalty_code)
-@d rel_penalty==int_par(rel_penalty_code)
-@d pre_display_penalty==int_par(pre_display_penalty_code)
-@d post_display_penalty==int_par(post_display_penalty_code)
-@d inter_line_penalty==int_par(inter_line_penalty_code)
-@d double_hyphen_demerits==int_par(double_hyphen_demerits_code)
-@d final_hyphen_demerits==int_par(final_hyphen_demerits_code)
-@d adj_demerits==int_par(adj_demerits_code)
-@d mag==int_par(mag_code)
-@d delimiter_factor==int_par(delimiter_factor_code)
-@d looseness==int_par(looseness_code)
-@d time==int_par(time_code)
-@d day==int_par(day_code)
-@d month==int_par(month_code)
-@d year==int_par(year_code)
-@d show_box_breadth==int_par(show_box_breadth_code)
-@d show_box_depth==int_par(show_box_depth_code)
-@d hbadness==int_par(hbadness_code)
-@d vbadness==int_par(vbadness_code)
-@d pausing==int_par(pausing_code)
-@d tracing_online==int_par(tracing_online_code)
-@d tracing_macros==int_par(tracing_macros_code)
-@d tracing_stats==int_par(tracing_stats_code)
-@d tracing_paragraphs==int_par(tracing_paragraphs_code)
-@d tracing_pages==int_par(tracing_pages_code)
-@d tracing_output==int_par(tracing_output_code)
-@d tracing_lost_chars==int_par(tracing_lost_chars_code)
-@d tracing_commands==int_par(tracing_commands_code)
-@d tracing_restores==int_par(tracing_restores_code)
-@d uc_hyph==int_par(uc_hyph_code)
-@d output_penalty==int_par(output_penalty_code)
-@d max_dead_cycles==int_par(max_dead_cycles_code)
-@d hang_after==int_par(hang_after_code)
-@d floating_penalty==int_par(floating_penalty_code)
-@d global_defs==int_par(global_defs_code)
-@d cur_fam==int_par(cur_fam_code)
-@d escape_char==int_par(escape_char_code)
-@d default_hyphen_char==int_par(default_hyphen_char_code)
-@d default_skew_char==int_par(default_skew_char_code)
-@d end_line_char==int_par(end_line_char_code)
-@d new_line_char==int_par(new_line_char_code)
-@d language==int_par(language_code)
-@d left_hyphen_min==int_par(left_hyphen_min_code)
-@d right_hyphen_min==int_par(right_hyphen_min_code)
-@d holding_inserts==int_par(holding_inserts_code)
-@d error_context_lines==int_par(error_context_lines_code)
-@#
-@d 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_adjust_interword_glue == int_par(pdf_adjust_interword_glue_code)
-@d pdf_prepend_kern == int_par(pdf_prepend_kern_code)
-@d pdf_append_kern == int_par(pdf_append_kern_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_major_version == int_par(pdf_major_version_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_suppress_warning_dup_dest == int_par(pdf_suppress_warning_dup_dest_code)
-@d pdf_suppress_warning_dup_map == int_par(pdf_suppress_warning_dup_map_code)
-@d pdf_suppress_warning_page_group == int_par(pdf_suppress_warning_page_group_code)
-@d pdf_info_omit_date == int_par(pdf_info_omit_date_code)
-@d pdf_suppress_ptex_info == int_par(pdf_suppress_ptex_info_code)
-@d pdf_omit_charset == int_par(pdf_omit_charset_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)
-
-@<Assign the values |depth_threshold:=show_box_depth|...@>=
-depth_threshold:=show_box_depth;
-breadth_max:=show_box_breadth
-
-@ We can print the symbolic name of an integer parameter as follows.
-
-@p procedure print_param(@!n:integer);
-begin case n of
-pretolerance_code:print_esc("pretolerance");
-tolerance_code:print_esc("tolerance");
-line_penalty_code:print_esc("linepenalty");
-hyphen_penalty_code:print_esc("hyphenpenalty");
-ex_hyphen_penalty_code:print_esc("exhyphenpenalty");
-club_penalty_code:print_esc("clubpenalty");
-widow_penalty_code:print_esc("widowpenalty");
-display_widow_penalty_code:print_esc("displaywidowpenalty");
-broken_penalty_code:print_esc("brokenpenalty");
-bin_op_penalty_code:print_esc("binoppenalty");
-rel_penalty_code:print_esc("relpenalty");
-pre_display_penalty_code:print_esc("predisplaypenalty");
-post_display_penalty_code:print_esc("postdisplaypenalty");
-inter_line_penalty_code:print_esc("interlinepenalty");
-double_hyphen_demerits_code:print_esc("doublehyphendemerits");
-final_hyphen_demerits_code:print_esc("finalhyphendemerits");
-adj_demerits_code:print_esc("adjdemerits");
-mag_code:print_esc("mag");
-delimiter_factor_code:print_esc("delimiterfactor");
-looseness_code:print_esc("looseness");
-time_code:print_esc("time");
-day_code:print_esc("day");
-month_code:print_esc("month");
-year_code:print_esc("year");
-show_box_breadth_code:print_esc("showboxbreadth");
-show_box_depth_code:print_esc("showboxdepth");
-hbadness_code:print_esc("hbadness");
-vbadness_code:print_esc("vbadness");
-pausing_code:print_esc("pausing");
-tracing_online_code:print_esc("tracingonline");
-tracing_macros_code:print_esc("tracingmacros");
-tracing_stats_code:print_esc("tracingstats");
-tracing_paragraphs_code:print_esc("tracingparagraphs");
-tracing_pages_code:print_esc("tracingpages");
-tracing_output_code:print_esc("tracingoutput");
-tracing_lost_chars_code:print_esc("tracinglostchars");
-tracing_commands_code:print_esc("tracingcommands");
-tracing_restores_code:print_esc("tracingrestores");
-uc_hyph_code:print_esc("uchyph");
-output_penalty_code:print_esc("outputpenalty");
-max_dead_cycles_code:print_esc("maxdeadcycles");
-hang_after_code:print_esc("hangafter");
-floating_penalty_code:print_esc("floatingpenalty");
-global_defs_code:print_esc("globaldefs");
-cur_fam_code:print_esc("fam");
-escape_char_code:print_esc("escapechar");
-default_hyphen_char_code:print_esc("defaulthyphenchar");
-default_skew_char_code:print_esc("defaultskewchar");
-end_line_char_code:print_esc("endlinechar");
-new_line_char_code:print_esc("newlinechar");
-language_code:print_esc("language");
-left_hyphen_min_code:print_esc("lefthyphenmin");
-right_hyphen_min_code:print_esc("righthyphenmin");
-holding_inserts_code:print_esc("holdinginserts");
-error_context_lines_code:print_esc("errorcontextlines");
-@#
-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_major_version_code: print_esc("pdfmajorversion");
-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_adjust_interword_glue_code: print_esc("pdfadjustinterwordglue");
-pdf_prepend_kern_code: print_esc("pdfprependkern");
-pdf_append_kern_code: print_esc("pdfappendkern");
-pdf_gen_tounicode_code: print_esc("pdfgentounicode");
-pdf_draftmode_code: print_esc("pdfdraftmode");
-pdf_inclusion_copy_font_code: print_esc("pdfinclusioncopyfonts");
-pdf_suppress_warning_dup_dest_code: print_esc("pdfsuppresswarningdupdest");
-pdf_suppress_warning_dup_map_code: print_esc("pdfsuppresswarningdupmap");
-pdf_suppress_warning_page_group_code:print_esc("pdfsuppresswarningpagegroup");
-pdf_info_omit_date_code:print_esc("pdfinfoomitdate");
-pdf_suppress_ptex_info_code: print_esc("pdfsuppressptexinfo");
-pdf_omit_charset_code: print_esc("pdfomitcharset");
-@/@<Cases for |print_param|@>@/
-othercases print("[unknown integer parameter!]")
-endcases;
-end;
-
-@ The integer parameter names must be entered into the hash table.
-
-@<Put each...@>=
-primitive("pretolerance",assign_int,int_base+pretolerance_code);@/
-@!@:pretolerance_}{\.{\\pretolerance} primitive@>
-primitive("tolerance",assign_int,int_base+tolerance_code);@/
-@!@:tolerance_}{\.{\\tolerance} primitive@>
-primitive("linepenalty",assign_int,int_base+line_penalty_code);@/
-@!@:line_penalty_}{\.{\\linepenalty} primitive@>
-primitive("hyphenpenalty",assign_int,int_base+hyphen_penalty_code);@/
-@!@:hyphen_penalty_}{\.{\\hyphenpenalty} primitive@>
-primitive("exhyphenpenalty",assign_int,int_base+ex_hyphen_penalty_code);@/
-@!@:ex_hyphen_penalty_}{\.{\\exhyphenpenalty} primitive@>
-primitive("clubpenalty",assign_int,int_base+club_penalty_code);@/
-@!@:club_penalty_}{\.{\\clubpenalty} primitive@>
-primitive("widowpenalty",assign_int,int_base+widow_penalty_code);@/
-@!@:widow_penalty_}{\.{\\widowpenalty} primitive@>
-primitive("displaywidowpenalty",
- assign_int,int_base+display_widow_penalty_code);@/
-@!@:display_widow_penalty_}{\.{\\displaywidowpenalty} primitive@>
-primitive("brokenpenalty",assign_int,int_base+broken_penalty_code);@/
-@!@:broken_penalty_}{\.{\\brokenpenalty} primitive@>
-primitive("binoppenalty",assign_int,int_base+bin_op_penalty_code);@/
-@!@:bin_op_penalty_}{\.{\\binoppenalty} primitive@>
-primitive("relpenalty",assign_int,int_base+rel_penalty_code);@/
-@!@:rel_penalty_}{\.{\\relpenalty} primitive@>
-primitive("predisplaypenalty",assign_int,int_base+pre_display_penalty_code);@/
-@!@:pre_display_penalty_}{\.{\\predisplaypenalty} primitive@>
-primitive("postdisplaypenalty",assign_int,int_base+post_display_penalty_code);@/
-@!@:post_display_penalty_}{\.{\\postdisplaypenalty} primitive@>
-primitive("interlinepenalty",assign_int,int_base+inter_line_penalty_code);@/
-@!@:inter_line_penalty_}{\.{\\interlinepenalty} primitive@>
-primitive("doublehyphendemerits",
- assign_int,int_base+double_hyphen_demerits_code);@/
-@!@:double_hyphen_demerits_}{\.{\\doublehyphendemerits} primitive@>
-primitive("finalhyphendemerits",
- assign_int,int_base+final_hyphen_demerits_code);@/
-@!@:final_hyphen_demerits_}{\.{\\finalhyphendemerits} primitive@>
-primitive("adjdemerits",assign_int,int_base+adj_demerits_code);@/
-@!@:adj_demerits_}{\.{\\adjdemerits} primitive@>
-primitive("mag",assign_int,int_base+mag_code);@/
-@!@:mag_}{\.{\\mag} primitive@>
-primitive("delimiterfactor",assign_int,int_base+delimiter_factor_code);@/
-@!@:delimiter_factor_}{\.{\\delimiterfactor} primitive@>
-primitive("looseness",assign_int,int_base+looseness_code);@/
-@!@:looseness_}{\.{\\looseness} primitive@>
-primitive("time",assign_int,int_base+time_code);@/
-@!@:time_}{\.{\\time} primitive@>
-primitive("day",assign_int,int_base+day_code);@/
-@!@:day_}{\.{\\day} primitive@>
-primitive("month",assign_int,int_base+month_code);@/
-@!@:month_}{\.{\\month} primitive@>
-primitive("year",assign_int,int_base+year_code);@/
-@!@:year_}{\.{\\year} primitive@>
-primitive("showboxbreadth",assign_int,int_base+show_box_breadth_code);@/
-@!@:show_box_breadth_}{\.{\\showboxbreadth} primitive@>
-primitive("showboxdepth",assign_int,int_base+show_box_depth_code);@/
-@!@:show_box_depth_}{\.{\\showboxdepth} primitive@>
-primitive("hbadness",assign_int,int_base+hbadness_code);@/
-@!@:hbadness_}{\.{\\hbadness} primitive@>
-primitive("vbadness",assign_int,int_base+vbadness_code);@/
-@!@:vbadness_}{\.{\\vbadness} primitive@>
-primitive("pausing",assign_int,int_base+pausing_code);@/
-@!@:pausing_}{\.{\\pausing} primitive@>
-primitive("tracingonline",assign_int,int_base+tracing_online_code);@/
-@!@:tracing_online_}{\.{\\tracingonline} primitive@>
-primitive("tracingmacros",assign_int,int_base+tracing_macros_code);@/
-@!@:tracing_macros_}{\.{\\tracingmacros} primitive@>
-primitive("tracingstats",assign_int,int_base+tracing_stats_code);@/
-@!@:tracing_stats_}{\.{\\tracingstats} primitive@>
-primitive("tracingparagraphs",assign_int,int_base+tracing_paragraphs_code);@/
-@!@:tracing_paragraphs_}{\.{\\tracingparagraphs} primitive@>
-primitive("tracingpages",assign_int,int_base+tracing_pages_code);@/
-@!@:tracing_pages_}{\.{\\tracingpages} primitive@>
-primitive("tracingoutput",assign_int,int_base+tracing_output_code);@/
-@!@:tracing_output_}{\.{\\tracingoutput} primitive@>
-primitive("tracinglostchars",assign_int,int_base+tracing_lost_chars_code);@/
-@!@:tracing_lost_chars_}{\.{\\tracinglostchars} primitive@>
-primitive("tracingcommands",assign_int,int_base+tracing_commands_code);@/
-@!@:tracing_commands_}{\.{\\tracingcommands} primitive@>
-primitive("tracingrestores",assign_int,int_base+tracing_restores_code);@/
-@!@:tracing_restores_}{\.{\\tracingrestores} primitive@>
-primitive("uchyph",assign_int,int_base+uc_hyph_code);@/
-@!@:uc_hyph_}{\.{\\uchyph} primitive@>
-primitive("outputpenalty",assign_int,int_base+output_penalty_code);@/
-@!@:output_penalty_}{\.{\\outputpenalty} primitive@>
-primitive("maxdeadcycles",assign_int,int_base+max_dead_cycles_code);@/
-@!@:max_dead_cycles_}{\.{\\maxdeadcycles} primitive@>
-primitive("hangafter",assign_int,int_base+hang_after_code);@/
-@!@:hang_after_}{\.{\\hangafter} primitive@>
-primitive("floatingpenalty",assign_int,int_base+floating_penalty_code);@/
-@!@:floating_penalty_}{\.{\\floatingpenalty} primitive@>
-primitive("globaldefs",assign_int,int_base+global_defs_code);@/
-@!@:global_defs_}{\.{\\globaldefs} primitive@>
-primitive("fam",assign_int,int_base+cur_fam_code);@/
-@!@:fam_}{\.{\\fam} primitive@>
-primitive("escapechar",assign_int,int_base+escape_char_code);@/
-@!@:escape_char_}{\.{\\escapechar} primitive@>
-primitive("defaulthyphenchar",assign_int,int_base+default_hyphen_char_code);@/
-@!@:default_hyphen_char_}{\.{\\defaulthyphenchar} primitive@>
-primitive("defaultskewchar",assign_int,int_base+default_skew_char_code);@/
-@!@:default_skew_char_}{\.{\\defaultskewchar} primitive@>
-primitive("endlinechar",assign_int,int_base+end_line_char_code);@/
-@!@:end_line_char_}{\.{\\endlinechar} primitive@>
-primitive("newlinechar",assign_int,int_base+new_line_char_code);@/
-@!@:new_line_char_}{\.{\\newlinechar} primitive@>
-primitive("language",assign_int,int_base+language_code);@/
-@!@:language_}{\.{\\language} primitive@>
-primitive("lefthyphenmin",assign_int,int_base+left_hyphen_min_code);@/
-@!@:left_hyphen_min_}{\.{\\lefthyphenmin} primitive@>
-primitive("righthyphenmin",assign_int,int_base+right_hyphen_min_code);@/
-@!@:right_hyphen_min_}{\.{\\righthyphenmin} primitive@>
-primitive("holdinginserts",assign_int,int_base+holding_inserts_code);@/
-@!@:holding_inserts_}{\.{\\holdinginserts} primitive@>
-primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/
-@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
-primitive("pdfoutput",assign_int,int_base+pdf_output_code);@/
-@!@:pdf_output_}{\.{\\pdfoutput} primitive@>
-primitive("pdfcompresslevel",assign_int,int_base+pdf_compress_level_code);@/
-@!@:pdf_compress_level_}{\.{\\pdfcompresslevel} primitive@>
-primitive("pdfobjcompresslevel",assign_int,int_base+pdf_objcompresslevel_code);@/
-@!@:pdf_objcompresslevel_}{\.{\\pdfobjcompresslevel} primitive@>
-primitive("pdfdecimaldigits",assign_int,int_base+pdf_decimal_digits_code);@/
-@!@:pdf_decimal_digits_}{\.{\\pdfdecimaldigits} primitive@>
-primitive("pdfmovechars",assign_int,int_base+pdf_move_chars_code);@/
-@!@:pdf_move_chars_}{\.{\\pdfmovechars} primitive@>
-primitive("pdfimageresolution",assign_int,int_base+pdf_image_resolution_code);@/
-@!@:pdf_image_resolution_}{\.{\\pdfimageresolution} primitive@>
-primitive("pdfpkresolution",assign_int,int_base+pdf_pk_resolution_code);@/
-@!@:pdf_pk_resolution_}{\.{\\pdfpkresolution} primitive@>
-primitive("pdfuniqueresname",assign_int,int_base+pdf_unique_resname_code);@/
-@!@:pdf_unique_resname_}{\.{\\pdfuniqueresname} primitive@>
-primitive("pdfoptionpdfminorversion",assign_int,int_base+pdf_minor_version_code);@/
-@!@:pdf_minor_version_}{\.{\\pdfoptionpdfminorversion} primitive@>
-primitive("pdfoptionalwaysusepdfpagebox",assign_int,int_base+pdf_option_always_use_pdfpagebox_code);@/
-@!@:pdf_option_always_use_pdfpagebox_}{\.{\\pdfoptionalwaysusepdfpagebox} primitive@>
-primitive("pdfoptionpdfinclusionerrorlevel",assign_int,int_base+pdf_option_pdf_inclusion_errorlevel_code);@/
-@!@:pdf_option_pdf_inclusion_errorlevel_}{\.{\\pdfoptionpdfinclusionerrorlevel} primitive@>
-primitive("pdfmajorversion",assign_int,int_base+pdf_major_version_code);@/
-@!@:pdf_major_version_}{\.{\\pdfmajorversion} primitive@>
-primitive("pdfminorversion",assign_int,int_base+pdf_minor_version_code);@/
-@!@:pdf_minor_version_}{\.{\\pdfminorversion} primitive@>
-primitive("pdfforcepagebox",assign_int,int_base+pdf_force_pagebox_code);@/
-@!@:pdf_force_pagebox_}{\.{\\pdfforcepagebox} primitive@>
-primitive("pdfpagebox",assign_int,int_base+pdf_pagebox_code);@/
-@!@:pdf_pagebox_}{\.{\\pdfpagebox} primitive@>
-primitive("pdfinclusionerrorlevel",assign_int,int_base+pdf_inclusion_errorlevel_code);@/
-@!@:pdf_inclusion_errorlevel_}{\.{\\pdfinclusionerrorlevel} primitive@>
-primitive("pdfgamma",assign_int,int_base+pdf_gamma_code);@/
-@!@:pdf_gamma_}{\.{\\pdfgamma} primitive@>
-primitive("pdfimagegamma",assign_int,int_base+pdf_image_gamma_code);@/
-@!@:pdf_image_gamma_}{\.{\\pdfimagegamma} primitive@>
-primitive("pdfimagehicolor",assign_int,int_base+pdf_image_hicolor_code);@/
-@!@:pdf_image_hicolor_}{\.{\\pdfimagehicolor} primitive@>
-primitive("pdfimageapplygamma",assign_int,int_base+pdf_image_apply_gamma_code);@/
-@!@:pdf_image_apply_gamma_}{\.{\\pdfimageapplygamma} primitive@>
-primitive("pdfadjustspacing",assign_int,int_base+pdf_adjust_spacing_code);@/
-@!@:pdf_adjust_spacing_}{\.{\\pdfadjustspacing} primitive@>
-primitive("pdfprotrudechars",assign_int,int_base+pdf_protrude_chars_code);@/
-@!@:pdf_protrude_chars_}{\.{\\pdfprotrudechars} primitive@>
-primitive("pdftracingfonts",assign_int,int_base+pdf_tracing_fonts_code);@/
-@!@:pdf_tracing_fonts_}{\.{\\pdftracingfonts} primitive@>
-primitive("pdfadjustinterwordglue",assign_int,int_base+pdf_adjust_interword_glue_code);@/
-@!@:pdf_adjust_interword_glue_}{\.{\\pdfadjustinterwordglue} primitive@>
-primitive("pdfprependkern",assign_int,int_base+pdf_prepend_kern_code);@/
-@!@:pdf_prepend_kern_}{\.{\\pdfprependkern} primitive@>
-primitive("pdfappendkern",assign_int,int_base+pdf_append_kern_code);@/
-@!@:pdf_append_kern_}{\.{\\pdfappendkern} primitive@>
-primitive("pdfgentounicode",assign_int,int_base+pdf_gen_tounicode_code);@/
-@!@:pdf_gen_tounicode_}{\.{\\pdfgentounicode} primitive@>
-primitive("pdfdraftmode",assign_int,int_base+pdf_draftmode_code);@/
-@!@:pdf_draftmode_}{\.{\\pdfdraftmode} primitive@>
-primitive("pdfinclusioncopyfonts",assign_int,int_base+pdf_inclusion_copy_font_code);@/
-@!@:pdf_inclusion_copy_font_}{\.{\\pdfinclusioncopyfonts} primitive@>
-
-primitive("pdfsuppresswarningdupdest",assign_int,int_base+pdf_suppress_warning_dup_dest_code);@/
-@!@:pdf_suppress_warning_dup_dest_}{\.{\\pdfsuppresswarningdupdest} primitive@>
-
-primitive("pdfsuppresswarningdupmap",assign_int,int_base+pdf_suppress_warning_dup_map_code);@/
-@!@:pdf_suppress_warning_dup_map_}{\.{\\pdfsuppresswarningdupmap} primitive@>
-
-primitive("pdfsuppresswarningpagegroup",assign_int,int_base+pdf_suppress_warning_page_group_code);@/
-@!@:pdf_suppress_warning_page_group_}{\.{\\pdfsuppresswarningpagegroup} primitive@>
-
-primitive("pdfinfoomitdate",assign_int,int_base+pdf_info_omit_date_code);@/
-@!@:pdf_info_omit_date_}{\.{\\pdfinfoomitdate} primitive@>
-
-primitive("pdfsuppressptexinfo",assign_int,int_base+pdf_suppress_ptex_info_code);@/
-@!@:pdf_suppress_ptex_info_}{\.{\\pdfsuppressptexinfo} primitive@>
-
-primitive("pdfomitcharset",assign_int,int_base+pdf_omit_charset_code);@/
-@!@:pdf_omit_charset}{\.{\\pdfomitcharset} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-assign_int: if chr_code<count_base then print_param(chr_code-int_base)
- else begin print_esc("count"); print_int(chr_code-count_base);
- end;
-
-@ The integer parameters should really be initialized by a macro package;
-the following initialization does the minimum to keep \TeX\ from
-complete failure.
-@^null delimiter@>
-
-@<Initialize table entries...@>=
-for k:=int_base to del_code_base-1 do eqtb[k].int:=0;
-mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25;
-escape_char:="\"; end_line_char:=carriage_return;
-for k:=0 to 255 do del_code(k):=-1;
-del_code("."):=0; {this null delimiter is used in error recovery}
-
-@ The following procedure, which is called just before \TeX\ initializes its
-input and output, establishes the initial values of the date and time.
-@^system dependencies@>
-Since standard \PASCAL\ cannot provide such information, something special
-is needed. The program here simply assumes that suitable values appear in
-the global variables \\{sys\_time}, \\{sys\_day}, \\{sys\_month}, and
-\\{sys\_year} (which are initialized to noon on 4 July 1776,
-in case the implementor is careless).
-
-@p procedure fix_date_and_time;
-begin sys_time:=12*60;
-sys_day:=4; sys_month:=7; sys_year:=1776; {self-evident truths}
-time:=sys_time; {minutes since midnight}
-day:=sys_day; {day of the month}
-month:=sys_month; {month of the year}
-year:=sys_year; {Anno Domini}
-end;
-
-@ @<Show equivalent |n|, in region 5@>=
-begin if n<count_base then print_param(n-int_base)
-else if n<del_code_base then
- begin print_esc("count"); print_int(n-count_base);
- end
-else begin print_esc("delcode"); print_int(n-del_code_base);
- end;
-print_char("="); print_int(eqtb[n].int);
-end
-
-@ @<Set variable |c| to the current escape character@>=c:=escape_char
-
-@ @<Character |s| is the current new-line character@>=s=new_line_char
-
-@ \TeX\ is occasionally supposed to print diagnostic information that
-goes only into the transcript file, unless |tracing_online| is positive.
-Here are two routines that adjust the destination of print commands:
-
-@p procedure begin_diagnostic; {prepare to do some tracing}
-begin old_setting:=selector;
-if (tracing_online<=0)and(selector=term_and_log) then
- begin decr(selector);
- if history=spotless then history:=warning_issued;
- end;
-end;
-@#
-procedure end_diagnostic(@!blank_line:boolean);
- {restore proper conditions after tracing}
-begin print_nl("");
-if blank_line then print_ln;
-selector:=old_setting;
-end;
-
-@ Of course we had better declare a few more global variables, if the previous
-routines are going to work.
-
-@<Glob...@>=
-@!old_setting:0..max_selector;
-@!sys_time,@!sys_day,@!sys_month,@!sys_year:integer;
- {date and time supplied by external system}
-
-@ The final region of |eqtb| contains the dimension parameters defined
-here, and the 256 \.{\\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 pdftex_first_dimen_code = 21 {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 pdf_page_width_code = pdftex_first_dimen_code + 2 {page width of the PDF output}
-@d pdf_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 256 user-defined \.{\\dimen} registers}
-@d eqtb_size=scaled_base+255 {largest subscript of |eqtb|}
-@#
-@d dimen(#)==eqtb[scaled_base+#].sc
-@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity}
-@d par_indent==dimen_par(par_indent_code)
-@d math_surround==dimen_par(math_surround_code)
-@d line_skip_limit==dimen_par(line_skip_limit_code)
-@d hsize==dimen_par(hsize_code)
-@d vsize==dimen_par(vsize_code)
-@d max_depth==dimen_par(max_depth_code)
-@d split_max_depth==dimen_par(split_max_depth_code)
-@d box_max_depth==dimen_par(box_max_depth_code)
-@d hfuzz==dimen_par(hfuzz_code)
-@d vfuzz==dimen_par(vfuzz_code)
-@d delimiter_shortfall==dimen_par(delimiter_shortfall_code)
-@d null_delimiter_space==dimen_par(null_delimiter_space_code)
-@d script_space==dimen_par(script_space_code)
-@d pre_display_size==dimen_par(pre_display_size_code)
-@d display_width==dimen_par(display_width_code)
-@d display_indent==dimen_par(display_indent_code)
-@d overfull_rule==dimen_par(overfull_rule_code)
-@d hang_indent==dimen_par(hang_indent_code)
-@d h_offset==dimen_par(h_offset_code)
-@d v_offset==dimen_par(v_offset_code)
-@d emergency_stretch==dimen_par(emergency_stretch_code)
-@d pdf_h_origin == dimen_par(pdf_h_origin_code)
-@d pdf_v_origin == dimen_par(pdf_v_origin_code)
-@d pdf_page_width == dimen_par(pdf_page_width_code)
-@d pdf_page_height == dimen_par(pdf_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");
-pdf_h_origin_code: print_esc("pdfhorigin");
-pdf_v_origin_code: print_esc("pdfvorigin");
-pdf_page_width_code: print_esc("pdfpagewidth");
-pdf_page_height_code: print_esc("pdfpageheight");
-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("parindent",assign_dimen,dimen_base+par_indent_code);@/
-@!@:par_indent_}{\.{\\parindent} primitive@>
-primitive("mathsurround",assign_dimen,dimen_base+math_surround_code);@/
-@!@:math_surround_}{\.{\\mathsurround} primitive@>
-primitive("lineskiplimit",assign_dimen,dimen_base+line_skip_limit_code);@/
-@!@:line_skip_limit_}{\.{\\lineskiplimit} primitive@>
-primitive("hsize",assign_dimen,dimen_base+hsize_code);@/
-@!@:hsize_}{\.{\\hsize} primitive@>
-primitive("vsize",assign_dimen,dimen_base+vsize_code);@/
-@!@:vsize_}{\.{\\vsize} primitive@>
-primitive("maxdepth",assign_dimen,dimen_base+max_depth_code);@/
-@!@:max_depth_}{\.{\\maxdepth} primitive@>
-primitive("splitmaxdepth",assign_dimen,dimen_base+split_max_depth_code);@/
-@!@:split_max_depth_}{\.{\\splitmaxdepth} primitive@>
-primitive("boxmaxdepth",assign_dimen,dimen_base+box_max_depth_code);@/
-@!@:box_max_depth_}{\.{\\boxmaxdepth} primitive@>
-primitive("hfuzz",assign_dimen,dimen_base+hfuzz_code);@/
-@!@:hfuzz_}{\.{\\hfuzz} primitive@>
-primitive("vfuzz",assign_dimen,dimen_base+vfuzz_code);@/
-@!@:vfuzz_}{\.{\\vfuzz} primitive@>
-primitive("delimitershortfall",
- assign_dimen,dimen_base+delimiter_shortfall_code);@/
-@!@:delimiter_shortfall_}{\.{\\delimitershortfall} primitive@>
-primitive("nulldelimiterspace",
- assign_dimen,dimen_base+null_delimiter_space_code);@/
-@!@:null_delimiter_space_}{\.{\\nulldelimiterspace} primitive@>
-primitive("scriptspace",assign_dimen,dimen_base+script_space_code);@/
-@!@:script_space_}{\.{\\scriptspace} primitive@>
-primitive("predisplaysize",assign_dimen,dimen_base+pre_display_size_code);@/
-@!@:pre_display_size_}{\.{\\predisplaysize} primitive@>
-primitive("displaywidth",assign_dimen,dimen_base+display_width_code);@/
-@!@:display_width_}{\.{\\displaywidth} primitive@>
-primitive("displayindent",assign_dimen,dimen_base+display_indent_code);@/
-@!@:display_indent_}{\.{\\displayindent} primitive@>
-primitive("overfullrule",assign_dimen,dimen_base+overfull_rule_code);@/
-@!@:overfull_rule_}{\.{\\overfullrule} primitive@>
-primitive("hangindent",assign_dimen,dimen_base+hang_indent_code);@/
-@!@:hang_indent_}{\.{\\hangindent} primitive@>
-primitive("hoffset",assign_dimen,dimen_base+h_offset_code);@/
-@!@:h_offset_}{\.{\\hoffset} primitive@>
-primitive("voffset",assign_dimen,dimen_base+v_offset_code);@/
-@!@:v_offset_}{\.{\\voffset} primitive@>
-primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/
-@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@>
-primitive("pdfhorigin",assign_dimen,dimen_base+pdf_h_origin_code);@/
-@!@:pdf_h_origin_}{\.{\\pdfhorigin} primitive@>
-primitive("pdfvorigin",assign_dimen,dimen_base+pdf_v_origin_code);@/
-@!@:pdf_v_origin_}{\.{\\pdfvorigin} primitive@>
-primitive("pdfpagewidth",assign_dimen,dimen_base+pdf_page_width_code);@/
-@!@:pdf_page_width_}{\.{\\pdfpagewidth} primitive@>
-primitive("pdfpageheight",assign_dimen,dimen_base+pdf_page_height_code);@/
-@!@:pdf_page_height_}{\.{\\pdfpageheight} primitive@>
-primitive("pdflinkmargin",assign_dimen,dimen_base+pdf_link_margin_code);@/
-@!@:pdf_link_margin_}{\.{\\pdflinkmargin} primitive@>
-primitive("pdfdestmargin",assign_dimen,dimen_base+pdf_dest_margin_code);@/
-@!@:pdf_dest_margin_}{\.{\\pdfdestmargin} primitive@>
-primitive("pdfthreadmargin",assign_dimen,dimen_base+pdf_thread_margin_code);@/
-@!@:pdf_thread_margin_}{\.{\\pdfthreadmargin} primitive@>
-primitive("pdffirstlineheight",assign_dimen,dimen_base+pdf_first_line_height_code);@/
-@!@:pdf_first_line_height_}{\.{\\pdffirstlineheight} primitive@>
-primitive("pdflastlinedepth",assign_dimen,dimen_base+pdf_last_line_depth_code);@/
-@!@:pdf_last_line_depth_}{\.{\\pdflastlinedepth} primitive@>
-primitive("pdfeachlineheight",assign_dimen,dimen_base+pdf_each_line_height_code);@/
-@!@:pdf_each_line_height_}{\.{\\pdfeachlineheight} primitive@>
-primitive("pdfeachlinedepth",assign_dimen,dimen_base+pdf_each_line_depth_code);@/
-@!@:pdf_each_line_depth_}{\.{\\pdfeachlinedepth} primitive@>
-primitive("pdfignoreddimen",assign_dimen,dimen_base+pdf_ignored_dimen_code);@/
-@!@:pdf_ignored_dimen_}{\.{\\pdfignoreddimen} primitive@>
-primitive("pdfpxdimen",assign_dimen,dimen_base+pdf_px_dimen_code);@/
-@!@:pdf_px_dimen_}{\.{\\pdfpxdimen} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-assign_dimen: if chr_code<scaled_base then
- print_length_param(chr_code-dimen_base)
- else begin print_esc("dimen"); print_int(chr_code-scaled_base);
- end;
-
-@ @<Initialize table entries...@>=
-for k:=dimen_base to eqtb_size do eqtb[k].sc:=0;
-
-@ @<Show equivalent |n|, in region 6@>=
-begin if n<scaled_base then print_length_param(n-dimen_base)
-else begin print_esc("dimen"); print_int(n-scaled_base);
- end;
-print_char("="); print_scaled(eqtb[n].sc); print("pt");
-end
-
-@ Here is a procedure that displays the contents of |eqtb[n]|
-symbolically.
-
-@p@t\4@>@<Declare the procedure called |print_cmd_chr|@>@;@/
-@!stat procedure show_eqtb(@!n:pointer);
-begin if n<active_base then print_char("?") {this can't happen}
-else if n<glue_base then @<Show equivalent |n|, in region 1 or 2@>
-else if n<local_base then @<Show equivalent |n|, in region 3@>
-else if n<int_base then @<Show equivalent |n|, in region 4@>
-else if n<dimen_base then @<Show equivalent |n|, in region 5@>
-else if n<=eqtb_size then @<Show equivalent |n|, in region 6@>
-else print_char("?"); {this can't happen either}
-end;
-tats
-
-@ The last two regions of |eqtb| have fullword values instead of the
-three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary,
-but \TeX\ needs to store the |eq_level| information in another array
-called |xeq_level|.
-
-@<Glob...@>=
-@!eqtb:array[active_base..eqtb_size] of memory_word;
-@!xeq_level:array[int_base..eqtb_size] of quarterword;
-
-@ @<Set init...@>=
-for k:=int_base to eqtb_size do xeq_level[k]:=level_one;
-
-@ When the debugging routine |search_mem| is looking for pointers having a
-given value, it is interested only in regions 1 to~3 of~|eqtb|, and in the
-first part of region~4.
-
-@<Search |eqtb| for equivalents equal to |p|@>=
-for q:=active_base to box_base+255 do
- begin if equiv(q)=p then
- begin print_nl("EQUIV("); print_int(q); print_char(")");
- end;
- end
-
-@* \[18] The hash table.
-Control sequences are stored and retrieved by means of a fairly standard hash
-table algorithm called the method of ``coalescing lists'' (cf.\ Algorithm 6.4C
-in {\sl The Art of Computer Programming\/}). Once a control sequence enters the
-table, it is never removed, because there are complicated situations
-involving \.{\\gdef} where the removal of a control sequence at the end of
-a group would be a mistake preventable only by the introduction of a
-complicated reference-count mechanism.
-
-The actual sequence of letters forming a control sequence identifier is
-stored in the |str_pool| array together with all the other strings. An
-auxiliary array |hash| consists of items with two halfword fields per
-word. The first of these, called |next(p)|, points to the next identifier
-belonging to the same coalesced list as the identifier corresponding to~|p|;
-and the other, called |text(p)|, points to the |str_start| entry for
-|p|'s identifier. If position~|p| of the hash table is empty, we have
-|text(p)=0|; if position |p| is either empty or the end of a coalesced
-hash list, we have |next(p)=0|. An auxiliary pointer variable called
-|hash_used| is maintained in such a way that all locations |p>=hash_used|
-are nonempty. The global variable |cs_count| tells how many multiletter
-control sequences have been defined, if statistics are being kept.
-
-A global boolean variable called |no_new_control_sequence| is set to
-|true| during the time that new hash table entries are forbidden.
-
-@d next(#) == hash[#].lh {link for coalesced lists}
-@d text(#) == hash[#].rh {string number for control sequence name}
-@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
-@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name}
-
-@<Glob...@>=
-@!hash: array[hash_base..undefined_control_sequence-1] of two_halves;
- {the hash table}
-@!hash_used:pointer; {allocation pointer for |hash|}
-@!no_new_control_sequence:boolean; {are new identifiers legal?}
-@!cs_count:integer; {total number of known identifiers}
-
-@ Primitive support needs a few extra variables and definitions
-
-@d prim_prime=1777 {about 85\pct! of |primitive_size|}
-@d prim_base=1
-@d prim_next(#) == prim[#].lh {link for coalesced lists}
-@d prim_text(#) == prim[#].rh {string number for control sequence name, plus one}
-@d prim_is_full == (prim_used=prim_base) {test if all positions are occupied}
-@d prim_eq_level_field(#)==#.hh.b1
-@d prim_eq_type_field(#)==#.hh.b0
-@d prim_equiv_field(#)==#.hh.rh
-@d prim_eq_level(#)==prim_eq_level_field(eqtb[prim_eqtb_base+#]) {level of definition}
-@d prim_eq_type(#)==prim_eq_type_field(eqtb[prim_eqtb_base+#]) {command code for equivalent}
-@d prim_equiv(#)==prim_equiv_field(eqtb[prim_eqtb_base+#]) {equivalent value}
-@d undefined_primitive=0
-@d biggest_char=255 { 65535 in XeTeX }
-
-@<Glob...@>=
-@!prim: array [0..prim_size] of two_halves; {the primitives table}
-@!prim_used:pointer; {allocation pointer for |prim|}
-
-@ @<Set init...@>=
-no_new_control_sequence:=true; {new identifiers are usually forbidden}
-prim_next(0):=0; prim_text(0):=0;
-for k:=1 to prim_size do prim[k]:=prim[0];
-next(hash_base):=0; text(hash_base):=0;
-for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base];
-
-@ @<Initialize table entries...@>=
-prim_used:=prim_size; {nothing is used}
-hash_used:=frozen_control_sequence; {nothing is used}
-cs_count:=0;
-eq_type(frozen_dont_expand):=dont_expand;
-text(frozen_dont_expand):="notexpanded:";
-@.notexpanded:@>
-
-eq_type(frozen_primitive):=ignore_spaces;
-equiv(frozen_primitive):=1;
-eq_level(frozen_primitive):=level_one;
-text(frozen_primitive):="pdfprimitive";
-@ Here is the subroutine that searches the hash table for an identifier
-that matches a given string of length |l>1| appearing in |buffer[j..
-(j+l-1)]|. If the identifier is found, the corresponding hash table address
-is returned. Otherwise, if the global variable |no_new_control_sequence|
-is |true|, the dummy address |undefined_control_sequence| is returned.
-Otherwise the identifier is inserted into the hash table and its location
-is returned.
-
-@p function id_lookup(@!j,@!l:integer):pointer; {search the hash table}
-label found; {go here if you found it}
-var h:integer; {hash code}
-@!d:integer; {number of characters in incomplete current string}
-@!p:pointer; {index in |hash| array}
-@!k:pointer; {index in |buffer| array}
-begin @<Compute the hash code |h|@>;
-p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
-loop@+begin if text(p)>0 then if length(text(p))=l then
- if str_eq_buf(text(p),j) then goto found;
- if next(p)=0 then
- begin if no_new_control_sequence then
- p:=undefined_control_sequence
- else @<Insert a new control sequence after |p|, then make
- |p| point to it@>;
- goto found;
- end;
- p:=next(p);
- end;
-found: id_lookup:=p;
-end;
-
-@ @<Insert a new control...@>=
-begin if text(p)>0 then
- begin repeat if hash_is_full then overflow("hash size",hash_size);
-@:TeX capacity exceeded hash size}{\quad hash size@>
- decr(hash_used);
- until text(hash_used)=0; {search for an empty location in |hash|}
- next(p):=hash_used; p:=hash_used;
- end;
-str_room(l); d:=cur_length;
-while pool_ptr>str_start[str_ptr] do
- begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr];
- end; {move current string up to make room for another}
-for k:=j to j+l-1 do append_char(buffer[k]);
-text(p):=make_string; pool_ptr:=pool_ptr+d;
-@!stat incr(cs_count);@+tats@;@/
-end
-
-@ The value of |hash_prime| should be roughly 85\pct! of |hash_size|, and it
-should be a prime number. The theory of hashing tells us to expect fewer
-than two table probes, on the average, when the search is successful.
-[See J.~S. Vitter, {\sl Journal of the ACM\/ \bf30} (1983), 231--258.]
-@^Vitter, Jeffrey Scott@>
-
-@<Compute the hash code |h|@>=
-h:=buffer[j];
-for k:=j+1 to j+l-1 do
- begin h:=h+h+buffer[k];
- while h>=hash_prime do h:=h-hash_prime;
- end
-
-@ Here is the subroutine that searches the primitive table for an identifier:
-
-@p function prim_lookup(@!s:str_number):pointer; {search the primitives table}
-label found; {go here if you found it}
-var h:integer; {hash code}
-@!p:pointer; {index in |hash| array}
-@!k:pointer; {index in string pool}
-@!j,@!l:integer;
-begin
-if s<=biggest_char then begin
- if s<0 then begin p:=undefined_primitive; goto found; end
- else p:=(s mod prim_prime)+prim_base; {we start searching here}
- end
-else begin
- j:=str_start[s];
- if s = str_ptr then l := cur_length else l := length(s);
- @<Compute the primitive code |h|@>;
- p:=h+prim_base; {we start searching here; note that |0<=h<prim_prime|}
- end;
-loop@+begin
- if prim_text(p)>1+biggest_char then { |p| points a multi-letter primitive }
- begin if length(prim_text(p)-1)=l then
- if str_eq_str(prim_text(p)-1,s) then goto found;
- end
- else if prim_text(p)=1+s then goto found; { |p| points a single-letter primitive }
- if prim_next(p)=0 then
- begin if no_new_control_sequence then
- p:=undefined_primitive
- else @<Insert a new primitive after |p|, then make
- |p| point to it@>;
- goto found;
- end;
- p:=prim_next(p);
- end;
-found: prim_lookup:=p;
-end;
-
-@ @<Insert a new primitive...@>=
-begin if prim_text(p)>0 then
- begin repeat if prim_is_full then overflow("primitive size",prim_size);
-@:TeX capacity exceeded primitive size}{\quad primitive size@>
- decr(prim_used);
- until prim_text(prim_used)=0; {search for an empty location in |prim|}
- prim_next(p):=prim_used; p:=prim_used;
- end;
-prim_text(p):=s+1;
-end
-
-@ The value of |prim_prime| should be roughly 85\pct! of
-|prim_size|, and it should be a prime number.
-
-@<Compute the primitive code |h|@>=
-h:=str_pool[j];
-for k:=j+1 to j+l-1 do
- begin h:=h+h+str_pool[k];
- while h>=prim_prime do h:=h-prim_prime;
- end
-
-
-@ Single-character control sequences do not need to be looked up in a hash
-table, since we can use the character code itself as a direct address.
-The procedure |print_cs| prints the name of a control sequence, given
-a pointer to its address in |eqtb|. A space is printed after the name
-unless it is a single nonletter or an active character. This procedure
-might be invoked with invalid data, so it is ``extra robust.'' The
-individual characters must be printed one at a time using |print|, since
-they may be unprintable.
-
-@<Basic printing...@>=
-procedure print_cs(@!p:integer); {prints a purported control sequence}
-begin if p<hash_base then {single character}
- if p>=single_base then
- if p=null_cs then
- begin print_esc("csname"); print_esc("endcsname"); print_char(" ");
- end
- else begin print_esc(p-single_base);
- if cat_code(p-single_base)=letter then print_char(" ");
- end
- else if p<active_base then print_esc("IMPOSSIBLE.")
-@.IMPOSSIBLE@>
- else print(p-active_base)
-else if p>=undefined_control_sequence then print_esc("IMPOSSIBLE.")
-else if (text(p)<0)or(text(p)>=str_ptr) then print_esc("NONEXISTENT.")
-@.NONEXISTENT@>
-else begin
- if (p>=prim_eqtb_base)and(p<frozen_null_font) then
- print_esc(prim_text(p-prim_eqtb_base)-1) else print_esc(text(p));
- print_char(" ");
- end;
-end;
-
-@ Here is a similar procedure; it avoids the error checks, and it never
-prints a space after the control sequence.
-
-@<Basic printing procedures@>=
-procedure sprint_cs(@!p:pointer); {prints a control sequence}
-begin if p<hash_base then
- if p<single_base then print(p-active_base)
- else if p<null_cs then print_esc(p-single_base)
- else begin print_esc("csname"); print_esc("endcsname");
- end
-else if (p>=prim_eqtb_base)and(p<frozen_null_font) then
- print_esc(prim_text(p-prim_eqtb_base)-1)
-else print_esc(text(p));
-end;
-
-@ We need to put \TeX's ``primitive'' control sequences into the hash
-table, together with their command code (which will be the |eq_type|)
-and an operand (which will be the |equiv|). The |primitive| procedure
-does this, in a way that no \TeX\ user can. The global value |cur_val|
-contains the new |eqtb| pointer after |primitive| has acted.
-
-Until pdf\TeX\ 1.40.19 (released in 2018), a bug in primitive handling
-caused, e.g., \.{\\pdfprimitive\\ \\q} to swallow the \.{\\q} instead of
-giving an undefined control sequence error. The original report was
-posted by Hironori Kitagawa
-(\.{tug.org/pipermail/tex-k/2017-October/002816.html}). Largely
-quoting from that message:
-
-The cause was |cur_tok| not being set in the ``Cases of |main_control|\dots''
-module, because |back_input| unscans the token, but only looks at
-|cur_tok|, which represents the internalized \.{\\pdfprimitive} at that
-time. So \.{\\pdfprimitive\\vrule\\q} becomes ``(internalized
-\.{\\pdfprimitive})''\.{\\q}, hence no error (and \.{\\vrule} disappears).
-
-Hironori's explanation of the previous behavior and fix continues (off-list):
-
-\yskip\textindent{*} |back_input| (and similar routine $\langle\,$Insert token
-|p| into \TeX's input$\,\rangle$) only stores |cur_tok| to a token list.
-
-\textindent{*} When \TeX\ gets input from a token list (at module
-$\langle\,$Input from token list, |goto restart| \dots$\,\rangle$),
-\TeX\ looks at the saved |cur_tok| value $t$, and recover the command
-code (|cur_cmd|) and its modifier (|cur_chr|) from it:
-
-{\advance\leftskip by 1.5em
-\textindent{--} If |t>=cs_token_flag|, $t$ points to an |eqtb| location
-|t - cs_token_flag|.
-
-\textindent{--} If |t<cs_token_flag|, |cur_cmd| and |cur_chr| are set
-with |cur_cmd:=t div @'400; cur_chr:=t mod @'400|.
-
-\textindent{--} This $t$ is used to display the token (|show_token_list|).
-\par}
-
-\textindent{*} pdf\TeX\ defines |cs_token_flag| as \.{"FFF}. So simply
-using |cur_tok:=(cur_cmd*@'400)+cur_chr| by \.{\\pdfprimitive} does not
-work correctly with primitives whose command codes |cur_cmd| $\ge16$.
-
-Increasing |cs_token_flag| to \.{"FFFF} or somewhat higher
-might suffice for fixing this situation in pdf\TeX.
-However, this approach does not seem good, because
-
-\textindent{1)} an (indirect) mapping from |cur_tok| to control sequence
-name is needed anyway, for displaying the token, and
-
-\textindent{2)} this does not work in Japanese e-(u)p\TeX.
-
-Thus, we now put |prim_eqtb| entries into the end of region 2 of
-|eqtb| (which contains some frozen primitives, such as ``frozen \.{\\fi}''
-and ``frozen \.{\\cr}''), thus treating |prim_eqtb| entries as a permanent
-location for primitives.
-
-@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword);
-var k:pool_pointer; {index into |str_pool|}
-@!j:0..buf_size; {index into |buffer|}
-@!l:small_number; {length of the string}
-@!prim_val:integer; {needed to fill |prim_eqtb|}
-begin if s<256 then begin
- cur_val:=s+single_base;
- prim_val:=prim_lookup(s);
-end
-else begin k:=str_start[s]; l:=str_start[s+1]-k;
- {we will move |s| into the (possibly non-empty) |buffer|}
- if first+l>buf_size+1 then
- overflow("buffer size",buf_size);
-@:TeX capacity exceeded buffer size}{\quad buffer size@>
- for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]);
- cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|}
- flush_string; text(cur_val):=s; {we don't want to have the string twice}
- prim_val:=prim_lookup(s);
- end;
-eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o;
-prim_eq_level(prim_val):=level_one;
-prim_eq_type(prim_val):=c;
-prim_equiv(prim_val):=o;
-end;
-tini
-
-@ Many of \TeX's primitives need no |equiv|, since they are identifiable
-by their |eq_type| alone. These primitives are loaded into the hash table
-as follows:
-
-@<Put each of \TeX's primitives into the hash table@>=
-primitive(" ",ex_space,0);@/
-@!@:Single-character primitives /}{\quad\.{\\\ }@>
-primitive("/",ital_corr,0);@/
-@!@:Single-character primitives /}{\quad\.{\\/}@>
-primitive("accent",accent,0);@/
-@!@:accent_}{\.{\\accent} primitive@>
-primitive("advance",advance,0);@/
-@!@:advance_}{\.{\\advance} primitive@>
-primitive("afterassignment",after_assignment,0);@/
-@!@:after_assignment_}{\.{\\afterassignment} primitive@>
-primitive("aftergroup",after_group,0);@/
-@!@:after_group_}{\.{\\aftergroup} primitive@>
-primitive("begingroup",begin_group,0);@/
-@!@:begin_group_}{\.{\\begingroup} primitive@>
-primitive("char",char_num,0);@/
-@!@:char_}{\.{\\char} primitive@>
-primitive("csname",cs_name,0);@/
-@!@:cs_name_}{\.{\\csname} primitive@>
-primitive("delimiter",delim_num,0);@/
-@!@:delimiter_}{\.{\\delimiter} primitive@>
-primitive("divide",divide,0);@/
-@!@:divide_}{\.{\\divide} primitive@>
-primitive("endcsname",end_cs_name,0);@/
-@!@:end_cs_name_}{\.{\\endcsname} primitive@>
-primitive("endgroup",end_group,0);
-@!@:end_group_}{\.{\\endgroup} primitive@>
-text(frozen_end_group):="endgroup"; eqtb[frozen_end_group]:=eqtb[cur_val];@/
-primitive("expandafter",expand_after,0);@/
-@!@:expand_after_}{\.{\\expandafter} primitive@>
-primitive("font",def_font,0);@/
-@!@:font_}{\.{\\font} primitive@>
-primitive("letterspacefont",letterspace_font,0);@/
-@!@:letterspace_font_}{\.{\\letterspacefont} primitive@>
-primitive("pdfcopyfont",pdf_copy_font,0);@/
-@!@:pdf_copy_font_}{\.{\\pdfcopyfont} primitive@>
-primitive("fontdimen",assign_font_dimen,0);@/
-@!@:font_dimen_}{\.{\\fontdimen} primitive@>
-primitive("halign",halign,0);@/
-@!@:halign_}{\.{\\halign} primitive@>
-primitive("hrule",hrule,0);@/
-@!@:hrule_}{\.{\\hrule} primitive@>
-primitive("ignorespaces",ignore_spaces,0);@/
-@!@:ignore_spaces_}{\.{\\ignorespaces} primitive@>
-primitive("insert",insert,0);@/
-@!@:insert_}{\.{\\insert} primitive@>
-primitive("mark",mark,0);@/
-@!@:mark_}{\.{\\mark} primitive@>
-primitive("mathaccent",math_accent,0);@/
-@!@:math_accent_}{\.{\\mathaccent} primitive@>
-primitive("mathchar",math_char_num,0);@/
-@!@:math_char_}{\.{\\mathchar} primitive@>
-primitive("mathchoice",math_choice,0);@/
-@!@:math_choice_}{\.{\\mathchoice} primitive@>
-primitive("multiply",multiply,0);@/
-@!@:multiply_}{\.{\\multiply} primitive@>
-primitive("noalign",no_align,0);@/
-@!@:no_align_}{\.{\\noalign} primitive@>
-primitive("noboundary",no_boundary,0);@/
-@!@:no_boundary_}{\.{\\noboundary} primitive@>
-primitive("noexpand",no_expand,0);@/
-@!@:no_expand_}{\.{\\noexpand} primitive@>
-primitive("pdfprimitive",no_expand,1);@/
-@!@:pdfprimitive_}{\.{\\pdfprimitive} primitive@>
-primitive("nonscript",non_script,0);@/
-@!@:non_script_}{\.{\\nonscript} primitive@>
-primitive("omit",omit,0);@/
-@!@:omit_}{\.{\\omit} primitive@>
-primitive("parshape",set_shape,par_shape_loc);@/
-@!@:par_shape_}{\.{\\parshape} primitive@>
-primitive("penalty",break_penalty,0);@/
-@!@:penalty_}{\.{\\penalty} primitive@>
-primitive("prevgraf",set_prev_graf,0);@/
-@!@:prev_graf_}{\.{\\prevgraf} primitive@>
-primitive("radical",radical,0);@/
-@!@:radical_}{\.{\\radical} primitive@>
-primitive("read",read_to_cs,0);@/
-@!@:read_}{\.{\\read} primitive@>
-primitive("relax",relax,256); {cf.\ |scan_file_name|}
-@!@:relax_}{\.{\\relax} primitive@>
-text(frozen_relax):="relax"; eqtb[frozen_relax]:=eqtb[cur_val];@/
-primitive("setbox",set_box,0);@/
-@!@:set_box_}{\.{\\setbox} primitive@>
-primitive("the",the,0);@/
-@!@:the_}{\.{\\the} primitive@>
-primitive("toks",toks_register,mem_bot);@/
-@!@:toks_}{\.{\\toks} primitive@>
-primitive("vadjust",vadjust,0);@/
-@!@:vadjust_}{\.{\\vadjust} primitive@>
-primitive("valign",valign,0);@/
-@!@:valign_}{\.{\\valign} primitive@>
-primitive("vcenter",vcenter,0);@/
-@!@:vcenter_}{\.{\\vcenter} primitive@>
-primitive("vrule",vrule,0);@/
-@!@:vrule_}{\.{\\vrule} primitive@>
-
-@ Each primitive has a corresponding inverse, so that it is possible to
-display the cryptic numeric contents of |eqtb| in symbolic form.
-Every call of |primitive| in this program is therefore accompanied by some
-straightforward code that forms part of the |print_cmd_chr| routine
-below.
-
-@<Cases of |print_cmd_chr|...@>=
-accent: print_esc("accent");
-advance: print_esc("advance");
-after_assignment: print_esc("afterassignment");
-after_group: print_esc("aftergroup");
-assign_font_dimen: print_esc("fontdimen");
-begin_group: print_esc("begingroup");
-break_penalty: print_esc("penalty");
-char_num: print_esc("char");
-cs_name: print_esc("csname");
-def_font: print_esc("font");
-letterspace_font: print_esc("letterspacefont");
-pdf_copy_font: print_esc("pdfcopyfont");
-delim_num: print_esc("delimiter");
-divide: print_esc("divide");
-end_cs_name: print_esc("endcsname");
-end_group: print_esc("endgroup");
-ex_space: print_esc(" ");
-expand_after: if chr_code=0 then print_esc("expandafter")
- @<Cases of |expandafter| for |print_cmd_chr|@>;
-halign: print_esc("halign");
-hrule: print_esc("hrule");
-ignore_spaces: if chr_code=0 then print_esc("ignorespaces") else print_esc("pdfprimitive");
-insert: print_esc("insert");
-ital_corr: print_esc("/");
-mark: begin print_esc("mark");
- if chr_code>0 then print_char("s");
- end;
-math_accent: print_esc("mathaccent");
-math_char_num: print_esc("mathchar");
-math_choice: print_esc("mathchoice");
-multiply: print_esc("multiply");
-no_align: print_esc("noalign");
-no_boundary:print_esc("noboundary");
-no_expand: if chr_code=0 then print_esc("noexpand")
- else print_esc("pdfprimitive");
-non_script: print_esc("nonscript");
-omit: print_esc("omit");
-radical: print_esc("radical");
-read_to_cs: if chr_code=0 then print_esc("read")
- @<Cases of |read| for |print_cmd_chr|@>;
-relax: print_esc("relax");
-set_box: print_esc("setbox");
-set_prev_graf: print_esc("prevgraf");
-set_shape: case chr_code of
- par_shape_loc: print_esc("parshape");
- @<Cases of |set_shape| for |print_cmd_chr|@>@;@/
- end; {there are no other cases}
-the: if chr_code=0 then print_esc("the")
- @<Cases of |the| for |print_cmd_chr|@>;
-toks_register: @<Cases of |toks_register| for |print_cmd_chr|@>;
-vadjust: print_esc("vadjust");
-valign: if chr_code=0 then print_esc("valign")@/
- @<Cases of |valign| for |print_cmd_chr|@>;
-vcenter: print_esc("vcenter");
-vrule: print_esc("vrule");
-
-@ We will deal with the other primitives later, at some point in the program
-where their |eq_type| and |equiv| values are more meaningful. For example,
-the primitives for math mode will be loaded when we consider the routines
-that deal with formulas. It is easy to find where each particular
-primitive was treated by looking in the index at the end; for example, the
-section where |"radical"| entered |eqtb| is listed under `\.{\\radical}
-primitive'. (Primitives consisting of a single nonalphabetic character,
-@!like `\.{\\/}', are listed under `Single-character primitives'.)
-@!@^Single-character primitives@>
-
-Meanwhile, this is a convenient place to catch up on something we were unable
-to do before the hash table was defined:
-
-@* \[19] Saving and restoring equivalents.
-The nested structure provided by `$\.{\char'173}\ldots\.{\char'175}$' groups
-in \TeX\ means that |eqtb| entries valid in outer groups should be saved
-and restored later if they are overridden inside the braces. When a new |eqtb|
-value is being assigned, the program therefore checks to see if the previous
-entry belongs to an outer level. In such a case, the old value is placed
-on the |save_stack| just before the new value enters |eqtb|. At the
-end of a grouping level, i.e., when the right brace is sensed, the
-|save_stack| is used to restore the outer values, and the inner ones are
-destroyed.
-
-Entries on the |save_stack| are of type |memory_word|. The top item on
-this stack is |save_stack[p]|, where |p=save_ptr-1|; it contains three
-fields called |save_type|, |save_level|, and |save_index|, and it is
-interpreted in one of five ways:
-
-\yskip\hangg 1) If |save_type(p)=restore_old_value|, then
-|save_index(p)| is a location in |eqtb| whose current value should
-be destroyed at the end of the current group and replaced by |save_stack[p-1]|.
-Furthermore if |save_index(p)>=int_base|, then |save_level(p)|
-should replace the corresponding entry in |xeq_level|.
-
-\yskip\hangg 2) If |save_type(p)=restore_zero|, then |save_index(p)|
-is a location in |eqtb| whose current value should be destroyed at the end
-of the current group, when it should be
-replaced by the value of |eqtb[undefined_control_sequence]|.
-
-\yskip\hangg 3) If |save_type(p)=insert_token|, then |save_index(p)|
-is a token that should be inserted into \TeX's input when the current
-group ends.
-
-\yskip\hangg 4) If |save_type(p)=level_boundary|, then |save_level(p)|
-is a code explaining what kind of group we were previously in, and
-|save_index(p)| points to the level boundary word at the bottom of
-the entries for that group.
-Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
-source line number at which the current level of grouping was entered.
-
-\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a
-chain of sparse array entries to be restored at the end of the current
-group. Furthermore |save_index(p)| and |save_level(p)| should replace
-the values of |sa_chain| and |sa_level| respectively.
-
-@d save_type(#)==save_stack[#].hh.b0 {classifies a |save_stack| entry}
-@d save_level(#)==save_stack[#].hh.b1
- {saved level for regions 5 and 6, or group code}
-@d save_index(#)==save_stack[#].hh.rh
- {|eqtb| location or token or |save_stack| location}
-@d restore_old_value=0 {|save_type| when a value should be restored later}
-@d restore_zero=1 {|save_type| when an undefined entry should be restored}
-@d insert_token=2 {|save_type| when a token is being saved for later use}
-@d level_boundary=3 {|save_type| corresponding to beginning of group}
-@d restore_sa=4 {|save_type| when sparse array entries should be restored}
-
-@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
-
-@ Here are the group codes that are used to discriminate between different
-kinds of groups. They allow \TeX\ to decide what special actions, if any,
-should be performed when a group ends.
-\def\grp{\.{\char'173...\char'175}}
-
-Some groups are not supposed to be ended by right braces. For example,
-the `\.\$' that begins a math formula causes a |math_shift_group| to
-be started, and this should be terminated by a matching `\.\$'. Similarly,
-a group that starts with \.{\\left} should end with \.{\\right}, and
-one that starts with \.{\\begingroup} should end with \.{\\endgroup}.
-
-@d bottom_level=0 {group code for the outside world}
-@d simple_group=1 {group code for local structure only}
-@d hbox_group=2 {code for `\.{\\hbox}\grp'}
-@d adjusted_hbox_group=3 {code for `\.{\\hbox}\grp' in vertical mode}
-@d vbox_group=4 {code for `\.{\\vbox}\grp'}
-@d vtop_group=5 {code for `\.{\\vtop}\grp'}
-@d align_group=6 {code for `\.{\\halign}\grp', `\.{\\valign}\grp'}
-@d no_align_group=7 {code for `\.{\\noalign}\grp'}
-@d output_group=8 {code for output routine}
-@d math_group=9 {code for, e.g., `\.{\char'136}\grp'}
-@d disc_group=10 {code for `\.{\\discretionary}\grp\grp\grp'}
-@d insert_group=11 {code for `\.{\\insert}\grp', `\.{\\vadjust}\grp'}
-@d vcenter_group=12 {code for `\.{\\vcenter}\grp'}
-@d math_choice_group=13 {code for `\.{\\mathchoice}\grp\grp\grp\grp'}
-@d semi_simple_group=14 {code for `\.{\\begingroup...\\endgroup}'}
-@d math_shift_group=15 {code for `\.{\$...\$}'}
-@d math_left_group=16 {code for `\.{\\left...\\right}'}
-@d max_group_code=16
-
-@<Types...@>=
-@!group_code=0..max_group_code; {|save_level| for a level boundary}
-
-@ The global variable |cur_group| keeps track of what sort of group we are
-currently in. Another global variable, |cur_boundary|, points to the
-topmost |level_boundary| word. And |cur_level| is the current depth of
-nesting. The routines are designed to preserve the condition that no entry
-in the |save_stack| or in |eqtb| ever has a level greater than |cur_level|.
-
-@ @<Glob...@>=
-@!save_stack : array[0..save_size] of memory_word;
-@!save_ptr : 0..save_size; {first unused entry on |save_stack|}
-@!max_save_stack:0..save_size; {maximum usage of save stack}
-@!cur_level: quarterword; {current nesting level for groups}
-@!cur_group: group_code; {current group type}
-@!cur_boundary: 0..save_size; {where the current level begins}
-
-@ At this time it might be a good idea for the reader to review the introduction
-to |eqtb| that was given above just before the long lists of parameter names.
-Recall that the ``outer level'' of the program is |level_one|, since
-undefined control sequences are assumed to be ``defined'' at |level_zero|.
-
-@<Set init...@>=
-save_ptr:=0; cur_level:=level_one; cur_group:=bottom_level; cur_boundary:=0;
-max_save_stack:=0;
-
-@ The following macro is used to test if there is room for up to seven more
-entries on |save_stack|. By making a conservative test like this, we can
-get by with testing for overflow in only a few places.
-
-@d check_full_save_stack==if save_ptr>max_save_stack then
- begin max_save_stack:=save_ptr;
- if max_save_stack>save_size-7 then overflow("save size",save_size);
-@:TeX capacity exceeded save size}{\quad save size@>
- end
-
-@ Procedure |new_save_level| is called when a group begins. The
-argument is a group identification code like `|hbox_group|'. After
-calling this routine, it is safe to put five more entries on |save_stack|.
-
-In some cases integer-valued items are placed onto the
-|save_stack| just below a |level_boundary| word, because this is a
-convenient place to keep information that is supposed to ``pop up'' just
-when the group has finished.
-For example, when `\.{\\hbox to 100pt}\grp' is being treated, the 100pt
-dimension is stored on |save_stack| just before |new_save_level| is
-called.
-
-We use the notation |saved(k)| to stand for an integer item that
-appears in location |save_ptr+k| of the save stack.
-
-@d saved(#)==save_stack[save_ptr+#].int
-
-@p procedure new_save_level(@!c:group_code); {begin a new level of grouping}
-begin check_full_save_stack;
-if eTeX_ex then
- begin saved(0):=line; incr(save_ptr);
- end;
-save_type(save_ptr):=level_boundary; save_level(save_ptr):=cur_group;
-save_index(save_ptr):=cur_boundary;
-if cur_level=max_quarterword then overflow("grouping levels",
-@:TeX capacity exceeded grouping levels}{\quad grouping levels@>
- max_quarterword-min_quarterword);
- {quit if |(cur_level+1)| is too big to be stored in |eqtb|}
-cur_boundary:=save_ptr; cur_group:=c;
-@!stat if tracing_groups>0 then group_trace(false);@+tats@;@/
-incr(cur_level); incr(save_ptr);
-end;
-
-@ Just before an entry of |eqtb| is changed, the following procedure should
-be called to update the other data structures properly. It is important
-to keep in mind that reference counts in |mem| include references from
-within |save_stack|, so these counts must be handled carefully.
-@^reference counts@>
-
-@p procedure eq_destroy(@!w:memory_word); {gets ready to forget |w|}
-var q:pointer; {|equiv| field of |w|}
-begin case eq_type_field(w) of
-call,long_call,outer_call,long_outer_call: delete_token_ref(equiv_field(w));
-glue_ref: delete_glue_ref(equiv_field(w));
-shape_ref: begin q:=equiv_field(w); {we need to free a \.{\\parshape} block}
- if q<>null then free_node(q,info(q)+info(q)+1);
- end; {such a block is |2n+1| words long, where |n=info(q)|}
-box_ref: flush_node_list(equiv_field(w));
-@/@<Cases for |eq_destroy|@>@/
-othercases do_nothing
-endcases;
-end;
-
-@ To save a value of |eqtb[p]| that was established at level |l|, we
-can use the following subroutine.
-
-@p procedure eq_save(@!p:pointer;@!l:quarterword); {saves |eqtb[p]|}
-begin check_full_save_stack;
-if l=level_zero then save_type(save_ptr):=restore_zero
-else begin save_stack[save_ptr]:=eqtb[p]; incr(save_ptr);
- save_type(save_ptr):=restore_old_value;
- end;
-save_level(save_ptr):=l; save_index(save_ptr):=p; incr(save_ptr);
-end;
-
-@ The procedure |eq_define| defines an |eqtb| entry having specified
-|eq_type| and |equiv| fields, and saves the former value if appropriate.
-This procedure is used only for entries in the first four regions of |eqtb|,
-i.e., only for entries that have |eq_type| and |equiv| fields.
-After calling this routine, it is safe to put four more entries on
-|save_stack|, provided that there was room for four more entries before
-the call, since |eq_save| makes the necessary test.
-
-@d assign_trace(#)==@!stat if tracing_assigns>0 then restore_trace(#);
- tats
-
-@p procedure eq_define(@!p:pointer;@!t:quarterword;@!e:halfword);
- {new data for |eqtb|}
-label exit;
-begin if eTeX_ex and(eq_type(p)=t)and(equiv(p)=e) then
- begin assign_trace(p,"reassigning")@;@/
- eq_destroy(eqtb[p]); return;
- end;
-assign_trace(p,"changing")@;@/
-if eq_level(p)=cur_level then eq_destroy(eqtb[p])
-else if cur_level>level_one then eq_save(p,eq_level(p));
-eq_level(p):=cur_level; eq_type(p):=t; equiv(p):=e;
-assign_trace(p,"into")@;@/
-exit:end;
-
-@ The counterpart of |eq_define| for the remaining (fullword) positions in
-|eqtb| is called |eq_word_define|. Since |xeq_level[p]>=level_one| for all
-|p|, a `|restore_zero|' will never be used in this case.
-
-@p procedure eq_word_define(@!p:pointer;@!w:integer);
-label exit;
-begin if eTeX_ex and(eqtb[p].int=w) then
- begin assign_trace(p,"reassigning")@;@/
- return;
- end;
-assign_trace(p,"changing")@;@/
-if xeq_level[p]<>cur_level then
- begin eq_save(p,xeq_level[p]); xeq_level[p]:=cur_level;
- end;
-eqtb[p].int:=w;
-assign_trace(p,"into")@;@/
-exit:end;
-
-@ The |eq_define| and |eq_word_define| routines take care of local definitions.
-@^global definitions@>
-Global definitions are done in almost the same way, but there is no need
-to save old values, and the new value is associated with |level_one|.
-
-@p procedure geq_define(@!p:pointer;@!t:quarterword;@!e:halfword);
- {global |eq_define|}
-begin assign_trace(p,"globally changing")@;@/
-begin eq_destroy(eqtb[p]);
-eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
-end;
-assign_trace(p,"into")@;@/
-end;
-@#
-procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|}
-begin assign_trace(p,"globally changing")@;@/
-begin eqtb[p].int:=w; xeq_level[p]:=level_one;
-end;
-assign_trace(p,"into")@;@/
-end;
-
-@ Subroutine |save_for_after| puts a token on the stack for save-keeping.
-
-@p procedure save_for_after(@!t:halfword);
-begin if cur_level>level_one then
- begin check_full_save_stack;
- save_type(save_ptr):=insert_token; save_level(save_ptr):=level_zero;
- save_index(save_ptr):=t; incr(save_ptr);
- end;
-end;
-
-@ The |unsave| routine goes the other way, taking items off of |save_stack|.
-This routine takes care of restoration when a level ends; everything
-belonging to the topmost group is cleared off of the save stack.
-
-@p
-procedure@?back_input; forward; @t\2@>
-procedure unsave; {pops the top level off the save stack}
-label done;
-var p:pointer; {position to be restored}
-@!l:quarterword; {saved level, if in fullword regions of |eqtb|}
-@!t:halfword; {saved value of |cur_tok|}
-@!a:boolean; {have we already processed an \.{\\aftergroup} ?}
-begin a:=false;
-if cur_level>level_one then
- begin decr(cur_level);
- @<Clear off top level from |save_stack|@>;
- end
-else confusion("curlevel"); {|unsave| is not used when |cur_group=bottom_level|}
-@:this can't happen curlevel}{\quad curlevel@>
-end;
-
-@ @<Clear off...@>=
-loop@+begin decr(save_ptr);
- if save_type(save_ptr)=level_boundary then goto done;
- p:=save_index(save_ptr);
- if save_type(save_ptr)=insert_token then
- @<Insert token |p| into \TeX's input@>
- else if save_type(save_ptr)=restore_sa then
- begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr);
- end
- else begin if save_type(save_ptr)=restore_old_value then
- begin l:=save_level(save_ptr); decr(save_ptr);
- end
- else save_stack[save_ptr]:=eqtb[undefined_control_sequence];
- @<Store \(s)|save_stack[save_ptr]| in |eqtb[p]|, unless
- |eqtb[p]| holds a global value@>;
- end;
- end;
-done: @!stat if tracing_groups>0 then group_trace(true);@+tats@;@/
-if grp_stack[in_open]=cur_boundary then group_warning;
- {groups possibly not properly nested with files}
-cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr);
-if eTeX_ex then decr(save_ptr)
-
-@ A global definition, which sets the level to |level_one|,
-@^global definitions@>
-will not be undone by |unsave|. If at least one global definition of
-|eqtb[p]| has been carried out within the group that just ended, the
-last such definition will therefore survive.
-
-@<Store \(s)|save...@>=
-if p<int_base then
- if eq_level(p)=level_one then
- begin eq_destroy(save_stack[save_ptr]); {destroy the saved value}
- @!stat if tracing_restores>0 then restore_trace(p,"retaining");@+tats@;@/
- end
- else begin eq_destroy(eqtb[p]); {destroy the current value}
- eqtb[p]:=save_stack[save_ptr]; {restore the saved value}
- @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
- end
-else if xeq_level[p]<>level_one then
- begin eqtb[p]:=save_stack[save_ptr]; xeq_level[p]:=l;
- @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
- end
-else begin
- @!stat if tracing_restores>0 then restore_trace(p,"retaining");@+tats@;@/
- end
-
-@ @<Declare \eTeX\ procedures for tr...@>=
-@!stat procedure restore_trace(@!p:pointer;@!s:str_number);
- {|eqtb[p]| has just been restored or retained}
-begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
-show_eqtb(p); print_char("}");
-end_diagnostic(false);
-end;
-tats
-
-@ When looking for possible pointers to a memory location, it is helpful
-to look for references from |eqtb| that might be waiting on the
-save stack. Of course, we might find spurious pointers too; but this
-routine is merely an aid when debugging, and at such times we are
-grateful for any scraps of information, even if they prove to be irrelevant.
-@^dirty \PASCAL@>
-
-@<Search |save_stack| for equivalents that point to |p|@>=
-if save_ptr>0 then for q:=0 to save_ptr-1 do
- begin if equiv_field(save_stack[q])=p then
- begin print_nl("SAVE("); print_int(q); print_char(")");
- end;
- end
-
-@ Most of the parameters kept in |eqtb| can be changed freely, but there's
-an exception: The magnification should not be used with two different
-values during any \TeX\ job, since a single magnification is applied to an
-entire run. The global variable |mag_set| is set to the current magnification
-whenever it becomes necessary to ``freeze'' it at a particular value.
-
-@<Glob...@>=
-@!mag_set:integer; {if nonzero, this magnification should be used henceforth}
-
-@ @<Set init...@>=
-mag_set:=0;
-
-@ The |prepare_mag| subroutine is called whenever \TeX\ wants to use |mag|
-for magnification.
-
-@p procedure prepare_mag;
-begin if (mag_set>0)and(mag<>mag_set) then
- begin print_err("Incompatible magnification ("); print_int(mag);
-@.Incompatible magnification@>
- print(");"); print_nl(" the previous value will be retained");
- help2("I can handle only one magnification ratio per job. So I've")@/
- ("reverted to the magnification you used earlier on this run.");@/
- int_error(mag_set);
- geq_word_define(int_base+mag_code,mag_set); {|mag:=mag_set|}
- end;
-if (mag<=0)or(mag>32768) then
- begin print_err("Illegal magnification has been changed to 1000");@/
-@.Illegal magnification...@>
- help1("The magnification ratio must be between 1 and 32768.");
- int_error(mag); geq_word_define(int_base+mag_code,1000);
- end;
-mag_set:=mag;
-end;
-
-@* \[20] Token lists.
-A \TeX\ token is either a character or a control sequence, and it is
-@^token@>
-represented internally in one of two ways: (1)~A character whose ASCII
-code number is |c| and whose command code is |m| is represented as the
-number $2^8m+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^{12}-1$@>| is larger than
-$2^8m+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==@'7777 {amount added to the |eqtb| location in a
- token that stands for a control sequence; is a multiple of~256, less~1}
-@d left_brace_token=@'0400 {$2^8\cdot|left_brace|$}
-@d left_brace_limit=@'1000 {$2^8\cdot(|left_brace|+1)$}
-@d right_brace_token=@'1000 {$2^8\cdot|right_brace|$}
-@d right_brace_limit=@'1400 {$2^8\cdot(|right_brace|+1)$}
-@d math_shift_token=@'1400 {$2^8\cdot|math_shift|$}
-@d tab_token=@'2000 {$2^8\cdot|tab_mark|$}
-@d out_param_token=@'2400 {$2^8\cdot|out_param|$}
-@d space_token=@'5040 {$2^8\cdot|spacer|+|" "|$}
-@d letter_token=@'5400 {$2^8\cdot|letter|$}
-@d other_token=@'6000 {$2^8\cdot|other_char|$}
-@d match_token=@'6400 {$2^8\cdot|match|$}
-@d end_match_token=@'7000 {$2^8\cdot|end_match|$}
-@d protected_token=@'7001 {$2^8\cdot|end_match|+1$}
-
-@ @<Check the ``constant''...@>=
-if cs_token_flag+undefined_control_sequence>max_halfword then bad:=21;
-
-@ A token list is a singly linked list of one-word nodes in |mem|, where
-each word contains a token and a link. Macro definitions, output-routine
-definitions, marks, \.{\\write} texts, and a few other things
-are remembered by \TeX\ in the form
-of token lists, usually preceded by a node with a reference count in its
-|token_ref_count| field. The token stored in location |p| is called
-|info(p)|.
-
-Three special commands appear in the token lists of macro definitions.
-When |m=match|, it means that \TeX\ should scan a parameter
-for the current macro; when |m=end_match|, it means that parameter
-matching should end and \TeX\ should start reading the macro text; and
-when |m=out_param|, it means that \TeX\ should insert parameter
-number |c| into the text at this point.
-
-The enclosing \.{\char'173} and \.{\char'175} characters of a macro
-definition are omitted, but an output routine
-will be enclosed in braces.
-
-Here is an example macro definition that illustrates these conventions.
-After \TeX\ processes the text
-$$\.{\\def\\mac a\#1\#2 \\b \{\#1\\-a \#\#1\#2 \#2\}}$$
-the definition of \.{\\mac} is represented as a token list containing
-$$\def\,{\hskip2pt}
-\vbox{\halign{\hfil#\hfil\cr
-(reference count), |letter|\,\.a, |match|\,\#, |match|\,\#, |spacer|\,\.\ ,
-\.{\\b}, |end_match|,\cr
-|out_param|\,1, \.{\\-}, |letter|\,\.a, |spacer|\,\.\ , |mac_param|\,\#,
-|other_char|\,\.1,\cr
-|out_param|\,2, |spacer|\,\.\ , |out_param|\,2.\cr}}$$
-The procedure |scan_toks| builds such token lists, and |macro_call|
-does the parameter matching.
-@^reference counts@>
-
-Examples such as
-$$\.{\\def\\m\{\\def\\m\{a\}\ b\}}$$
-explain why reference counts would be needed even if \TeX\ had no \.{\\let}
-operation: When the token list for \.{\\m} is being read, the redefinition of
-\.{\\m} changes the |eqtb| entry before the token list has been fully
-consumed, so we dare not simply destroy a token list when its
-control sequence is being redefined.
-
-If the parameter-matching part of a definition ends with `\.{\#\{}',
-the corresponding token list will have `\.\{' just before the `|end_match|'
-and also at the very end. The first `\.\{' is used to delimit the parameter; the
-second one keeps the first from disappearing.
-
-@ The procedure |show_token_list|, which prints a symbolic form of
-the token list that starts at a given node |p|, illustrates these
-conventions. The token list being displayed should not begin with a reference
-count. However, the procedure is intended to be robust, so that if the
-memory links are awry or if |p| is not really a pointer to a token list,
-nothing catastrophic will happen.
-
-An additional parameter |q| is also given; this parameter is either null
-or it points to a node in the token list where a certain magic computation
-takes place that will be explained later. (Basically, |q| is non-null when
-we are printing the two-line context information at the time of an error
-message; |q| marks the place corresponding to where the second line
-should begin.)
-
-For example, if |p| points to the node containing the first \.a in the
-token list above, then |show_token_list| will print the string
-$$\hbox{`\.{a\#1\#2\ \\b\ ->\#1\\-a\ \#\#1\#2\ \#2}';}$$
-and if |q| points to the node containing the second \.a,
-the magic computation will be performed just before the second \.a is printed.
-
-The generation will stop, and `\.{\\ETC.}' will be printed, if the length
-of printing exceeds a given limit~|l|. Anomalous entries are printed in the
-form of control sequences that are not followed by a blank space, e.g.,
-`\.{\\BAD.}'; this cannot be confused with actual control sequences because
-a real control sequence named \.{BAD} would come out `\.{\\BAD\ }'.
-
-@<Declare the procedure called |show_token_list|@>=
-procedure show_token_list(@!p,@!q:integer;@!l:integer);
-label exit;
-var m,@!c:integer; {pieces of a token}
-@!match_chr: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<hi_mem_min) or (p>mem_end) then
- begin print_esc("CLOBBERED."); return;
-@.CLOBBERED@>
- end;
-if info(p)>=cs_token_flag then print_cs(info(p)-cs_token_flag)
-else begin m:=info(p) div @'400; c:=info(p) mod @'400;
- if info(p)<0 then print_esc("BAD.")
-@.BAD@>
- else @<Display the token $(|m|,|c|)$@>;
- end
-
-@ The procedure usually ``learns'' the character code used for macro
-parameters by seeing one in a |match| command before it runs into any
-|out_param| commands.
-
-@<Display the token ...@>=
-case m of
-left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer,
- letter,other_char: print(c);
-mac_param: begin print(c); print(c);
- end;
-out_param: begin print(match_chr);
- if c<=9 then print_char(c+"0")
- else begin print_char("!"); return;
- end;
- end;
-match: begin match_chr:=c; print(c); incr(n); print_char(n);
- if n>"9" then return;
- end;
-end_match: if c=0 then print("->");
-@.->@>
-othercases print_esc("BAD.")
-@.BAD@>
-endcases
-
-@ Here's the way we sometimes want to display a token list, given a pointer
-to its reference count; the pointer may be null.
-
-@p procedure token_show(@!p:pointer);
-begin if p<>null then show_token_list(link(p),null,10000000);
-end;
-
-@ The |print_meaning| subroutine displays |cur_cmd| and |cur_chr| in
-symbolic form, including the expansion of a macro or mark.
-
-@p procedure print_meaning;
-begin print_cmd_chr(cur_cmd,cur_chr);
-if cur_cmd>=call then
- begin print_char(":"); print_ln; token_show(cur_chr);
- end
-else if (cur_cmd=top_bot_mark)and(cur_chr<marks_code) then
- begin print_char(":"); print_ln;
- token_show(cur_mark[cur_chr]);
- end;
-end;
-
-@* \[21] Introduction to the syntactic routines.
-Let's pause a moment now and try to look at the Big Picture.
-The \TeX\ program consists of three main parts: syntactic routines,
-semantic routines, and output routines. The chief purpose of the
-syntactic routines is to deliver the user's input to the semantic routines,
-one token at a time. The semantic routines act as an interpreter
-responding to these tokens, which may be regarded as commands. And the
-output routines are periodically called on to convert box-and-glue
-lists into a compact set of instructions that will be sent
-to a typesetter. We have discussed the basic data structures and utility
-routines of \TeX, so we are good and ready to plunge into the real activity by
-considering the syntactic routines.
-
-Our current goal is to come to grips with the |get_next| procedure,
-which is the keystone of \TeX's input mechanism. Each call of |get_next|
-sets the value of three variables |cur_cmd|, |cur_chr|, and |cur_cs|,
-representing the next input token.
-$$\vbox{\halign{#\hfil\cr
- \hbox{|cur_cmd| denotes a command code from the long list of codes
- given above;}\cr
- \hbox{|cur_chr| denotes a character code or other modifier of the command
- code;}\cr
- \hbox{|cur_cs| is the |eqtb| location of the current control sequence,}\cr
- \hbox{\qquad if the current token was a control sequence,
- otherwise it's zero.}\cr}}$$
-Underlying this external behavior of |get_next| is all the machinery
-necessary to convert from character files to tokens. At a given time we
-may be only partially finished with the reading of several files (for
-which \.{\\input} was specified), and partially finished with the expansion
-of some user-defined macros and/or some macro parameters, and partially
-finished with the generation of some text in a template for \.{\\halign},
-and so on. When reading a character file, special characters must be
-classified as math delimiters, etc.; comments and extra blank spaces must
-be removed, paragraphs must be recognized, and control sequences must be
-found in the hash table. Furthermore there are occasions in which the
-scanning routines have looked ahead for a word like `\.{plus}' but only
-part of that word was found, hence a few characters must be put back
-into the input and scanned again.
-
-To handle these situations, which might all be present simultaneously,
-\TeX\ uses various stacks that hold information about the incomplete
-activities, and there is a finite state control for each level of the
-input mechanism. These stacks record the current state of an implicitly
-recursive process, but the |get_next| procedure is not recursive.
-Therefore it will not be difficult to translate these algorithms into
-low-level languages that do not support recursion.
-
-@<Glob...@>=
-@!cur_cmd: eight_bits; {current command set by |get_next|}
-@!cur_chr: halfword; {operand of current command}
-@!cur_cs: pointer; {control sequence found here, zero if none found}
-@!cur_tok: halfword; {packed representative of |cur_cmd| and |cur_chr|}
-
-@ The |print_cmd_chr| routine prints a symbolic interpretation of a
-command code and its modifier. This is used in certain `\.{You can\'t}'
-error messages, and in the implementation of diagnostic routines like
-\.{\\show}.
-
-The body of |print_cmd_chr| is a rather tedious listing of print
-commands, and most of it is essentially an inverse to the |primitive|
-routine that enters a \TeX\ primitive into |eqtb|. Therefore much of
-this procedure appears elsewhere in the program,
-together with the corresponding |primitive| calls.
-
-@d chr_cmd(#)==begin print(#); print_ASCII(chr_code);
- end
-
-@<Declare the procedure called |print_cmd_chr|@>=
-procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
-var n:integer; {temp variable}
-begin case cmd of
-left_brace: chr_cmd("begin-group character ");
-right_brace: chr_cmd("end-group character ");
-math_shift: chr_cmd("math shift character ");
-mac_param: chr_cmd("macro parameter character ");
-sup_mark: chr_cmd("superscript character ");
-sub_mark: chr_cmd("subscript character ");
-endv: print("end of alignment template");
-spacer: chr_cmd("blank space ");
-letter: chr_cmd("the letter ");
-other_char: chr_cmd("the character ");
-@t\4@>@<Cases of |print_cmd_chr| for symbolic printing of primitives@>@/
-othercases print("[unknown command code!]")
-endcases;
-end;
-
-@ Here is a procedure that displays the current command.
-
-@p procedure show_cur_cmd_chr;
-var n:integer; {level of \.{\\if...\\fi} nesting}
-@!l:integer; {line where \.{\\if} started}
-@!p:pointer;
-begin begin_diagnostic; print_nl("{");
-if mode<>shown_mode then
- begin print_mode(mode); print(": "); shown_mode:=mode;
- end;
-print_cmd_chr(cur_cmd,cur_chr);
-if tracing_ifs>0 then
- if cur_cmd>=if_test then if cur_cmd<=fi_or_else then
- begin print(": ");
- if cur_cmd=fi_or_else then
- begin print_cmd_chr(if_test,cur_if); print_char(" ");
- n:=0; l:=if_line;
- end
- else begin n:=1; l:=line;
- end;
- p:=cond_ptr;
- while p<>null do
- begin incr(n); p:=link(p);
- end;
- print("(level "); print_int(n); print_char(")"); print_if_line(l);
- end;
-print_char("}");
-end_diagnostic(false);
-end;
-
-@* \[22] Input stacks and states.
-This implementation of
-\TeX\ uses two different conventions for representing sequential stacks.
-@^stack conventions@>@^conventions for representing stacks@>
-
-\yskip\hangg 1) If there is frequent access to the top entry, and if the
-stack is essentially never empty, then the top entry is kept in a global
-variable (even better would be a machine register), and the other entries
-appear in the array $\\{stack}[0\to(\\{ptr}-1)]$. For example, the
-semantic stack described above is handled this way, and so is the input
-stack that we are about to study.
-
-\yskip\hangg 2) If there is infrequent top access, the entire stack contents
-are in the array $\\{stack}[0\to(\\{ptr}-1)]$. For example, the |save_stack|
-is treated this way, as we have seen.
-
-\yskip\noindent
-The state of \TeX's input mechanism appears in the input stack, whose
-entries are records with six fields, called |state|, |index|, |start|, |loc|,
-|limit|, and |name|. This stack is maintained with
-convention~(1), so it is declared in the following way:
-
-@<Types...@>=
-@!in_state_record = record
- @!state_field, @!index_field: quarterword;
- @!start_field,@!loc_field, @!limit_field, @!name_field: halfword;
- end;
-
-@ @<Glob...@>=
-@!input_stack : array[0..stack_size] of in_state_record;
-@!input_ptr : 0..stack_size; {first unused location of |input_stack|}
-@!max_in_stack: 0..stack_size; {largest value of |input_ptr| when pushing}
-@!cur_input : in_state_record;
- {the ``top'' input state, according to convention (1)}
-
-@ We've already defined the special variable |loc==cur_input.loc_field|
-in our discussion of basic input-output routines. The other components of
-|cur_input| are defined in the same way:
-
-@d state==cur_input.state_field {current scanner state}
-@d index==cur_input.index_field {reference for buffer information}
-@d start==cur_input.start_field {starting position in |buffer|}
-@d limit==cur_input.limit_field {end of current line in |buffer|}
-@d name==cur_input.name_field {name of the current file}
-
-@ Let's look more closely now at the control variables
-(|state|,~|index|,~|start|,~|loc|,~|limit|,~|name|),
-assuming that \TeX\ is reading a line of characters that have been input
-from some file or from the user's terminal. There is an array called
-|buffer| that acts as a stack of all lines of characters that are
-currently being read from files, including all lines on subsidiary
-levels of the input stack that are not yet completed. \TeX\ will return to
-the other lines when it is finished with the present input file.
-
-(Incidentally, on a machine with byte-oriented addressing, it might be
-appropriate to combine |buffer| with the |str_pool| array,
-letting the buffer entries grow downward from the top of the string pool
-and checking that these two tables don't bump into each other.)
-
-The line we are currently working on begins in position |start| of the
-buffer; the next character we are about to read is |buffer[loc]|; and
-|limit| is the location of the last character present. If |loc>limit|,
-the line has been completely read. Usually |buffer[limit]| is the
-|end_line_char|, denoting the end of a line, but this is not
-true if the current line is an insertion that was entered on the user's
-terminal in response to an error message.
-
-The |name| variable is a string number that designates the name of
-the current file, if we are reading a text file. It is zero if we
-are reading from the terminal; it is |n+1| if we are reading from
-input stream |n|, where |0<=n<=16|. (Input stream 16 stands for
-an invalid stream number; in such cases the input is actually from
-the terminal, under control of the procedure |read_toks|.)
-Finally |18<=name<=19| indicates that we are reading a pseudo file
-created by the \.{\\scantokens} command.
-
-The |state| variable has one of three values, when we are scanning such
-files:
-$$\baselineskip 15pt\vbox{\halign{#\hfil\cr
-1) |state=mid_line| is the normal state.\cr
-2) |state=skip_blanks| is like |mid_line|, but blanks are ignored.\cr
-3) |state=new_line| is the state at the beginning of a line.\cr}}$$
-These state values are assigned numeric codes so that if we add the state
-code to the next character's command code, we get distinct values. For
-example, `|mid_line+spacer|' stands for the case that a blank
-space character occurs in the middle of a line when it is not being
-ignored; after this case is processed, the next value of |state| will
-be |skip_blanks|.
-
-@d mid_line=1 {|state| code when scanning a line of characters}
-@d skip_blanks=2+max_char_code {|state| code when ignoring blanks}
-@d new_line=3+max_char_code+max_char_code {|state| code at start of line}
-
-@ Additional information about the current line is available via the
-|index| variable, which counts how many lines of characters are present
-in the buffer below the current level. We have |index=0| when reading
-from the terminal and prompting the user for each line; then if the user types,
-e.g., `\.{\\input paper}', we will have |index=1| while reading
-the file \.{paper.tex}. However, it does not follow that |index| is the
-same as the input stack pointer, since many of the levels on the input
-stack may come from token lists. For example, the instruction `\.{\\input
-paper}' might occur in a token list.
-
-The global variable |in_open| is equal to the |index|
-value of the highest non-token-list level. Thus, the number of partially read
-lines in the buffer is |in_open+1|, and we have |in_open=index|
-when we are not reading a token list.
-
-If we are not currently reading from the terminal, or from an input
-stream, we are reading from the file variable |input_file[index]|. We use
-the notation |terminal_input| as a convenient abbreviation for |name=0|,
-and |cur_file| as an abbreviation for |input_file[index]|.
-
-The global variable |line| contains the line number in the topmost
-open file, for use in error messages. If we are not reading from
-the terminal, |line_stack[index]| holds the line number for the
-enclosing level, so that |line| can be restored when the current
-file has been read. Line numbers should never be negative, since the
-negative of the current line number is used to identify the user's output
-routine in the |mode_line| field of the semantic nest entries.
-
-If more information about the input state is needed, it can be
-included in small arrays like those shown here. For example,
-the current page or segment number in the input file might be
-put into a variable |@!page|, maintained for enclosing levels in
-`\ignorespaces|@!page_stack:array[1..max_in_open] of integer|\unskip'
-by analogy with |line_stack|.
-@^system dependencies@>
-
-@d terminal_input==(name=0) {are we reading from the terminal?}
-@d cur_file==input_file[index] {the current |alpha_file| variable}
-
-@<Glob...@>=
-@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
-@!open_parens : 0..max_in_open; {the number of open text files}
-@!input_file : array[1..max_in_open] of alpha_file;
-@!line : integer; {current line number in the current source file}
-@!line_stack : array[1..max_in_open] of integer;
-
-@ Users of \TeX\ sometimes forget to balance left and right braces properly,
-and one of the ways \TeX\ tries to spot such errors is by considering an
-input file as broken into subfiles by control sequences that
-are declared to be \.{\\outer}.
-
-A variable called |scanner_status| tells \TeX\ whether or not to complain
-when a subfile ends. This variable has six possible values:
-
-\yskip\hang|normal|, means that a subfile can safely end here without incident.
-
-\yskip\hang|skipping|, means that a subfile can safely end here, but not a file,
-because we're reading past some conditional text that was not selected.
-
-\yskip\hang|defining|, means that a subfile shouldn't end now because a
-macro is being defined.
-
-\yskip\hang|matching|, means that a subfile shouldn't end now because a
-macro is being used and we are searching for the end of its arguments.
-
-\yskip\hang|aligning|, means that a subfile shouldn't end now because we are
-not finished with the preamble of an \.{\\halign} or \.{\\valign}.
-
-\yskip\hang|absorbing|, means that a subfile shouldn't end now because we are
-reading a balanced token list for \.{\\message}, \.{\\write}, etc.
-
-\yskip\noindent
-If the |scanner_status| is not |normal|, the variable |warning_index| points
-to the |eqtb| location for the relevant control sequence name to print
-in an error message.
-
-@d skipping=1 {|scanner_status| when passing conditional text}
-@d defining=2 {|scanner_status| when reading a macro definition}
-@d matching=3 {|scanner_status| when reading macro arguments}
-@d aligning=4 {|scanner_status| when reading an alignment preamble}
-@d absorbing=5 {|scanner_status| when reading a balanced text}
-
-@<Glob...@>=
-@!scanner_status : normal..absorbing; {can a subfile end now?}
-@!warning_index : pointer; {identifier relevant to non-|normal| scanner status}
-@!def_ref : pointer; {reference count of token list being defined}
-
-@ Here is a procedure that uses |scanner_status| to print a warning message
-when a subfile has ended, and at certain other crucial times:
-
-@<Declare the procedure called |runaway|@>=
-procedure runaway;
-var p:pointer; {head of runaway list}
-begin if scanner_status>skipping then
- begin print_nl("Runaway ");
-@.Runaway...@>
- case scanner_status of
- defining: begin print("definition"); p:=def_ref;
- end;
- matching: begin print("argument"); p:=temp_head;
- end;
- aligning: begin print("preamble"); p:=hold_head;
- end;
- absorbing: begin print("text"); p:=def_ref;
- end;
- end; {there are no other cases}
- print_char("?");print_ln; show_token_list(link(p),null,error_line-10);
- end;
-end;
-
-@ However, all this discussion about input state really applies only to the
-case that we are inputting from a file. There is another important case,
-namely when we are currently getting input from a token list. In this case
-|state=token_list|, and the conventions about the other state variables
-are different:
-
-\yskip\hang|loc| is a pointer to the current node in the token list, i.e.,
-the node that will be read next. If |loc=null|, the token list has been
-fully read.
-
-\yskip\hang|start| points to the first node of the token list; this node
-may or may not contain a reference count, depending on the type of token
-list involved.
-
-\yskip\hang|token_type|, which takes the place of |index| in the
-discussion above, is a code number that explains what kind of token list
-is being scanned.
-
-\yskip\hang|name| points to the |eqtb| address of the control sequence
-being expanded, if the current token list is a macro.
-
-\yskip\hang|param_start|, which takes the place of |limit|, tells where
-the parameters of the current macro begin in the |param_stack|, if the
-current token list is a macro.
-
-\yskip\noindent The |token_type| can take several values, depending on
-where the current token list came from:
-
-\yskip\hang|parameter|, if a parameter is being scanned;
-
-\hang|u_template|, if the \<u_j> part of an alignment
-template is being scanned;
-
-\hang|v_template|, if the \<v_j> part of an alignment
-template is being scanned;
-
-\hang|backed_up|, if the token list being scanned has been inserted as
-`to be read again';
-
-\hang|inserted|, if the token list being scanned has been inserted as
-the text expansion of a \.{\\count} or similar variable;
-
-\hang|macro|, if a user-defined control sequence is being scanned;
-
-\hang|output_text|, if an \.{\\output} routine is being scanned;
-
-\hang|every_par_text|, if the text of \.{\\everypar} is being scanned;
-
-\hang|every_math_text|, if the text of \.{\\everymath} is being scanned;
-
-\hang|every_display_text|, if the text of \.{\\everydisplay} is being scanned;
-
-\hang|every_hbox_text|, if the text of \.{\\everyhbox} is being scanned;
-
-\hang|every_vbox_text|, if the text of \.{\\everyvbox} is being scanned;
-
-\hang|every_job_text|, if the text of \.{\\everyjob} is being scanned;
-
-\hang|every_cr_text|, if the text of \.{\\everycr} is being scanned;
-
-\hang|mark_text|, if the text of a \.{\\mark} is being scanned;
-
-\hang|write_text|, if the text of a \.{\\write} is being scanned.
-
-\yskip\noindent
-The codes for |output_text|, |every_par_text|, etc., are equal to a constant
-plus the corresponding codes for token list parameters |output_routine_loc|,
-|every_par_loc|, etc. The token list begins with a reference count if and
-only if |token_type>=macro|.
-@^reference counts@>
-
-Since \eTeX's additional token list parameters precede |toks_base|, the
-corresponding token types must precede |write_text|.
-
-@d token_list=0 {|state| code when scanning a token list}
-@d token_type==index {type of current token list}
-@d param_start==limit {base of macro parameters in |param_stack|}
-@d parameter=0 {|token_type| code for parameter}
-@d u_template=1 {|token_type| code for \<u_j> template}
-@d v_template=2 {|token_type| code for \<v_j> template}
-@d backed_up=3 {|token_type| code for text to be reread}
-@d 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=toks_base-eTeX_text_offset {|token_type| code for \.{\\write}}
-
-@ The |param_stack| is an auxiliary array used to hold pointers to the token
-lists for parameters at the current level and subsidiary levels of input.
-This stack is maintained with convention (2), and it grows at a different
-rate from the others.
-
-@<Glob...@>=
-@!param_stack:array [0..param_size] of pointer;
- {token list pointers for parameters}
-@!param_ptr:0..param_size; {first unused entry in |param_stack|}
-@!max_param_stack:integer;
- {largest value of |param_ptr|, will be |<=param_size+9|}
-
-@ The input routines must also interact with the processing of
-\.{\\halign} and \.{\\valign}, since the appearance of tab marks and
-\.{\\cr} in certain places is supposed to trigger the beginning of special
-\<v_j> template text in the scanner. This magic is accomplished by an
-|align_state| variable that is increased by~1 when a `\.{\char'173}' is
-scanned and decreased by~1 when a `\.{\char'175}' is scanned. The |align_state|
-is nonzero during the \<u_j> template, after which it is set to zero; the
-\<v_j> template begins when a tab mark or \.{\\cr} occurs at a time that
-|align_state=0|.
-
-@<Glob...@>=
-@!align_state:integer; {group level with respect to current alignment}
-
-@ Thus, the ``current input state'' can be very complicated indeed; there
-can be many levels and each level can arise in a variety of ways. The
-|show_context| procedure, which is used by \TeX's error-reporting routine to
-print out the current input state on all levels down to the most recent
-line of characters from an input file, illustrates most of these conventions.
-The global variable |base_ptr| contains the lowest level that was
-displayed by this procedure.
-
-@<Glob...@>=
-@!base_ptr:0..stack_size; {shallowest level shown by |show_context|}
-
-@ The status at each level is indicated by printing two lines, where the first
-line indicates what was read so far and the second line shows what remains
-to be read. The context is cropped, if necessary, so that the first line
-contains at most |half_error_line| characters, and the second contains
-at most |error_line|. Non-current input levels whose |token_type| is
-`|backed_up|' are shown only if they have not been fully read.
-
-@p procedure show_context; {prints where the scanner is}
-label done;
-var old_setting:0..max_selector; {saved |selector| setting}
-@!nn:integer; {number of contexts shown so far, less one}
-@!bottom_line:boolean; {have we reached the final context to be shown?}
-@<Local variables for formatting calculations@>@/
-begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
- {store current state}
-nn:=-1; bottom_line:=false;
-loop@+begin cur_input:=input_stack[base_ptr]; {enter into the context}
- if (state<>token_list) then
- if (name>19) or (base_ptr=0) then bottom_line:=true;
- if (base_ptr=input_ptr)or bottom_line or(nn<error_context_lines) then
- @<Display the current context@>
- else if nn=error_context_lines then
- begin print_nl("..."); incr(nn); {omitted if |error_context_lines<0|}
- end;
- if bottom_line then goto done;
- decr(base_ptr);
- end;
-done: cur_input:=input_stack[input_ptr]; {restore original state}
-end;
-
-@ @<Display the current context@>=
-begin if (base_ptr=input_ptr) or (state<>token_list) or
- (token_type<>backed_up) or (loc<>null) then
- {we omit backed-up token lists that have already been read}
- begin tally:=0; {get ready to count characters}
- old_setting:=selector;
- if state<>token_list then
- begin @<Print location of current line@>;
- @<Pseudoprint the line@>;
- end
- else begin @<Print type of token list@>;
- @<Pseudoprint the token list@>;
- end;
- selector:=old_setting; {stop pseudoprinting}
- @<Print two lines using the tricky pseudoprinted information@>;
- incr(nn);
- end;
-end
-
-@ This routine should be changed, if necessary, to give the best possible
-indication of where the current line resides in the input file.
-For example, on some systems it is best to print both a page and line number.
-@^system dependencies@>
-
-@<Print location of current line@>=
-if name<=17 then
- if terminal_input then
- if base_ptr=0 then print_nl("<*>") else print_nl("<insert> ")
- else begin print_nl("<read ");
- if name=17 then print_char("*")@+else print_int(name-1);
-@.*\relax@>
- print_char(">");
- end
-else 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(buffer[i]);
- end
-
-@ @<Pseudoprint the token list@>=
-begin_pseudoprint;
-if token_type<macro then show_token_list(start,loc,100000)
-else show_token_list(link(start),loc,100000) {avoid reference count}
-
-@ Here is the missing piece of |show_token_list| that is activated when the
-token beginning line~2 is about to be shown:
-
-@<Do magic computation@>=set_trick_count
-
-@* \[23] Maintaining the input stacks.
-The following subroutines change the input status in commonly needed ways.
-
-First comes |push_input|, which stores the current state and creates a
-new level (having, initially, the same properties as the old).
-
-@d push_input==@t@> {enter a new input level, save the old}
- begin if input_ptr>max_in_stack then
- begin max_in_stack:=input_ptr;
- if input_ptr=stack_size then overflow("input stack size",stack_size);
-@:TeX capacity exceeded input stack size}{\quad input stack size@>
- end;
- input_stack[input_ptr]:=cur_input; {stack the record}
- incr(input_ptr);
- end
-
-@ And of course what goes up must come down.
-
-@d pop_input==@t@> {leave an input level, re-enter the old}
- begin decr(input_ptr); cur_input:=input_stack[input_ptr];
- end
-
-@ Here is a procedure that starts a new level of token-list input, given
-a token list |p| and its type |t|. If |t=macro|, the calling routine should
-set |name| and |loc|.
-
-@d back_list(#)==begin_token_list(#,backed_up) {backs up a simple token list}
-@d ins_list(#)==begin_token_list(#,inserted) {inserts a simple token list}
-
-@p procedure begin_token_list(@!p:pointer;@!t:quarterword);
-begin push_input; state:=token_list; start:=p; token_type:=t;
-if t>=macro then {the token list starts with a reference count}
- begin add_token_ref(p);
- if t=macro then param_start:=param_ptr
- else begin loc:=link(p);
- if tracing_macros>1 then
- begin begin_diagnostic; print_nl("");
- case t of
- mark_text:print_esc("mark");
- write_text:print_esc("write");
- othercases print_cmd_chr(assign_toks,t-output_text+output_routine_loc)
- endcases;@/
- print("->"); token_show(p); end_diagnostic(false);
- end;
- end;
- end
-else loc:=p;
-end;
-
-@ When a token list has been fully scanned, the following computations
-should be done as we leave that level of input. The |token_type| tends
-to be equal to either |backed_up| or |inserted| about 2/3 of the time.
-@^inner loop@>
-
-@p procedure end_token_list; {leave a token-list input level}
-begin if token_type>=backed_up then {token list to be deleted}
- begin if token_type<=inserted then flush_list(start)
- else begin delete_token_ref(start); {update reference count}
- if token_type=macro then {parameters must be flushed}
- while param_ptr>param_start do
- begin decr(param_ptr);
- flush_list(param_stack[param_ptr]);
- end;
- end;
- end
-else if token_type=u_template then
- if align_state>500000 then align_state:=0
- else fatal_error("(interwoven alignment preambles are not allowed)");
-@.interwoven alignment preambles...@>
-pop_input;
-check_interrupt;
-end;
-
-@ Sometimes \TeX\ has read too far and wants to ``unscan'' what it has
-seen. The |back_input| procedure takes care of this by putting the token
-just scanned back into the input stream, ready to be read again. This
-procedure can be used only if |cur_tok| represents the token to be
-replaced. Some applications of \TeX\ use this procedure a lot,
-so it has been slightly optimized for speed.
-@^inner loop@>
-
-@p procedure back_input; {undoes one token of input}
-var p:pointer; {a token list of length one}
-begin while (state=token_list)and(loc=null)and(token_type<>v_template) do
- end_token_list; {conserve stack space}
-p:=get_avail; info(p):=cur_tok;
-if cur_tok<right_brace_limit then
- if cur_tok<left_brace_limit then decr(align_state)
- else incr(align_state);
-push_input; state:=token_list; start:=p; token_type:=backed_up;
-loc:=p; {that was |back_list(p)|, without procedure overhead}
-end;
-
-@ @<Insert token |p| into \TeX's input@>=
-begin t:=cur_tok; cur_tok:=p;
-if a then
- begin p:=get_avail; info(p):=cur_tok; link(p):=loc; loc:=p; start:=p;
- if cur_tok<right_brace_limit then
- if cur_tok<left_brace_limit then decr(align_state)
- else incr(align_state);
- end
-else begin back_input; a:=eTeX_ex;
- end;
-cur_tok:=t;
-end
-
-@ The |back_error| routine is used when we want to replace an offending token
-just before issuing an error message. This routine, like |back_input|,
-requires that |cur_tok| has been set. We disable interrupts during the
-call of |back_input| so that the help message won't be lost.
-
-@p procedure back_error; {back up one token and call |error|}
-begin OK_to_interrupt:=false; back_input; OK_to_interrupt:=true; error;
-end;
-@#
-procedure ins_error; {back up one inserted token and call |error|}
-begin OK_to_interrupt:=false; back_input; token_type:=inserted;
-OK_to_interrupt:=true; error;
-end;
-
-@ The |begin_file_reading| procedure starts a new level of input for lines
-of characters to be read from a file, or as an insertion from the
-terminal. It does not take care of opening the file, nor does it set |loc|
-or |limit| or |line|.
-@^system dependencies@>
-
-@p procedure begin_file_reading;
-begin if in_open=max_in_open then overflow("text input levels",max_in_open);
-@:TeX capacity exceeded text input levels}{\quad text input levels@>
-if first=buf_size then overflow("buffer size",buf_size);
-@:TeX capacity exceeded buffer size}{\quad buffer size@>
-incr(in_open); push_input; index:=in_open;
-eof_seen[index]:=false;
-grp_stack[index]:=cur_boundary; if_stack[index]:=cond_ptr;
-line_stack[index]:=line; start:=first; state:=mid_line;
-name:=0; {|terminal_input| is now |true|}
-end;
-
-@ Conversely, the variables must be downdated when such a level of input
-is finished:
-
-@p procedure end_file_reading;
-begin first:=start; line:=line_stack[index];
-if (name=18)or(name=19) then pseudo_close else
-if name>17 then a_close(cur_file); {forget it}
-pop_input; decr(in_open);
-end;
-
-@ In order to keep the stack from overflowing during a long sequence of
-inserted `\.{\\show}' commands, the following routine removes completed
-error-inserted lines from memory.
-
-@p procedure clear_for_error_prompt;
-begin while (state<>token_list)and terminal_input and@|
- (input_ptr>0)and(loc>limit) do end_file_reading;
-print_ln; clear_terminal;
-end;
-
-@ To get \TeX's whole input mechanism going, we perform the following
-actions.
-
-@<Initialize the input routines@>=
-begin input_ptr:=0; max_in_stack:=0;
-in_open:=0; open_parens:=0; max_buf_stack:=0;
-grp_stack[0]:=0; if_stack[0]:=null;
-param_ptr:=0; max_param_stack:=0;
-first:=buf_size; repeat buffer[first]:=0; decr(first); until first=0;
-scanner_status:=normal; warning_index:=null; first:=1;
-state:=new_line; start:=1; index:=0; line:=0; name:=0;
-force_eof:=false;
-align_state:=1000000;@/
-if not init_terminal then goto final_end;
-limit:=last; first:=last+1; {|init_terminal| has set |loc| and |last|}
-end
-
-@* \[24] Getting the next token.
-The heart of \TeX's input mechanism is the |get_next| procedure, which
-we shall develop in the next few sections of the program. Perhaps we
-shouldn't actually call it the ``heart,'' however, because it really acts
-as \TeX's eyes and mouth, reading the source files and gobbling them up.
-And it also helps \TeX\ to regurgitate stored token lists that are to be
-processed again.
-@^eyes and mouth@>
-
-The main duty of |get_next| is to input one token and to set |cur_cmd|
-and |cur_chr| to that token's command code and modifier. Furthermore, if
-the input token is a control sequence, the |eqtb| location of that control
-sequence is stored in |cur_cs|; otherwise |cur_cs| is set to zero.
-
-Underlying this simple description is a certain amount of complexity
-because of all the cases that need to be handled.
-However, the inner loop of |get_next| is reasonably short and fast.
-
-When |get_next| is asked to get the next token of a \.{\\read} line,
-it sets |cur_cmd=cur_chr=cur_cs=0| in the case that no more tokens
-appear on that line. (There might not be any tokens at all, if the
-|end_line_char| has |ignore| as its catcode.)
-
-@ The value of |par_loc| is the |eqtb| address of `\.{\\par}'. This quantity
-is needed because a blank line of input is supposed to be exactly equivalent
-to the appearance of \.{\\par}; we must set |cur_cs:=par_loc|
-when detecting a blank line.
-
-@<Glob...@>=
-@!par_loc:pointer; {location of `\.{\\par}' in |eqtb|}
-@!par_token:halfword; {token representing `\.{\\par}'}
-
-@ @<Put each...@>=
-primitive("par",par_end,256); {cf.\ |scan_file_name|}
-@!@:par_}{\.{\\par} primitive@>
-par_loc:=cur_val; par_token:=cs_token_flag+par_loc;
-
-@ @<Cases of |print_cmd_chr|...@>=
-par_end:print_esc("par");
-
-@ Before getting into |get_next|, let's consider the subroutine that
-is called when an `\.{\\outer}' control sequence has been scanned or
-when the end of a file has been reached. These two cases are distinguished
-by |cur_cs|, which is zero at the end of a file.
-
-@p procedure check_outer_validity;
-var p:pointer; {points to inserted token list}
-@!q:pointer; {auxiliary pointer}
-begin if scanner_status<>normal then
- begin deletions_allowed:=false;
- @<Back up an outer control sequence so that it can be reread@>;
- if scanner_status>skipping then
- @<Tell the user what has run away and try to recover@>
- else begin print_err("Incomplete "); print_cmd_chr(if_test,cur_if);
-@.Incomplete \\if...@>
- print("; all text was ignored after line "); print_int(skip_line);
- help3("A forbidden control sequence occurred in skipped text.")@/
- ("This kind of error happens when you say `\if...' and forget")@/
- ("the matching `\fi'. I've inserted a `\fi'; this might work.");
- if cur_cs<>0 then cur_cs:=0
- else help_line[2]:=@|
- "The file ended while I was skipping conditional text.";
- cur_tok:=cs_token_flag+frozen_fi; ins_error;
- end;
- deletions_allowed:=true;
- end;
-end;
-
-@ An outer control sequence that occurs in a \.{\\read} will not be reread,
-since the error recovery for \.{\\read} is not very powerful.
-
-@<Back up an outer control sequence so that it can be reread@>=
-if cur_cs<>0 then
- begin if (state=token_list)or(name<1)or(name>17) then
- begin p:=get_avail; info(p):=cs_token_flag+cur_cs;
- back_list(p); {prepare to read the control sequence again}
- end;
- cur_cmd:=spacer; cur_chr:=" "; {replace it by a space}
- end
-
-@ @<Tell the user what has run away...@>=
-begin runaway; {print a definition, argument, or preamble}
-if cur_cs=0 then print_err("File ended")
-@.File ended while scanning...@>
-else begin cur_cs:=0; print_err("Forbidden control sequence found");
-@.Forbidden control sequence...@>
- end;
-print(" while scanning ");
-@<Print either `\.{definition}' or `\.{use}' or `\.{preamble}' or `\.{text}',
- and insert tokens that should lead to recovery@>;
-print(" of "); sprint_cs(warning_index);
-help4("I suspect you have forgotten a `}', causing me")@/
-("to read past where you wanted me to stop.")@/
-("I'll try to recover; but if the error is serious,")@/
-("you'd better type `E' or `X' now and fix your file.");@/
-error;
-end
-
-@ The recovery procedure can't be fully understood without knowing more
-about the \TeX\ routines that should be aborted, but we can sketch the
-ideas here: For a runaway definition or a runaway balanced text
-we will insert a right brace; for a
-runaway preamble, we will insert a special \.{\\cr} token and a right
-brace; and for a runaway argument, we will set |long_state| to
-|outer_call| and insert \.{\\par}.
-
-@<Print either `\.{definition}' or ...@>=
-p:=get_avail;
-case scanner_status of
-defining:begin print("definition"); info(p):=right_brace_token+"}";
- end;
-matching:begin print("use"); info(p):=par_token; long_state:=outer_call;
- end;
-aligning:begin print("preamble"); info(p):=right_brace_token+"}"; q:=p;
- p:=get_avail; link(p):=q; info(p):=cs_token_flag+frozen_cr;
- align_state:=-1000000;
- end;
-absorbing:begin print("text"); info(p):=right_brace_token+"}";
- end;
-end; {there are no other cases}
-ins_list(p)
-
-@ We need to mention a procedure here that may be called by |get_next|.
-
-@p procedure@?firm_up_the_line; forward;
-
-@ Now we're ready to take the plunge into |get_next| itself. Parts of
-this routine are executed more often than any other instructions of \TeX.
-@^mastication@>@^inner loop@>
-
-@d switch=25 {a label in |get_next|}
-@d start_cs=26 {another}
-
-@p procedure get_next; {sets |cur_cmd|, |cur_chr|, |cur_cs| to next token}
-label restart, {go here to get the next input token}
- switch, {go here to eat the next character from a file}
- reswitch, {go here to digest it again}
- start_cs, {go here to start looking for a control sequence}
- found, {go here when a control sequence has been found}
- exit; {go here when the next input token has been got}
-var k:0..buf_size; {an index into |buffer|}
-@!t:halfword; {a token}
-@!cat:0..max_char_code; {|cat_code(cur_chr)|, usually}
-@!c,@!cc:ASCII_code; {constituents of a possible expanded code}
-@!d:2..3; {number of excess characters in an expanded code}
-begin restart: cur_cs:=0;
-if state<>token_list then
-@<Input from external file, |goto restart| if no input found@>
-else @<Input from token list, |goto restart| if end of list or
- if a parameter needs to be expanded@>;
-@<If an alignment entry has just ended, take appropriate action@>;
-exit:end;
-
-@ An alignment entry ends when a tab or \.{\\cr} occurs, provided that the
-current level of braces is the same as the level that was present at the
-beginning of that alignment entry; i.e., provided that |align_state| has
-returned to the value it had after the \<u_j> template for that entry.
-@^inner loop@>
-
-@<If an alignment entry has just ended, take appropriate action@>=
-if cur_cmd<=car_ret then if cur_cmd>=tab_mark then if align_state=0 then
- @<Insert the \(v)\<v_j> template and |goto restart|@>
-
-@ @<Input from external file, |goto restart| if no input found@>=
-@^inner loop@>
-begin switch: if loc<=limit then {current line not yet finished}
- begin cur_chr:=buffer[loc]; incr(loc);
- reswitch: cur_cmd:=cat_code(cur_chr);
- @<Change state if necessary, and |goto switch| if the
- current character should be ignored,
- or |goto reswitch| if the current character
- changes to another@>;
- end
-else begin state:=new_line;@/
- @<Move to next line of file,
- or |goto restart| if there is no next line,
- or |return| if a \.{\\read} line has finished@>;
- check_interrupt;
- goto switch;
- end;
-end
-
-@ The following 48-way switch accomplishes the scanning quickly, assuming
-that a decent \PASCAL\ compiler has translated the code. Note that the numeric
-values for |mid_line|, |skip_blanks|, and |new_line| are spaced
-apart from each other by |max_char_code+1|, so we can add a character's
-command code to the state to get a single number that characterizes both.
-
-@d any_state_plus(#) == mid_line+#,skip_blanks+#,new_line+#
-
-@<Change state if necessary...@>=
-case state+cur_cmd of
-@<Cases where character is ignored@>: goto switch;
-any_state_plus(escape): @<Scan a control sequence
- and set |state:=skip_blanks| or |mid_line|@>;
-any_state_plus(active_char): @<Process an active-character control sequence
- and set |state:=mid_line|@>;
-any_state_plus(sup_mark): @<If this |sup_mark| starts an expanded character
- like~\.{\^\^A} or~\.{\^\^df}, then |goto reswitch|,
- otherwise set |state:=mid_line|@>;
-any_state_plus(invalid_char): @<Decry the invalid character and
- |goto restart|@>;
-@t\4@>@<Handle situations involving spaces, braces, changes of state@>@;
-othercases do_nothing
-endcases
-
-@ @<Cases where character is ignored@>=
-any_state_plus(ignore),skip_blanks+spacer,new_line+spacer
-
-@ We go to |restart| instead of to |switch|, because |state| might equal
-|token_list| after the error has been dealt with
-(cf.\ |clear_for_error_prompt|).
-
-@<Decry the invalid...@>=
-begin print_err("Text line contains an invalid character");
-@.Text line contains...@>
-help2("A funny symbol that I can't read has just been input.")@/
-("Continue, and I'll forget that it ever happened.");@/
-deletions_allowed:=false; error; deletions_allowed:=true;
-goto restart;
-end
-
-@ @d add_delims_to(#)==#+math_shift,#+tab_mark,#+mac_param,
- #+sub_mark,#+letter,#+other_char
-
-@<Handle situations involving spaces, braces, changes of state@>=
-mid_line+spacer:@<Enter |skip_blanks| state, emit a space@>;
-mid_line+car_ret:@<Finish line, emit a space@>;
-skip_blanks+car_ret,any_state_plus(comment):
- @<Finish line, |goto switch|@>;
-new_line+car_ret:@<Finish line, emit a \.{\\par}@>;
-mid_line+left_brace: incr(align_state);
-skip_blanks+left_brace,new_line+left_brace: begin
- state:=mid_line; incr(align_state);
- end;
-mid_line+right_brace: decr(align_state);
-skip_blanks+right_brace,new_line+right_brace: begin
- state:=mid_line; decr(align_state);
- end;
-add_delims_to(skip_blanks),add_delims_to(new_line): state:=mid_line;
-
-@ When a character of type |spacer| gets through, its character code is
-changed to $\.{"\ "}=@'40$. This means that the ASCII codes for tab and space,
-and for the space inserted at the end of a line, will
-be treated alike when macro parameters are being matched. We do this
-since such characters are indistinguishable on most computer terminal displays.
-
-@<Finish line, emit a space@>=
-begin loc:=limit+1; cur_cmd:=spacer; cur_chr:=" ";
-end
-
-@ The following code is performed only when |cur_cmd=spacer|.
-
-@<Enter |skip_blanks| state, emit a space@>=
-begin state:=skip_blanks; cur_chr:=" ";
-end
-
-@ @<Finish line, |goto switch|@>=
-begin loc:=limit+1; goto switch;
-end
-
-@ @<Finish line, emit a \.{\\par}@>=
-begin loc:=limit+1; cur_cs:=par_loc; cur_cmd:=eq_type(cur_cs);
-cur_chr:=equiv(cur_cs);
-if cur_cmd>=outer_call then check_outer_validity;
-end
-
-@ Notice that a code like \.{\^\^8} becomes \.x if not followed by a hex digit.
-
-@d is_hex(#)==(((#>="0")and(#<="9"))or((#>="a")and(#<="f")))
-@d hex_to_cur_chr==
- if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10;
- if cc<="9" then cur_chr:=16*cur_chr+cc-"0"
- else cur_chr:=16*cur_chr+cc-"a"+10
-
-@<If this |sup_mark| starts an expanded character...@>=
-begin if cur_chr=buffer[loc] then if loc<limit then
- begin c:=buffer[loc+1]; @+if c<@'200 then {yes we have an expanded char}
- begin loc:=loc+2;
- if is_hex(c) then if loc<=limit then
- begin cc:=buffer[loc]; @+if is_hex(cc) then
- begin incr(loc); hex_to_cur_chr; goto reswitch;
- end;
- end;
- if c<@'100 then cur_chr:=c+@'100 @+else cur_chr:=c-@'100;
- goto reswitch;
- end;
- end;
-state:=mid_line;
-end
-
-@ @<Process an active-character...@>=
-begin cur_cs:=cur_chr+active_base;
-cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs); state:=mid_line;
-if cur_cmd>=outer_call then check_outer_validity;
-end
-
-@ Control sequence names are scanned only when they appear in some line of
-a file; once they have been scanned the first time, their |eqtb| location
-serves as a unique identification, so \TeX\ doesn't need to refer to the
-original name any more except when it prints the equivalent in symbolic form.
-
-The program that scans a control sequence has been written carefully
-in order to avoid the blowups that might otherwise occur if a malicious
-user tried something like `\.{\\catcode\'15=0}'. The algorithm might
-look at |buffer[limit+1]|, but it never looks at |buffer[limit+2]|.
-
-If expanded characters like `\.{\^\^A}' or `\.{\^\^df}'
-appear in or just following
-a control sequence name, they are converted to single characters in the
-buffer and the process is repeated, slowly but surely.
-
-@<Scan a control...@>=
-begin if loc>limit then cur_cs:=null_cs {|state| is irrelevant in this case}
-else begin start_cs: k:=loc; cur_chr:=buffer[k]; cat:=cat_code(cur_chr);
- incr(k);
- if cat=letter then state:=skip_blanks
- else if cat=spacer then state:=skip_blanks
- else state:=mid_line;
- if (cat=letter)and(k<=limit) then
- @<Scan ahead in the buffer until finding a nonletter;
- if an expanded code is encountered, reduce it
- and |goto start_cs|; otherwise if a multiletter control
- sequence is found, adjust |cur_cs| and |loc|, and
- |goto found|@>
- else @<If an expanded code is present, reduce it and |goto start_cs|@>;
- cur_cs:=single_base+buffer[loc]; incr(loc);
- end;
-found: cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
-if cur_cmd>=outer_call then check_outer_validity;
-end
-
-@ Whenever we reach the following piece of code, we will have
-|cur_chr=buffer[k-1]| and |k<=limit+1| and |cat=cat_code(cur_chr)|. If an
-expanded code like \.{\^\^A} or \.{\^\^df} appears in |buffer[(k-1)..(k+1)]|
-or |buffer[(k-1)..(k+2)]|, we
-will store the corresponding code in |buffer[k-1]| and shift the rest of
-the buffer left two or three places.
-
-@<If an expanded...@>=
-begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then
- begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present}
- begin d:=2;
- if is_hex(c) then @+if k+2<=limit then
- begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d);
- end;
- if d>2 then
- begin hex_to_cur_chr; buffer[k-1]:=cur_chr;
- end
- else if c<@'100 then buffer[k-1]:=c+@'100
- else buffer[k-1]:=c-@'100;
- limit:=limit-d; first:=first-d;
- while k<=limit do
- begin buffer[k]:=buffer[k+d]; incr(k);
- end;
- goto start_cs;
- end;
- end;
-end
-
-@ @<Scan ahead in the buffer...@>=
-begin repeat cur_chr:=buffer[k]; cat:=cat_code(cur_chr); incr(k);
-until (cat<>letter)or(k>limit);
-@<If an expanded...@>;
-if cat<>letter then decr(k);
- {now |k| points to first nonletter}
-if k>loc+1 then {multiletter control sequence has been scanned}
- begin cur_cs:=id_lookup(loc,k-loc); loc:=k; goto found;
- end;
-end
-
-@ Let's consider now what happens when |get_next| is looking at a token list.
-
-@<Input from token list, |goto restart| if end of list or
- if a parameter needs to be expanded@>=
-if loc<>null then {list not exhausted}
-@^inner loop@>
- begin t:=info(loc); loc:=link(loc); {move to next}
- if t>=cs_token_flag then {a control sequence token}
- begin cur_cs:=t-cs_token_flag;
- cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
- if cur_cmd>=outer_call then
- if cur_cmd=dont_expand then
- @<Get the next token, suppressing expansion@>
- else check_outer_validity;
- end
- else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400;
- case cur_cmd of
- left_brace: incr(align_state);
- right_brace: decr(align_state);
- out_param: @<Insert macro parameter and |goto restart|@>;
- othercases do_nothing
- endcases;
- end;
- end
-else begin {we are done with this token list}
- end_token_list; goto restart; {resume previous level}
- end
-
-@ The present point in the program is reached only when the |expand|
-routine has inserted a special marker into the input. In this special
-case, |info(loc)| is known to be a control sequence token, and |link(loc)=null|.
-
-@d no_expand_flag=257 {this characterizes a special variant of |relax|}
-
-@<Get the next token, suppressing expansion@>=
-begin cur_cs:=info(loc)-cs_token_flag; loc:=null;@/
-cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
-if cur_cmd>max_command then
- begin cur_cmd:=relax; cur_chr:=no_expand_flag;
- end;
-end
-
-@ @<Insert macro parameter...@>=
-begin begin_token_list(param_stack[param_start+cur_chr-1],parameter);
-goto restart;
-end
-
-@ All of the easy branches of |get_next| have now been taken care of.
-There is one more branch.
-
-@d end_line_char_inactive == (end_line_char<0)or(end_line_char>255)
-
-@<Move to next line of file, or |goto restart|...@>=
-if name>17 then @<Read next line of file into |buffer|, or
- |goto restart| if the file has ended@>
-else begin if not terminal_input then {\.{\\read} line has ended}
- begin cur_cmd:=0; cur_chr:=0; return;
- end;
- if input_ptr>0 then {text was inserted during error recovery}
- begin end_file_reading; goto restart; {resume previous level}
- end;
- if selector<log_only then open_log_file;
- if interaction>nonstop_mode then
- begin if end_line_char_inactive then incr(limit);
- if limit=start then {previous line was empty}
- print_nl("(Please type a command or say `\end')");
-@.Please type...@>
- print_ln; first:=start;
- prompt_input("*"); {input on-line into |buffer|}
-@.*\relax@>
- limit:=last;
- if end_line_char_inactive then decr(limit)
- else buffer[limit]:=end_line_char;
- first:=limit+1;
- loc:=start;
- end
- else fatal_error("*** (job aborted, no legal \end found)");
-@.job aborted@>
- {nonstop mode, which is intended for overnight batch processing,
- never waits for on-line input}
- end
-
-@ The global variable |force_eof| is normally |false|; it is set |true|
-by an \.{\\endinput} command.
-
-@<Glob...@>=
-@!force_eof:boolean; {should the next \.{\\input} be aborted early?}
-
-@ @<Read next line of file into |buffer|, or
- |goto restart| if the file has ended@>=
-begin incr(line); first:=start;
-if not force_eof then
- if name<=19 then
- begin if pseudo_input then {not end of file}
- firm_up_the_line {this sets |limit|}
- else if (every_eof<>null)and not eof_seen[index] then
- begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
- begin_token_list(every_eof,every_eof_text); goto restart;
- end
- else force_eof:=true;
- end
- else
- begin if input_ln(cur_file,true) then {not end of file}
- firm_up_the_line {this sets |limit|}
- else if (every_eof<>null)and not eof_seen[index] then
- begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
- begin_token_list(every_eof,every_eof_text); goto restart;
- end
- else force_eof:=true;
- end;
-if force_eof then
- begin if tracing_nesting>0 then
- if (grp_stack[in_open]<>cur_boundary)or@|
- (if_stack[in_open]<>cond_ptr) then file_warning;
- {give warning for some unfinished groups and/or conditionals}
- if name>=19 then
- begin print_char(")"); decr(open_parens);
- update_terminal; {show user that file has been read}
- end;
- force_eof:=false;
- end_file_reading; {resume previous level}
- check_outer_validity; goto restart;
- end;
-if end_line_char_inactive then decr(limit)
-else buffer[limit]:=end_line_char;
-first:=limit+1; loc:=start; {ready to read}
-end
-
-@ If the user has set the |pausing| parameter to some positive value,
-and if nonstop mode has not been selected, each line of input is displayed
-on the terminal and the transcript file, followed by `\.{=>}'.
-\TeX\ waits for a response. If the response is simply |carriage_return|, the
-line is accepted as it stands, otherwise the line typed is
-used instead of the line in the file.
-
-@p procedure firm_up_the_line;
-var k:0..buf_size; {an index into |buffer|}
-begin limit:=last;
-if pausing>0 then if interaction>nonstop_mode then
- begin wake_up_terminal; print_ln;
- if start<limit then for k:=start to limit-1 do print(buffer[k]);
- first:=limit; prompt_input("=>"); {wait for user response}
-@.=>@>
- if last>first then
- begin for k:=first to last-1 do {move line down in buffer}
- buffer[k+start-first]:=buffer[k];
- limit:=start+last-first;
- end;
- end;
-end;
-
-@ Since |get_next| is used so frequently in \TeX, it is convenient
-to define three related procedures that do a little more:
-
-\yskip\hang|get_token| not only sets |cur_cmd| and |cur_chr|, it
-also sets |cur_tok|, a packed halfword version of the current token.
-
-\yskip\hang|get_x_token|, meaning ``get an expanded token,'' is like
-|get_token|, but if the current token turns out to be a user-defined
-control sequence (i.e., a macro call), or a conditional,
-or something like \.{\\topmark} or \.{\\expandafter} or \.{\\csname},
-it is eliminated from the input by beginning the expansion of the macro
-or the evaluation of the conditional.
-
-\yskip\hang|x_token| is like |get_x_token| except that it assumes that
-|get_next| has already been called.
-
-\yskip\noindent
-In fact, these three procedures account for almost every use of |get_next|.
-
-@ No new control sequences will be defined except during a call of
-|get_token|, or when \.{\\csname} compresses a token list, because
-|no_new_control_sequence| is always |true| at other times.
-
-@p procedure get_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|}
-begin no_new_control_sequence:=false; get_next; no_new_control_sequence:=true;
-@^inner loop@>
-if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
-else cur_tok:=cs_token_flag+cur_cs;
-end;
-
-@* \[25] Expanding the next token.
-Only a dozen or so command codes |>max_command| can possibly be returned by
-|get_next|; in increasing order, they are |undefined_cs|, |expand_after|,
-|no_expand|, |input|, |if_test|, |fi_or_else|, |cs_name|, |convert|, |the|,
-|top_bot_mark|, |call|, |long_call|, |outer_call|, |long_outer_call|, and
-|end_template|.{\emergencystretch=40pt\par}
-
-The |expand| subroutine is used when |cur_cmd>max_command|. It removes a
-``call'' or a conditional or one of the other special operations just
-listed. It follows that |expand| might invoke itself recursively. In all
-cases, |expand| destroys the current token, but it sets things up so that
-the next |get_next| will deliver the appropriate next token. The value of
-|cur_tok| need not be known when |expand| is called.
-
-Since several of the basic scanning routines communicate via global variables,
-their values are saved as local variables of |expand| so that
-recursive calls don't invalidate them.
-@^recursion@>
-
-@p@t\4@>@<Declare the procedure called |macro_call|@>@;@/
-@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
-@t\4@>@<Declare \eTeX\ procedures for expanding@>@;@/
-procedure@?pass_text; forward;@t\2@>
-procedure@?start_input; forward;@t\2@>
-procedure@?conditional; forward;@t\2@>
-procedure@?get_x_token; forward;@t\2@>
-procedure@?conv_toks; forward;@t\2@>
-procedure@?ins_the_toks; forward;@t\2@>
-procedure expand;
-label reswitch;
-var t:halfword; {token that is being ``expanded after''}
-@!b:boolean; {keep track of nested csnames}
-@!p,@!q,@!r:pointer; {for list manipulation}
-@!j:0..buf_size; {index into |buffer|}
-@!cv_backup:integer; {to save the global quantity |cur_val|}
-@!cvl_backup,@!radix_backup,@!co_backup:small_number;
- {to save |cur_val_level|, etc.}
-@!backup_backup:pointer; {to save |link(backup_head)|}
-@!save_scanner_status:small_number; {temporary storage of |scanner_status|}
-begin cv_backup:=cur_val; cvl_backup:=cur_val_level; radix_backup:=radix;
-co_backup:=cur_order; backup_backup:=link(backup_head);
-reswitch:
-if cur_cmd<call then @<Expand a nonmacro@>
-else if cur_cmd<end_template then macro_call
-else @<Insert a token containing |frozen_endv|@>;
-cur_val:=cv_backup; cur_val_level:=cvl_backup; radix:=radix_backup;
-cur_order:=co_backup; link(backup_head):=backup_backup;
-end;
-
-@ @<Glob...@>=
-@!is_in_csname: boolean;
-
-@ @<Set init...@>=
-is_in_csname := false;
-
-@ @<Expand a nonmacro@>=
-begin if tracing_commands>1 then show_cur_cmd_chr;
-case cur_cmd of
-top_bot_mark:@<Insert the \(a)appropriate mark text into the scanner@>;
-expand_after:if cur_chr=0 then @<Expand the token after the next token@>
- else @<Negate a boolean conditional and |goto reswitch|@>;
-no_expand: if cur_chr=0 then @<Suppress expansion of the next token@>
- else @<Implement \.{\\pdfprimitive}@>;
-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 \.{\\pdfprimitive} 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 \.{\\pdfprimitive}, that is
-sneaked in as an alternate form of |ignore_spaces|.
-@!@:pdfprimitive_}{\.{\\pdfprimitive} primitive (internalized)@>
-
-Simply pushing back a token that matches the correct internal command
-does not work, because approach would not survive roundtripping to a
-temporary file.
-
-@<Implement \.{\\pdfprimitive}@>=
-begin save_scanner_status := scanner_status; scanner_status:=normal;
-get_token; scanner_status:=save_scanner_status;
-if cur_cs < hash_base then
- cur_cs := prim_lookup(cur_cs-single_base)
-else
- cur_cs := prim_lookup(text(cur_cs));
-if cur_cs<>undefined_primitive then begin
- t := prim_eq_type(cur_cs);
- if t>max_command then begin
- cur_cmd := t;
- cur_chr := prim_equiv(cur_cs);
- cur_tok := (cur_cmd*@'400)+cur_chr;
- cur_cs := 0;
- goto reswitch;
- end
- else begin
- back_input; { now |loc| and |start| point to a one-item list }
- p:=get_avail; info(p):=cs_token_flag+frozen_primitive;
- link(p):=loc; loc:=p; start:=p;
- end;
- end;
-end
-
-@ This block deals with unexpandable \.{\\primitive} appearing at a spot where
-an integer or an internal values should have been found. It fetches the
-next token then resets |cur_cmd|, |cur_cs|, and |cur_tok|, based on the
-primitive value of that token. No expansion takes place, because the
-next token may be all sorts of things. This could trigger further
-expansion creating new errors.
-
-@<Reset |cur_tok| for unexpandable primitives, goto restart @>=
-begin
-get_token;
-if cur_cs < hash_base then
- cur_cs := prim_lookup(cur_cs-single_base)
-else
- cur_cs := prim_lookup(text(cur_cs));
-if cur_cs<>undefined_primitive then begin
- cur_cmd := prim_eq_type(cur_cs);
- cur_chr := prim_equiv(cur_cs);
- cur_cs := prim_eqtb_base+cur_cs;
- cur_tok := cs_token_flag+cur_cs;
- end
-else begin
- cur_cmd := relax;
- cur_chr := 0;
- cur_tok := cs_token_flag+frozen_relax;
- cur_cs := frozen_relax;
- end;
-goto restart;
-end
-
-@ @<Complain about an undefined macro@>=
-begin print_err("Undefined control sequence");
-@.Undefined control sequence@>
-help5("The control sequence at the end of the top line")@/
-("of your error message was never \def'ed. If you have")@/
-("misspelled it (e.g., `\hobx'), type `I' and the correct")@/
-("spelling (e.g., `I\hbox'). Otherwise just continue,")@/
-("and I'll forget about whatever was undefined.");
-error;
-end
-
-@ The |expand| procedure and some other routines that construct token
-lists find it convenient to use the following macros, which are valid only if
-the variables |p| and |q| are reserved for token-list building.
-
-@d store_new_token(#)==begin q:=get_avail; link(p):=q; info(q):=#;
- p:=q; {|link(p)| is |null|}
- end
-@d fast_store_new_token(#)==begin fast_get_avail(q); link(p):=q; info(q):=#;
- p:=q; {|link(p)| is |null|}
- end
-
-@ @<Manufacture a control...@>=
-begin r:=get_avail; p:=r; {head of the list of characters}
-b := is_in_csname; is_in_csname := true;
-repeat get_x_token;
-if cur_cs=0 then store_new_token(cur_tok);
-until cur_cs<>0;
-if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
-is_in_csname := b;
-@<Look up the characters of list |r| in the hash table, and set |cur_cs|@>;
-flush_list(r);
-if eq_type(cur_cs)=undefined_cs then
- begin eq_define(cur_cs,relax,256); {N.B.: The |save_stack| might change}
- end; {the control sequence will now match `\.{\\relax}'}
-cur_tok:=cur_cs+cs_token_flag; back_input;
-end
-
-@ @<Complain about missing \.{\\endcsname}@>=
-begin print_err("Missing "); print_esc("endcsname"); print(" inserted");
-@.Missing \\endcsname...@>
-help2("The control sequence marked <to be read again> should")@/
- ("not appear between \csname and \endcsname.");
-back_error;
-end
-
-@ @<Look up the characters of list |r| in the hash table...@>=
-j:=first; p:=link(r);
-while p<>null do
- begin if j>=max_buf_stack then
- begin max_buf_stack:=j+1;
- if max_buf_stack=buf_size then
- overflow("buffer size",buf_size);
-@:TeX capacity exceeded buffer size}{\quad buffer size@>
- end;
- buffer[j]:=info(p) mod @'400; incr(j); p:=link(p);
- end;
-if j>first+1 then
- begin no_new_control_sequence:=false; cur_cs:=id_lookup(first,j-first);
- no_new_control_sequence:=true;
- end
-else if j=first then cur_cs:=null_cs {the list is empty}
-else cur_cs:=single_base+buffer[first] {the list has length one}
-
-@ An |end_template| command is effectively changed to an |endv| command
-by the following code. (The reason for this is discussed below; the
-|frozen_end_template| at the end of the template has passed the
-|check_outer_validity| test, so its mission of error detection has been
-accomplished.)
-
-@<Insert a token containing |frozen_endv|@>=
-begin cur_tok:=cs_token_flag+frozen_endv; back_input;
-end
-
-@ The processing of \.{\\input} involves the |start_input| subroutine,
-which will be declared later; the processing of \.{\\endinput} is trivial.
-
-@<Put each...@>=
-primitive("input",input,0);@/
-@!@:input_}{\.{\\input} primitive@>
-primitive("endinput",input,1);@/
-@!@:end_input_}{\.{\\endinput} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-input: if chr_code=0 then print_esc("input")
- @/@<Cases of |input| for |print_cmd_chr|@>@/
- else print_esc("endinput");
-
-@ @<Initiate or terminate input...@>=
-if cur_chr=1 then force_eof:=true
-@/@<Cases for |input|@>@/
-else if name_in_progress then insert_relax
-else start_input
-
-@ Sometimes the expansion looks too far ahead, so we want to insert
-a harmless \.{\\relax} into the user's input.
-
-@<Declare the procedure called |insert_relax|@>=
-procedure insert_relax;
-begin cur_tok:=cs_token_flag+cur_cs; back_input;
-cur_tok:=cs_token_flag+frozen_relax; back_input; token_type:=inserted;
-end;
-
-@ Here is a recursive procedure that is \TeX's usual way to get the
-next token of input. It has been slightly optimized to take account of
-common cases.
-
-@p procedure get_x_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
- and expands macros}
-label restart,done;
-begin restart: get_next;
-@^inner loop@>
-if cur_cmd<=max_command then goto done;
-if cur_cmd>=call then
- if cur_cmd<end_template then macro_call
- else begin cur_cs:=frozen_endv; cur_cmd:=endv;
- goto done; {|cur_chr=null_list|}
- end
-else expand;
-goto restart;
-done: if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
-else cur_tok:=cs_token_flag+cur_cs;
-end;
-
-@ The |get_x_token| procedure is essentially equivalent to two consecutive
-procedure calls: |get_next; x_token|.
-
-@p procedure x_token; {|get_x_token| without the initial |get_next|}
-begin while cur_cmd>max_command do
- begin expand;
- get_next;
- end;
-if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr
-else cur_tok:=cs_token_flag+cur_cs;
-end;
-
-@ A control sequence that has been \.{\\def}'ed by the user is expanded by
-\TeX's |macro_call| procedure.
-
-Before we get into the details of |macro_call|, however, let's consider the
-treatment of primitives like \.{\\topmark}, since they are essentially
-macros without parameters. The token lists for such marks are kept in a
-global array of five pointers; we refer to the individual entries of this
-array by symbolic names |top_mark|, etc. The value of |top_mark| is either
-|null| or a pointer to the reference count of a token list.
-
-@d marks_code==5 {add this for \.{\\topmarks} etc.}
-@#
-@d top_mark_code=0 {the mark in effect at the previous page break}
-@d first_mark_code=1 {the first mark between |top_mark| and |bot_mark|}
-@d bot_mark_code=2 {the mark in effect at the current page break}
-@d split_first_mark_code=3 {the first mark found by \.{\\vsplit}}
-@d split_bot_mark_code=4 {the last mark found by \.{\\vsplit}}
-@d top_mark==cur_mark[top_mark_code]
-@d first_mark==cur_mark[first_mark_code]
-@d bot_mark==cur_mark[bot_mark_code]
-@d split_first_mark==cur_mark[split_first_mark_code]
-@d split_bot_mark==cur_mark[split_bot_mark_code]
-
-@<Glob...@>=
-@!cur_mark:array[top_mark_code..split_bot_mark_code] of pointer;
- {token lists for marks}
-
-@ @<Set init...@>=
-top_mark:=null; first_mark:=null; bot_mark:=null;
-split_first_mark:=null; split_bot_mark:=null;
-
-@ @<Put each...@>=
-primitive("topmark",top_bot_mark,top_mark_code);
-@!@:top_mark_}{\.{\\topmark} primitive@>
-primitive("firstmark",top_bot_mark,first_mark_code);
-@!@:first_mark_}{\.{\\firstmark} primitive@>
-primitive("botmark",top_bot_mark,bot_mark_code);
-@!@:bot_mark_}{\.{\\botmark} primitive@>
-primitive("splitfirstmark",top_bot_mark,split_first_mark_code);
-@!@:split_first_mark_}{\.{\\splitfirstmark} primitive@>
-primitive("splitbotmark",top_bot_mark,split_bot_mark_code);
-@!@:split_bot_mark_}{\.{\\splitbotmark} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-top_bot_mark: begin case (chr_code mod marks_code) of
- first_mark_code: print_esc("firstmark");
- bot_mark_code: print_esc("botmark");
- split_first_mark_code: print_esc("splitfirstmark");
- split_bot_mark_code: print_esc("splitbotmark");
- othercases print_esc("topmark")
- endcases;
- if chr_code>=marks_code then print_char("s");
- end;
-
-@ The following code is activated when |cur_cmd=top_bot_mark| and
-when |cur_chr| is a code like |top_mark_code|.
-
-@<Insert the \(a)appropriate mark text into the scanner@>=
-begin t:=cur_chr mod marks_code;
-if cur_chr>=marks_code then scan_register_num@+else cur_val:=0;
-if cur_val=0 then cur_ptr:=cur_mark[t]
-else @<Compute the mark pointer for mark type |t| and class |cur_val|@>;
-if cur_ptr<>null then begin_token_list(cur_ptr,mark_text);
-end
-
-@ Now let's consider |macro_call| itself, which is invoked when \TeX\ is
-scanning a control sequence whose |cur_cmd| is either |call|, |long_call|,
-|outer_call|, or |long_outer_call|. The control sequence definition
-appears in the token list whose reference count is in location |cur_chr|
-of |mem|.
-
-The global variable |long_state| will be set to |call| or to |long_call|,
-depending on whether or not the control sequence disallows \.{\\par}
-in its parameters. The |get_next| routine will set |long_state| to
-|outer_call| and emit \.{\\par}, if a file ends or if an \.{\\outer}
-control sequence occurs in the midst of an argument.
-
-@<Glob...@>=
-@!long_state:call..long_outer_call; {governs the acceptance of \.{\\par}}
-
-@ The parameters, if any, must be scanned before the macro is expanded.
-Parameters are token lists without reference counts. They are placed on
-an auxiliary stack called |pstack| while they are being scanned, since
-the |param_stack| may be losing entries during the matching process.
-(Note that |param_stack| can't be gaining entries, since |macro_call| is
-the only routine that puts anything onto |param_stack|, and it
-is not recursive.)
-
-@<Glob...@>=
-@!pstack:array[0..8] of pointer; {arguments supplied to a macro}
-
-@ After parameter scanning is complete, the parameters are moved to the
-|param_stack|. Then the macro body is fed to the scanner; in other words,
-|macro_call| places the defined text of the control sequence at the
-top of\/ \TeX's input stack, so that |get_next| will proceed to read it
-next.
-
-The global variable |cur_cs| contains the |eqtb| address of the control sequence
-being expanded, when |macro_call| begins. If this control sequence has not been
-declared \.{\\long}, i.e., if its command code in the |eq_type| field is
-not |long_call| or |long_outer_call|, its parameters are not allowed to contain
-the control sequence \.{\\par}. If an illegal \.{\\par} appears, the macro
-call is aborted, and the \.{\\par} will be rescanned.
-
-@<Declare the procedure called |macro_call|@>=
-procedure macro_call; {invokes a user-defined control sequence}
-label exit, continue, done, done1, found;
-var r:pointer; {current node in the macro's token list}
-@!p:pointer; {current node in parameter token list being built}
-@!q:pointer; {new node being put into the token list}
-@!s:pointer; {backup pointer for parameter matching}
-@!t:pointer; {cycle pointer for backup recovery}
-@!u,@!v:pointer; {auxiliary pointers for backup recovery}
-@!rbrace_ptr:pointer; {one step before the last |right_brace| token}
-@!n:small_number; {the number of parameters scanned}
-@!unbalance:halfword; {unmatched left braces in current parameter}
-@!m:halfword; {the number of tokens or groups (usually)}
-@!ref_count:pointer; {start of the token list}
-@!save_scanner_status:small_number; {|scanner_status| upon entry}
-@!save_warning_index:pointer; {|warning_index| upon entry}
-@!match_chr:ASCII_code; {character used in parameter}
-begin save_scanner_status:=scanner_status; save_warning_index:=warning_index;
-warning_index:=cur_cs; ref_count:=cur_chr; r:=link(ref_count); n:=0;
-if tracing_macros>0 then @<Show the text of the macro being expanded@>;
-if info(r)=protected_token then r:=link(r);
-if info(r)<>end_match_token then
- @<Scan the parameters and make |link(r)| point to the macro body; but
- |return| if an illegal \.{\\par} is detected@>;
-@<Feed the macro body and its parameters to the scanner@>;
-exit:scanner_status:=save_scanner_status; warning_index:=save_warning_index;
-end;
-
-@ Before we put a new token list on the input stack, it is wise to clean off
-all token lists that have recently been depleted. Then a user macro that ends
-with a call to itself will not require unbounded stack space.
-
-@<Feed the macro body and its parameters to the scanner@>=
-while (state=token_list)and(loc=null)and(token_type<>v_template) do
- end_token_list; {conserve stack space}
-begin_token_list(ref_count,macro); name:=warning_index; loc:=link(r);
-if n>0 then
- begin if param_ptr+n>max_param_stack then
- begin max_param_stack:=param_ptr+n;
- if max_param_stack>param_size then
- overflow("parameter stack size",param_size);
-@:TeX capacity exceeded parameter stack size}{\quad parameter stack size@>
- end;
- for m:=0 to n-1 do param_stack[param_ptr+m]:=pstack[m];
- param_ptr:=param_ptr+n;
- end
-
-@ At this point, the reader will find it advisable to review the explanation
-of token list format that was presented earlier, since many aspects of that
-format are of importance chiefly in the |macro_call| routine.
-
-The token list might begin with a string of compulsory tokens before the
-first |match| or |end_match|. In that case the macro name is supposed to be
-followed by those tokens; the following program will set |s=null| to
-represent this restriction. Otherwise |s| will be set to the first token of
-a string that will delimit the next parameter.
-
-@<Scan the parameters and make |link(r)| point to the macro body...@>=
-begin scanner_status:=matching; unbalance:=0;
-long_state:=eq_type(cur_cs);
-if long_state>=outer_call then long_state:=long_state-2;
-repeat link(temp_head):=null;
-if (info(r)>match_token+255)or(info(r)<match_token) then s:=null
-else begin match_chr:=info(r)-match_token; s:=link(r); r:=s;
- p:=temp_head; m:=0;
- end;
-@<Scan a parameter until its delimiter string has been found; or, if |s=null|,
- simply scan the delimiter string@>;@/
-{now |info(r)| is a token whose command code is either |match| or |end_match|}
-until info(r)=end_match_token;
-end
-
-@ If |info(r)| is a |match| or |end_match| command, it cannot be equal to
-any token found by |get_token|. Therefore an undelimited parameter---i.e.,
-a |match| that is immediately followed by |match| or |end_match|---will
-always fail the test `|cur_tok=info(r)|' in the following algorithm.
-
-@<Scan a parameter until its delimiter string has been found; or, ...@>=
-continue: get_token; {set |cur_tok| to the next token of input}
-if cur_tok=info(r) then
- @<Advance \(r)|r|; |goto found| if the parameter delimiter has been
- fully matched, otherwise |goto continue|@>;
-@<Contribute the recently matched tokens to the current parameter, and
- |goto continue| if a partial match is still in effect;
- but abort if |s=null|@>;
-if cur_tok=par_token then if long_state<>long_call then
- @<Report a runaway argument and abort@>;
-if cur_tok<right_brace_limit then
- if cur_tok<left_brace_limit then
- @<Contribute an entire group to the current parameter@>
- else @<Report an extra right brace and |goto continue|@>
-else @<Store the current token, but |goto continue| if it is
- a blank space that would become an undelimited parameter@>;
-incr(m);
-if info(r)>end_match_token then goto continue;
-if info(r)<match_token then goto continue;
-found: if s<>null then @<Tidy up the parameter just scanned, and tuck it away@>
-
-@ @<Store the current token, but |goto continue| if it is...@>=
-begin if cur_tok=space_token then
- if info(r)<=end_match_token then
- if info(r)>=match_token then goto continue;
-store_new_token(cur_tok);
-end
-
-@ A slightly subtle point arises here: When the parameter delimiter ends
-with `\.{\#\{}', the token list will have a left brace both before and
-after the |end_match|\kern-.4pt. Only one of these should affect the
-|align_state|, but both will be scanned, so we must make a correction.
-
-@<Advance \(r)|r|; |goto found| if the parameter delimiter has been fully...@>=
-begin r:=link(r);
-if (info(r)>=match_token)and(info(r)<=end_match_token) then
- begin if cur_tok<left_brace_limit then decr(align_state);
- goto found;
- end
-else goto continue;
-end
-
-@ @<Report an extra right brace and |goto continue|@>=
-begin back_input; print_err("Argument of "); sprint_cs(warning_index);
-@.Argument of \\x has...@>
-print(" has an extra }");
-help6("I've run across a `}' that doesn't seem to match anything.")@/
- ("For example, `\def\a#1{...}' and `\a}' would produce")@/
- ("this error. If you simply proceed now, the `\par' that")@/
- ("I've just inserted will cause me to report a runaway")@/
- ("argument that might be the root of the problem. But if")@/
- ("your `}' was spurious, just type `2' and it will go away.");
-incr(align_state); long_state:=call; cur_tok:=par_token; ins_error;
-goto continue;
-end {a white lie; the \.{\\par} won't always trigger a runaway}
-
-@ If |long_state=outer_call|, a runaway argument has already been reported.
-
-@<Report a runaway argument and abort@>=
-begin if long_state=call then
- begin runaway; print_err("Paragraph ended before ");
-@.Paragraph ended before...@>
- sprint_cs(warning_index); print(" was complete");
- help3("I suspect you've forgotten a `}', causing me to apply this")@/
- ("control sequence to too much text. How can we recover?")@/
- ("My plan is to forget the whole thing and hope for the best.");
- back_error;
- end;
-pstack[n]:=link(temp_head); align_state:=align_state-unbalance;
-for m:=0 to n do flush_list(pstack[m]);
-return;
-end
-
-@ When the following code becomes active, we have matched tokens from |s| to
-the predecessor of |r|, and we have found that |cur_tok<>info(r)|. An
-interesting situation now presents itself: If the parameter is to be
-delimited by a string such as `\.{ab}', and if we have scanned `\.{aa}',
-we want to contribute one `\.a' to the current parameter and resume
-looking for a `\.b'. The program must account for such partial matches and
-for others that can be quite complex. But most of the time we have |s=r|
-and nothing needs to be done.
-
-Incidentally, it is possible for \.{\\par} tokens to sneak in to certain
-parameters of non-\.{\\long} macros. For example, consider a case like
-`\.{\\def\\a\#1\\par!\{...\}}' where the first \.{\\par} is not followed
-by an exclamation point. In such situations it does not seem appropriate
-to prohibit the \.{\\par}, so \TeX\ keeps quiet about this bending of
-the rules.
-
-@<Contribute the recently matched tokens to the current parameter...@>=
-if s<>r then
- if s=null then @<Report an improper use of the macro and abort@>
- else begin t:=s;
- repeat store_new_token(info(t)); incr(m); u:=link(t); v:=s;
- loop@+ begin if u=r then
- if cur_tok<>info(v) then goto done
- else begin r:=link(v); goto continue;
- end;
- if info(u)<>info(v) then goto done;
- u:=link(u); v:=link(v);
- end;
- done: t:=link(t);
- until t=r;
- r:=s; {at this point, no tokens are recently matched}
- end
-
-@ @<Report an improper use...@>=
-begin print_err("Use of "); sprint_cs(warning_index);
-@.Use of x doesn't match...@>
-print(" doesn't match its definition");
-help4("If you say, e.g., `\def\a1{...}', then you must always")@/
- ("put `1' after `\a', since control sequence names are")@/
- ("made up of letters only. The macro here has not been")@/
- ("followed by the required stuff, so I'm ignoring it.");
-error; return;
-end
-
-@ @<Contribute an entire group to the current parameter@>=
-begin unbalance:=1;
-@^inner loop@>
-loop@+ begin fast_store_new_token(cur_tok); get_token;
- if cur_tok=par_token then if long_state<>long_call then
- @<Report a runaway argument and abort@>;
- if cur_tok<right_brace_limit then
- if cur_tok<left_brace_limit then incr(unbalance)
- else begin decr(unbalance);
- if unbalance=0 then goto done1;
- end;
- end;
-done1: rbrace_ptr:=p; store_new_token(cur_tok);
-end
-
-@ If the parameter consists of a single group enclosed in braces, we must
-strip off the enclosing braces. That's why |rbrace_ptr| was introduced.
-
-@<Tidy up the parameter just scanned, and tuck it away@>=
-begin if (m=1)and(info(p)<right_brace_limit) then
- begin link(rbrace_ptr):=null; free_avail(p);
- p:=link(temp_head); pstack[n]:=link(p); free_avail(p);
- end
-else pstack[n]:=link(temp_head);
-incr(n);
-if tracing_macros>0 then
- begin begin_diagnostic; print_nl(match_chr); print_int(n);
- print("<-"); show_token_list(pstack[n-1],null,1000);
- end_diagnostic(false);
- end;
-end
-
-@ @<Show the text of the macro being expanded@>=
-begin begin_diagnostic; print_ln; print_cs(warning_index);
-token_show(ref_count); end_diagnostic(false);
-end
-
-@* \[26] Basic scanning subroutines.
-Let's turn now to some procedures that \TeX\ calls upon frequently to digest
-certain kinds of patterns in the input. Most of these are quite simple;
-some are quite elaborate. Almost all of the routines call |get_x_token|,
-which can cause them to be invoked recursively.
-@^stomach@>
-@^recursion@>
-
-@ The |scan_left_brace| routine is called when a left brace is supposed to be
-the next non-blank token. (The term ``left brace'' means, more precisely,
-a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to
-appear before the |left_brace|.
-
-@p procedure scan_left_brace; {reads a mandatory |left_brace|}
-begin @<Get the next non-blank non-relax non-call token@>;
-if cur_cmd<>left_brace then
- begin print_err("Missing { inserted");
-@.Missing \{ inserted@>
- help4("A left brace was mandatory here, so I've put one in.")@/
- ("You might want to delete and/or insert some corrections")@/
- ("so that I will find a matching right brace soon.")@/
- ("(If you're confused by all this, try typing `I}' now.)");
- back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace;
- cur_chr:="{"; incr(align_state);
- end;
-end;
-
-@ @<Get the next non-blank non-relax non-call token@>=
-repeat get_x_token;
-until (cur_cmd<>spacer)and(cur_cmd<>relax)
-
-@ The |scan_optional_equals| routine looks for an optional `\.=' sign preceded
-by optional spaces; `\.{\\relax}' is not ignored here.
-
-@p procedure scan_optional_equals;
-begin @<Get the next non-blank non-call token@>;
-if cur_tok<>other_token+"=" then back_input;
-end;
-
-@ @<Get the next non-blank non-call token@>=
-repeat get_x_token;
-until cur_cmd<>spacer
-
-@ In case you are getting bored, here is a slightly less trivial routine:
-Given a string of lowercase letters, like `\.{pt}' or `\.{plus}' or
-`\.{width}', the |scan_keyword| routine checks to see whether the next
-tokens of input match this string. The match must be exact, except that
-uppercase letters will match their lowercase counterparts; uppercase
-equivalents are determined by subtracting |"a"-"A"|, rather than using the
-|uc_code| table, since \TeX\ uses this routine only for its own limited
-set of keywords.
-
-If a match is found, the characters are effectively removed from the input
-and |true| is returned. Otherwise |false| is returned, and the input
-is left essentially unchanged (except for the fact that some macros
-may have been expanded, etc.).
-@^inner loop@>
-
-@p function scan_keyword(@!s:str_number):boolean; {look for a given string}
-label exit;
-var p:pointer; {tail of the backup list}
-@!q:pointer; {new node being added to the token list via |store_new_token|}
-@!k:pool_pointer; {index into |str_pool|}
-@!save_cur_cs:pointer; {to save |cur_cs|}
-begin p:=backup_head; link(p):=null; k:=str_start[s];
-save_cur_cs:=cur_cs;
-while k<str_start[s+1] do
- begin get_x_token; {recursion is possible here}
-@^recursion@>
- if (cur_cs=0)and@|
- ((cur_chr=so(str_pool[k]))or(cur_chr=so(str_pool[k])-"a"+"A")) then
- begin store_new_token(cur_tok); incr(k);
- end
- else if (cur_cmd<>spacer)or(p<>backup_head) then
- begin back_input;
- if p<>backup_head then back_list(link(backup_head));
- cur_cs:=save_cur_cs;
- scan_keyword:=false; return;
- end;
- end;
-flush_list(link(backup_head)); scan_keyword:=true;
-exit:end;
-
-@ Here is a procedure that sounds an alarm when mu and non-mu units
-are being switched.
-
-@p procedure mu_error;
-begin print_err("Incompatible glue units");
-@.Incompatible glue units@>
-help1("I'm going to assume that 1mu=1pt when they're mixed.");
-error;
-end;
-
-@ The next routine `|scan_something_internal|' is used to fetch internal
-numeric quantities like `\.{\\hsize}', and also to handle the `\.{\\the}'
-when expanding constructions like `\.{\\the\\toks0}' and
-`\.{\\the\\baselineskip}'. Soon we will be considering the |scan_int|
-procedure, which calls |scan_something_internal|; on the other hand,
-|scan_something_internal| also calls |scan_int|, for constructions like
-`\.{\\catcode\`\\\$}' or `\.{\\fontdimen} \.3 \.{\\ff}'. So we
-have to declare |scan_int| as a |forward| procedure. A few other
-procedures are also declared at this point.
-
-@p procedure@?scan_int; forward; {scans an integer value}
-@t\4\4@>@<Declare procedures that scan restricted classes of integers@>@;
-@t\4\4@>@<Declare \eTeX\ procedures for scanning@>@;
-@t\4\4@>@<Declare procedures that scan font-related stuff@>
-
-@ \TeX\ doesn't know exactly what to expect when |scan_something_internal|
-begins. For example, an integer or dimension or glue value could occur
-immediately after `\.{\\hskip}'; and one can even say \.{\\the} with
-respect to token lists in constructions like
-`\.{\\xdef\\o\{\\the\\output\}}'. On the other hand, only integers are
-allowed after a construction like `\.{\\count}'. To handle the various
-possibilities, |scan_something_internal| has a |level| parameter, which
-tells the ``highest'' kind of quantity that |scan_something_internal| is
-allowed to produce. Six levels are distinguished, namely |int_val|,
-|dimen_val|, |glue_val|, |mu_val|, |ident_val|, and |tok_val|.
-
-The output of |scan_something_internal| (and of the other routines
-|scan_int|, |scan_dimen|, and |scan_glue| below) is put into the global
-variable |cur_val|, and its level is put into |cur_val_level|. The highest
-values of |cur_val_level| are special: |mu_val| is used only when
-|cur_val| points to something in a ``muskip'' register, or to one of the
-three parameters \.{\\thinmuskip}, \.{\\medmuskip}, \.{\\thickmuskip};
-|ident_val| is used only when |cur_val| points to a font identifier;
-|tok_val| is used only when |cur_val| points to |null| or to the reference
-count of a token list. The last two cases are allowed only when
-|scan_something_internal| is called with |level=tok_val|.
-
-If the output is glue, |cur_val| will point to a glue specification, and
-the reference count of that glue will have been updated to reflect this
-reference; if the output is a nonempty token list, |cur_val| will point to
-its reference count, but in this case the count will not have been updated.
-Otherwise |cur_val| will contain the integer or scaled value in question.
-
-@d int_val=0 {integer values}
-@d dimen_val=1 {dimension values}
-@d glue_val=2 {glue specifications}
-@d mu_val=3 {math glue specifications}
-@d ident_val=4 {font identifier}
-@d tok_val=5 {token lists}
-
-@<Glob...@>=
-@!cur_val:integer; {value returned by numeric scanners}
-@!cur_val_level:int_val..tok_val; {the ``level'' of this value}
-
-@ The hash table is initialized with `\.{\\count}', `\.{\\dimen}', `\.{\\skip}',
-and `\.{\\muskip}' all having |register| as their command code; they are
-distinguished by the |chr_code|, which is either |int_val|, |dimen_val|,
-|glue_val|, or |mu_val| more than |mem_bot| (dynamic variable-size nodes
-cannot have these values)
-
-@<Put each...@>=
-primitive("count",register,mem_bot+int_val);
-@!@:count_}{\.{\\count} primitive@>
-primitive("dimen",register,mem_bot+dimen_val);
-@!@:dimen_}{\.{\\dimen} primitive@>
-primitive("skip",register,mem_bot+glue_val);
-@!@:skip_}{\.{\\skip} primitive@>
-primitive("muskip",register,mem_bot+mu_val);
-@!@:mu_skip_}{\.{\\muskip} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-register: @<Cases of |register| for |print_cmd_chr|@>;
-
-@ OK, we're ready for |scan_something_internal| itself. A second parameter,
-|negative|, is set |true| if the value that is found should be negated.
-It is assumed that |cur_cmd| and |cur_chr| represent the first token of
-the internal quantity to be scanned; an error will be signalled if
-|cur_cmd<min_internal| or |cur_cmd>max_internal|.
-
-@d scanned_result_end(#)==cur_val_level:=#;@+end
-@d scanned_result(#)==@+begin cur_val:=#;scanned_result_end
-
-@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,@!r:pointer; {general purpose indices}
-@!tx:pointer; {effective tail node}
-@!i:four_quarters; {character info}
-@!p:0..nest_size; {index into |nest|}
-begin restart: m:=cur_chr;
-case cur_cmd of
-def_code: @<Fetch a character code from some table@>;
-toks_register,assign_toks,def_family,set_font,def_font,letterspace_font,pdf_copy_font: @<Fetch a token list or
- font identifier, provided that |level=tok_val|@>;
-assign_int: scanned_result(eqtb[m].int)(int_val);
-assign_dimen: scanned_result(eqtb[m].sc)(dimen_val);
-assign_glue: scanned_result(equiv(m))(glue_val);
-assign_mu_glue: scanned_result(equiv(m))(mu_val);
-set_aux: @<Fetch the |space_factor| or the |prev_depth|@>;
-set_prev_graf: @<Fetch the |prev_graf|@>;
-set_page_int:@<Fetch the |dead_cycles| or the |insert_penalties|@>;
-set_page_dimen: @<Fetch something on the |page_so_far|@>;
-set_shape: @<Fetch the |par_shape| size@>;
-set_box_dimen: @<Fetch a box dimension@>;
-char_given,math_given: scanned_result(cur_chr)(int_val);
-assign_font_dimen: @<Fetch a font dimension@>;
-assign_font_int: @<Fetch a font integer@>;
-register: @<Fetch a register@>;
-last_item: @<Fetch an item in the current node, if appropriate@>;
-ignore_spaces: {trap unexpandable primitives}
- if cur_chr=1 then @<Reset |cur_tok| for unexpandable primitives, goto restart@>;
-othercases @<Complain that \.{\\the} can't do this; give zero result@>
-endcases;@/
-while cur_val_level>level do @<Convert \(c)|cur_val| to a lower level@>;
-@<Fix the reference count, if any, and negate |cur_val| if |negative|@>;
-exit:end;
-
-@ @<Fetch a character code from some table@>=
-begin scan_char_num;
-if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val)
-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|}
- if m=mem_bot then
- begin scan_register_num;
- if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
- else begin find_sa_element(tok_val,cur_val,false);
- if cur_ptr=null then cur_val:=null
- else cur_val:=sa_ptr(cur_ptr);
- end;
- end
- else cur_val:=sa_ptr(m)
- else cur_val:=equiv(m);
- cur_val_level:=tok_val;
- end
-else begin back_input; scan_font_ident;
- scanned_result(font_id_base+cur_val)(ident_val);
- end
-
-@ Users refer to `\.{\\the\\spacefactor}' only in horizontal
-mode, and to `\.{\\the\\prevdepth}' only in vertical mode; so we put the
-associated mode in the modifier part of the |set_aux| command.
-The |set_page_int| command has modifier 0 or 1, for `\.{\\deadcycles}' and
-`\.{\\insertpenalties}', respectively. The |set_box_dimen| command is
-modified by either |width_offset|, |height_offset|, or |depth_offset|.
-And the |last_item| command is modified by either |int_val|, |dimen_val|,
-|glue_val|, |input_line_no_code|, or |badness_code|.
-\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 elapsed_time_code = pdftex_first_rint_code + 10 {code for \.{\\pdfelapsedtime}}
-@d pdf_shell_escape_code = pdftex_first_rint_code + 11 {code for \.{\\pdfshellescape}}
-@d random_seed_code = pdftex_first_rint_code + 12 {code for \.{\\pdfrandomseed}}
-@d pdf_last_link_code = pdftex_first_rint_code + 13 {code for \.{\\pdflastlink}}
-@d pdftex_last_item_codes = pdftex_first_rint_code + 13 {end of \pdfTeX's command codes}
-@#
-@d eTeX_int=pdftex_last_item_codes+1 {first of \eTeX\ codes for integers}
-@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions}
-@d eTeX_glue=eTeX_dim+9 {first of \eTeX\ codes for glue}
-@d eTeX_mu=eTeX_glue+1 {first of \eTeX\ codes for muglue}
-@d eTeX_expr=eTeX_mu+1 {first of \eTeX\ codes for expressions}
-
-@<Put each...@>=
-primitive("spacefactor",set_aux,hmode);
-@!@:space_factor_}{\.{\\spacefactor} primitive@>
-primitive("prevdepth",set_aux,vmode);@/
-@!@:prev_depth_}{\.{\\prevdepth} primitive@>
-primitive("deadcycles",set_page_int,0);
-@!@:dead_cycles_}{\.{\\deadcycles} primitive@>
-primitive("insertpenalties",set_page_int,1);
-@!@:insert_penalties_}{\.{\\insertpenalties} primitive@>
-primitive("wd",set_box_dimen,width_offset);
-@!@:wd_}{\.{\\wd} primitive@>
-primitive("ht",set_box_dimen,height_offset);
-@!@:ht_}{\.{\\ht} primitive@>
-primitive("dp",set_box_dimen,depth_offset);
-@!@:dp_}{\.{\\dp} primitive@>
-primitive("lastpenalty",last_item,int_val);
-@!@:last_penalty_}{\.{\\lastpenalty} primitive@>
-primitive("lastkern",last_item,dimen_val);
-@!@:last_kern_}{\.{\\lastkern} primitive@>
-primitive("lastskip",last_item,glue_val);
-@!@:last_skip_}{\.{\\lastskip} primitive@>
-primitive("inputlineno",last_item,input_line_no_code);
-@!@:input_line_no_}{\.{\\inputlineno} primitive@>
-primitive("badness",last_item,badness_code);
-@!@:badness_}{\.{\\badness} primitive@>
-primitive("pdftexversion",last_item,pdftex_version_code);@/
-@!@:pdftex_version_}{\.{\\pdftexversion} primitive@>
-primitive("pdflastobj",last_item,pdf_last_obj_code);@/
-@!@:pdf_last_obj_}{\.{\\pdflastobj} primitive@>
-primitive("pdflastxform",last_item,pdf_last_xform_code);@/
-@!@:pdf_last_xform_}{\.{\\pdflastxform} primitive@>
-primitive("pdflastximage",last_item,pdf_last_ximage_code);@/
-@!@:pdf_last_ximage_}{\.{\\pdflastximage} primitive@>
-primitive("pdflastximagepages",last_item,pdf_last_ximage_pages_code);@/
-@!@:pdf_last_ximage_pages_}{\.{\\pdflastximagepages} primitive@>
-primitive("pdflastannot",last_item,pdf_last_annot_code);@/
-@!@:pdf_last_annot_}{\.{\\pdflastannot} primitive@>
-primitive("pdflastxpos",last_item,pdf_last_x_pos_code);@/
-@!@:pdf_last_x_pos_}{\.{\\pdflastxpos} primitive@>
-primitive("pdflastypos",last_item,pdf_last_y_pos_code);@/
-@!@:pdf_last_y_pos_}{\.{\\pdflastypos} primitive@>
-primitive("pdfretval",last_item,pdf_retval_code);@/
-@!@:pdf_retval_}{\.{\\pdfretval} primitive@>
-primitive("pdflastximagecolordepth",last_item,pdf_last_ximage_colordepth_code);@/
-@!@:pdf_last_ximage_colordepth_}{\.{\\pdflastximagecolordepth} primitive@>
-primitive("pdfelapsedtime",last_item,elapsed_time_code);
-@!@:elapsed_time_}{\.{\\pdfelapsedtime} primitive@>
-primitive("pdfshellescape",last_item,pdf_shell_escape_code);
-@!@:pdf_shell_escape_}{\.{\\pdfshellescape} primitive@>
-primitive("pdfrandomseed",last_item,random_seed_code);
-@!@:random_seed_}{\.{\\pdfrandomseed} primitive@>
-primitive("pdflastlink",last_item,pdf_last_link_code);@/
-@!@:pdf_last_link_}{\.{\\pdflastlink} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-set_aux: if chr_code=vmode then print_esc("prevdepth")
-@+else print_esc("spacefactor");
-set_page_int: if chr_code=0 then print_esc("deadcycles")
-@/@<Cases of |set_page_int| for |print_cmd_chr|@>@/
-@+else print_esc("insertpenalties");
-set_box_dimen: if chr_code=width_offset then print_esc("wd")
-else if chr_code=height_offset then print_esc("ht")
-else print_esc("dp");
-last_item: case chr_code of
- int_val: print_esc("lastpenalty");
- dimen_val: print_esc("lastkern");
- glue_val: print_esc("lastskip");
- input_line_no_code: print_esc("inputlineno");
- @/@<Cases of |last_item| for |print_cmd_chr|@>@/
- pdftex_version_code: print_esc("pdftexversion");
- pdf_last_obj_code: print_esc("pdflastobj");
- pdf_last_xform_code: print_esc("pdflastxform");
- pdf_last_ximage_code: print_esc("pdflastximage");
- pdf_last_ximage_pages_code: print_esc("pdflastximagepages");
- pdf_last_annot_code: print_esc("pdflastannot");
- pdf_last_x_pos_code: print_esc("pdflastxpos");
- pdf_last_y_pos_code: print_esc("pdflastypos");
- pdf_retval_code: print_esc("pdfretval");
- pdf_last_ximage_colordepth_code: print_esc("pdflastximagecolordepth");
- elapsed_time_code: print_esc("pdfelapsedtime");
- pdf_shell_escape_code: print_esc("pdfshellescape");
- random_seed_code: print_esc("pdfrandomseed");
- pdf_last_link_code: print_esc("pdflastlink");
- othercases print_esc("badness")
- endcases;
-
-@ @<Fetch the |space_factor| or the |prev_depth|@>=
-if abs(mode)<>m then
- begin print_err("Improper "); print_cmd_chr(set_aux,m);
-@.Improper \\spacefactor@>
-@.Improper \\prevdepth@>
- help4("You can refer to \spacefactor only in horizontal mode;")@/
- ("you can refer to \prevdepth only in vertical mode; and")@/
- ("neither of these is meaningful inside \write. So")@/
- ("I'm forgetting what you said and using zero instead.");
- error;
- if level<>tok_val then scanned_result(0)(dimen_val)
- else scanned_result(0)(int_val);
- end
-else if m=vmode then scanned_result(prev_depth)(dimen_val)
-else scanned_result(space_factor)(int_val)
-
-@ @<Fetch the |dead_cycles| or the |insert_penalties|@>=
-begin if m=0 then cur_val:=dead_cycles
-@/@<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>@/
-else cur_val:=insert_penalties;
-cur_val_level:=int_val;
-end
-
-@ @<Fetch a box dimension@>=
-begin scan_register_num; fetch_box(q);
-if q=null then cur_val:=0 @+else cur_val:=mem[q+m].sc;
-cur_val_level:=dimen_val;
-end
-
-@ Inside an \.{\\output} routine, a user may wish to look at the page totals
-that were present at the moment when output was triggered.
-
-@d max_dimen==@'7777777777 {$2^{30}-1$}
-
-@<Fetch something on the |page_so_far|@>=
-begin if (page_contents=empty) and (not output_active) then
- if m=0 then cur_val:=max_dimen@+else cur_val:=0
-else cur_val:=page_so_far[m];
-cur_val_level:=dimen_val;
-end
-
-@ @<Fetch the |prev_graf|@>=
-if mode=0 then scanned_result(0)(int_val) {|prev_graf=0| within \.{\\write}}
-else begin nest[nest_ptr]:=cur_list; p:=nest_ptr;
- while abs(nest[p].mode_field)<>vmode do decr(p);
- scanned_result(nest[p].pg_field)(int_val);
- end
-
-@ @<Fetch the |par_shape| size@>=
-begin if m>par_shape_loc then @<Fetch a penalties array element@>
-else if par_shape_ptr=null then cur_val:=0
-else cur_val:=info(par_shape_ptr);
-cur_val_level:=int_val;
-end
-
-@ Here is where \.{\\lastpenalty}, \.{\\lastkern}, \.{\\lastskip}, and
-\.{\\lastnodetype} are
-implemented. The reference count for \.{\\lastskip} will be updated later.
-
-We also handle \.{\\inputlineno} and \.{\\badness} here, because they are
-legal in similar contexts.
-
-The macro |find_effective_tail_eTeX| sets |tx| to the last non-\.{\\endM}
-node of the current list.
-
-@d find_effective_tail_eTeX==
-tx:=tail;
-if not is_char_node(tx) then
- if (type(tx)=math_node)and(subtype(tx)=end_M_code) then
- begin r:=head;
- repeat q:=r; r:=link(q);
- until r=tx;
- tx:=q;
- end
-@#
-@d find_effective_tail==find_effective_tail_eTeX
-
-@<Fetch an item in the current node...@>=
-if m>=input_line_no_code then
- if m>=eTeX_glue then @<Process an expression and |return|@>@;
- else if m>=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;
- 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;
- elapsed_time_code: cur_val := get_microinterval;
- random_seed_code: cur_val := random_seed;
- pdf_shell_escape_code:
- begin
- if shellenabledp then begin
- if restrictedshell then cur_val :=2
- else cur_val := 1;
- end
- else cur_val := 0;
- end;
- 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;
- find_effective_tail;
- if cur_chr=last_node_type_code then
- begin cur_val_level:=int_val;
- if (tx=head)or(mode=0) then cur_val:=-1;
- end
- else cur_val_level:=cur_chr;
- if not is_char_node(tx)and(mode<>0) then
- case cur_chr of
- int_val: if type(tx)=penalty_node then cur_val:=penalty(tx);
- dimen_val: if type(tx)=kern_node then cur_val:=width(tx);
- glue_val: if type(tx)=glue_node then
- begin cur_val:=glue_ptr(tx);
- if subtype(tx)=mu_glue then cur_val_level:=mu_val;
- end;
- last_node_type_code: if type(tx)<=unset_node then cur_val:=type(tx)+1
- else cur_val:=unset_node+2;
- end {there are no other cases}
- else if (mode=vmode)and(tx=head) then
- case cur_chr of
- int_val: cur_val:=last_penalty;
- dimen_val: cur_val:=last_kern;
- glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
- last_node_type_code: cur_val:=last_node_type;
- end; {there are no other cases}
- end
-
-@ @<Fetch a font dimension@>=
-begin find_font_dimen(false); font_info[fmem_ptr].sc:=0;
-scanned_result(font_info[cur_val].sc)(dimen_val);
-end
-
-@ @<Fetch a font integer@>=
-begin scan_font_ident;
-if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
-else if m=1 then scanned_result(skew_char[cur_val])(int_val)
-else 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);
- kn_bs_code_base: scanned_result(get_kn_bs_code(n, k))(int_val);
- st_bs_code_base: scanned_result(get_st_bs_code(n, k))(int_val);
- sh_bs_code_base: scanned_result(get_sh_bs_code(n, k))(int_val);
- kn_bc_code_base: scanned_result(get_kn_bc_code(n, k))(int_val);
- kn_ac_code_base: scanned_result(get_kn_ac_code(n, k))(int_val);
- end;
-end;
-end
-
-@ @<Fetch a register@>=
-begin if (m<mem_bot)or(m>lo_mem_stat_max) then
- begin cur_val_level:=sa_type(m);
- if cur_val_level<glue_val then cur_val:=sa_int(m)
- else cur_val:=sa_ptr(m);
- end
-else begin scan_register_num; cur_val_level:=m-mem_bot;
- if cur_val>255 then
- begin find_sa_element(cur_val_level,cur_val,false);
- if cur_ptr=null then
- if cur_val_level<glue_val then cur_val:=0
- else cur_val:=zero_glue
- else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
- else cur_val:=sa_ptr(cur_ptr);
- end
- else
- case cur_val_level of
-int_val:cur_val:=count(cur_val);
-dimen_val:cur_val:=dimen(cur_val);
-glue_val: cur_val:=skip(cur_val);
-mu_val: cur_val:=mu_skip(cur_val);
-end; {there are no other cases}
- end;
-end
-
-@ @<Complain that \.{\\the} can't do this; give zero result@>=
-begin print_err("You can't use `"); print_cmd_chr(cur_cmd,cur_chr);
-@.You can't use x after ...@>
-print("' after "); print_esc("the");
-help1("I'm forgetting what you said and using zero instead.");
-error;
-if level<>tok_val then scanned_result(0)(dimen_val)
-else scanned_result(0)(int_val);
-end
-
-@ When a |glue_val| changes to a |dimen_val|, we use the width component
-of the glue; there is no need to decrease the reference count, since it
-has not yet been increased. When a |dimen_val| changes to an |int_val|,
-we use scaled points so that the value doesn't actually change. And when a
-|mu_val| changes to a |glue_val|, the value doesn't change either.
-
-@<Convert \(c)|cur_val| to a lower level@>=
-begin if cur_val_level=glue_val then cur_val:=width(cur_val)
-else if cur_val_level=mu_val then mu_error;
-decr(cur_val_level);
-end
-
-@ If |cur_val| points to a glue specification at this point, the reference
-count for the glue does not yet include the reference by |cur_val|.
-If |negative| is |true|, |cur_val_level| is known to be |<=mu_val|.
-
-@<Fix the reference count, if any, ...@>=
-if negative then
- if cur_val_level>=glue_val then
- begin cur_val:=new_spec(cur_val);
- @<Negate all three glue components of |cur_val|@>;
- end
- else negate(cur_val)
-else if (cur_val_level>=glue_val)and(cur_val_level<=mu_val) then
- add_glue_ref(cur_val)
-
-@ @<Negate all three...@>=
-begin negate(width(cur_val));
-negate(stretch(cur_val));
-negate(shrink(cur_val));
-end
-
-@ Our next goal is to write the |scan_int| procedure, which scans anything that
-\TeX\ treats as an integer. But first we might as well look at some simple
-applications of |scan_int| that have already been made inside of
-|scan_something_internal|.
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-procedure scan_eight_bit_int;
-begin scan_int;
-if (cur_val<0)or(cur_val>255) then
- begin print_err("Bad register code");
-@.Bad register code@>
- help2("A register number must be between 0 and 255.")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-end;
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-procedure scan_char_num;
-begin scan_int;
-if (cur_val<0)or(cur_val>255) then
- begin print_err("Bad character code");
-@.Bad character code@>
- help2("A character number must be between 0 and 255.")@/
- ("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;
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-procedure scan_fifteen_bit_int;
-begin scan_int;
-if (cur_val<0)or(cur_val>@'77777) then
- begin print_err("Bad mathchar");
-@.Bad mathchar@>
- help2("A mathchar number must be between 0 and 32767.")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
-end;
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-procedure scan_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;
-
-@ An integer number can be preceded by any number of spaces and `\.+' or
-`\.-' signs. Then comes either a decimal constant (i.e., radix 10), an
-octal constant (i.e., radix 8, preceded by~\.\'), a hexadecimal constant
-(radix 16, preceded by~\."), an alphabetic constant (preceded by~\.\`), or
-an internal variable. After scanning is complete,
-|cur_val| will contain the answer, which must be at most
-$2^{31}-1=2147483647$ in absolute value. The value of |radix| is set to
-10, 8, or 16 in the cases of decimal, octal, or hexadecimal constants,
-otherwise |radix| is set to zero. An optional space follows a constant.
-
-@d octal_token=other_token+"'" {apostrophe, indicates an octal constant}
-@d hex_token=other_token+"""" {double quote, indicates a hex constant}
-@d alpha_token=other_token+"`" {reverse apostrophe, precedes alpha constants}
-@d point_token=other_token+"." {decimal point}
-@d continental_point_token=other_token+"," {decimal point, Eurostyle}
-
-@<Glob...@>=
-@!radix:small_number; {|scan_int| sets this to 8, 10, 16, or zero}
-
-@ We initialize the following global variables just in case |expand|
-comes into action before any of the basic scanning routines has assigned
-them a value.
-
-@<Set init...@>=
-cur_val:=0; cur_val_level:=int_val; radix:=0; cur_order:=normal;
-
-@ The |scan_int| routine is used also to scan the integer part of a
-fraction; for example, the `\.3' in `\.{3.14159}' will be found by
-|scan_int|. The |scan_dimen| routine assumes that |cur_tok=point_token|
-after the integer part of such a fraction has been scanned by |scan_int|,
-and that the decimal point has been backed up to be scanned again.
-
-@p procedure scan_int; {sets |cur_val| to an integer}
-label done, restart;
-var negative:boolean; {should the answer be negated?}
-@!m:integer; {|@t$2^{31}$@> div radix|, the threshold of danger}
-@!d:small_number; {the digit just scanned}
-@!vacuous:boolean; {have no digits appeared?}
-@!OK_so_far:boolean; {has an error message been issued?}
-begin radix:=0; OK_so_far:=true;@/
-@<Get the next non-blank non-sign token; set |negative| appropriately@>;
-restart:
-if cur_tok=alpha_token then @<Scan an alphabetic character code into |cur_val|@>
-else if cur_tok=cs_token_flag+frozen_primitive then
- @<Reset |cur_tok| for unexpandable primitives, goto restart@>
-else if (cur_cmd>=min_internal)and(cur_cmd<=max_internal) then
- scan_something_internal(int_val,false)
-else @<Scan a numeric constant@>;
-if negative then negate(cur_val);
-end;
-
-@ @<Get the next non-blank non-sign token...@>=
-negative:=false;
-repeat @<Get the next non-blank non-call token@>;
-if cur_tok=other_token+"-" then
- begin negative := not negative; cur_tok:=other_token+"+";
- end;
-until cur_tok<>other_token+"+"
-
-@ A space is ignored after an alphabetic character constant, so that
-such constants behave like numeric ones.
-
-@<Scan an alphabetic character code into |cur_val|@>=
-begin get_token; {suppress macro expansion}
-if cur_tok<cs_token_flag then
- begin cur_val:=cur_chr;
- if cur_cmd<=right_brace then
- if cur_cmd=right_brace then incr(align_state)
- else decr(align_state);
- end
-else if cur_tok<cs_token_flag+single_base then
- cur_val:=cur_tok-cs_token_flag-active_base
-else cur_val:=cur_tok-cs_token_flag-single_base;
-if cur_val>255 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:
-
-@ A specification like `\.{filllll}' or `\.{fill L L L}' will lead to two
-error messages (one for each additional keyword \.{"l"}).
-
-@<Scan for \(f)\.{fil} units...@>=
-if scan_keyword("fil") then
-@.fil@>
- begin cur_order:=fil;
- while scan_keyword("l") do
- begin if cur_order=filll then
- begin print_err("Illegal unit of measure (");
-@.Illegal unit of measure@>
- print("replaced by filll)");
- help1("I dddon't go any higher than filll."); error;
- end
- else incr(cur_order);
- end;
- goto attach_fraction;
- end
-
-@ @<Scan for \(u)units that are internal dimensions...@>=
-save_cur_val:=cur_val;
-@<Get the next non-blank non-call...@>;
-if (cur_cmd<min_internal)or(cur_cmd>max_internal) then back_input
-else begin if mu then
- begin scan_something_internal(mu_val,false); @<Coerce glue...@>;
- if cur_val_level<>mu_val then mu_error;
- end
- else scan_something_internal(dimen_val,false);
- v:=cur_val; goto found;
- end;
-if mu then goto not_found;
-if scan_keyword("em") then v:=(@<The em width for |cur_font|@>)
-@.em@>
-else if scan_keyword("ex") then v:=(@<The x-height for |cur_font|@>)
-@.ex@>
-else if scan_keyword("px") then v:=pdf_px_dimen
-@.px@>
-else goto not_found;
-@<Scan an optional space@>;
-found:cur_val:=nx_plus_y(save_cur_val,v,xn_over_d(v,f,@'200000));
-goto attach_sign;
-not_found:
-
-@ @<Scan for \(m)\.{mu} units and |goto attach_fraction|@>=
-if scan_keyword("mu") then goto attach_fraction
-@.mu@>
-else begin print_err("Illegal unit of measure ("); print("mu inserted)");
-@.Illegal unit of measure@>
- help4("The unit of measurement in math glue must be mu.")@/
- ("To recover gracefully from this error, it's best to")@/
- ("delete the erroneous units; e.g., type `2' to delete")@/
- ("two letters. (See Chapter 27 of The TeXbook.)");
-@:TeXbook}{\sl The \TeX book@>
- error; goto attach_fraction;
- end
-
-@ @<Adjust \(f)for the magnification ratio@>=
-begin prepare_mag;
-if mag<>1000 then
- begin cur_val:=xn_over_d(cur_val,1000,mag);
- f:=(1000*f+@'200000*remainder) div mag;
- cur_val:=cur_val+(f div @'200000); f:=f mod @'200000;
- end;
-end
-
-@ The necessary conversion factors can all be specified exactly as
-fractions whose numerator and denominator sum to 32768 or less.
-According to the definitions here, $\rm2660\,dd\approx1000.33297\,mm$;
-this agrees well with the value $\rm1000.333\,mm$ cited by Bosshard
-@^Bosshard, Hans Rudolf@>
-in {\sl Technische Grundlagen zur Satzherstellung\/} (Bern, 1980).
-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 width(q):=default_rule
-else begin height(q):=default_rule; depth(q):=0;
- end;
-reswitch: if scan_keyword("width") then
-@.width@>
- begin scan_normal_dimen; width(q):=cur_val; goto reswitch;
- end;
-if scan_keyword("height") then
-@.height@>
- begin scan_normal_dimen; height(q):=cur_val; goto reswitch;
- end;
-if scan_keyword("depth") then
-@.depth@>
- begin scan_normal_dimen; depth(q):=cur_val; goto reswitch;
- end;
-scan_rule_spec:=q;
-end;
-
-@* \[27] Building token lists.
-The token lists for macros and for other things like \.{\\mark} and \.{\\output}
-and \.{\\write} are produced by a procedure called |scan_toks|.
-
-Before we get into the details of |scan_toks|, let's consider a much
-simpler task, that of converting the current string into a token list.
-The |str_toks| function does this; it classifies spaces as type |spacer|
-and everything else as type |other_char|.
-
-The token list created by |str_toks| begins at |link(temp_head)| and ends
-at the value |p| that is returned. (If |p=temp_head|, the list is empty.)
-
-@p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/
-function str_toks(@!b:pool_pointer):pointer;
- {converts |str_pool[b..pool_ptr-1]| to a token list}
-var p:pointer; {tail of the token list}
-@!q:pointer; {new node being added to the token list via |store_new_token|}
-@!t:halfword; {token being appended}
-@!k:pool_pointer; {index into |str_pool|}
-begin str_room(1);
-p:=temp_head; link(p):=null; k:=b;
-while k<pool_ptr do
- begin t:=so(str_pool[k]);
- if t=" " then t:=space_token
- else t:=other_token+t;
- fast_store_new_token(t);
- 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 @<Copy the token list@>
-else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
- case cur_val_level of
- int_val:print_int(cur_val);
- dimen_val:begin print_scaled(cur_val); print("pt");
- end;
- glue_val: begin print_spec(cur_val,"pt"); delete_glue_ref(cur_val);
- end;
- mu_val: begin print_spec(cur_val,"mu"); delete_glue_ref(cur_val);
- end;
- end; {there are no other cases}
- selector:=old_setting; the_toks:=str_toks(b);
- end;
-exit:end;
-
-@ @<Copy the token list@>=
-begin p:=temp_head; link(p):=null;
-if cur_val_level=ident_val then store_new_token(cs_token_flag+cur_val)
-else if cur_val<>null then
- begin r:=link(cur_val); {do not copy the reference count}
- while r<>null do
- begin fast_store_new_token(info(r)); r:=link(r);
- end;
- end;
-the_toks:=p;
-end
-
-@ Here's part of the |expand| subroutine that we are now ready to complete:
-
-@p procedure ins_the_toks;
-begin link(garbage):=the_toks; ins_list(link(temp_head));
-end;
-
-@ The primitives \.{\\number}, \.{\\romannumeral}, \.{\\string}, \.{\\meaning},
-\.{\\fontname}, and \.{\\jobname} are defined as follows.
-
-\eTeX\ adds \.{\\eTeXrevision} such that |job_name_code| remains last.
-
-\pdfTeX\ adds \.{\\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_convert_base=5 {base for \eTeX's command codes}
-@d eTeX_revision_code=etex_convert_base {command code for \.{\\eTeXrevision}}
-@d etex_convert_codes=etex_convert_base+1 {end of \eTeX's command codes}
-@d expanded_code = etex_convert_codes {command code for \.{\\expanded}}
-@d pdftex_first_expand_code = expanded_code + 1 {base for \pdfTeX's command codes}
-@d 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 pdf_escape_string_code = pdftex_first_expand_code + 7 {command code for \.{\\pdfescapestring}}
-@d pdf_escape_name_code = pdftex_first_expand_code + 8 {command code for \.{\\pdfescapename}}
-@d left_margin_kern_code = pdftex_first_expand_code + 9 {command code for \.{\\leftmarginkern}}
-@d right_margin_kern_code = pdftex_first_expand_code + 10 {command code for \.{\\rightmarginkern}}
-@d pdf_strcmp_code = pdftex_first_expand_code + 11 {command code for \.{\\pdfstrcmp}}
-@d pdf_colorstack_init_code = pdftex_first_expand_code + 12 {command code for \.{\\pdfcolorstackinit}}
-@d pdf_escape_hex_code = pdftex_first_expand_code + 13 {command code for \.{\\pdfescapehex}}
-@d pdf_unescape_hex_code = pdftex_first_expand_code + 14 {command code for \.{\\pdfunescapehex}}
-@d pdf_creation_date_code = pdftex_first_expand_code + 15 {command code for \.{\\pdfcreationdate}}
-@d pdf_file_mod_date_code = pdftex_first_expand_code + 16 {command code for \.{\\pdffilemoddate}}
-@d pdf_file_size_code = pdftex_first_expand_code + 17 {command code for \.{\\pdffilesize}}
-@d pdf_mdfive_sum_code = pdftex_first_expand_code + 18 {command code for \.{\\pdfmdfivesum}}
-@d pdf_file_dump_code = pdftex_first_expand_code + 19 {command code for \.{\\pdffiledump}}
-@d pdf_match_code = pdftex_first_expand_code + 20 {command code for \.{\\pdfmatch}}
-@d pdf_last_match_code = pdftex_first_expand_code + 21 {command code for \.{\\pdflastmatch}}
-@d uniform_deviate_code = pdftex_first_expand_code + 22 {end of \pdfTeX's command codes}
-@d normal_deviate_code = pdftex_first_expand_code + 23 {end of \pdfTeX's command codes}
-@d pdf_insert_ht_code = pdftex_first_expand_code + 24 {command code for \.{\\pdfinsertht}}
-@d pdf_ximage_bbox_code = pdftex_first_expand_code + 25 {command code for \.{\\pdfximagebbox}}
-@d pdftex_convert_codes = pdftex_first_expand_code + 26 {end of \pdfTeX's command codes}
-@d job_name_code=pdftex_convert_codes {command code for \.{\\jobname}}
-
-@<Put each...@>=
-primitive("number",convert,number_code);@/
-@!@:number_}{\.{\\number} primitive@>
-primitive("romannumeral",convert,roman_numeral_code);@/
-@!@:roman_numeral_}{\.{\\romannumeral} primitive@>
-primitive("string",convert,string_code);@/
-@!@:string_}{\.{\\string} primitive@>
-primitive("meaning",convert,meaning_code);@/
-@!@:meaning_}{\.{\\meaning} primitive@>
-primitive("fontname",convert,font_name_code);@/
-@!@:font_name_}{\.{\\fontname} primitive@>
-@#
-primitive("expanded",convert,expanded_code);@/
-@!@:expanded_}{\.{\\expanded} primitive@>
-@#
-primitive("pdftexrevision",convert,pdftex_revision_code);@/
-@!@:pdftex_revision_}{\.{\\pdftexrevision} primitive@>
-primitive("pdftexbanner",convert,pdftex_banner_code);@/
-@!@:pdftex_banner_}{\.{\\pdftexbanner} primitive@>
-primitive("pdffontname",convert,pdf_font_name_code);@/
-@!@:pdf_font_name_}{\.{\\pdffontname} primitive@>
-primitive("pdffontobjnum",convert,pdf_font_objnum_code);@/
-@!@:pdf_font_objnum_}{\.{\\pdffontobjnum} primitive@>
-primitive("pdffontsize",convert,pdf_font_size_code);@/
-@!@:pdf_font_size_}{\.{\\pdffontsize} primitive@>
-primitive("pdfpageref",convert,pdf_page_ref_code);@/
-@!@:pdf_page_ref_}{\.{\\pdfpageref} primitive@>
-primitive("leftmarginkern",convert,left_margin_kern_code);@/
-@!@:left_margin_kern_}{\.{\\leftmarginkern} primitive@>
-primitive("rightmarginkern",convert,right_margin_kern_code);@/
-@!@:right_margin_kern_}{\.{\\rightmarginkern} primitive@>
-primitive("pdfxformname",convert,pdf_xform_name_code);@/
-@!@:pdf_xform_name_}{\.{\\pdfxformname} primitive@>
-primitive("pdfescapestring",convert,pdf_escape_string_code);@/
-@!@:pdf_escape_string_}{\.{\\pdfescapestring} primitive@>
-primitive("pdfescapename",convert,pdf_escape_name_code);@/
-@!@:pdf_escape_name_}{\.{\\pdfescapename} primitive@>
-primitive("pdfescapehex",convert,pdf_escape_hex_code);@/
-@!@:pdf_escape_hex_}{\.{\\pdfescapehex} primitive@>
-primitive("pdfunescapehex",convert,pdf_unescape_hex_code);@/
-@!@:pdf_unescape_hex_}{\.{\\pdfunescapehex} primitive@>
-primitive("pdfcreationdate",convert,pdf_creation_date_code);@/
-@!@:pdf_creation_date_}{\.{\\pdfcreationdate} primitive@>
-primitive("pdffilemoddate",convert,pdf_file_mod_date_code);@/
-@!@:pdf_file_mod_date_}{\.{\\pdffilemoddate} primitive@>
-primitive("pdffilesize",convert,pdf_file_size_code);@/
-@!@:pdf_file_size_}{\.{\\pdffilesize} primitive@>
-primitive("pdfmdfivesum",convert,pdf_mdfive_sum_code);@/
-@!@:pdf_mdfive_sum_}{\.{\\pdfmdfivesum} primitive@>
-primitive("pdffiledump",convert,pdf_file_dump_code);@/
-@!@:pdf_file_dump_}{\.{\\pdffiledump} primitive@>
-primitive("pdfmatch",convert,pdf_match_code);@/
-@!@:pdf_match_}{\.{\\pdfmatch} primitive@>
-primitive("pdflastmatch",convert,pdf_last_match_code);@/
-@!@:pdf_last_match_}{\.{\\pdflastmatch} primitive@>
-primitive("pdfstrcmp",convert,pdf_strcmp_code);@/
-@!@:pdf_strcmp_}{\.{\\pdfstrcmp} primitive@>
-primitive("pdfcolorstackinit",convert,pdf_colorstack_init_code);@/
-@!@:pdf_colorstack_init_}{\.{\\pdfcolorstackinit} primitive@>
-primitive("pdfuniformdeviate",convert,uniform_deviate_code);@/
-@!@:uniform_deviate_}{\.{\\pdfuniformdeviate} primitive@>
-primitive("pdfnormaldeviate",convert,normal_deviate_code);@/
-@!@:normal_deviate_}{\.{\\pdfnormaldeviate} primitive@>
-@#
-primitive("jobname",convert,job_name_code);@/
-@!@:job_name_}{\.{\\jobname} primitive@>
-primitive("pdfinsertht",convert,pdf_insert_ht_code);@/
-@!@:pdf_insert_ht_}{\.{\\pdfinsertht} primitive@>
-primitive("pdfximagebbox",convert,pdf_ximage_bbox_code);@/
-@!@:pdf_ximage_bbox_}{\.{\\pdfximagebbox} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-convert: case chr_code of
- number_code: print_esc("number");
- roman_numeral_code: print_esc("romannumeral");
- string_code: print_esc("string");
- meaning_code: print_esc("meaning");
- font_name_code: print_esc("fontname");
- eTeX_revision_code: print_esc("eTeXrevision");
- expanded_code: print_esc("expanded");
- pdftex_revision_code: print_esc("pdftexrevision");
- pdftex_banner_code: print_esc("pdftexbanner");
- pdf_font_name_code: print_esc("pdffontname");
- pdf_font_objnum_code: print_esc("pdffontobjnum");
- pdf_font_size_code: print_esc("pdffontsize");
- pdf_page_ref_code: print_esc("pdfpageref");
- left_margin_kern_code: print_esc("leftmarginkern");
- right_margin_kern_code: print_esc("rightmarginkern");
- pdf_xform_name_code: print_esc("pdfxformname");
- pdf_escape_string_code: print_esc("pdfescapestring");
- pdf_escape_name_code: print_esc("pdfescapename");
- pdf_escape_hex_code: print_esc("pdfescapehex");
- pdf_unescape_hex_code: print_esc("pdfunescapehex");
- pdf_creation_date_code: print_esc("pdfcreationdate");
- pdf_file_mod_date_code: print_esc("pdffilemoddate");
- pdf_file_size_code: print_esc("pdffilesize");
- pdf_mdfive_sum_code: print_esc("pdfmdfivesum");
- pdf_file_dump_code: print_esc("pdffiledump");
- pdf_match_code: print_esc("pdfmatch");
- pdf_last_match_code: print_esc("pdflastmatch");
- pdf_strcmp_code: print_esc("pdfstrcmp");
- pdf_colorstack_init_code: print_esc("pdfcolorstackinit");
- uniform_deviate_code: print_esc("pdfuniformdeviate");
- normal_deviate_code: print_esc("pdfnormaldeviate");
- pdf_insert_ht_code: print_esc("pdfinsertht");
- pdf_ximage_bbox_code: print_esc("pdfximagebbox");
- othercases print_esc("jobname")
- endcases;
-
-@ The procedure |conv_toks| uses |str_toks| to insert the token list
-for |convert| functions into the scanner; `\.{\\outer}' control sequences
-are allowed to follow `\.{\\string}' and `\.{\\meaning}'.
-
-The extra temp string |u| is needed because |pdf_scan_ext_toks| incorporates
-any pending string in its output. In order to save such a pending string,
-we have to create a temporary string that is destroyed immediately after.
-
-@d save_cur_string==if str_start[str_ptr]<pool_ptr then u:=make_string
-@d restore_cur_string==if u<>0 then begin decr(str_ptr); u:=0; end
-
-@p procedure conv_toks;
-label exit;
-var old_setting:0..max_selector; {holds |selector| setting}
-p, q: pointer;
-@!c:number_code..job_name_code; {desired type of conversion}
-@!save_scanner_status:small_number; {|scanner_status| upon entry}
-@!save_def_ref: pointer; {|def_ref| upon entry, important if inside `\.{\\message}'}
-@!save_warning_index: pointer;
-@!bool: boolean; {temp boolean}
-@!i: integer; {first temp integer}
-@!j: integer; {second temp integer}
-@!b:pool_pointer; {base of temporary string}
-@!s: str_number; {first temp string}
-@!t: str_number; {second temp string}
-@!u: str_number; {saved current string string}
-begin
-c:=cur_chr;
-u:=0; { will become non-nil if a string is already being built}
-@<Scan the argument for command |c|@>;
-old_setting:=selector; selector:=new_string; b:=pool_ptr;
-@<Print the result of command |c|@>;
-selector:=old_setting; link(garbage):=str_toks(b); ins_list(link(temp_head));
-exit:end;
-
-@ @<Scan the argument for command |c|@>=
-case c of
-number_code,roman_numeral_code: scan_int;
-string_code, meaning_code: begin save_scanner_status:=scanner_status;
- scanner_status:=normal; get_token; scanner_status:=save_scanner_status;
- end;
-font_name_code: scan_font_ident;
-eTeX_revision_code: do_nothing;
-expanded_code:
- begin
- save_scanner_status := scanner_status;
- save_warning_index := warning_index;
- save_def_ref := def_ref;
- save_cur_string;
- scan_pdf_ext_toks;
- warning_index := save_warning_index;
- scanner_status := save_scanner_status;
- ins_list(link(def_ref));
- free_avail(def_ref);
- def_ref := save_def_ref;
- restore_cur_string;
- return;
- end;
-pdftex_revision_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_register_num;
- fetch_box(p);
- if (p = null) or (type(p) <> 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_escape_string_code:
- begin
- 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;
- b := pool_ptr;
- escapestring(str_start[s]);
- link(garbage) := str_toks(b);
- flush_str(s);
- ins_list(link(temp_head));
- restore_cur_string;
- return;
- end;
-pdf_escape_name_code:
- begin
- 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;
- b := pool_ptr;
- escapename(str_start[s]);
- link(garbage) := str_toks(b);
- flush_str(s);
- ins_list(link(temp_head));
- restore_cur_string;
- return;
- end;
-pdf_escape_hex_code:
- begin
- 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;
- b := pool_ptr;
- escapehex(str_start[s]);
- link(garbage) := str_toks(b);
- flush_str(s);
- ins_list(link(temp_head));
- restore_cur_string;
- return;
- end;
-pdf_unescape_hex_code:
- begin
- 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;
- b := pool_ptr;
- unescapehex(str_start[s]);
- link(garbage) := str_toks(b);
- flush_str(s);
- ins_list(link(temp_head));
- restore_cur_string;
- return;
- end;
-pdf_creation_date_code:
- begin
- b := pool_ptr;
- getcreationdate;
- link(garbage) := str_toks(b);
- ins_list(link(temp_head));
- return;
- end;
-pdf_file_mod_date_code:
- begin
- save_scanner_status := scanner_status;
- save_warning_index := warning_index;
- save_def_ref := def_ref;
- save_cur_string;
- scan_pdf_ext_toks;
- 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;
- b := pool_ptr;
- getfilemoddate(s);
- link(garbage) := str_toks(b);
- flush_str(s);
- ins_list(link(temp_head));
- restore_cur_string;
- return;
- end;
-pdf_file_size_code:
- begin
- save_scanner_status := scanner_status;
- save_warning_index := warning_index;
- save_def_ref := def_ref;
- save_cur_string;
- scan_pdf_ext_toks;
- 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;
- b := pool_ptr;
- getfilesize(s);
- link(garbage) := str_toks(b);
- flush_str(s);
- ins_list(link(temp_head));
- restore_cur_string;
- return;
- end;
-pdf_mdfive_sum_code:
- begin
- save_scanner_status := scanner_status;
- save_warning_index := warning_index;
- save_def_ref := def_ref;
- save_cur_string;
- bool := scan_keyword("file");
- 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;
- b := pool_ptr;
- getmd5sum(s, bool);
- link(garbage) := str_toks(b);
- flush_str(s);
- ins_list(link(temp_head));
- restore_cur_string;
- return;
- end;
-pdf_file_dump_code:
- begin
- save_scanner_status := scanner_status;
- save_warning_index := warning_index;
- save_def_ref := def_ref;
- save_cur_string;
- {scan offset}
- cur_val := 0;
- if (scan_keyword("offset")) then begin
- scan_int;
- if (cur_val < 0) then begin
- print_err("Bad file offset");
-@.Bad file offset@>
- help2("A file offset must be between 0 and 2^{31}-1,")@/
- ("I changed this one to zero.");
- int_error(cur_val);
- cur_val := 0;
- end;
- end;
- i := cur_val;
- {scan length}
- cur_val := 0;
- if (scan_keyword("length")) then begin
- scan_int;
- if (cur_val < 0) then begin
- print_err("Bad dump length");
-@.Bad dump length@>
- help2("A dump length must be between 0 and 2^{31}-1,")@/
- ("I changed this one to zero.");
- int_error(cur_val);
- cur_val := 0;
- end;
- end;
- j := cur_val;
- {scan file name}
- scan_pdf_ext_toks;
- 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;
- b := pool_ptr;
- getfiledump(s, i, j);
- link(garbage) := str_toks(b);
- flush_str(s);
- ins_list(link(temp_head));
- restore_cur_string;
- return;
- end;
-pdf_match_code:
- begin
- save_scanner_status := scanner_status;
- save_warning_index := warning_index;
- save_def_ref := def_ref;
- save_cur_string;
- {scan for icase}
- bool := scan_keyword("icase");
- {scan for subcount}
- i := -1; {default for subcount}
- if scan_keyword("subcount") then begin
- scan_int;
- i := cur_val;
- end;
- scan_pdf_ext_toks;
- s := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- scan_pdf_ext_toks;
- t := 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;
- b := pool_ptr;
- matchstrings(s, t, i, bool);
- link(garbage) := str_toks(b);
- flush_str(t);
- flush_str(s);
- ins_list(link(temp_head));
- restore_cur_string;
- return;
- end;
-pdf_last_match_code:
- begin
- scan_int;
- if cur_val < 0 then begin
- print_err("Bad match number");
-@.Bad match number@>
- help2("Since I expected zero or a positive number,")@/
- ("I changed this one to zero.");
- int_error(cur_val);
- cur_val := 0;
- end;
- b := pool_ptr;
- getmatch(cur_val);
- link(garbage) := str_toks(b);
- ins_list(link(temp_head));
- return;
- end;
-pdf_strcmp_code:
- begin
- save_scanner_status := scanner_status;
- save_warning_index := warning_index;
- save_def_ref := def_ref;
- save_cur_string;
- compare_strings;
- def_ref := save_def_ref;
- warning_index := save_warning_index;
- scanner_status := save_scanner_status;
- restore_cur_string;
- end;
-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;
-job_name_code: if job_name=0 then open_log_file;
-uniform_deviate_code: scan_int;
-normal_deviate_code: do_nothing;
-pdf_insert_ht_code: scan_register_num;
-pdf_ximage_bbox_code: begin
- scan_int;
- pdf_check_obj(obj_type_ximage, cur_val);
- i := obj_ximage_data(cur_val);
- scan_int;
- j := cur_val;
- if (j < 1) or (j > 4) then
- pdf_error("pdfximagebbox", "invalid parameter");
-end;
-end {there are no other cases}
-
-@ @<Print the result of command |c|@>=
-case c of
-number_code: print_int(cur_val);
-roman_numeral_code: print_roman_int(cur_val);
-string_code:if cur_cs<>0 then sprint_cs(cur_cs)
- else print_char(cur_chr);
-meaning_code: print_meaning;
-font_name_code: begin print(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;
-eTeX_revision_code: print(eTeX_revision);
-pdftex_revision_code: print(pdftex_revision);
-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(p);
- while (p <> null) and
- (cp_skipable(p) or
- ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = left_skip_code + 1)))
- do
- p := link(p);
- if (p <> null) and (not is_char_node(p)) and
- (type(p) = margin_kern_node) and (subtype(p) = left_side) then
- print_scaled(width(p))
- else
- print("0");
- print("pt");
-end;
-right_margin_kern_code: begin
- q := list_ptr(p);
- p := prev_rightmost(q, null);
- while (p <> null) and
- (cp_skipable(p) or
- ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = right_skip_code + 1)))
- do
- p := prev_rightmost(q, p);
- if (p <> null) and (not is_char_node(p)) and
- (type(p) = margin_kern_node) and (subtype(p) = right_side) then
- print_scaled(width(p))
- else
- print("0");
- print("pt");
-end;
-pdf_xform_name_code: print_int(obj_info(cur_val));
-pdf_strcmp_code: print_int(cur_val);
-pdf_colorstack_init_code: print_int(cur_val);
-uniform_deviate_code: print_int(unif_rand(cur_val));
-normal_deviate_code: print_int(norm_rand);
-pdf_insert_ht_code: begin
- i := qi(cur_val);
- p := page_ins_head;
- while i >= subtype(link(p)) do
- p := link(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) + image_width(i));
- 4: print_scaled(epdf_orig_y(i) + image_height(i));
- endcases;
- end else
- print_scaled(0);
- print("pt");
-end;
-job_name_code: print(job_name);
-end {there are no other cases}
-
-@ Now we can't postpone the difficulties any longer; we must bravely tackle
-|scan_toks|. This function returns a pointer to the tail of a new token
-list, and it also makes |def_ref| point to the reference count at the
-head of that list.
-
-There are two boolean parameters, |macro_def| and |xpand|. If |macro_def|
-is true, the goal is to create the token list for a macro definition;
-otherwise the goal is to create the token list for some other \TeX\
-primitive: \.{\\mark}, \.{\\output}, \.{\\everypar}, \.{\\lowercase},
-\.{\\uppercase}, \.{\\message}, \.{\\errmessage}, \.{\\write}, or
-\.{\\special}. In the latter cases a left brace must be scanned next; this
-left brace will not be part of the token list, nor will the matching right
-brace that comes at the end. If |xpand| is false, the token list will
-simply be copied from the input using |get_token|. Otherwise all expandable
-tokens will be expanded until unexpandable tokens are left, except that
-the results of expanding `\.{\\the}' are not expanded further.
-If both |macro_def| and |xpand| are true, the expansion applies
-only to the macro body (i.e., to the material following the first
-|left_brace| character).
-
-The value of |cur_cs| when |scan_toks| begins should be the |eqtb|
-address of the control sequence to display in ``runaway'' error
-messages.
-
-@p function scan_toks(@!macro_def,@!xpand:boolean):pointer;
-label found,continue,done,done1,done2;
-var t:halfword; {token representing the highest parameter number}
-@!s:halfword; {saved token}
-@!p:pointer; {tail of the token list being built}
-@!q:pointer; {new node being added to the token list via |store_new_token|}
-@!unbalance:halfword; {number of unmatched left braces}
-@!hash_brace:halfword; {possible `\.{\#\{}' token}
-begin if macro_def then scanner_status:=defining
-@+else scanner_status:=absorbing;
-warning_index:=cur_cs; def_ref:=get_avail; token_ref_count(def_ref):=null;
-p:=def_ref; hash_brace:=0; t:=zero_token;
-if macro_def then @<Scan and build the parameter part of the macro definition@>
-else scan_left_brace; {remove the compulsory left brace}
-@<Scan and build the body of the token list; |goto found| when finished@>;
-found: scanner_status:=normal;
-if hash_brace<>0 then store_new_token(hash_brace);
-scan_toks:=p;
-end;
-
-@ @<Scan and build the parameter part...@>=
-begin loop begin continue: get_token; {set |cur_cmd|, |cur_chr|, |cur_tok|}
- if cur_tok<right_brace_limit then goto done1;
- if cur_cmd=mac_param then
- @<If the next character is a parameter number, make |cur_tok|
- a |match| token; but if it is a left brace, store
- `|left_brace|, |end_match|', set |hash_brace|, and |goto done|@>;
- store_new_token(cur_tok);
- end;
-done1: store_new_token(end_match_token);
-if cur_cmd=right_brace then
- @<Express shock at the missing left brace; |goto found|@>;
-done: end
-
-@ @<Express shock...@>=
-begin print_err("Missing { inserted"); incr(align_state);
-@.Missing \{ inserted@>
-help2("Where was the left brace? You said something like `\def\a}',")@/
- ("which I'm going to interpret as `\def\a{}'."); error; goto found;
-end
-
-@ @<If the next character is a parameter number...@>=
-begin s:=match_token+cur_chr; get_token;
-if cur_tok<left_brace_limit then
- begin hash_brace:=cur_tok;
- store_new_token(cur_tok); store_new_token(end_match_token);
- goto done;
- end;
-if t=zero_token+9 then
- begin print_err("You already have nine parameters");
-@.You already have nine...@>
- help2("I'm going to ignore the # sign you just used,")@/
- ("as well as the token that followed it."); error; goto continue;
- end
-else begin incr(t);
- if cur_tok<>t then
- begin print_err("Parameters must be numbered consecutively");
-@.Parameters...consecutively@>
- help2("I've inserted the digit you should have used after the #.")@/
- ("Type `1' to delete what you did use."); back_error;
- end;
- cur_tok:=s;
- end;
-end
-
-@ @<Scan and build the body of the token list; |goto found| when finished@>=
-unbalance:=1;
-loop@+ begin if xpand then @<Expand the next part of the input@>
- else get_token;
- if cur_tok<right_brace_limit then
- if cur_cmd<right_brace then incr(unbalance)
- else begin decr(unbalance);
- if unbalance=0 then goto found;
- end
- else if cur_cmd=mac_param then
- if macro_def then @<Look for parameter number or \.{\#\#}@>;
- store_new_token(cur_tok);
- end
-
-@ Here we insert an entire token list created by |the_toks| without
-expanding it further.
-
-@<Expand the next part of the input@>=
-begin loop begin get_next;
- if cur_cmd>=call then
- if info(link(cur_chr))=protected_token then
- begin cur_cmd:=relax; cur_chr:=no_expand_flag;
- end;
- if cur_cmd<=max_command then goto done2;
- if cur_cmd<>the then expand
- else begin q:=the_toks;
- if link(temp_head)<>null then
- begin link(p):=link(temp_head); p:=q;
- end;
- end;
- end;
-done2: x_token
-end
-
-@ @<Look for parameter number...@>=
-begin s:=cur_tok;
-if xpand then get_x_token else get_token;
-if cur_cmd<>mac_param then
- if (cur_tok<=zero_token)or(cur_tok>t) then
- begin print_err("Illegal parameter number in definition of ");
-@.Illegal parameter number...@>
- sprint_cs(warning_index);
- help3("You meant to type ## instead of #, right?")@/
- ("Or maybe a } was forgotten somewhere earlier, and things")@/
- ("are all screwed up? I'm going to assume that you meant ##.");
- back_error; cur_tok:=s;
- end
- else cur_tok:=out_param_token-"0"+cur_chr;
-end
-
-@ Another way to create a token list is via the \.{\\read} command. The
-sixteen files potentially usable for reading appear in the following
-global variables. The value of |read_open[n]| will be |closed| if
-stream number |n| has not been opened or if it has been fully read;
-|just_open| if an \.{\\openin} but not a \.{\\read} has been done;
-and |normal| if it is open and ready to read the next line.
-
-@d closed=2 {not open, or at end of file}
-@d just_open=1 {newly opened, first line not yet read}
-
-@<Glob...@>=
-@!read_file:array[0..15] of 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 read_open[k]:=closed;
-
-@ The |read_toks| procedure constructs a token list like that for any
-macro definition, and makes |cur_val| point to it. Parameter |r| points
-to the control sequence that will receive this token list.
-
-@p procedure read_toks(@!n:integer;@!r:pointer;@!j:halfword);
-label done;
-var p:pointer; {tail of the token list}
-@!q:pointer; {new node being added to the token list via |store_new_token|}
-@!s:integer; {saved value of |align_state|}
-@!m:small_number; {stream number}
-begin scanner_status:=defining; warning_index:=r;
-def_ref:=get_avail; token_ref_count(def_ref):=null;
-p:=def_ref; {the reference count}
-store_new_token(end_match_token);
-if (n<0)or(n>15) then m:=16@+else m:=n;
-s:=align_state; align_state:=1000000; {disable tab marks, etc.}
-repeat @<Input and store tokens from the next line of the file@>;
-until align_state=1000000;
-cur_val:=def_ref; scanner_status:=normal; align_state:=s;
-end;
-
-@ @<Input and store tokens from the next line of the file@>=
-begin_file_reading; name:=m+1;
-if read_open[m]=closed then @<Input for \.{\\read} from the terminal@>
-else if read_open[m]=just_open then @<Input the first line of |read_file[m]|@>
-else @<Input the next line of |read_file[m]|@>;
-limit:=last;
-if end_line_char_inactive then decr(limit)
-else buffer[limit]:=end_line_char;
-first:=limit+1; loc:=start; state:=new_line;@/
-@<Handle \.{\\readline} and |goto done|@>;@/
-loop@+ begin get_token;
- if cur_tok=0 then goto done;
- {|cur_cmd=cur_chr=0| will occur at the end of the line}
- if align_state<1000000 then {unmatched `\.\}' aborts the line}
- begin repeat get_token; until cur_tok=0;
- align_state:=1000000; goto done;
- end;
- store_new_token(cur_tok);
- end;
-done: end_file_reading
-
-@ Here we input on-line into the |buffer| array, prompting the user explicitly
-if |n>=0|. The value of |n| is set negative so that additional prompts
-will not be given in the case of multi-line input.
-
-@<Input for \.{\\read} from the terminal@>=
-if interaction>nonstop_mode then
- if n<0 then prompt_input("")
- else begin wake_up_terminal;
- print_ln; sprint_cs(r); prompt_input("="); n:=-1;
- end
-else fatal_error("*** (cannot \read from terminal in nonstop modes)")
-@.cannot \\read@>
-
-@ The first line of a file must be treated specially, since |input_ln|
-must be told not to start with |get|.
-@^system dependencies@>
-
-@<Input the first line of |read_file[m]|@>=
-if input_ln(read_file[m],false) then read_open[m]:=normal
-else begin a_close(read_file[m]); read_open[m]:=closed;
- end
-
-@ An empty line is appended at the end of a |read_file|.
-@^empty line at end of file@>
-
-@<Input the next line of |read_file[m]|@>=
-begin if not input_ln(read_file[m],true) then
- begin a_close(read_file[m]); read_open[m]:=closed;
- if align_state<>1000000 then
- begin runaway;
- print_err("File ended within "); print_esc("read");
-@.File ended within \\read@>
- help1("This \read has unbalanced braces.");
- align_state:=1000000; limit:=0; error;
- end;
- end;
-end
-
-@* \[28] Conditional processing.
-We consider now the way \TeX\ handles various kinds of \.{\\if} commands.
-
-@d unless_code=32 {amount added for `\.{\\unless}' prefix}
-@#
-@d if_char_code=0 { `\.{\\if}' }
-@d if_cat_code=1 { `\.{\\ifcat}' }
-@d if_int_code=2 { `\.{\\ifnum}' }
-@d if_dim_code=3 { `\.{\\ifdim}' }
-@d if_odd_code=4 { `\.{\\ifodd}' }
-@d if_vmode_code=5 { `\.{\\ifvmode}' }
-@d if_hmode_code=6 { `\.{\\ifhmode}' }
-@d if_mmode_code=7 { `\.{\\ifmmode}' }
-@d if_inner_code=8 { `\.{\\ifinner}' }
-@d if_void_code=9 { `\.{\\ifvoid}' }
-@d if_hbox_code=10 { `\.{\\ifhbox}' }
-@d if_vbox_code=11 { `\.{\\ifvbox}' }
-@d ifx_code=12 { `\.{\\ifx}' }
-@d if_eof_code=13 { `\.{\\ifeof}' }
-@d if_true_code=14 { `\.{\\iftrue}' }
-@d if_false_code=15 { `\.{\\iffalse}' }
-@d if_case_code=16 { `\.{\\ifcase}' }
-@d if_pdfprimitive_code=21 { `\.{\\ifpdfprimitive}' }
-
-@<Put each...@>=
-primitive("if",if_test,if_char_code);
-@!@:if_char_}{\.{\\if} primitive@>
-primitive("ifcat",if_test,if_cat_code);
-@!@:if_cat_code_}{\.{\\ifcat} primitive@>
-primitive("ifnum",if_test,if_int_code);
-@!@:if_int_}{\.{\\ifnum} primitive@>
-primitive("ifdim",if_test,if_dim_code);
-@!@:if_dim_}{\.{\\ifdim} primitive@>
-primitive("ifodd",if_test,if_odd_code);
-@!@:if_odd_}{\.{\\ifodd} primitive@>
-primitive("ifvmode",if_test,if_vmode_code);
-@!@:if_vmode_}{\.{\\ifvmode} primitive@>
-primitive("ifhmode",if_test,if_hmode_code);
-@!@:if_hmode_}{\.{\\ifhmode} primitive@>
-primitive("ifmmode",if_test,if_mmode_code);
-@!@:if_mmode_}{\.{\\ifmmode} primitive@>
-primitive("ifinner",if_test,if_inner_code);
-@!@:if_inner_}{\.{\\ifinner} primitive@>
-primitive("ifvoid",if_test,if_void_code);
-@!@:if_void_}{\.{\\ifvoid} primitive@>
-primitive("ifhbox",if_test,if_hbox_code);
-@!@:if_hbox_}{\.{\\ifhbox} primitive@>
-primitive("ifvbox",if_test,if_vbox_code);
-@!@:if_vbox_}{\.{\\ifvbox} primitive@>
-primitive("ifx",if_test,ifx_code);
-@!@:ifx_}{\.{\\ifx} primitive@>
-primitive("ifeof",if_test,if_eof_code);
-@!@:if_eof_}{\.{\\ifeof} primitive@>
-primitive("iftrue",if_test,if_true_code);
-@!@:if_true_}{\.{\\iftrue} primitive@>
-primitive("iffalse",if_test,if_false_code);
-@!@:if_false_}{\.{\\iffalse} primitive@>
-primitive("ifcase",if_test,if_case_code);
-@!@:if_case_}{\.{\\ifcase} primitive@>
-primitive("ifpdfprimitive",if_test,if_pdfprimitive_code);
-@!@:if_pdfprimitive_}{\.{\\ifpdfprimitive} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-if_test: begin if chr_code>=unless_code then print_esc("unless");
-case chr_code mod unless_code of
- if_cat_code:print_esc("ifcat");
- if_int_code:print_esc("ifnum");
- if_dim_code:print_esc("ifdim");
- if_odd_code:print_esc("ifodd");
- if_vmode_code:print_esc("ifvmode");
- if_hmode_code:print_esc("ifhmode");
- if_mmode_code:print_esc("ifmmode");
- if_inner_code:print_esc("ifinner");
- if_void_code:print_esc("ifvoid");
- if_hbox_code:print_esc("ifhbox");
- if_vbox_code:print_esc("ifvbox");
- ifx_code:print_esc("ifx");
- if_eof_code:print_esc("ifeof");
- if_true_code:print_esc("iftrue");
- if_false_code:print_esc("iffalse");
- if_case_code:print_esc("ifcase");
- if_pdfprimitive_code:print_esc("ifpdfprimitive");
- @/@<Cases of |if_test| for |print_cmd_chr|@>@/
- othercases print_esc("if")
- endcases;
-end;
-
-@ Conditions can be inside conditions, and this nesting has a stack
-that is independent of the |save_stack|.
-
-Four global variables represent the top of the condition stack:
-|cond_ptr| points to pushed-down entries, if any; |if_limit| specifies
-the largest code of a |fi_or_else| command that is syntactically legal;
-|cur_if| is the name of the current type of conditional; and |if_line|
-is the line number at which it began.
-
-If no conditions are currently in progress, the condition stack has the
-special state |cond_ptr=null|, |if_limit=normal|, |cur_if=0|, |if_line=0|.
-Otherwise |cond_ptr| points to a two-word node; the |type|, |subtype|, and
-|link| fields of the first word contain |if_limit|, |cur_if|, and
-|cond_ptr| at the next level, and the second word contains the
-corresponding |if_line|.
-
-@d if_node_size=2 {number of words in stack entry for conditionals}
-@d if_line_field(#)==mem[#+1].int
-@d if_code=1 {code for \.{\\if...} being evaluated}
-@d fi_code=2 {code for \.{\\fi}}
-@d else_code=3 {code for \.{\\else}}
-@d or_code=4 {code for \.{\\or}}
-
-@<Glob...@>=
-@!cond_ptr:pointer; {top of the condition stack}
-@!if_limit:normal..or_code; {upper bound on |fi_or_else| codes}
-@!cur_if:small_number; {type of conditional being worked on}
-@!if_line:integer; {line where that conditional began}
-
-@ @<Set init...@>=
-cond_ptr:=null; if_limit:=normal; cur_if:=0; if_line:=0;
-
-@ @<Put each...@>=
-primitive("fi",fi_or_else,fi_code);
-@!@:fi_}{\.{\\fi} primitive@>
-text(frozen_fi):="fi"; eqtb[frozen_fi]:=eqtb[cur_val];
-primitive("or",fi_or_else,or_code);
-@!@:or_}{\.{\\or} primitive@>
-primitive("else",fi_or_else,else_code);
-@!@:else_}{\.{\\else} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-fi_or_else: if chr_code=fi_code then print_esc("fi")
- else if chr_code=or_code then print_esc("or")
- else print_esc("else");
-
-@ When we skip conditional text, we keep track of the line number
-where skipping began, for use in error messages.
-
-@<Glob...@>=
-@!skip_line:integer; {skipping began here}
-
-@ Here is a procedure that ignores text until coming to an \.{\\or},
-\.{\\else}, or \.{\\fi} at the current level of $\.{\\if}\ldots\.{\\fi}$
-nesting. After it has acted, |cur_chr| will indicate the token that
-was found, but |cur_tok| will not be set (because this makes the
-procedure run faster).
-
-@p procedure pass_text;
-label done;
-var l:integer; {level of $\.{\\if}\ldots\.{\\fi}$ nesting}
-@!save_scanner_status:small_number; {|scanner_status| upon entry}
-begin save_scanner_status:=scanner_status; scanner_status:=skipping; l:=0;
-skip_line:=line;
-loop@+ begin get_next;
- if cur_cmd=fi_or_else then
- begin if l=0 then goto done;
- if cur_chr=fi_code then decr(l);
- end
- else if cur_cmd=if_test then incr(l);
- end;
-done: scanner_status:=save_scanner_status;
-if tracing_ifs>0 then show_cur_cmd_chr;
-end;
-
-@ When we begin to process a new \.{\\if}, we set |if_limit:=if_code|; then
-if\/ \.{\\or} or \.{\\else} or \.{\\fi} occurs before the current \.{\\if}
-condition has been evaluated, \.{\\relax} will be inserted.
-For example, a sequence of commands like `\.{\\ifvoid1\\else...\\fi}'
-would otherwise require something after the `\.1'.
-
-@<Push the condition stack@>=
-begin p:=get_node(if_node_size); link(p):=cond_ptr; type(p):=if_limit;
-subtype(p):=cur_if; if_line_field(p):=if_line;
-cond_ptr:=p; cur_if:=cur_chr; if_limit:=if_code; if_line:=line;
-end
-
-@ @<Pop the condition stack@>=
-begin if if_stack[in_open]=cond_ptr then if_warning;
- {conditionals possibly not properly nested with files}
-p:=cond_ptr; if_line:=if_line_field(p);
-cur_if:=subtype(p); if_limit:=type(p); cond_ptr:=link(p);
-free_node(p,if_node_size);
-end
-
-@ Here's a procedure that changes the |if_limit| code corresponding to
-a given value of |cond_ptr|.
-
-@p procedure change_if_limit(@!l:small_number;@!p:pointer);
-label exit;
-var q:pointer;
-begin if p=cond_ptr then if_limit:=l {that's the easy case}
-else begin q:=cond_ptr;
- loop@+ begin if q=null then confusion("if");
-@:this can't happen if}{\quad if@>
- if link(q)=p then
- begin type(q):=l; return;
- end;
- q:=link(q);
- end;
- end;
-exit:end;
-
-@ A condition is started when the |expand| procedure encounters
-an |if_test| command; in that case |expand| reduces to |conditional|,
-which is a recursive procedure.
-@^recursion@>
-
-@p procedure conditional;
-label exit,common_ending;
-var b:boolean; {is the condition true?}
-@!e:boolean; {keep track of nested csnames}
-@!r:"<"..">"; {relation to be evaluated}
-@!m,@!n:integer; {to be tested against the second operand}
-@!p,@!q:pointer; {for traversing token lists in \.{\\ifx} tests}
-@!save_scanner_status:small_number; {|scanner_status| upon entry}
-@!save_cond_ptr:pointer; {|cond_ptr| corresponding to this conditional}
-@!this_if:small_number; {type of this conditional}
-@!is_unless:boolean; {was this if preceded by `\.{\\unless}' ?}
-begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
-@<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;
-is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/
-@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
-if is_unless then b:=not b;
-if tracing_commands>1 then @<Display the value of |b|@>;
-if b then
- begin change_if_limit(else_code,save_cond_ptr);
- return; {wait for \.{\\else} or \.{\\fi}}
- end;
-@<Skip to \.{\\else} or \.{\\fi}, then |goto common_ending|@>;
-common_ending: if cur_chr=fi_code then @<Pop the condition stack@>
-else if_limit:=fi_code; {wait for \.{\\fi}}
-exit:end;
-
-@ In a construction like `\.{\\if\\iftrue abc\\else d\\fi}', the first
-\.{\\else} that we come to after learning that the \.{\\if} is false is
-not the \.{\\else} we're looking for. Hence the following curious
-logic is needed.
-
-@ @<Skip to \.{\\else} or \.{\\fi}...@>=
-loop@+ begin pass_text;
- if cond_ptr=save_cond_ptr then
- begin if cur_chr<>or_code then goto common_ending;
- print_err("Extra "); print_esc("or");
-@.Extra \\or@>
- help1("I'm ignoring this; it doesn't match any \if.");
- error;
- end
- else if cur_chr=fi_code then @<Pop the condition stack@>;
- end
-
-@ @<Either process \.{\\ifcase} or set |b|...@>=
-case this_if of
-if_char_code, if_cat_code: @<Test if two characters match@>;
-if_int_code, if_dim_code: @<Test relation between integers or dimensions@>;
-if_odd_code: @<Test if an integer is odd@>;
-if_vmode_code: b:=(abs(mode)=vmode);
-if_hmode_code: b:=(abs(mode)=hmode);
-if_mmode_code: b:=(abs(mode)=mmode);
-if_inner_code: b:=(mode<0);
-if_void_code, if_hbox_code, if_vbox_code: @<Test box register status@>;
-ifx_code: @<Test if two tokens match@>;
-if_eof_code: begin scan_four_bit_int; b:=(read_open[cur_val]=closed);
- end;
-if_true_code: b:=true;
-if_false_code: b:=false;
-@/@<Cases for |conditional|@>@/
-if_case_code: @<Select the appropriate case
- and |return| or |goto common_ending|@>;
-if_pdfprimitive_code: begin
- save_scanner_status:=scanner_status;
- scanner_status:=normal;
- get_next;
- scanner_status:=save_scanner_status;
- if cur_cs < hash_base then
- m := prim_lookup(cur_cs-single_base)
- else
- m := prim_lookup(text(cur_cs));
- b :=((cur_cmd<>undefined_cs) and
- (m<>undefined_primitive) and
- (cur_cmd=prim_eq_type(m)) and
- (cur_chr=prim_equiv(m)));
- end;
-end {there are no other cases}
-
-@ @<Display the value of |b|@>=
-begin begin_diagnostic;
-if b then print("{true}")@+else print("{false}");
-end_diagnostic(false);
-end
-
-@ Here we use the fact that |"<"|, |"="|, and |">"| are consecutive ASCII
-codes.
-@^ASCII code@>
-
-@<Test relation between integers or dimensions@>=
-begin if this_if=if_int_code then scan_int@+else scan_normal_dimen;
-n:=cur_val; @<Get the next non-blank non-call...@>;
-if (cur_tok>=other_token+"<")and(cur_tok<=other_token+">") then
- r:=cur_tok-other_token
-else begin print_err("Missing = inserted for ");
-@.Missing = inserted@>
- print_cmd_chr(if_test,this_if);
- help1("I was expecting to see `<', `=', or `>'. Didn't.");
- back_error; r:="=";
- end;
-if this_if=if_int_code then scan_int@+else scan_normal_dimen;
-case r of
-"<": b:=(n<cur_val);
-"=": b:=(n=cur_val);
-">": b:=(n>cur_val);
-end;
-end
-
-@ @<Test if an integer is odd@>=
-begin scan_int; b:=odd(cur_val);
-end
-
-@ @<Test box register status@>=
-begin scan_register_num; fetch_box(p);
-if this_if=if_void_code then b:=(p=null)
-else if p=null then b:=false
-else if this_if=if_hbox_code then b:=(type(p)=hlist_node)
-else b:=(type(p)=vlist_node);
-end
-
-@ An active character will be treated as category 13 following
-\.{\\if\\noexpand} or following \.{\\ifcat\\noexpand}. We use the fact that
-active characters have the smallest tokens, among all control sequences.
-
-@d get_x_token_or_active_char==@t@>@;
- begin get_x_token;
- if cur_cmd=relax then if cur_chr=no_expand_flag then
- begin cur_cmd:=active_char;
- cur_chr:=cur_tok-cs_token_flag-active_base;
- end;
- end
-
-@<Test if two characters match@>=
-begin get_x_token_or_active_char;
-if (cur_cmd>active_char)or(cur_chr>255) then {not a character}
- begin m:=relax; n:=256;
- end
-else begin m:=cur_cmd; n:=cur_chr;
- end;
-get_x_token_or_active_char;
-if (cur_cmd>active_char)or(cur_chr>255) then
- begin cur_cmd:=relax; cur_chr:=256;
- end;
-if this_if=if_char_code then b:=(n=cur_chr)@+else b:=(m=cur_cmd);
-end
-
-@ Note that `\.{\\ifx}' will declare two macros different if one is \\{long}
-or \\{outer} and the other isn't, even though the texts of the macros are
-the same.
-
-We need to reset |scanner_status|, since \.{\\outer} control sequences
-are allowed, but we might be scanning a macro definition or preamble.
-
-@<Test if two tokens match@>=
-begin save_scanner_status:=scanner_status; scanner_status:=normal;
-get_next; n:=cur_cs; p:=cur_cmd; q:=cur_chr;
-get_next; if cur_cmd<>p then b:=false
-else if cur_cmd<call then b:=(cur_chr=q)
-else @<Test if two macro texts match@>;
-scanner_status:=save_scanner_status;
-end
-
-@ Note also that `\.{\\ifx}' decides that macros \.{\\a} and \.{\\b} are
-different in examples like this:
-$$\vbox{\halign{\.{#}\hfil&\qquad\.{#}\hfil\cr
- {}\\def\\a\{\\c\}&
- {}\\def\\c\{\}\cr
- {}\\def\\b\{\\d\}&
- {}\\def\\d\{\}\cr}}$$
-
-@<Test if two macro texts match@>=
-begin p:=link(cur_chr); q:=link(equiv(n)); {omit reference counts}
-if p=q then b:=true
-else begin while (p<>null)and(q<>null) do
- if info(p)<>info(q) then p:=null
- else begin p:=link(p); q:=link(q);
- end;
- b:=((p=null)and(q=null));
- end;
-end
-
-@ @<Select the appropriate case and |return| or |goto common_ending|@>=
-begin scan_int; n:=cur_val; {|n| is the number of cases to pass}
-if tracing_commands>1 then
- begin begin_diagnostic; print("{case "); print_int(n); print_char("}");
- end_diagnostic(false);
- end;
-while n<>0 do
- begin pass_text;
- if cond_ptr=save_cond_ptr then
- if cur_chr=or_code then decr(n)
- else goto common_ending
- else if cur_chr=fi_code then @<Pop the condition stack@>;
- end;
-change_if_limit(or_code,save_cond_ptr);
-return; {wait for \.{\\or}, \.{\\else}, or \.{\\fi}}
-end
-
-@ The processing of conditionals is complete except for the following
-code, which is actually part of |expand|. It comes into play when
-\.{\\or}, \.{\\else}, or \.{\\fi} is scanned.
-
-@<Terminate the current conditional and skip to \.{\\fi}@>=
-begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
-if cur_chr>if_limit then
- if if_limit=if_code then insert_relax {condition not yet evaluated}
- else begin print_err("Extra "); print_cmd_chr(fi_or_else,cur_chr);
-@.Extra \\or@>
-@.Extra \\else@>
-@.Extra \\fi@>
- help1("I'm ignoring this; it doesn't match any \if.");
- error;
- end
-else begin while cur_chr<>fi_code do pass_text; {skip to \.{\\fi}}
- @<Pop the condition stack@>;
- end;
-end
-
-@* \[29] File names.
-It's time now to fret about file names. Besides the fact that different
-operating systems treat files in different ways, we must cope with the
-fact that completely different naming conventions are used by different
-groups of people. The following programs show what is required for one
-particular operating system; similar routines for other systems are not
-difficult to devise.
-@^fingers@>
-@^system dependencies@>
-
-\TeX\ assumes that a file name has three parts: the name proper; its
-``extension''; and a ``file area'' where it is found in an external file
-system. The extension of an input file or a write file is assumed to be
-`\.{.tex}' unless otherwise specified; it is `\.{.log}' on the
-transcript file that records each run of \TeX; it is `\.{.tfm}' on the font
-metric files that describe characters in the fonts \TeX\ uses; it is
-`\.{.dvi}' on the output files that specify typesetting information; and it
-is `\.{.fmt}' on the format files written by \.{INITEX} to initialize \TeX.
-The file area can be arbitrary on input files, but files are usually
-output to the user's current area. If an input file cannot be
-found on the specified area, \TeX\ will look for it on a special system
-area; this special area is intended for commonly used input files like
-\.{webmac.tex}.
-
-Simple uses of \TeX\ refer only to file names that have no explicit
-extension or area. For example, a person usually says `\.{\\input} \.{paper}'
-or `\.{\\font\\tenrm} \.= \.{helvetica}' instead of `\.{\\input}
-\.{paper.new}' or `\.{\\font\\tenrm} \.= \.{<csd.knuth>test}'. Simple file
-names are best, because they make the \TeX\ source files portable;
-whenever a file name consists entirely of letters and digits, it should be
-treated in the same way by all implementations of \TeX. However, users
-need the ability to refer to other files in their environment, especially
-when responding to error messages concerning unopenable files; therefore
-we want to let them use the syntax that appears in their favorite
-operating system.
-
-The following procedures don't allow spaces to be part of
-file names; but some users seem to like names that are spaced-out.
-System-dependent changes to allow such things should probably
-be made with reluctance, and only when an entire file name that
-includes spaces is ``quoted'' somehow.
-
-@ In order to isolate the system-dependent aspects of file names, the
-@^system dependencies@>
-system-independent parts of \TeX\ are expressed in terms
-of three system-dependent
-procedures called |begin_name|, |more_name|, and |end_name|. In
-essence, if the user-specified characters of the file name are $c_1\ldots c_n$,
-the system-independent driver program does the operations
-$$|begin_name|;\,|more_name|(c_1);\,\ldots\,;\,|more_name|(c_n);
-\,|end_name|.$$
-These three procedures communicate with each other via global variables.
-Afterwards the file name will appear in the string pool as three strings
-called |cur_name|\penalty10000\hskip-.05em,
-|cur_area|, and |cur_ext|; the latter two are null (i.e.,
-|""|), unless they were explicitly specified by the user.
-
-Actually the situation is slightly more complicated, because \TeX\ needs
-to know when the file name ends. The |more_name| routine is a function
-(with side effects) that returns |true| on the calls |more_name|$(c_1)$,
-\dots, |more_name|$(c_{n-1})$. The final call |more_name|$(c_n)$
-returns |false|; or, it returns |true| and the token following $c_n$ is
-something like `\.{\\hbox}' (i.e., not a character). In other words,
-|more_name| is supposed to return |true| unless it is sure that the
-file name has been completely scanned; and |end_name| is supposed to be able
-to finish the assembly of |cur_name|, |cur_area|, and |cur_ext| regardless of
-whether $|more_name|(c_n)$ returned |true| or |false|.
-
-@<Glob...@>=
-@!cur_name:str_number; {name of file just scanned}
-@!cur_area:str_number; {file area just scanned, or \.{""}}
-@!cur_ext:str_number; {file extension just scanned, or \.{""}}
-
-@ The file names we shall deal with for illustrative purposes have the
-following structure: If the name contains `\.>' or `\.:', the file area
-consists of all characters up to and including the final such character;
-otherwise the file area is null. If the remaining file name contains
-`\..', the file extension consists of all such characters from the first
-remaining `\..' to the end, otherwise the file extension is null.
-@^system dependencies@>
-
-We can scan such file names easily by using two global variables that keep track
-of the occurrences of area and extension delimiters:
-
-@<Glob...@>=
-@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
-@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
-
-@ Input files that can't be found in the user's area may appear in a standard
-system area called |TEX_area|. Font metric files whose areas are not given
-explicitly are assumed to appear in a standard system area called
-|TEX_font_area|. These system area names will, of course, vary from place
-to place.
-@^system dependencies@>
-
-@d TEX_area=="TeXinputs:"
-@.TeXinputs@>
-@d TEX_font_area=="TeXfonts:"
-@.TeXfonts@>
-
-@ Here now is the first of the system-dependent routines for file name scanning.
-@^system dependencies@>
-
-@p procedure begin_name;
-begin area_delimiter:=0; ext_delimiter:=0;
-end;
-
-@ And here's the second. The string pool might change as the file name is
-being scanned, since a new \.{\\csname} might be entered; therefore we keep
-|area_delimiter| and |ext_delimiter| relative to the beginning of the current
-string, instead of assigning an absolute address like |pool_ptr| to them.
-@^system dependencies@>
-
-@p function more_name(@!c:ASCII_code):boolean;
-begin if c=" " then more_name:=false
-else begin str_room(1); append_char(c); {contribute |c| to the current string}
- if (c=">")or(c=":") then
- begin area_delimiter:=cur_length; ext_delimiter:=0;
- end
- else if (c=".")and(ext_delimiter=0) then ext_delimiter:=cur_length;
- more_name:=true;
- end;
-end;
-
-@ The third.
-@^system dependencies@>
-
-@p procedure end_name;
-begin if str_ptr+3>max_strings then
- overflow("number of strings",max_strings-init_str_ptr);
-@:TeX capacity exceeded number of strings}{\quad number of strings@>
-if area_delimiter=0 then cur_area:=""
-else begin cur_area:=str_ptr;
- str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr);
- end;
-if ext_delimiter=0 then
- begin cur_ext:=""; cur_name:=make_string;
- end
-else begin cur_name:=str_ptr;
- str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1;
- incr(str_ptr); cur_ext:=make_string;
- end;
-end;
-
-@ Conversely, here is a routine that takes three strings and prints a file
-name that might have produced them. (The routine is system dependent, because
-some operating systems put the file area last instead of first.)
-@^system dependencies@>
-
-@<Basic printing...@>=
-procedure print_file_name(@!n,@!a,@!e:integer);
-begin slow_print(a); slow_print(n); slow_print(e);
-end;
-
-@ Another system-dependent routine is needed to convert three internal
-\TeX\ strings
-into the |name_of_file| value that is used to open files. The present code
-allows both lowercase and uppercase letters in the file name.
-@^system dependencies@>
-
-@d append_to_name(#)==begin c:=#; incr(k);
- if k<=file_name_size then name_of_file[k]:=xchr[c];
- end
-
-@p procedure pack_file_name(@!n,@!a,@!e:str_number);
-var k:integer; {number of positions filled in |name_of_file|}
-@!c: ASCII_code; {character being packed}
-@!j:pool_pointer; {index into |str_pool|}
-begin k:=0;
-for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j]));
-for j:=str_start[n] to str_start[n+1]-1 do append_to_name(so(str_pool[j]));
-for j:=str_start[e] to str_start[e+1]-1 do append_to_name(so(str_pool[j]));
-if k<=file_name_size then name_length:=k@+else name_length:=file_name_size;
-for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
-end;
-
-@ A messier routine is also needed, since format file names must be scanned
-before \TeX's string mechanism has been initialized. We shall use the
-global variable |TEX_format_default| to supply the text for default system areas
-and extensions related to format files.
-@^system dependencies@>
-
-@d format_default_length=20 {length of the |TEX_format_default| string}
-@d format_area_length=11 {length of its area part}
-@d format_ext_length=4 {length of its `\.{.fmt}' part}
-@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
-
-@<Glob...@>=
-@!TEX_format_default:packed array[1..format_default_length] of char;
-
-@ @<Set init...@>=
-TEX_format_default:='TeXformats:plain.fmt';
-@.TeXformats@>
-@.plain@>
-@^system dependencies@>
-
-@ @<Check the ``constant'' values for consistency@>=
-if format_default_length>file_name_size then bad:=31;
-
-@ Here is the messy routine that was just mentioned. It sets |name_of_file|
-from the first |n| characters of |TEX_format_default|, followed by
-|buffer[a..b]|, followed by the last |format_ext_length| characters of
-|TEX_format_default|.
-
-We dare not give error messages here, since \TeX\ calls this routine before
-the |error| routine is ready to roll. Instead, we simply drop excess characters,
-since the error will be detected in another way when a strange file name
-isn't found.
-@^system dependencies@>
-
-@p procedure pack_buffered_name(@!n:small_number;@!a,@!b:integer);
-var k:integer; {number of positions filled in |name_of_file|}
-@!c: ASCII_code; {character being packed}
-@!j:integer; {index into |buffer| or |TEX_format_default|}
-begin if n+b-a+1+format_ext_length>file_name_size then
- b:=a+file_name_size-n-1-format_ext_length;
-k:=0;
-for j:=1 to n do append_to_name(xord[TEX_format_default[j]]);
-for j:=a to b do append_to_name(buffer[j]);
-for j:=format_default_length-format_ext_length+1 to format_default_length do
- append_to_name(xord[TEX_format_default[j]]);
-if k<=file_name_size then name_length:=k@+else name_length:=file_name_size;
-for k:=name_length+1 to file_name_size do name_of_file[k]:=' ';
-end;
-
-@ Here is the only place we use |pack_buffered_name|. This part of the program
-becomes active when a ``virgin'' \TeX\ is trying to get going, just after
-the preliminary initialization, or when the user is substituting another
-format file by typing `\.\&' after the initial `\.{**}' prompt. The buffer
-contains the first line of input in |buffer[loc..(last-1)]|, where
-|loc<last| and |buffer[loc]<>" "|.
-
-@<Declare the function called |open_fmt_file|@>=
-function open_fmt_file:boolean;
-label found,exit;
-var j:0..buf_size; {the first space after the format file name}
-begin j:=loc;
-if buffer[loc]="&" then
- begin incr(loc); j:=loc; buffer[last]:=" ";
- while buffer[j]<>" " do incr(j);
- pack_buffered_name(0,loc,j-1); {try first without the system file area}
- if w_open_in(fmt_file) then goto found;
- pack_buffered_name(format_area_length,loc,j-1);
- {now try the system format file area}
- if w_open_in(fmt_file) then goto found;
- wake_up_terminal;
- wterm_ln('Sorry, I can''t find that format;',' will try PLAIN.');
-@.Sorry, I can't find...@>
- update_terminal;
- end;
- {now pull out all the stops: try for the system \.{plain} file}
-pack_buffered_name(format_default_length-format_ext_length,1,0);
-if not w_open_in(fmt_file) then
- begin wake_up_terminal;
- wterm_ln('I can''t find the PLAIN format file!');
-@.I can't find PLAIN...@>
-@.plain@>
- open_fmt_file:=false; return;
- end;
-found:loc:=j; open_fmt_file:=true;
-exit:end;
-
-@ Operating systems often make it possible to determine the exact name (and
-possible version number) of a file that has been opened. The following routine,
-which simply makes a \TeX\ string from the value of |name_of_file|, should
-ideally be changed to deduce the full name of file~|f|, which is the file
-most recently opened, if it is possible to do this in a \PASCAL\ program.
-@^system dependencies@>
-
-This routine might be called after string memory has overflowed, hence
-we dare not use `|str_room|'.
-
-@p function make_name_string:str_number;
-var k:1..file_name_size; {index into |name_of_file|}
-begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or
- (cur_length>0) then
- make_name_string:="?"
-else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
- make_name_string:=make_string;
- end;
-end;
-function a_make_name_string(var f:alpha_file):str_number;
-begin a_make_name_string:=make_name_string;
-end;
-function b_make_name_string(var f:byte_file):str_number;
-begin b_make_name_string:=make_name_string;
-end;
-function w_make_name_string(var f:word_file):str_number;
-begin w_make_name_string:=make_name_string;
-end;
-
-@ Now let's consider the ``driver''
-routines by which \TeX\ deals with file names
-in a system-independent manner. First comes a procedure that looks for a
-file name in the input by calling |get_x_token| for the information.
-
-@p procedure scan_file_name;
-label done;
-begin name_in_progress:=true; begin_name;
-@<Get the next non-blank non-call...@>;
-loop@+begin if (cur_cmd>other_char)or(cur_chr>255) then {not a character}
- begin back_input; goto done;
- end;
- if not more_name(cur_chr) then goto done;
- get_x_token;
- end;
-done: end_name; name_in_progress:=false;
-end;
-
-@ The global variable |name_in_progress| is used to prevent recursive
-use of |scan_file_name|, since the |begin_name| and other procedures
-communicate via global variables. Recursion would arise only by
-devious tricks like `\.{\\input\\input f}'; such attempts at sabotage
-must be thwarted. Furthermore, |name_in_progress| prevents \.{\\input}
-@^recursion@>
-from being initiated when a font size specification is being scanned.
-
-Another global variable, |job_name|, contains the file name that was first
-\.{\\input} by the user. This name is extended by `\.{.log}' and `\.{.dvi}'
-and `\.{.fmt}' in the names of \TeX's output files.
-
-@<Glob...@>=
-@!name_in_progress:boolean; {is a file name being scanned?}
-@!job_name:str_number; {principal file name}
-@!log_opened:boolean; {has the transcript file been opened?}
-
-@ Initially |job_name=0|; it becomes nonzero as soon as the true name is known.
-We have |job_name=0| if and only if the `\.{log}' file has not been opened,
-except of course for a short time just after |job_name| has become nonzero.
-
-@<Initialize the output...@>=
-job_name:=0; name_in_progress:=false; log_opened:=false;
-
-@ Here is a routine that manufactures the output file names, assuming that
-|job_name<>0|. It ignores and changes the current settings of |cur_area|
-and |cur_ext|.
-
-@d pack_cur_name==pack_file_name(cur_name,cur_area,cur_ext)
-
-@p procedure pack_job_name(@!s:str_number); {|s = ".log"|, |".dvi"|, or
- |format_extension|}
-begin cur_area:=""; cur_ext:=s;
-cur_name:=job_name; pack_cur_name;
-end;
-
-@ If some trouble arises when \TeX\ tries to open a file, the following
-routine calls upon the user to supply another file name. Parameter~|s|
-is used in the error message to identify the type of file; parameter~|e|
-is the default extension if none is given. Upon exit from the routine,
-variables |cur_name|, |cur_area|, |cur_ext|, and |name_of_file| are
-ready for another attempt at file opening.
-
-@p procedure prompt_file_name(@!s,@!e:str_number);
-label done;
-var k:0..buf_size; {index into |buffer|}
-begin if interaction=scroll_mode then wake_up_terminal;
-if s="input file name" then print_err("I can't find file `")
-@.I can't find file x@>
-else print_err("I can't write on file `");
-@.I can't write on file x@>
-print_file_name(cur_name,cur_area,cur_ext); print("'.");
-if e=".tex" then show_context;
-print_nl("Please type another "); print(s);
-@.Please type...@>
-if interaction<scroll_mode then
- fatal_error("*** (job aborted, file error in nonstop mode)");
-@.job aborted, file error...@>
-clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
-if cur_ext="" then cur_ext:=e;
-pack_cur_name;
-end;
-
-@ @<Scan file name in the buffer@>=
-begin begin_name; k:=first;
-while (buffer[k]=" ")and(k<last) do incr(k);
-loop@+ begin if k=last then goto done;
- if not more_name(buffer[k]) then goto done;
- incr(k);
- end;
-done:end_name;
-end
-
-@ Here's an example of how these conventions are used. Whenever it is time to
-ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
-
-@d ensure_dvi_open==if output_file_name=0 then
- begin if job_name=0 then open_log_file;
- pack_job_name(".dvi");
- while not b_open_out(dvi_file) do
- prompt_file_name("file name for output",".dvi");
- 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 a_open_out(log_file) do @<Try to get a different log file name@>;
-log_name:=a_make_name_string(log_file);
-selector:=log_only; log_opened:=true;
-@<Print the banner line, including the date and time@>;
-input_stack[input_ptr]:=cur_input; {make sure bottom level is in memory}
-print_nl("**");
-@.**@>
-l:=input_stack[0].limit_field; {last position of first line}
-if buffer[l]=end_line_char then decr(l);
-for k:=1 to l do print(buffer[k]);
-print_ln; {now the transcript file contains the first line of input}
-selector:=old_setting+2; {|log_only| or |term_and_log|}
-end;
-
-@ Sometimes |open_log_file| is called at awkward moments when \TeX\ is
-unable to print error messages or even to |show_context|.
-The |prompt_file_name| routine can result in a |fatal_error|, but the |error|
-routine will not be invoked because |log_opened| will be false.
-
-The normal idea of |batch_mode| is that nothing at all should be written
-on the terminal. However, in the unusual case that
-no log file could be opened, we make an exception and allow
-an explanatory message to be seen.
-
-Incidentally, the program always refers to the log file as a `\.{transcript
-file}', because some systems cannot use the extension `\.{.log}' for
-this file.
-
-@<Try to get a different log file name@>=
-begin selector:=term_only;
-prompt_file_name("transcript file name",".log");
-end
-
-@ @<Print the banner...@>=
-begin wlog(banner);
-slow_print(format_ident); print(" ");
-print_int(sys_day); print_char(" ");
-months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
-for k:=3*sys_month-2 to 3*sys_month do wlog(months[k]);
-print_char(" "); print_int(sys_year); print_char(" ");
-print_two(sys_time div 60); print_char(":"); print_two(sys_time mod 60);
-if eTeX_ex then
- begin; wlog_cr; wlog('entering extended mode');
- end;
-end
-
-@ Let's turn now to the procedure that is used to initiate file reading
-when an `\.{\\input}' command is being processed.
-Beware: For historic reasons, this code foolishly conserves a tiny bit
-of string pool space; but that can confuse the interactive `\.E' option.
-@^system dependencies@>
-
-@p procedure start_input; {\TeX\ will \.{\\input} something}
-label done;
-begin scan_file_name; {set |cur_name| to desired file name}
-if cur_ext="" then cur_ext:=".tex";
-pack_cur_name;
-loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
- if a_open_in(cur_file) then goto done;
- if cur_area="" then
- begin pack_file_name(cur_name,TEX_area,cur_ext);
- if a_open_in(cur_file) then goto done;
- end;
- end_file_reading; {remove the level that didn't work}
- prompt_file_name("input file name",".tex");
- end;
-done: name:=a_make_name_string(cur_file);
-if job_name=0 then
- begin job_name:=cur_name; open_log_file;
- end; {|open_log_file| doesn't |show_context|, so |limit|
- and |loc| needn't be set to meaningful values yet}
-if term_offset+length(name)>max_print_line-2 then print_ln
-else if (term_offset>0)or(file_offset>0) then print_char(" ");
-print_char("("); incr(open_parens); slow_print(name); update_terminal;
-state:=new_line;
-if name=str_ptr-1 then {conserve string pool space (but see note above)}
- begin flush_string; name:=cur_name;
- end;
-@<Read the first line of the new file@>;
-end;
-
-@ Here we have to remember to tell the |input_ln| routine not to
-start with a |get|. If the file is empty, it is considered to
-contain a single blank line.
-@^system dependencies@>
-@^empty line at end of file@>
-
-@<Read the first line...@>=
-begin line:=1;
-if input_ln(cur_file,false) then do_nothing;
-firm_up_the_line;
-if end_line_char_inactive then decr(limit)
-else buffer[limit]:=end_line_char;
-first:=limit+1; loc:=start;
-end
-
-@* \[30] Font metric data.
-\TeX\ gets its knowledge about fonts from font metric files, also called
-\.{TFM} files; the `\.T' in `\.{TFM}' stands for \TeX,
-but other programs know about them too.
-@:TFM files}{\.{TFM} files@>
-@^font metric files@>
-
-The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
-Since the number of bytes is always a multiple of 4, we could
-also regard the file as a sequence of 32-bit words, but \TeX\ uses the
-byte interpretation. The format of \.{TFM} files was designed by
-Lyle Ramshaw in 1980. The intent is to convey a lot of different kinds
-@^Ramshaw, Lyle Harold@>
-of information in a compact but useful form.
-
-@<Glob...@>=
-@!tfm_file:byte_file;
-
-@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
-integers that give the lengths of the various subsequent portions
-of the file. These twelve integers are, in order:
-$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
-|lf|&length of the entire file, in words;\cr
-|lh|&length of the header data, in words;\cr
-|bc|&smallest character code in the font;\cr
-|ec|&largest character code in the font;\cr
-|nw|&number of words in the width table;\cr
-|nh|&number of words in the height table;\cr
-|nd|&number of words in the depth table;\cr
-|ni|&number of words in the italic correction table;\cr
-|nl|&number of words in the lig/kern table;\cr
-|nk|&number of words in the kern table;\cr
-|ne|&number of words in the extensible character table;\cr
-|np|&number of font parameter words.\cr}}$$
-They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
-and
-$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
-Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
-and as few as 0 characters (if |bc=ec+1|).
-
-Incidentally, when two or more 8-bit bytes are combined to form an integer of
-16 or more bits, the most significant bytes appear first in the file.
-This is called BigEndian order.
-@!@^BigEndian order@>
-
-@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
-arrays having the informal specification
-$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
-\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr
-header&|[0..lh-1]@t\\{stuff}@>|\cr
-char\_info&|[bc..ec]char_info_word|\cr
-width&|[0..nw-1]fix_word|\cr
-height&|[0..nh-1]fix_word|\cr
-depth&|[0..nd-1]fix_word|\cr
-italic&|[0..ni-1]fix_word|\cr
-lig\_kern&|[0..nl-1]lig_kern_command|\cr
-kern&|[0..nk-1]fix_word|\cr
-exten&|[0..ne-1]extensible_recipe|\cr
-param&|[1..np]fix_word|\cr}}$$
-The most important data type used here is a |@!fix_word|, which is
-a 32-bit representation of a binary fraction. A |fix_word| is a signed
-quantity, with the two's complement of the entire word used to represent
-negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
-binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
-the smallest is $-2048$. We will see below, however, that all but two of
-the |fix_word| values must lie between $-16$ and $+16$.
-
-@ The first data array is a block of header information, which contains
-general facts about the font. The header must contain at least two words,
-|header[0]| and |header[1]|, whose meaning is explained below.
-Additional header information of use to other software routines might
-also be included, but \TeX82 does not need to know about such details.
-For example, 16 more words of header information are in use at the Xerox
-Palo Alto Research Center; the first ten specify the character coding
-scheme used (e.g., `\.{XEROX text}' or `\.{TeX math symbols}'), the next five
-give the font identifier (e.g., `\.{HELVETICA}' or `\.{CMSY}'), and the
-last gives the ``face byte.'' The program that converts \.{DVI} files
-to Xerox printing format gets this information by looking at the \.{TFM}
-file, which it needs to read anyway because of other information that
-is not explicitly repeated in \.{DVI}~format.
-
-\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into
-the \.{DVI} output file. Later on when the \.{DVI} file is printed,
-possibly on another computer, the actual font that gets used is supposed
-to have a check sum that agrees with the one in the \.{TFM} file used by
-\TeX. In this way, users will be warned about potential incompatibilities.
-(However, if the check sum is zero in either the font file or the \.{TFM}
-file, no check is made.) The actual relation between this check sum and
-the rest of the \.{TFM} file is not important; the check sum is simply an
-identification number with the property that incompatible fonts almost
-always have distinct check sums.
-@^check sum@>
-
-\yskip\hang|header[1]| is a |fix_word| containing the design size of
-the font, in units of \TeX\ points. This number must be at least 1.0; it is
-fairly arbitrary, but usually the design size is 10.0 for a ``10 point''
-font, i.e., a font that was designed to look best at a 10-point size,
-whatever that really means. When a \TeX\ user asks for a font
-`\.{at} $\delta$ \.{pt}', the effect is to override the design size
-and replace it by $\delta$, and to multiply the $x$ and~$y$ coordinates
-of the points in the font image by a factor of $\delta$ divided by the
-design size. {\sl All other dimensions in the\/ \.{TFM} file are
-|fix_word|\kern-1pt\ numbers in design-size units}, with the exception of
-|param[1]| (which denotes the slant ratio). Thus, for example, the value
-of |param[6]|, which defines the \.{em} unit, is often the |fix_word| value
-$2^{20}=1.0$, since many fonts have a design size equal to one em.
-The other dimensions must be less than 16 design-size units in absolute
-value; thus, |header[1]| and |param[1]| are the only |fix_word|
-entries in the whole \.{TFM} file whose first byte might be something
-besides 0 or 255.
-
-@ Next comes the |char_info| array, which contains one |@!char_info_word|
-per character. Each word in this part of the file contains six fields
-packed into four bytes as follows.
-
-\yskip\hang first byte: |@!width_index| (8 bits)\par
-\hang second byte: |@!height_index| (4 bits) times 16, plus |@!depth_index|
- (4~bits)\par
-\hang third byte: |@!italic_index| (6 bits) times 4, plus |@!tag|
- (2~bits)\par
-\hang fourth byte: |@!remainder| (8 bits)\par
-\yskip\noindent
-The actual width of a character is \\{width}|[width_index]|, in design-size
-units; this is a device for compressing information, since many characters
-have the same width. Since it is quite common for many characters
-to have the same height, depth, or italic correction, the \.{TFM} format
-imposes a limit of 16 different heights, 16 different depths, and
-64 different italic corrections.
-
-@!@^italic correction@>
-The italic correction of a character has two different uses.
-(a)~In ordinary text, the italic correction is added to the width only if
-the \TeX\ user specifies `\.{\\/}' after the character.
-(b)~In math formulas, the italic correction is always added to the width,
-except with respect to the positioning of subscripts.
-
-Incidentally, the relation $\\{width}[0]=\\{height}[0]=\\{depth}[0]=
-\\{italic}[0]=0$ should always hold, so that an index of zero implies a
-value of zero. The |width_index| should never be zero unless the
-character does not exist in the font, since a character is valid if and
-only if it lies between |bc| and |ec| and has a nonzero |width_index|.
-
-@ The |tag| field in a |char_info_word| has four values that explain how to
-interpret the |remainder| field.
-
-\yskip\hangg|tag=0| (|no_tag|) means that |remainder| is unused.\par
-\hangg|tag=1| (|lig_tag|) means that this character has a ligature/kerning
-program starting at position |remainder| in the |lig_kern| array.\par
-\hangg|tag=2| (|list_tag|) means that this character is part of a chain of
-characters of ascending sizes, and not the largest in the chain. The
-|remainder| field gives the character code of the next larger character.\par
-\hangg|tag=3| (|ext_tag|) means that this character code represents an
-extensible character, i.e., a character that is built up of smaller pieces
-so that it can be made arbitrarily large. The pieces are specified in
-|@!exten[remainder]|.\par
-\yskip\noindent
-Characters with |tag=2| and |tag=3| are treated as characters with |tag=0|
-unless they are used in special circumstances in math formulas. For example,
-the \.{\\sum} operation looks for a |list_tag|, and the \.{\\left}
-operation looks for both |list_tag| and |ext_tag|.
-
-@d no_tag=0 {vanilla character}
-@d lig_tag=1 {character has a ligature/kerning program}
-@d list_tag=2 {character has a successor in a charlist}
-@d ext_tag=3 {character is extensible}
-
-@ The |lig_kern| array contains instructions in a simple programming language
-that explains what to do for special letter pairs. Each word in this array is a
-|@!lig_kern_command| of four bytes.
-
-\yskip\hang first byte: |skip_byte|, indicates that this is the final program
- step if the byte is 128 or more, otherwise the next step is obtained by
- skipping this number of intervening steps.\par
-\hang second byte: |next_char|, ``if |next_char| follows the current character,
- then perform the operation and stop, otherwise continue.''\par
-\hang third byte: |op_byte|, indicates a ligature step if less than~128,
- a kern step otherwise.\par
-\hang fourth byte: |remainder|.\par
-\yskip\noindent
-In a kern step, an
-additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
-between the current character and |next_char|. This amount is
-often negative, so that the characters are brought closer together
-by kerning; but it might be positive.
-
-There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
-$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
-|remainder| is inserted between the current character and |next_char|;
-then the current character is deleted if $b=0$, and |next_char| is
-deleted if $c=0$; then we pass over $a$~characters to reach the next
-current character (which may have a ligature/kerning program of its own).
-
-If the very first instruction of the |lig_kern| array has |skip_byte=255|,
-the |next_char| byte is the so-called boundary character of this font;
-the value of |next_char| need not lie between |bc| and~|ec|.
-If the very last instruction of the |lig_kern| array has |skip_byte=255|,
-there is a special ligature/kerning program for a boundary character at the
-left, beginning at location |256*op_byte+remainder|.
-The interpretation is that \TeX\ puts implicit boundary characters
-before and after each consecutive string of characters from the same font.
-These implicit characters do not appear in the output, but they can affect
-ligatures and kerning.
-
-If the very first instruction of a character's |lig_kern| program has
-|skip_byte>128|, the program actually begins in location
-|256*op_byte+remainder|. This feature allows access to large |lig_kern|
-arrays, because the first instruction must otherwise
-appear in a location |<=255|.
-
-Any instruction with |skip_byte>128| in the |lig_kern| array must satisfy
-the condition
-$$\hbox{|256*op_byte+remainder<nl|.}$$
-If such an instruction is encountered during
-normal program execution, it denotes an unconditional halt; no ligature
-or kerning command is performed.
-
-@d stop_flag==qi(128) {value indicating `\.{STOP}' in a lig/kern program}
-@d kern_flag==qi(128) {op code for a kern step}
-@d skip_byte(#)==#.b0
-@d next_char(#)==#.b1
-@d op_byte(#)==#.b2
-@d rem_byte(#)==#.b3
-
-@ Extensible characters are specified by an |@!extensible_recipe|, which
-consists of four bytes called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this
-order). These bytes are the character codes of individual pieces used to
-build up a large symbol. If |top|, |mid|, or |bot| are zero, they are not
-present in the built-up result. For example, an extensible vertical line is
-like an extensible bracket, except that the top and bottom pieces are missing.
-
-Let $T$, $M$, $B$, and $R$ denote the respective pieces, or an empty box
-if the piece isn't present. Then the extensible characters have the form
-$TR^kMR^kB$ from top to bottom, for some |k>=0|, unless $M$ is absent;
-in the latter case we can have $TR^kB$ for both even and odd values of~|k|.
-The width of the extensible character is the width of $R$; and the
-height-plus-depth is the sum of the individual height-plus-depths of the
-components used, since the pieces are butted together in a vertical list.
-
-@d ext_top(#)==#.b0 {|top| piece in a recipe}
-@d ext_mid(#)==#.b1 {|mid| piece in a recipe}
-@d ext_bot(#)==#.b2 {|bot| piece in a recipe}
-@d ext_rep(#)==#.b3 {|rep| piece in a recipe}
-
-@ The final portion of a \.{TFM} file is the |param| array, which is another
-sequence of |fix_word| values.
-
-\yskip\hang|param[1]=slant| is the amount of italic slant, which is used
-to help position accents. For example, |slant=.25| means that when you go
-up one unit, you also go .25 units to the right. The |slant| is a pure
-number; it's the only |fix_word| other than the design size itself that is
-not scaled by the design size.
-
-\hang|param[2]=space| is the normal spacing between words in text.
-Note that character |" "| in the font need not have anything to do with
-blank spaces.
-
-\hang|param[3]=space_stretch| is the amount of glue stretching between words.
-
-\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
-
-\hang|param[5]=x_height| is the size of one ex in the font; it is also
-the height of letters for which accents don't have to be raised or lowered.
-
-\hang|param[6]=quad| is the size of one em in the font.
-
-\hang|param[7]=extra_space| is the amount added to |param[2]| at the
-ends of sentences.
-
-\yskip\noindent
-If fewer than seven parameters are present, \TeX\ sets the missing parameters
-to zero. Fonts used for math symbols are required to have
-additional parameter information, which is explained later.
-
-@d slant_code=1
-@d space_code=2
-@d space_stretch_code=3
-@d space_shrink_code=4
-@d x_height_code=5
-@d quad_code=6
-@d extra_space_code=7
-
-@ So that is what \.{TFM} files hold. Since \TeX\ has to absorb such information
-about lots of fonts, it stores most of the data in a large array called
-|font_info|. Each item of |font_info| is a |memory_word|; the |fix_word|
-data gets converted into |scaled| entries, while everything else goes into
-words of type |four_quarters|.
-
-When the user defines \.{\\font\\f}, say, \TeX\ assigns an internal number
-to the user's font~\.{\\f}. Adding this number to |font_id_base| gives the
-|eqtb| location of a ``frozen'' control sequence that will always select
-the font.
-
-@<Types...@>=
-@!internal_font_number=font_base..font_max; {|font| in a |char_node|}
-@!font_index=0..font_mem_size; {index into |font_info|}
-
-@ Here now is the (rather formidable) array of font arrays.
-
-@d non_char==qi(256) {a |halfword| code that can't match a real character}
-@d non_address=0 {a spurious |bchar_label|}
-
-@<Glob...@>=
-@!font_info:array[font_index] of memory_word;
- {the big collection of font data}
-@!fmem_ptr:font_index; {first unused word of |font_info|}
-@!font_ptr:internal_font_number; {largest internal font number in use}
-@!font_check:array[internal_font_number] of four_quarters; {check sum}
-@!font_size:array[internal_font_number] of scaled; {``at'' size}
-@!font_dsize:array[internal_font_number] of scaled; {``design'' size}
-@!font_params:array[internal_font_number] of font_index; {how many font
- parameters are present}
-@!font_name:array[internal_font_number] of str_number; {name of the font}
-@!font_area:array[internal_font_number] of str_number; {area of the font}
-@!font_bc:array[internal_font_number] of eight_bits;
- {beginning (smallest) character code}
-@!font_ec:array[internal_font_number] of eight_bits;
- {ending (largest) character code}
-@!font_glue:array[internal_font_number] of pointer;
- {glue specification for interword space, |null| if not allocated}
-@!font_used:array[internal_font_number] of boolean;
- {has a character from this font actually appeared in the output?}
-@!hyphen_char:array[internal_font_number] of integer;
- {current \.{\\hyphenchar} values}
-@!skew_char:array[internal_font_number] of integer;
- {current \.{\\skewchar} values}
-@!bchar_label:array[internal_font_number] of font_index;
- {start of |lig_kern| program for left boundary character,
- |non_address| if there is none}
-@!font_bchar:array[internal_font_number] of min_quarterword..non_char;
- {boundary character, |non_char| if there is none}
-@!font_false_bchar:array[internal_font_number] of min_quarterword..non_char;
- {|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
-
-@ Besides the arrays just enumerated, we have directory arrays that make it
-easy to get at the individual entries in |font_info|. For example, the
-|char_info| data for character |c| in font |f| will be in
-|font_info[char_base[f]+c].qqqq|; and if |w| is the |width_index|
-part of this word (the |b0| field), the width of the character is
-|font_info[width_base[f]+w].sc|. (These formulas assume that
-|min_quarterword| has already been added to |c| and to |w|, since \TeX\
-stores its quarterwords that way.)
-
-@<Glob...@>=
-@!char_base:array[internal_font_number] of integer;
- {base addresses for |char_info|}
-@!width_base:array[internal_font_number] of integer;
- {base addresses for widths}
-@!height_base:array[internal_font_number] of integer;
- {base addresses for heights}
-@!depth_base:array[internal_font_number] of integer;
- {base addresses for depths}
-@!italic_base:array[internal_font_number] of integer;
- {base addresses for italic corrections}
-@!lig_kern_base:array[internal_font_number] of integer;
- {base addresses for ligature/kerning programs}
-@!kern_base:array[internal_font_number] of integer;
- {base addresses for kerns}
-@!exten_base:array[internal_font_number] of integer;
- {base addresses for extensible recipes}
-@!param_base:array[internal_font_number] of integer;
- {base addresses for font parameters}
-
-@ @<Set init...@>=
-for k:=font_base to font_max do font_used[k]:=false;
-
-@ \TeX\ always knows at least one font, namely the null font. It has no
-characters, and its seven parameters are all equal to zero.
-
-@<Initialize table...@>=
-font_ptr:=null_font; fmem_ptr:=7;
-font_name[null_font]:="nullfont"; font_area[null_font]:="";
-hyphen_char[null_font]:="-"; skew_char[null_font]:=-1;
-bchar_label[null_font]:=non_address;
-font_bchar[null_font]:=non_char; font_false_bchar[null_font]:=non_char;
-font_bc[null_font]:=1; font_ec[null_font]:=0;
-font_size[null_font]:=0; font_dsize[null_font]:=0;
-char_base[null_font]:=0; width_base[null_font]:=0;
-height_base[null_font]:=0; depth_base[null_font]:=0;
-italic_base[null_font]:=0; lig_kern_base[null_font]:=0;
-kern_base[null_font]:=0; exten_base[null_font]:=0;
-font_glue[null_font]:=null; font_params[null_font]:=7;
-param_base[null_font]:=-1;
-for k:=0 to 6 do font_info[k].sc:=0;
-
-@ @<Put each...@>=
-primitive("nullfont",set_font,null_font);
-@!@:null_font_}{\.{\\nullfont} primitive@>
-text(frozen_null_font):="nullfont"; eqtb[frozen_null_font]:=eqtb[cur_val];
-
-@ Of course we want to define macros that suppress the detail of how font
-information is actually packed, so that we don't have to write things like
-$$\hbox{|font_info[width_base[f]+font_info[char_base[f]+c].qqqq.b0].sc|}$$
-too often. The \.{WEB} definitions here make |char_info(f)(c)| the
-|four_quarters| word of font information corresponding to character
-|c| of font |f|. If |q| is such a word, |char_width(f)(q)| will be
-the character's width; hence the long formula above is at least
-abbreviated to
-$$\hbox{|char_width(f)(char_info(f)(c))|.}$$
-Usually, of course, we will fetch |q| first and look at several of its
-fields at the same time.
-
-The italic correction of a character will be denoted by
-|char_italic(f)(q)|, so it is analogous to |char_width|. But we will get
-at the height and depth in a slightly different way, since we usually want
-to compute both height and depth if we want either one. The value of
-|height_depth(q)| will be the 8-bit quantity
-$$b=|height_index|\times16+|depth_index|,$$ and if |b| is such a byte we
-will write |char_height(f)(b)| and |char_depth(f)(b)| for the height and
-depth of the character |c| for which |q=char_info(f)(c)|. Got that?
-
-The tag field will be called |char_tag(q)|; the remainder byte will be
-called |rem_byte(q)|, using a macro that we have already defined above.
-
-Access to a character's |width|, |height|, |depth|, and |tag| fields is
-part of \TeX's inner loop, so we want these macros to produce code that is
-as fast as possible under the circumstances.
-@^inner loop@>
-
-@d char_info_end(#)==#].qqqq
-@d char_info(#)==font_info[char_base[#]+char_info_end
-@d char_width_end(#)==#.b0].sc
-@d char_width(#)==font_info[width_base[#]+char_width_end
-@d char_exists(#)==(#.b0>min_quarterword)
-@d char_italic_end(#)==(qo(#.b2)) div 4].sc
-@d char_italic(#)==font_info[italic_base[#]+char_italic_end
-@d height_depth(#)==qo(#.b1)
-@d char_height_end(#)==(#) div 16].sc
-@d char_height(#)==font_info[height_base[#]+char_height_end
-@d char_depth_end(#)==(#) mod 16].sc
-@d char_depth(#)==font_info[depth_base[#]+char_depth_end
-@d char_tag(#)==((qo(#.b2)) mod 4)
-
-@ The global variable |null_character| is set up to be a word of
-|char_info| for a character that doesn't exist. Such a word provides a
-convenient way to deal with erroneous situations.
-
-@<Glob...@>=
-@!null_character:four_quarters; {nonexistent character information}
-
-@ @<Set init...@>=
-null_character.b0:=min_quarterword; null_character.b1:=min_quarterword;
-null_character.b2:=min_quarterword; null_character.b3:=min_quarterword;
-
-@ Here are some macros that help process ligatures and kerns.
-We write |char_kern(f)(j)| to find the amount of kerning specified by
-kerning command~|j| in font~|f|. If |j| is the |char_info| for a character
-with a ligature/kern program, the first instruction of that program is either
-|i=font_info[lig_kern_start(f)(j)]| or |font_info[lig_kern_restart(f)(i)]|,
-depending on whether or not |skip_byte(i)<=stop_flag|.
-
-The constant |kern_base_offset| should be simplified, for \PASCAL\ compilers
-that do not do local optimization.
-@^system dependencies@>
-
-@d char_kern_end(#)==256*op_byte(#)+rem_byte(#)].sc
-@d char_kern(#)==font_info[kern_base[#]+char_kern_end
-@d kern_base_offset==256*(128+min_quarterword)
-@d lig_kern_start(#)==lig_kern_base[#]+rem_byte {beginning of lig/kern program}
-@d lig_kern_restart_end(#)==256*op_byte(#)+rem_byte(#)+32768-kern_base_offset
-@d lig_kern_restart(#)==lig_kern_base[#]+lig_kern_restart_end
-
-@ Font parameters are referred to as |slant(f)|, |space(f)|, etc.
-
-@d param_end(#)==param_base[#]].sc
-@d param(#)==font_info[#+param_end
-@d slant==param(slant_code) {slant to the right, per unit distance upward}
-@d space==param(space_code) {normal space between words}
-@d space_stretch==param(space_stretch_code) {stretch between words}
-@d space_shrink==param(space_shrink_code) {shrink between words}
-@d x_height==param(x_height_code) {one ex}
-@d quad==param(quad_code) {one em}
-@d extra_space==param(extra_space_code) {additional space at end of sentence}
-
-@<The em width for |cur_font|@>=quad(cur_font)
-
-@ @<The x-height for |cur_font|@>=x_height(cur_font)
-
-@ \TeX\ checks the information of a \.{TFM} file for validity as the
-file is being read in, so that no further checks will be needed when
-typesetting is going on. The somewhat tedious subroutine that does this
-is called |read_font_info|. It has four parameters: the user font
-identifier~|u|, the file name and area strings |nom| and |aire|, and the
-``at'' size~|s|. If |s|~is negative, it's the negative of a scale factor
-to be applied to the design size; |s=-1000| is the normal case.
-Otherwise |s| will be substituted for the design size; in this
-case, |s| must be positive and less than $2048\rm\,pt$
-(i.e., it must be less than $2^{27}$ when considered as an integer).
-
-The subroutine opens and closes a global file variable called |tfm_file|.
-It returns the value of the internal font number that was just loaded.
-If an error is detected, an error message is issued and no font
-information is stored; |null_font| is returned in this case.
-
-@d bad_tfm=11 {label for |read_font_info|}
-@d abort==goto bad_tfm {do this when the \.{TFM} data is wrong}
-
-@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
- @!s:scaled):internal_font_number; {input a \.{TFM} file}
-label done,bad_tfm,not_found;
-var k:font_index; {index into |font_info|}
-@!file_opened:boolean; {was |tfm_file| successfully opened?}
-@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np:halfword;
- {sizes of subfiles}
-@!f:internal_font_number; {the new font's number}
-@!g:internal_font_number; {the number to return}
-@!a,@!b,@!c,@!d:eight_bits; {byte variables}
-@!qw:four_quarters;@!sw:scaled; {accumulators}
-@!bch_label:integer; {left boundary start location, or infinity}
-@!bchar:0..256; {boundary character, or 256}
-@!z:scaled; {the design size or the ``at'' size}
-@!alpha:integer;@!beta:1..16;
- {auxiliary quantities used in fixed-point multiplication}
-begin g:=null_font;@/
-@<Read and check the font data; |abort| if the \.{TFM} file is
- malformed; if there's no room for this font, say so and |goto
- done|; otherwise |incr(font_ptr)| and |goto done|@>;
-bad_tfm: @<Report that the font won't be loaded@>;
-done: if file_opened then b_close(tfm_file);
-read_font_info:=g;
-end;
-
-@ There are programs called \.{TFtoPL} and \.{PLtoTF} that convert
-between the \.{TFM} format and a symbolic property-list format
-that can be easily edited. These programs contain extensive
-diagnostic information, so \TeX\ does not have to bother giving
-precise details about why it rejects a particular \.{TFM} file.
-@.TFtoPL@> @.PLtoTF@>
-
-@d start_font_error_message==print_err("Font "); sprint_cs(u);
- print_char("="); print_file_name(nom,aire,"");
- if s>=0 then
- begin print(" at "); print_scaled(s); print("pt");
- end
- else if s<>-1000 then
- begin print(" scaled "); print_int(-s);
- end
-
-@<Report that the font won't be loaded@>=
-start_font_error_message;
-@.Font x=xx not loadable...@>
-if file_opened then print(" not loadable: Bad metric (TFM) file")
-else print(" not loadable: Metric (TFM) file not found");
-help5("I wasn't able to read the size data for this font,")@/
-("so I will ignore the font specification.")@/
-("[Wizards can fix TFM files using TFtoPL/PLtoTF.]")@/
-("You might try inserting a different font spec;")@/
-("e.g., type `I\font<same font id>=<substitute font name>'.");
-error
-
-@ @<Read and check...@>=
-@<Open |tfm_file| for input@>;
-@<Read the {\.{TFM}} size fields@>;
-@<Use size fields to allocate font information@>;
-@<Read the {\.{TFM}} header@>;
-@<Read character data@>;
-@<Read box dimensions@>;
-@<Read ligature/kern program@>;
-@<Read extensible character recipes@>;
-@<Read font parameters@>;
-@<Make final adjustments and |goto done|@>
-
-@ @<Open |tfm_file| for input@>=
-file_opened:=false;
-if aire="" then pack_file_name(nom,TEX_font_area,".tfm")
-else pack_file_name(nom,aire,".tfm");
-if not b_open_in(tfm_file) then abort;
-file_opened:=true
-
-@ Note: A malformed \.{TFM} file might be shorter than it claims to be;
-thus |eof(tfm_file)| might be true when |read_font_info| refers to
-|tfm_file^| or when it says |get(tfm_file)|. If such circumstances
-cause system error messages, you will have to defeat them somehow,
-for example by defining |fget| to be `\ignorespaces|begin get(tfm_file);|
-|if eof(tfm_file) then abort; end|\unskip'.
-@^system dependencies@>
-
-@d fget==get(tfm_file)
-@d fbyte==tfm_file^
-@d read_sixteen(#)==begin #:=fbyte;
- if #>127 then abort;
- fget; #:=#*@'400+fbyte;
- end
-@d store_four_quarters(#)==begin fget; a:=fbyte; qw.b0:=qi(a);
- fget; b:=fbyte; qw.b1:=qi(b);
- fget; c:=fbyte; qw.b2:=qi(c);
- fget; d:=fbyte; qw.b3:=qi(d);
- #:=qw;
- end
-
-@ @<Read the {\.{TFM}} size fields@>=
-begin read_sixteen(lf);
-fget; read_sixteen(lh);
-fget; read_sixteen(bc);
-fget; read_sixteen(ec);
-if (bc>ec+1)or(ec>255) then abort;
-if bc>255 then {|bc=256| and |ec=255|}
- begin bc:=1; ec:=0;
- end;
-fget; read_sixteen(nw);
-fget; read_sixteen(nh);
-fget; read_sixteen(nd);
-fget; read_sixteen(ni);
-fget; read_sixteen(nl);
-fget; read_sixteen(nk);
-fget; read_sixteen(ne);
-fget; read_sixteen(np);
-if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort;
-if (nw=0)or(nh=0)or(nd=0)or(ni=0) then abort;
-end
-
-@ The preliminary settings of the index-offset variables |char_base|,
-|width_base|, |lig_kern_base|, |kern_base|, and |exten_base| will be
-corrected later by subtracting |min_quarterword| from them; and we will
-subtract 1 from |param_base| too. It's best to forget about such anomalies
-until later.
-
-@<Use size fields to allocate font information@>=
-lf:=lf-6-lh; {|lf| words should be loaded into |font_info|}
-if np<7 then lf:=lf+7-np; {at least seven parameters will appear}
-if (font_ptr=font_max)or(fmem_ptr+lf>font_mem_size) then
- @<Apologize for not loading the font, |goto done|@>;
-f:=font_ptr+1;
-char_base[f]:=fmem_ptr-bc;
-width_base[f]:=char_base[f]+ec+1;
-height_base[f]:=width_base[f]+nw;
-depth_base[f]:=height_base[f]+nh;
-italic_base[f]:=depth_base[f]+nd;
-lig_kern_base[f]:=italic_base[f]+ni;
-kern_base[f]:=lig_kern_base[f]+nl-kern_base_offset;
-exten_base[f]:=kern_base[f]+kern_base_offset+nk;
-param_base[f]:=exten_base[f]+ne
-
-@ @<Apologize for not loading...@>=
-begin start_font_error_message;
-print(" not loaded: Not enough room left");
-@.Font x=xx not loaded...@>
-help4("I'm afraid I won't be able to make use of this font,")@/
-("because my memory for character-size data is too small.")@/
-("If you're really stuck, ask a wizard to enlarge me.")@/
-("Or maybe try `I\font<same font id>=<name of loaded font>'.");
-error; goto done;
-end
-
-@ Only the first two words of the header are needed by \TeX82.
-
-@<Read the {\.{TFM}} header@>=
-begin if lh<2 then abort;
-store_four_quarters(font_check[f]);
-fget; read_sixteen(z); {this rejects a negative design size}
-fget; z:=z*@'400+fbyte; fget; z:=(z*@'20)+(fbyte div@'20);
-if z<unity then abort;
-while lh>2 do
- begin fget;fget;fget;fget;decr(lh); {ignore the rest of the header}
- end;
-font_dsize[f]:=z;
-if s<>-1000 then
- if s>=0 then z:=s
- else z:=xn_over_d(z,-s,1000);
-font_size[f]:=z;
-end
-
-@ @<Read character data@>=
-for k:=fmem_ptr to width_base[f]-1 do
- begin store_four_quarters(font_info[k].qqqq);
- if (a>=nw)or(b div @'20>=nh)or(b mod @'20>=nd)or
- (c div 4>=ni) then abort;
- case c mod 4 of
- lig_tag: if d>=nl then abort;
- ext_tag: if d>=ne then abort;
- list_tag: @<Check for charlist cycle@>;
- othercases do_nothing {|no_tag|}
- endcases;
- end
-
-@ We want to make sure that there is no cycle of characters linked together
-by |list_tag| entries, since such a cycle would get \TeX\ into an endless
-loop. If such a cycle exists, the routine here detects it when processing
-the largest character code in the cycle.
-
-@d check_byte_range(#)==begin if (#<bc)or(#>ec) then abort@+end
-@d current_character_being_worked_on==k+bc-fmem_ptr
-
-@<Check for charlist cycle@>=
-begin check_byte_range(d);
-while d<current_character_being_worked_on do
- begin qw:=char_info(f)(d);
- {N.B.: not |qi(d)|, since |char_base[f]| hasn't been adjusted yet}
- if char_tag(qw)<>list_tag then goto not_found;
- d:=qo(rem_byte(qw)); {next character on the list}
- end;
-if d=current_character_being_worked_on then abort; {yes, there's a cycle}
-not_found:end
-
-@ A |fix_word| whose four bytes are $(a,b,c,d)$ from left to right represents
-the number
-$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
-b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
--16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
-(No other choices of |a| are allowed, since the magnitude of a number in
-design-size units must be less than 16.) We want to multiply this
-quantity by the integer~|z|, which is known to be less than $2^{27}$.
-If $|z|<2^{23}$, the individual multiplications $b\cdot z$,
-$c\cdot z$, $d\cdot z$ cannot overflow; otherwise we will divide |z| by 2,
-4, 8, or 16, to obtain a multiplier less than $2^{23}$, and we can
-compensate for this later. If |z| has thereby been replaced by
-$|z|^\prime=|z|/2^e$, let $\beta=2^{4-e}$; we shall compute
-$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$
-if $a=0$, or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$.
-This calculation must be done exactly, in order to guarantee portability
-of \TeX\ between computers.
-
-@d store_scaled(#)==begin fget; a:=fbyte; fget; b:=fbyte;
- fget; c:=fbyte; fget; d:=fbyte;@/
- sw:=(((((d*z)div@'400)+(c*z))div@'400)+(b*z))div beta;
- if a=0 then #:=sw@+else if a=255 then #:=sw-alpha@+else abort;
- end
-
-@p function store_scaled_f(sq, z: scaled): scaled;
-var a,b,c,d:eight_bits; sw:scaled;
-alpha:integer;
-beta:1..16;
-begin
- alpha:=16;
- if z>=@'1000000000 then pdf_error("font", "size is too large");
- while z>=@'40000000 do
- begin z:=z div 2; alpha:=alpha+alpha;
- end;
- beta:=256 div alpha; alpha:=alpha*z;
- if sq >= 0 then begin
- d:=sq mod 256; sq:=sq div 256; {any "mod 256" not really needed, would typecast alone be safe?}
- c:=sq mod 256; sq:=sq div 256;
- b:=sq mod 256; sq:=sq div 256;
- a:=sq mod 256;
- end else begin
- sq:=(sq+1073741824)+1073741824; {braces for optimizing compiler}
- d:=sq mod 256; sq:=sq div 256;
- c:=sq mod 256; sq:=sq div 256;
- b:=sq mod 256; sq:=sq div 256;
- a:=(sq+128) mod 256;
- end;
- sw:=(((((d*z)div@'400)+(c*z))div@'400)+(b*z))div beta;
- if a=0 then store_scaled_f:=sw@+else if a=255 then store_scaled_f:=sw-alpha@+else pdf_error("store_scaled_f", "vf scaling");
-end;
-
-
-@ @<Read box dimensions@>=
-begin @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>;
-for k:=width_base[f] to lig_kern_base[f]-1 do
- store_scaled(font_info[k].sc);
-if font_info[width_base[f]].sc<>0 then abort; {\\{width}[0] must be zero}
-if font_info[height_base[f]].sc<>0 then abort; {\\{height}[0] must be zero}
-if font_info[depth_base[f]].sc<>0 then abort; {\\{depth}[0] must be zero}
-if font_info[italic_base[f]].sc<>0 then abort; {\\{italic}[0] must be zero}
-end
-
-@ @<Replace |z|...@>=
-begin alpha:=16;
-if z>=@'1000000000 then pdf_error("font", "size is too large");
-while z>=@'40000000 do
- begin z:=z div 2; alpha:=alpha+alpha;
- end;
-beta:=256 div alpha; alpha:=alpha*z;
-end
-
-@ @d check_existence(#)==@t@>@;@/
- begin check_byte_range(#);
- qw:=char_info(f)(#); {N.B.: not |qi(#)|}
- if not char_exists(qw) then abort;
- end
-
-@<Read ligature/kern program@>=
-bch_label:=@'77777; bchar:=256;
-if nl>0 then
- begin for k:=lig_kern_base[f] to kern_base[f]+kern_base_offset-1 do
- begin store_four_quarters(font_info[k].qqqq);
- if a>128 then
- begin if 256*c+d>=nl then abort;
- if a=255 then if k=lig_kern_base[f] then bchar:=b;
- end
- else begin if b<>bchar then check_existence(b);
- if c<128 then check_existence(d) {check ligature}
- else if 256*(c-128)+d>=nk then abort; {check kern}
- if a<128 then if k-lig_kern_base[f]+a+1>=nl then abort;
- end;
- end;
- if a=255 then bch_label:=256*c+d;
- end;
-for k:=kern_base[f]+kern_base_offset to exten_base[f]-1 do
- store_scaled(font_info[k].sc);
-
-@ @<Read extensible character recipes@>=
-for k:=exten_base[f] to param_base[f]-1 do
- begin store_four_quarters(font_info[k].qqqq);
- if a<>0 then check_existence(a);
- if b<>0 then check_existence(b);
- if c<>0 then check_existence(c);
- check_existence(d);
- end
-
-@ We check to see that the \.{TFM} file doesn't end prematurely; but
-no error message is given for files having more than |lf| words.
-
-@<Read font parameters@>=
-begin for k:=1 to np do
- if k=1 then {the |slant| parameter is a pure number}
- begin fget; sw:=fbyte; if sw>127 then sw:=sw-256;
- fget; sw:=sw*@'400+fbyte; fget; sw:=sw*@'400+fbyte;
- fget; font_info[param_base[f]].sc:=
- (sw*@'20)+(fbyte div@'20);
- end
- else store_scaled(font_info[param_base[f]+k-1].sc);
-if eof(tfm_file) then abort;
-for k:=np+1 to 7 do font_info[param_base[f]+k-1].sc:=0;
-end
-
-@ Now to wrap it up, we have checked all the necessary things about the \.{TFM}
-file, and all we need to do is put the finishing touches on the data for
-the new font.
-
-@d adjust(#)==#[f]:=qo(#[f])
- {correct for the excess |min_quarterword| that was added}
-
-@<Make final adjustments...@>=
-if np>=7 then font_params[f]:=np@+else font_params[f]:=7;
-hyphen_char[f]:=default_hyphen_char; skew_char[f]:=default_skew_char;
-if bch_label<nl then bchar_label[f]:=bch_label+lig_kern_base[f]
-else bchar_label[f]:=non_address;
-font_bchar[f]:=qi(bchar);
-font_false_bchar[f]:=qi(bchar);
-if bchar<=ec then if bchar>=bc then
- begin qw:=char_info(f)(bchar); {N.B.: not |qi(bchar)|}
- if char_exists(qw) then font_false_bchar[f]:=non_char;
- end;
-font_name[f]:=nom;
-font_area[f]:=aire;
-font_bc[f]:=bc; font_ec[f]:=ec; font_glue[f]:=null;
-adjust(char_base); adjust(width_base); adjust(lig_kern_base);
-adjust(kern_base); adjust(exten_base);
-decr(param_base[f]);
-fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; goto done
-
-@ Before we forget about the format of these tables, let's deal with two
-of \TeX's basic scanning routines related to font information.
-
-@<Declare procedures that scan font-related stuff@>=
-function test_no_ligatures(f: internal_font_number): integer;
-label exit;
-var c:integer;
-begin
- test_no_ligatures:= 1;
- for c := font_bc[f] to font_ec[f] do
- if char_exists(orig_char_info(f)(c)) then
- if odd(char_tag(orig_char_info(f)(c))) then begin
- test_no_ligatures:= 0;
- return;
- end;
- exit:
-end;
-
-function get_tag_code(f: internal_font_number; c: eight_bits): integer;
-var i:small_number;
-begin
- if is_valid_char(c) then
- begin i := char_tag(char_info(f)(c));
- if i = lig_tag then
- get_tag_code := 1
- else if i = list_tag then
- get_tag_code := 2
- else if i = ext_tag then
- get_tag_code := 4
- else
- get_tag_code := 0;
- end
- else
- get_tag_code := -1;
-end;
-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 f:=cur_chr
-else if cur_cmd=def_family then
- begin m:=cur_chr; scan_four_bit_int; f:=equiv(m+cur_val);
- end
-else begin print_err("Missing font identifier");
-@.Missing font identifier@>
- help2("I was looking for a control sequence whose")@/
- ("current meaning has been defined by \font.");
- back_error; f:=null_font;
- end;
-cur_val:=f;
-end;
-
-@ The following routine is used to implement `\.{\\fontdimen} |n| |f|'.
-The boolean parameter |writing| is set |true| if the calling program
-intends to change the parameter value.
-
-@<Declare procedures that scan font-related stuff@>=
-procedure find_font_dimen(@!writing:boolean);
- {sets |cur_val| to |font_info| location}
-var f:internal_font_number;
-@!n:integer; {the parameter number}
-begin scan_int; n:=cur_val; scan_font_ident; f:=cur_val;
-if n<=0 then cur_val:=fmem_ptr
-else begin if writing and(n<=space_shrink_code)and@|
- (n>=space_code)and(font_glue[f]<>null) then
- begin delete_glue_ref(font_glue[f]);
- font_glue[f]:=null;
- end;
- if n>font_params[f] then
- if f<font_ptr then cur_val:=fmem_ptr
- else @<Increase the number of parameters in the last font@>
- else cur_val:=n+param_base[f];
- end;
-@<Issue an error message if |cur_val=fmem_ptr|@>;
-end;
-
-@ @<Issue an error message if |cur_val=fmem_ptr|@>=
-if cur_val=fmem_ptr then
- begin print_err("Font "); print_esc(font_id_text(f));
- print(" has only "); print_int(font_params[f]);
- print(" fontdimen parameters");
-@.Font x has only...@>
- help2("To increase the number of font parameters, you must")@/
- ("use \fontdimen immediately after the \font is loaded.");
- error;
- end
-
-@ @<Increase the number of parameters...@>=
-begin repeat if fmem_ptr=font_mem_size then
- overflow("font memory",font_mem_size);
-@:TeX capacity exceeded font memory}{\quad font memory@>
-font_info[fmem_ptr].sc:=0; incr(fmem_ptr); incr(font_params[f]);
-until n=font_params[f];
-cur_val:=fmem_ptr-1; {this equals |param_base[f]+font_params[f]|}
-end
-
-@ When \TeX\ wants to typeset a character that doesn't exist, the
-character node is not created; thus the output routine can assume
-that characters exist when it sees them. The following procedure
-prints a warning message unless the user has suppressed it.
-
-@p procedure char_warning(@!f:internal_font_number;@!c:eight_bits);
-var old_setting: integer; {saved value of |tracing_online|}
-begin if tracing_lost_chars>0 then
- begin old_setting:=tracing_online;
- if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
- begin begin_diagnostic;
- print_nl("Missing character: There is no ");
-@.Missing character@>
- print_ASCII(c); print(" in font ");
- slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
- end;
- tracing_online:=old_setting;
- end;
-end;
-
-@ Here is a function that returns a pointer to a character node for a
-given character in a given font. If that character doesn't exist,
-|null| is returned instead.
-
-@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer;
-label exit;
-var p:pointer; {newly allocated node}
-begin if font_bc[f]<=c then if font_ec[f]>=c then
- if char_exists(char_info(f)(qi(c))) then
- begin p:=get_avail; font(p):=f; character(p):=qi(c);
- new_character:=p; return;
- end;
-char_warning(f,c);
-new_character:=null;
-exit:end;
-
-@* \[31] Device-independent file format.
-The most important output produced by a run of \TeX\ is the ``device
-independent'' (\.{DVI}) file that specifies where characters and rules
-are to appear on printed pages. The form of these files was designed by
-David R. Fuchs in 1979. Almost any reasonable typesetting device can be
-@^Fuchs, David Raymond@>
-@:DVI_files}{\.{DVI} files@>
-driven by a program that takes \.{DVI} files as input, and dozens of such
-\.{DVI}-to-whatever programs have been written. Thus, it is possible to
-print the output of \TeX\ on many different kinds of equipment, using \TeX\
-as a device-independent ``front end.''
-
-A \.{DVI} file is a stream of 8-bit bytes, which may be regarded as a
-series of commands in a machine-like language. The first byte of each command
-is the operation code, and this code is followed by zero or more bytes
-that provide parameters to the command. The parameters themselves may consist
-of several consecutive bytes; for example, the `|set_rule|' command has two
-parameters, each of which is four bytes long. Parameters are usually
-regarded as nonnegative integers; but four-byte-long parameters,
-and shorter parameters that denote distances, can be
-either positive or negative. Such parameters are given in two's complement
-notation. For example, a two-byte-long distance parameter has a value between
-$-2^{15}$ and $2^{15}-1$. As in \.{TFM} files, numbers that occupy
-more than one byte position appear in BigEndian order.
-
-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 put_rule=137 {typeset a rule}
-@d nop=138 {no operation}
-@d bop=139 {beginning of page}
-@d eop=140 {ending of page}
-@d push=141 {save the current positions}
-@d pop=142 {restore previous positions}
-@d right1=143 {move right}
-@d w0=147 {move right by |w|}
-@d w1=148 {move right and set |w|}
-@d x0=152 {move right by |x|}
-@d x1=153 {move right and set |x|}
-@d down1=157 {move down}
-@d y0=161 {move down by |y|}
-@d y1=162 {move down and set |y|}
-@d z0=166 {move down by |z|}
-@d z1=167 {move down and set |z|}
-@d fnt_num_0=171 {set current font to 0}
-@d fnt1=235 {set current font}
-@d xxx1=239 {extension to \.{DVI} primitives}
-@d xxx4=242 {potentially long extension to \.{DVI} primitives}
-@d fnt_def1=243 {define the meaning of a font number}
-@d pre=247 {preamble}
-@d post=248 {postamble beginning}
-@d post_post=249 {postamble ending}
-
-@ 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:quarterword; {character and font in current |char_node|}
-@!rule_ht,@!rule_dp,@!rule_wd:scaled; {size of current rule being output}
-@!g:pointer; {current glue specification}
-@!lq,@!lr:integer; {quantities used in calculations for leaders}
-
-@ @<Set init...@>=
-total_pages:=0; max_v:=0; max_h:=0; max_push:=0; last_bop:=-1;
-doing_leaders:=false; dead_cycles:=0; cur_s:=-1;
-
-@ The \.{DVI} bytes are output to a buffer instead of being written directly
-to the output file. This makes it possible to reduce the overhead of
-subroutine calls, thereby measurably speeding up the computation, since
-output of \.{DVI} bytes is part of \TeX's inner loop. And it has another
-advantage as well, since we can change instructions in the buffer in order to
-make the output more compact. For example, a `|down2|' command can be
-changed to a `|y2|', thereby making a subsequent `|y0|' command possible,
-saving two bytes.
-
-The output buffer is divided into two parts of equal size; the bytes found
-in |dvi_buf[0..half_buf-1]| constitute the first half, and those in
-|dvi_buf[half_buf..dvi_buf_size-1]| constitute the second. The global
-variable |dvi_ptr| points to the position that will receive the next
-output byte. When |dvi_ptr| reaches |dvi_limit|, which is always equal
-to one of the two values |half_buf| or |dvi_buf_size|, the half buffer that
-is about to be invaded next is sent to the output and |dvi_limit| is
-changed to its other value. Thus, there is always at least a half buffer's
-worth of information present, except at the very beginning of the job.
-
-Bytes of the \.{DVI} file are numbered sequentially starting with 0;
-the next byte to be generated will be number |dvi_offset+dvi_ptr|.
-A byte is present in the buffer only if its number is |>=dvi_gone|.
-
-@<Types...@>=
-@!dvi_index=0..dvi_buf_size; {an index into the output buffer}
-
-@ Some systems may find it more efficient to make |dvi_buf| a |packed|
-array, since output of four bytes at once may be facilitated.
-@^system dependencies@>
-
-@<Glob...@>=
-@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
-@!half_buf:dvi_index; {half of |dvi_buf_size|}
-@!dvi_limit:dvi_index; {end of the current half buffer}
-@!dvi_ptr:dvi_index; {the next available buffer address}
-@!dvi_offset:integer; {|dvi_buf_size| times the number of times the
- output buffer has been fully emptied}
-@!dvi_gone:integer; {the number of bytes already output to |dvi_file|}
-
-@ Initially the buffer is all in one piece; we will output half of it only
-after it first fills up.
-
-@<Set init...@>=
-half_buf:=dvi_buf_size div 2; dvi_limit:=dvi_buf_size; dvi_ptr:=0;
-dvi_offset:=0; dvi_gone:=0;
-
-@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
-|write_dvi(a,b)|. For best results, this procedure should be optimized to
-run as fast as possible on each particular system, since it is part of
-\TeX's inner loop. It is safe to assume that |a| and |b+1| will both be
-multiples of 4 when |write_dvi(a,b)| is called; therefore it is possible on
-many machines to use efficient methods to pack four bytes per word and to
-output an array of words with one system call.
-@^system dependencies@>
-@^inner loop@>
-@^defecation@>
-
-@p procedure write_dvi(@!a,@!b:dvi_index);
-var k:dvi_index;
-begin for k:=a to b do write(dvi_file,dvi_buf[k]);
-end;
-
-@ To put a byte in the buffer without paying the cost of invoking a procedure
-each time, we use the macro |dvi_out|.
-
-@d dvi_out(#)==@+begin dvi_buf[dvi_ptr]:=#; incr(dvi_ptr);
- if dvi_ptr=dvi_limit then dvi_swap;
- end
-
-@p procedure dvi_swap; {outputs half of the buffer}
-begin if dvi_limit=dvi_buf_size then
- begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
- dvi_offset:=dvi_offset+dvi_buf_size; dvi_ptr:=0;
- end
-else begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
- end;
-dvi_gone:=dvi_gone+half_buf;
-end;
-
-@ Here is how we clean out the buffer when \TeX\ is all through; |dvi_ptr|
-will be a multiple of~4.
-
-@<Empty the last bytes out of |dvi_buf|@>=
-if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
-if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
-
-@ The |dvi_four| procedure outputs four bytes in two's complement notation,
-without risking arithmetic overflow.
-
-@p procedure dvi_four(@!x:integer);
-begin if x>=0 then dvi_out(x div @'100000000)
-else begin x:=x+@'10000000000;
- x:=x+@'10000000000;
- dvi_out((x div @'100000000) + 128);
- end;
-x:=x mod @'100000000; dvi_out(x div @'200000);
-x:=x mod @'200000; dvi_out(x div @'400);
-dvi_out(x mod @'400);
-end;
-
-@ A mild optimization of the output is performed by the |dvi_pop|
-routine, which issues a |pop| unless it is possible to cancel a
-`|push| |pop|' pair. The parameter to |dvi_pop| is the byte address
-following the old |push| that matches the new |pop|.
-
-@p procedure dvi_pop(@!l:integer);
-begin if (l=dvi_offset+dvi_ptr)and(dvi_ptr>0) then decr(dvi_ptr)
-else dvi_out(pop);
-end;
-
-@ Here's a procedure that outputs a font definition. Since \TeX82 uses at
-most 256 different fonts per job, |fnt_def1| is always used as the command code.
-
-@p procedure dvi_font_def(@!f:internal_font_number);
-var k:pool_pointer; {index into |str_pool|}
-begin dvi_out(fnt_def1);
-dvi_out(f-font_base-1);@/
-dvi_out(qo(font_check[f].b0));
-dvi_out(qo(font_check[f].b1));
-dvi_out(qo(font_check[f].b2));
-dvi_out(qo(font_check[f].b3));@/
-dvi_four(font_size[f]);
-dvi_four(font_dsize[f]);@/
-dvi_out(length(font_area[f]));
-dvi_out(length(font_name[f]));
-@<Output the font name whose internal number is |f|@>;
-end;
-
-@ @<Output the font name whose internal number is |f|@>=
-for k:=str_start[font_area[f]] to str_start[font_area[f]+1]-1 do
- dvi_out(so(str_pool[k]));
-for k:=str_start[font_name[f]] to str_start[font_name[f]+1]-1 do
- dvi_out(so(str_pool[k]))
-
-@ Versions of \TeX\ intended for small computers might well choose to omit
-the ideas in the next few parts of this program, since it is not really
-necessary to optimize the \.{DVI} code by making use of the |w0|, |x0|,
-|y0|, and |z0| commands. Furthermore, the algorithm that we are about to
-describe does not pretend to give an optimum reduction in the length
-of the \.{DVI} code; after all, speed is more important than compactness.
-But the method is surprisingly effective, and it takes comparatively little
-time.
-
-We can best understand the basic idea by first considering a simpler problem
-that has the same essential characteristics. Given a sequence of digits,
-say $3\,1\,4\,1\,5\,9\,2\,6\,5\,3\,5\,8\,9$, we want to assign subscripts
-$d$, $y$, or $z$ to each digit so as to maximize the number of ``$y$-hits''
-and ``$z$-hits''; a $y$-hit is an instance of two appearances of the same
-digit with the subscript $y$, where no $y$'s intervene between the two
-appearances, and a $z$-hit is defined similarly. For example, the sequence
-above could be decorated with subscripts as follows:
-$$3_z\,1_y\,4_d\,1_y\,5_y\,9_d\,2_d\,6_d\,5_y\,3_z\,5_y\,8_d\,9_d.$$
-There are three $y$-hits ($1_y\ldots1_y$ and $5_y\ldots5_y\ldots5_y$) and
-one $z$-hit ($3_z\ldots3_z$); there are no $d$-hits, since the two appearances
-of $9_d$ have $d$'s between them, but we don't count $d$-hits so it doesn't
-matter how many there are. These subscripts are analogous to the \.{DVI}
-commands called \\{down}, $y$, and $z$, and the digits are analogous to
-different amounts of vertical motion; a $y$-hit or $z$-hit corresponds to
-the opportunity to use the one-byte commands |y0| or |z0| in a \.{DVI} file.
-
-\TeX's method of assigning subscripts works like this: Append a new digit,
-say $\delta$, to the right of the sequence. Now look back through the
-sequence until one of the following things happens: (a)~You see
-$\delta_y$ or $\delta_z$, and this was the first time you encountered a
-$y$ or $z$ subscript, respectively. Then assign $y$ or $z$ to the new
-$\delta$; you have scored a hit. (b)~You see $\delta_d$, and no $y$
-subscripts have been encountered so far during this search. Then change
-the previous $\delta_d$ to $\delta_y$ (this corresponds to changing a
-command in the output buffer), and assign $y$ to the new $\delta$; it's
-another hit. (c)~You see $\delta_d$, and a $y$ subscript has been seen
-but not a $z$. Change the previous $\delta_d$ to $\delta_z$ and assign
-$z$ to the new $\delta$. (d)~You encounter both $y$ and $z$ subscripts
-before encountering a suitable $\delta$, or you scan all the way to the
-front of the sequence. Assign $d$ to the new $\delta$; this assignment may
-be changed later.
-
-The subscripts $3_z\,1_y\,4_d\ldots\,$ in the example above were, in fact,
-produced by this procedure, as the reader can verify. (Go ahead and try it.)
-
-@ In order to implement such an idea, \TeX\ maintains a stack of pointers
-to the \\{down}, $y$, and $z$ commands that have been generated for the
-current page. And there is a similar stack for \\{right}, |w|, and |x|
-commands. These stacks are called the down stack and right stack, and their
-top elements are maintained in the variables |down_ptr| and |right_ptr|.
-
-Each entry in these stacks contains four fields: The |width| field is
-the amount of motion down or to the right; the |location| field is the
-byte number of the \.{DVI} command in question (including the appropriate
-|dvi_offset|); the |link| field points to the next item below this one
-on the stack; and the |info| field encodes the options for possible change
-in the \.{DVI} command.
-
-@d movement_node_size=3 {number of words per entry in the down and right stacks}
-@d location(#)==mem[#+2].int {\.{DVI} byte number for a movement command}
-
-@<Glob...@>=
-@!down_ptr,@!right_ptr:pointer; {heads of the down and right stacks}
-
-@ @<Set init...@>=
-down_ptr:=null; right_ptr:=null;
-
-@ Here is a subroutine that produces a \.{DVI} command for some specified
-downward or rightward motion. It has two parameters: |w| is the amount
-of motion, and |o| is either |down1| or |right1|. We use the fact that
-the command codes have convenient arithmetic properties: |y1-down1=w1-right1|
-and |z1-down1=x1-right1|.
-
-@p procedure movement(@!w:scaled;@!o:eight_bits);
-label exit,found,not_found,2,1;
-var mstate:small_number; {have we seen a |y| or |z|?}
-@!p,@!q:pointer; {current and top nodes on the stack}
-@!k:integer; {index into |dvi_buf|, modulo |dvi_buf_size|}
-begin q:=get_node(movement_node_size); {new node for the top of the stack}
-width(q):=w; location(q):=dvi_offset+dvi_ptr;
-if o=down1 then
- begin link(q):=down_ptr; down_ptr:=q;
- end
-else begin link(q):=right_ptr; right_ptr:=q;
- end;
-@<Look at the other stack entries until deciding what sort of \.{DVI} command
- to generate; |goto found| if node |p| is a ``hit''@>;
-@<Generate a |down| or |right| command for |w| and |return|@>;
-found: @<Generate a |y0| or |z0| command in order to reuse a previous
- appearance of~|w|@>;
-exit:end;
-
-@ The |info| fields in the entries of the down stack or the right stack
-have six possible settings: |y_here| or |z_here| mean that the \.{DVI}
-command refers to |y| or |z|, respectively (or to |w| or |x|, in the
-case of horizontal motion); |yz_OK| means that the \.{DVI} command is
-\\{down} (or \\{right}) but can be changed to either |y| or |z| (or
-to either |w| or |x|); |y_OK| means that it is \\{down} and can be changed
-to |y| but not |z|; |z_OK| is similar; and |d_fixed| means it must stay
-\\{down}.
-
-The four settings |yz_OK|, |y_OK|, |z_OK|, |d_fixed| would not need to
-be distinguished from each other if we were simply solving the
-digit-subscripting problem mentioned above. But in \TeX's case there is
-a complication because of the nested structure of |push| and |pop|
-commands. Suppose we add parentheses to the digit-subscripting problem,
-redefining hits so that $\delta_y\ldots \delta_y$ is a hit if all $y$'s between
-the $\delta$'s are enclosed in properly nested parentheses, and if the
-parenthesis level of the right-hand $\delta_y$ is deeper than or equal to
-that of the left-hand one. Thus, `(' and `)' correspond to `|push|'
-and `|pop|'. Now if we want to assign a subscript to the final 1 in the
-sequence
-$$2_y\,7_d\,1_d\,(\,8_z\,2_y\,8_z\,)\,1$$
-we cannot change the previous $1_d$ to $1_y$, since that would invalidate
-the $2_y\ldots2_y$ hit. But we can change it to $1_z$, scoring a hit
-since the intervening $8_z$'s are enclosed in parentheses.
-
-The program below removes movement nodes that are introduced after a |push|,
-before it outputs the corresponding |pop|.
-
-@d y_here=1 {|info| when the movement entry points to a |y| command}
-@d z_here=2 {|info| when the movement entry points to a |z| command}
-@d yz_OK=3 {|info| corresponding to an unconstrained \\{down} command}
-@d y_OK=4 {|info| corresponding to a \\{down} that can't become a |z|}
-@d z_OK=5 {|info| corresponding to a \\{down} that can't become a |y|}
-@d d_fixed=6 {|info| corresponding to a \\{down} that can't change}
-
-@ When the |movement| procedure gets to the label |found|, the value of
-|info(p)| will be either |y_here| or |z_here|. If it is, say, |y_here|,
-the procedure generates a |y0| command (or a |w0| command), and marks
-all |info| fields between |q| and |p| so that |y| is not OK in that range.
-
-@<Generate a |y0| or |z0| command...@>=
-info(q):=info(p);
-if info(q)=y_here then
- begin dvi_out(o+y0-down1); {|y0| or |w0|}
- while link(q)<>p do
- begin q:=link(q);
- case info(q) of
- yz_OK: info(q):=z_OK;
- y_OK: info(q):=d_fixed;
- othercases do_nothing
- endcases;
- end;
- end
-else begin dvi_out(o+z0-down1); {|z0| or |x0|}
- while link(q)<>p do
- begin q:=link(q);
- case info(q) of
- yz_OK: info(q):=y_OK;
- z_OK: info(q):=d_fixed;
- othercases do_nothing
- endcases;
- end;
- end
-
-@ @<Generate a |down| or |right|...@>=
-info(q):=yz_OK;
-if abs(w)>=@'40000000 then
- begin dvi_out(o+3); {|down4| or |right4|}
- dvi_four(w); return;
- end;
-if abs(w)>=@'100000 then
- begin dvi_out(o+2); {|down3| or |right3|}
- if w<0 then w:=w+@'100000000;
- dvi_out(w div @'200000); w:=w mod @'200000; goto 2;
- end;
-if abs(w)>=@'200 then
- begin dvi_out(o+1); {|down2| or |right2|}
- if w<0 then w:=w+@'200000;
- goto 2;
- end;
-dvi_out(o); {|down1| or |right1|}
-if w<0 then w:=w+@'400;
-goto 1;
-2: dvi_out(w div @'400);
-1: dvi_out(w mod @'400); return
-
-@ As we search through the stack, we are in one of three states,
-|y_seen|, |z_seen|, or |none_seen|, depending on whether we have
-encountered |y_here| or |z_here| nodes. These states are encoded as
-multiples of 6, so that they can be added to the |info| fields for quick
-decision-making.
-@^inner loop@>
-
-@d none_seen=0 {no |y_here| or |z_here| nodes have been encountered yet}
-@d y_seen=6 {we have seen |y_here| but not |z_here|}
-@d z_seen=12 {we have seen |z_here| but not |y_here|}
-
-@<Look at the other stack entries until deciding...@>=
-p:=link(q); mstate:=none_seen;
-while p<>null do
- begin if width(p)=w then @<Consider a node with matching width;
- |goto found| if it's a hit@>
- else case mstate+info(p) of
- none_seen+y_here: mstate:=y_seen;
- none_seen+z_here: mstate:=z_seen;
- y_seen+z_here,z_seen+y_here: goto not_found;
- othercases do_nothing
- endcases;
- p:=link(p);
- end;
-not_found:
-
-@ We might find a valid hit in a |y| or |z| byte that is already gone
-from the buffer. But we can't change bytes that are gone forever; ``the
-moving finger writes, $\ldots\,\,$.''
-
-@<Consider a node with matching width...@>=
-case mstate+info(p) of
-none_seen+yz_OK,none_seen+y_OK,z_seen+yz_OK,z_seen+y_OK:@t@>@;@/
- if location(p)<dvi_gone then goto not_found
- else @<Change buffered instruction to |y| or |w| and |goto found|@>;
-none_seen+z_OK,y_seen+yz_OK,y_seen+z_OK:@t@>@;@/
- if location(p)<dvi_gone then goto not_found
- else @<Change buffered instruction to |z| or |x| and |goto found|@>;
-none_seen+y_here,none_seen+z_here,y_seen+z_here,z_seen+y_here: goto found;
-othercases do_nothing
-endcases
-
-@ @<Change buffered instruction to |y| or |w| and |goto found|@>=
-begin k:=location(p)-dvi_offset;
-if k<0 then k:=k+dvi_buf_size;
-dvi_buf[k]:=dvi_buf[k]+y1-down1;
-info(p):=y_here; goto found;
-end
-
-@ @<Change buffered instruction to |z| or |x| and |goto found|@>=
-begin k:=location(p)-dvi_offset;
-if k<0 then k:=k+dvi_buf_size;
-dvi_buf[k]:=dvi_buf[k]+z1-down1;
-info(p):=z_here; goto found;
-end
-
-@ In case you are wondering when all the movement nodes are removed from
-\TeX's memory, the answer is that they are recycled just before
-|hlist_out| and |vlist_out| finish outputting a box. This restores the
-down and right stacks to the state they were in before the box was output,
-except that some |info|'s may have become more restrictive.
-
-@p procedure prune_movements(@!l:integer);
- {delete movement nodes with |location>=l|}
-label done,exit;
-var p:pointer; {node being deleted}
-begin while down_ptr<>null do
- begin if location(down_ptr)<l then goto done;
- p:=down_ptr; down_ptr:=link(p); free_node(p,movement_node_size);
- end;
-done: while right_ptr<>null do
- begin if location(right_ptr)<l then return;
- p:=right_ptr; right_ptr:=link(p); free_node(p,movement_node_size);
- end;
-exit:end;
-
-@ The actual distances by which we want to move might be computed as the
-sum of several separate movements. For example, there might be several
-glue nodes in succession, or we might want to move right by the width of
-some box plus some amount of glue. More importantly, the baselineskip
-distances are computed in terms of glue together with the depth and
-height of adjacent boxes, and we want the \.{DVI} file to lump these
-three quantities together into a single motion.
-
-Therefore, \TeX\ maintains two pairs of global variables: |dvi_h| and |dvi_v|
-are the |h| and |v| coordinates corresponding to the commands actually
-output to the \.{DVI} file, while |cur_h| and |cur_v| are the coordinates
-corresponding to the current state of the output routines. Coordinate
-changes will accumulate in |cur_h| and |cur_v| without being reflected
-in the output, until such a change becomes necessary or desirable; we
-can call the |movement| procedure whenever we want to make |dvi_h=cur_h|
-or |dvi_v=cur_v|.
-
-The current font reflected in the \.{DVI} output is called |dvi_f|;
-there is no need for a `\\{cur\_f}' variable.
-
-The depth of nesting of |hlist_out| and |vlist_out| is called |cur_s|;
-this is essentially the depth of |push| commands in the \.{DVI} output.
-
-For mixed direction text (\TeXXeT) the current text direction is called
-|cur_dir|. As the box being shipped out will never be used again and
-soon be recycled, we can simply reverse any R-text (i.e., right-to-left)
-segments of hlist nodes as well as complete hlist nodes embedded in such
-segments. Moreover this can be done iteratively rather than recursively.
-There are, however, two complications related to leaders that require
-some additional bookkeeping: (1)~One and the same hlist node might be
-used more than once (but never inside both L- and R-text); and
-(2)~leader boxes inside hlists must be aligned with respect to the left
-edge of the original hlist.
-
-A math node is changed into a kern node whenever the text direction
-remains the same, it is replaced by an |edge_node| if the text direction
-changes; the subtype of an an |hlist_node| inside R-text is changed to
-|reversed| once its hlist has been reversed.
-@!@^data structure assumptions@>
-
-@d reversed=1 {subtype for an |hlist_node| whose hlist has been reversed}
-@d dlist=2 {subtype for an |hlist_node| from display math mode}
-@d box_lr(#) == (qo(subtype(#))) {direction mode of a box}
-@d set_box_lr(#) == subtype(#):=set_box_lr_end
-@d set_box_lr_end(#) == qi(#)
-@#
-@d left_to_right=0
-@d right_to_left=1
-@d reflected==1-cur_dir {the opposite of |cur_dir|}
-@#
-@d synch_h==if cur_h<>dvi_h then
- begin movement(cur_h-dvi_h,right1); dvi_h:=cur_h;
- end
-@d synch_v==if cur_v<>dvi_v then
- begin movement(cur_v-dvi_v,down1); dvi_v:=cur_v;
- end
-
-@<Glob...@>=
-@!dvi_h,@!dvi_v:scaled; {a \.{DVI} reader program thinks we are here}
-@!cur_h,@!cur_v:scaled; {\TeX\ thinks we are here}
-@!dvi_f:internal_font_number; {the current font}
-@!cur_s:integer; {current depth of output box nesting, initially $-1$}
-
-@ @<Calculate DVI page dimensions and margins@>=
-cur_h_offset := h_offset;
-cur_v_offset := v_offset;
-if pdf_page_width <> 0 then
- cur_page_width := pdf_page_width
-else
- cur_page_width := width(p) + 2*cur_h_offset + 2*4736286;
- {4736286 = 1in, the funny DVI origin offset}
-if pdf_page_height <> 0 then
- cur_page_height := pdf_page_height
-else
- cur_page_height := height(p) + depth(p) + 2*cur_v_offset + 2*4736286
- {4736286 = 1in, the funny DVI origin offset}
-
-@ @<Initialize variables as |ship_out| begins@>=
-dvi_h:=0; dvi_v:=0; cur_h:=h_offset; 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(" TeX 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[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[s]));
- pool_ptr:=str_start[str_ptr]; {flush the current string}
- end
-
-@ When |hlist_out| is called, its duty is to output the box represented
-by the |hlist_node| pointed to by |temp_ptr|. The reference point of that
-box has coordinates |(cur_h,cur_v)|.
-
-Similarly, when |vlist_out| is called, its duty is to output the box represented
-by the |vlist_node| pointed to by |temp_ptr|. The reference point of that
-box has coordinates |(cur_h,cur_v)|.
-@^recursion@>
-
-@p procedure@?vlist_out; forward; {|hlist_out| and |vlist_out| are mutually
- recursive}
-
-@ The recursive procedures |hlist_out| and |vlist_out| each have local variables
-|save_h| and |save_v| to hold the values of |dvi_h| and |dvi_v| just before
-entering a new level of recursion. In effect, the values of |save_h| and
-|save_v| on \TeX's run-time stack correspond to the values of |h| and |v|
-that a \.{DVI}-reading program will push onto its coordinate stack.
-
-@d move_past=13 {go to this label when advancing past glue or a rule}
-@d fin_rule=14 {go to this label to finish processing a rule}
-@d next_p=15 {go to this label when finished with node |p|}
-
-@p @t\4@>@<Declare procedures needed in |hlist_out|, |vlist_out|@>@t@>@/
-procedure hlist_out; {output an |hlist_node| box}
-label reswitch, move_past, fin_rule, next_p;
-var base_line: scaled; {the baseline coordinate for this box}
-@!left_edge: scaled; {the left coordinate for this box}
-@!save_h,@!save_v: scaled; {what |dvi_h| and |dvi_v| should pop to}
-@!this_box: pointer; {pointer to containing box}
-@!g_order: glue_ord; {applicable order of infinity for glue}
-@!g_sign: normal..shrinking; {selects type of glue}
-@!p:pointer; {current position in the hlist}
-@!save_loc:integer; {\.{DVI} byte location upon entry}
-@!leader_box:pointer; {the leader box being replicated}
-@!leader_wd:scaled; {width of leader box being replicated}
-@!lx:scaled; {extra space between leader boxes}
-@!outer_doing_leaders:boolean; {were we doing leaders?}
-@!edge:scaled; {right edge of sub-box or leader space}
-@!prev_p:pointer; {one step behind |p|}
-@!glue_temp:real; {glue value before rounding}
-@!cur_glue:real; {glue seen so far}
-@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
-begin cur_g:=0; cur_glue:=float_constant(0);
-this_box:=temp_ptr; g_order:=glue_order(this_box);
-g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
-incr(cur_s);
-if cur_s>0 then dvi_out(push);
-if cur_s>max_push then max_push:=cur_s;
-save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v;
-prev_p:=this_box+list_offset;
-@<Initialize |hlist_out| for mixed direction typesetting@>;
-left_edge:=cur_h;
-while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
- maintaining the condition |cur_v=base_line|@>;
-@<Finish |hlist_out| for mixed direction typesetting@>;
-prune_movements(save_loc);
-if cur_s>0 then dvi_pop(save_loc);
-decr(cur_s);
-end;
-
-@ We ought to give special care to the efficiency of one part of |hlist_out|,
-since it belongs to \TeX's inner loop. When a |char_node| is encountered,
-we save a little time by processing several nodes in succession until
-reaching a non-|char_node|. The program uses the fact that |set_char_0=0|.
-@^inner loop@>
-
-@<Output node |p| for |hlist_out|...@>=
-reswitch: if is_char_node(p) then
- begin synch_h; synch_v;
- repeat f:=font(p); c:=character(p);
- if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
- if c>=qi(128) then dvi_out(set1);
- dvi_out(qo(c));@/
- cur_h:=cur_h+char_width(f)(char_info(f)(c));
- prev_p:=link(prev_p); {N.B.: not |prev_p:=p|, |p| might be |lig_trick|}
- p:=link(p);
- until not is_char_node(p);
- dvi_h:=cur_h;
- end
-else @<Output the non-|char_node| |p| for |hlist_out|
- and move to the next node@>
-
-@ @<Change font |dvi_f| to |f|@>=
-begin if not font_used[f] then
- begin dvi_font_def(f); font_used[f]:=true;
- end;
-if f<=64+font_base then dvi_out(f-font_base-1+fnt_num_0)
-else begin dvi_out(fnt1); dvi_out(f-font_base-1);
- end;
-dvi_f:=f;
-end
-
-@ @<Output the non-|char_node| |p| for |hlist_out|...@>=
-begin case type(p) of
-hlist_node,vlist_node:@<Output a box in an hlist@>;
-rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
- goto fin_rule;
- end;
-whatsit_node: @<Output the whatsit node |p| in an hlist@>;
-glue_node: @<Move right or output leaders@>;
-margin_kern_node,
-kern_node:cur_h:=cur_h+width(p);
-math_node: @<Handle a math node in |hlist_out|@>;
-ligature_node: @<Make node |p| look like a |char_node| and |goto reswitch|@>;
-@/@<Cases of |hlist_out| that arise in mixed direction text only@>@;
-othercases do_nothing
-endcases;@/
-goto next_p;
-fin_rule: @<Output a rule in an hlist@>;
-move_past: cur_h:=cur_h+rule_wd;
-next_p:prev_p:=p; p:=link(p);
-end
-
-@ @<Output a box in an hlist@>=
-if list_ptr(p)=null then cur_h:=cur_h+width(p)
-else begin save_h:=dvi_h; save_v:=dvi_v;
- cur_v:=base_line+shift_amount(p); {shift the box down}
- temp_ptr:=p; edge:=cur_h+width(p);
- if cur_dir=right_to_left then cur_h:=edge;
- if type(p)=vlist_node then vlist_out@+else hlist_out;
- dvi_h:=save_h; dvi_v:=save_v;
- cur_h:=edge; cur_v:=base_line;
- end
-
-@ @<Output a rule in an hlist@>=
-if is_running(rule_ht) then rule_ht:=height(this_box);
-if is_running(rule_dp) then rule_dp:=depth(this_box);
-rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
-if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
- begin synch_h; cur_v:=base_line+rule_dp; synch_v;
- dvi_out(set_rule); dvi_four(rule_ht); dvi_four(rule_wd);
- cur_v:=base_line; dvi_h:=dvi_h+rule_wd;
- end
-
-@ @d billion==float_constant(1000000000)
-@d vet_glue(#)== glue_temp:=#;
- if glue_temp>billion then
- glue_temp:=billion
- else if glue_temp<-billion then
- glue_temp:=-billion
-@#
-@d round_glue==g:=glue_ptr(p); rule_wd:=width(g)-cur_g;
-if g_sign<>normal then
- begin if g_sign=stretching then
- begin if stretch_order(g)=g_order then
- begin cur_glue:=cur_glue+stretch(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
-@^real multiplication@>
- cur_g:=round(glue_temp);
- end;
- end
- else if shrink_order(g)=g_order then
- begin cur_glue:=cur_glue-shrink(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
- cur_g:=round(glue_temp);
- end;
- end;
-rule_wd:=rule_wd+cur_g
-
-@<Move right or output leaders@>=
-begin round_glue;
-if eTeX_ex then @<Handle a glue node for mixed direction typesetting@>;
-if subtype(p)>=a_leaders then
- @<Output leaders in an hlist, |goto fin_rule| if a rule
- or to |next_p| if done@>;
-goto move_past;
-end
-
-@ @<Output leaders in an hlist...@>=
-begin leader_box:=leader_ptr(p);
-if type(leader_box)=rule_node then
- begin rule_ht:=height(leader_box); rule_dp:=depth(leader_box);
- goto fin_rule;
- end;
-leader_wd:=width(leader_box);
-if (leader_wd>0)and(rule_wd>0) then
- begin rule_wd:=rule_wd+10; {compensate for floating-point rounding}
- if cur_dir=right_to_left then cur_h:=cur_h-10;
- edge:=cur_h+rule_wd; lx:=0;
- @<Let |cur_h| be the position of the first box, and set |leader_wd+lx|
- to the spacing between corresponding parts of boxes@>;
- while cur_h+leader_wd<=edge do
- @<Output a leader box at |cur_h|,
- then advance |cur_h| by |leader_wd+lx|@>;
- if cur_dir=right_to_left then cur_h:=edge
- else cur_h:=edge-10;
- goto next_p;
- end;
-end
-
-@ The calculations related to leaders require a bit of care. First, in the
-case of |a_leaders| (aligned leaders), we want to move |cur_h| to
-|left_edge| plus the smallest multiple of |leader_wd| for which the result
-is not less than the current value of |cur_h|; i.e., |cur_h| should become
-$|left_edge|+|leader_wd|\times\lceil
-(|cur_h|-|left_edge|)/|leader_wd|\rceil$. The program here should work in
-all cases even though some implementations of \PASCAL\ give nonstandard
-results for the |div| operation when |cur_h| is less than |left_edge|.
-
-In the case of |c_leaders| (centered leaders), we want to increase |cur_h|
-by half of the excess space not occupied by the leaders; and in the
-case of |x_leaders| (expanded leaders) we increase |cur_h|
-by $1/(q+1)$ of this excess space, where $q$ is the number of times the
-leader box will be replicated. Slight inaccuracies in the division might
-accumulate; half of this rounding error is placed at each end of the leaders.
-
-@<Let |cur_h| be the position of the first box, ...@>=
-if subtype(p)=a_leaders then
- begin save_h:=cur_h;
- cur_h:=left_edge+leader_wd*((cur_h-left_edge)@!div leader_wd);
- if cur_h<save_h then cur_h:=cur_h+leader_wd;
- end
-else begin lq:=rule_wd div leader_wd; {the number of box copies}
- lr:=rule_wd mod leader_wd; {the remaining space}
- if subtype(p)=c_leaders then cur_h:=cur_h+(lr div 2)
- else begin lx:=lr div (lq+1);
- cur_h:=cur_h+((lr-(lq-1)*lx) div 2);
- end;
- end
-
-@ The `\\{synch}' operations here are intended to decrease the number of
-bytes needed to specify horizontal and vertical motion in the \.{DVI} output.
-
-@<Output a leader box at |cur_h|, ...@>=
-begin cur_v:=base_line+shift_amount(leader_box); synch_v; save_v:=dvi_v;@/
-synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
-if cur_dir=right_to_left then cur_h:=cur_h+leader_wd;
-outer_doing_leaders:=doing_leaders; doing_leaders:=true;
-if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
-doing_leaders:=outer_doing_leaders;
-dvi_v:=save_v; dvi_h:=save_h; cur_v:=base_line;
-cur_h:=save_h+leader_wd+lx;
-end
-
-@ The |vlist_out| routine is similar to |hlist_out|, but a bit simpler.
-
-@p procedure vlist_out; {output a |vlist_node| box}
-label move_past, fin_rule, next_p;
-var left_edge: scaled; {the left coordinate for this box}
-@!top_edge: scaled; {the top coordinate for this box}
-@!save_h,@!save_v: scaled; {what |dvi_h| and |dvi_v| should pop to}
-@!this_box: pointer; {pointer to containing box}
-@!g_order: glue_ord; {applicable order of infinity for glue}
-@!g_sign: normal..shrinking; {selects type of glue}
-@!p:pointer; {current position in the vlist}
-@!save_loc:integer; {\.{DVI} byte location upon entry}
-@!leader_box:pointer; {the leader box being replicated}
-@!leader_ht:scaled; {height of leader box being replicated}
-@!lx:scaled; {extra space between leader boxes}
-@!outer_doing_leaders:boolean; {were we doing leaders?}
-@!edge:scaled; {bottom boundary of leader space}
-@!glue_temp:real; {glue value before rounding}
-@!cur_glue:real; {glue seen so far}
-@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
-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);
-incr(cur_s);
-if cur_s>0 then dvi_out(push);
-if cur_s>max_push then max_push:=cur_s;
-save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; cur_v:=cur_v-height(this_box);
-top_edge:=cur_v;
-while p<>null do @<Output node |p| for |vlist_out| and move to the next node,
- maintaining the condition |cur_h=left_edge|@>;
-prune_movements(save_loc);
-if cur_s>0 then dvi_pop(save_loc);
-decr(cur_s);
-end;
-
-@ @<Output node |p| for |vlist_out|...@>=
-begin if is_char_node(p) then confusion("vlistout")
-@:this can't happen vlistout}{\quad vlistout@>
-else @<Output the non-|char_node| |p| for |vlist_out|@>;
-next_p:p:=link(p);
-end
-
-@ @<Output the non-|char_node| |p| for |vlist_out|@>=
-begin case type(p) of
-hlist_node,vlist_node:@<Output a box in a vlist@>;
-rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
- goto fin_rule;
- end;
-whatsit_node: @<Output the whatsit node |p| in a vlist@>;
-glue_node: @<Move down or output leaders@>;
-kern_node: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@>=
-if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p)
-else begin cur_v:=cur_v+height(p); synch_v;
- save_h:=dvi_h; save_v:=dvi_v;
- if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p)
- else cur_h:=left_edge+shift_amount(p); {shift the box right}
- temp_ptr:=p;
- if type(p)=vlist_node then vlist_out@+else hlist_out;
- dvi_h:=save_h; dvi_v:=save_v;
- cur_v:=save_v+depth(p); cur_h:=left_edge;
- end
-
-@ @<Output a rule in a vlist...@>=
-if is_running(rule_wd) then rule_wd:=width(this_box);
-rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
-cur_v:=cur_v+rule_ht;
-if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
- begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd;
- synch_h; synch_v;
- dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
- cur_h:=left_edge;
- end;
-goto next_p
-
-@ @<Move down or output leaders@>=
-begin g:=glue_ptr(p); rule_ht:=width(g)-cur_g;
-if g_sign<>normal then
- begin if g_sign=stretching then
- begin if stretch_order(g)=g_order then
- begin cur_glue:=cur_glue+stretch(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
-@^real multiplication@>
- cur_g:=round(glue_temp);
- end;
- end
- else if shrink_order(g)=g_order then
- begin cur_glue:=cur_glue-shrink(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
- cur_g:=round(glue_temp);
- end;
- end;
-rule_ht:=rule_ht+cur_g;
-if subtype(p)>=a_leaders then
- @<Output leaders in a vlist, |goto fin_rule| if a rule
- or to |next_p| if done@>;
-goto move_past;
-end
-
-@ @<Output leaders in a vlist...@>=
-begin leader_box:=leader_ptr(p);
-if type(leader_box)=rule_node then
- begin rule_wd:=width(leader_box); rule_dp:=0;
- goto fin_rule;
- end;
-leader_ht:=height(leader_box)+depth(leader_box);
-if (leader_ht>0)and(rule_ht>0) then
- begin rule_ht:=rule_ht+10; {compensate for floating-point rounding}
- edge:=cur_v+rule_ht; lx:=0;
- @<Let |cur_v| be the position of the first box, and set |leader_ht+lx|
- to the spacing between corresponding parts of boxes@>;
- while cur_v+leader_ht<=edge do
- @<Output a leader box at |cur_v|,
- then advance |cur_v| by |leader_ht+lx|@>;
- cur_v:=edge-10; goto next_p;
- end;
-end
-
-@ @<Let |cur_v| be the position of the first box, ...@>=
-if subtype(p)=a_leaders then
- begin save_v:=cur_v;
- cur_v:=top_edge+leader_ht*((cur_v-top_edge)@!div leader_ht);
- if cur_v<save_v then cur_v:=cur_v+leader_ht;
- end
-else begin lq:=rule_ht div leader_ht; {the number of box copies}
- lr:=rule_ht mod leader_ht; {the remaining space}
- if subtype(p)=c_leaders then cur_v:=cur_v+(lr div 2)
- else begin lx:=lr div (lq+1);
- cur_v:=cur_v+((lr-(lq-1)*lx) div 2);
- end;
- end
-
-@ When we reach this part of the program, |cur_v| indicates the top of a
-leader box, not its baseline.
-
-@<Output a leader box at |cur_v|, ...@>=
-begin if cur_dir=right_to_left then
- cur_h:=left_edge-shift_amount(leader_box)
- else cur_h:=left_edge+shift_amount(leader_box);
-synch_h; save_h:=dvi_h;@/
-cur_v:=cur_v+height(leader_box); synch_v; save_v:=dvi_v;
-temp_ptr:=leader_box;
-outer_doing_leaders:=doing_leaders; doing_leaders:=true;
-if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
-doing_leaders:=outer_doing_leaders;
-dvi_v:=save_v; dvi_h:=save_h; cur_h:=left_edge;
-cur_v:=save_v-height(leader_box)+leader_ht+lx;
-end
-
-@ The |hlist_out| and |vlist_out| procedures are now complete, so we are
-ready for the |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}
-begin if tracing_output>0 then
- begin print_nl(""); print_ln;
- print("Completed box being shipped out");
-@.Completed box...@>
- end;
-if term_offset>max_print_line-9 then print_ln
-else if (term_offset>0)or(file_offset>0) then print_char(" ");
-print_char("["); j:=9;
-while (count(j)=0)and(j>0) do decr(j);
-for k:=0 to j do
- begin print_int(count(k));
- if k<j then print_char(".");
- end;
-update_terminal;
-if tracing_output>0 then
- begin print_char("]");
- begin_diagnostic; show_box(p); end_diagnostic(true);
- end;
-@<Ship box |p| out@>;
-if eTeX_ex then @<Check for LR anomalies at the end of |ship_out|@>;
-if tracing_output<=0 then print_char("]");
-dead_cycles:=0;
-update_terminal; {progress report}
-@<Flush the box from memory, showing statistics if requested@>;
-end;
-
-@ @<Flush the box from memory, showing statistics if requested@>=
-@!stat if tracing_stats>1 then
- begin print_nl("Memory usage before: ");
-@.Memory usage...@>
- print_int(var_used); print_char("&");
- print_int(dyn_used); print_char(";");
- end;
-tats@/
-flush_node_list(p);
-@!stat if tracing_stats>1 then
- begin print(" after: ");
- print_int(var_used); print_char("&");
- print_int(dyn_used); print("; still untouched: ");
- print_int(hi_mem_min-lo_mem_max-1); print_ln;
- end;
-tats
-
-@ @<Ship box |p| out@>=
-@<Update the values of |max_h| and |max_v|; but if the page is too large,
- |goto done|@>;
-@<Initialize variables as |ship_out| begins@>;
-page_loc:=dvi_offset+dvi_ptr;
-dvi_out(bop);
-for k:=0 to 9 do dvi_four(count(k));
-dvi_four(last_bop); last_bop:=page_loc;
-cur_v:=height(p)+v_offset; 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 print_nl("No pages of output.")
-@.No pages of output@>
-else begin dvi_out(post); {beginning of the postamble}
- dvi_four(last_bop); last_bop:=dvi_offset+dvi_ptr-5; {|post| location}
- dvi_four(25400000); dvi_four(473628672); {conversion ratio for sp}
- prepare_mag; dvi_four(mag); {magnification factor}
- dvi_four(max_v); dvi_four(max_h);@/
- dvi_out(max_push div 256); dvi_out(max_push mod 256);@/
- dvi_out((total_pages div 256) mod 256); dvi_out(total_pages mod 256);@/
- @<Output the font definitions for all fonts that were used@>;
- dvi_out(post_post); dvi_four(last_bop); dvi_out(id_byte);@/
- k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
- while k>0 do
- begin dvi_out(223); decr(k);
- end;
- @<Empty the last bytes out of |dvi_buf|@>;
- print_nl("Output written on "); slow_print(output_file_name);
-@.Output written on x@>
- print(" ("); print_int(total_pages); print(" page");
- if total_pages<>1 then print_char("s");
- print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes).");
- b_close(dvi_file);
- end
-
-@ @<Output the font definitions...@>=
-while font_ptr>font_base do
- begin if font_used[font_ptr] then dvi_font_def(font_ptr);
- decr(font_ptr);
- end
-
-
-@* \[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_hundred_inch + 50) div 100;
-pdf_v_origin := (one_hundred_inch + 50) div 100;
-pdf_compress_level := 9;
-pdf_objcompresslevel := 0;
-pdf_decimal_digits := 3;
-pdf_image_resolution := 72;
-pdf_major_version := 1;
-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(#)==((font_bc[f] <= #) and (# <= font_ec[f]) and
- char_exists(char_info(f)(#)))
-
-@p function get_pdf_compress_level: integer;
-begin
- get_pdf_compress_level := pdf_compress_level;
-end;
-
-function get_pdf_suppress_warning_dup_map: integer;
-begin
- get_pdf_suppress_warning_dup_map := pdf_suppress_warning_dup_map;
-end;
-
-function get_pdf_suppress_warning_page_group: integer;
-begin
- get_pdf_suppress_warning_page_group := pdf_suppress_warning_page_group;
-end;
-
-function get_pdf_suppress_ptex_info: integer;
-begin
- get_pdf_suppress_ptex_info := pdf_suppress_ptex_info;
-end;
-
-function get_pdf_omit_charset: integer;
-begin
- get_pdf_omit_charset := pdf_omit_charset;
-end;
-
-function get_nullfont: internal_font_number;
-begin
- get_nullfont := null_font;
-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: eight_bits): scaled;
-begin
- if is_valid_char(c) then
- get_charwidth := char_width(f)(char_info(f)(c))
- else
- get_charwidth := 0;
-end;
-
-function get_charheight(f: internal_font_number; c: eight_bits): scaled;
-begin
- if is_valid_char(c) then
- get_charheight := char_height(f)(height_depth(char_info(f)(c)))
- else
- get_charheight := 0;
-end;
-
-function get_chardepth(f: internal_font_number; c: eight_bits): scaled;
-begin
- if is_valid_char(c) then
- get_chardepth := char_depth(f)(height_depth(char_info(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);
-end;
-
-@ Helper for debugging purposes:
-
-@p procedure short_display_n(@!p, m:integer); {prints highlights of list |p|}
-var n:integer; {for replacement counts}
- i: integer;
-begin
-i := 0;
-font_in_short_display:=null_font;
-if p = null then
- return;
-while p>mem_min do
- begin if is_char_node(p) then
- begin if p<=mem_end then
- begin if font(p)<>font_in_short_display then
- begin if (font(p)<font_base)or(font(p)>font_max) then
- print_char("*")
-@.*\relax@>
- else print_font_identifier(font(p));
- print_char(" "); font_in_short_display:=font(p);
- end;
- print_ASCII(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(pre_break(p));
- print("|");
- short_display(post_break(p));
- print("|");
- n:=replace_count(p);
- while n>0 do
- begin if link(p)<>null then p:=link(p);
- decr(n);
- end;
- end
- else
- @<Print a short indication of the contents of node |p|@>;
- end;
- p:=link(p);
- if p = null then
- return;
- end;
- update_terminal;
-end;
-
-@ Sometimes it is necessary 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 := xrealloc_array(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 similar subroutines to handle the output buffer for
-PDF output. When compress is used, the state of writing to buffer
-is held in |zip_write_state|. We must write the header of PDF
-output file in initialization to ensure that it will be the first
-written bytes.
-
-@<Constants...@>=
-@!pdf_op_buf_size = 16384; {size of the PDF output buffer}
-@!inf_pdf_os_buf_size = 1; {initial value of |pdf_os_buf_size|}
-@!sup_pdf_os_buf_size = 5000000; {arbitrary upper hard limit of |pdf_os_buf_size|}
-@!pdf_os_max_objs = 100; {maximum number of objects in object stream}
-
-@ The following macros are similar as for \.{DVI} buffer handling:
-
-@d pdf_offset == (pdf_gone + pdf_ptr) {the file offset of last byte in PDF
-buffer that |pdf_ptr| points to}
-
-@d no_zip == 0 {no \.{ZIP} compression}
-@d zip_writing == 1 {\.{ZIP} compression being used}
-@d zip_finish == 2 {finish \.{ZIP} compression}
-
-@d pdf_quick_out(#) == {output a byte to PDF buffer without checking of
-overflow}
-begin
- pdf_buf[pdf_ptr] := #;
- incr(pdf_ptr);
-end
-
-@d pdf_room(#) == {make sure that there are at least |n| bytes free in PDF buffer}
-begin
- if pdf_os_mode and (# + pdf_ptr > pdf_buf_size) then
- pdf_os_get_os_buf(#)
- else if not pdf_os_mode and (# > pdf_buf_size) then
- overflow("PDF output buffer", pdf_op_buf_size)
- else if not pdf_os_mode and (# + pdf_ptr > pdf_buf_size) then
- pdf_flush;
-end
-
-@d pdf_out(#) == {do the same as |pdf_quick_out| and flush the PDF
-buffer if necessary}
-begin
- pdf_room(1);
- pdf_quick_out(#);
-end
-
-@<Glob...@>=
-@!pdf_file: byte_file; {the PDF output file}
-@!pdf_buf: ^eight_bits; {pointer to the PDF output buffer or PDF object stream buffer}
-@!pdf_buf_size: integer; {end of PDF output buffer or PDF object stream buffer}
-@!pdf_ptr: integer; {pointer to the first unused byte in the PDF buffer or object stream buffer}
-@!pdf_op_buf: ^eight_bits; {the PDF output buffer}
-@!pdf_os_buf: ^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_major_version: integer; {fixed major part of the PDF version}
-@!fixed_pdf_minor_version: integer; {fixed minor part of the PDF version}
-@!fixed_pdf_objcompresslevel: integer; {fixed level for activating PDF object streams}
-@!pdf_version_written: boolean; {flag if the PDF version has been written}
-@!fixed_pdfoutput: integer; {fixed output format}
-@!fixed_pdfoutput_set: boolean; {|fixed_pdfoutput| has been set?}
-@!fixed_gamma: integer;
-@!fixed_image_gamma: integer;
-@!fixed_image_hicolor: boolean;
-@!fixed_image_apply_gamma: integer;
-@!epochseconds: integer;
-@!microseconds: integer;
-@!fixed_pdf_draftmode: integer; {fixed \\pdfdraftmode}
-@!fixed_pdf_draftmode_set: boolean; {|fixed_pdf_draftmode| has been set?}
-@!pdf_page_group_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;
-pdf_version_written := false;
-fixed_pdfoutput_set := false;
-fixed_pdf_draftmode_set := false;
-
-
-@ @p
-function fix_int(val, min, max: integer): integer;
-begin
- if val < min then
- fix_int := min
- else if val > max then
- fix_int := max
- else
- fix_int := val;
-end;
-
-@ This ensures that |pdf_major_version| and |pdf_minor_version| are set
-to reasonable values before any bytes have been written to the generated
-PDF file. We also save their current values in case the user tries to
-change them later, along with |pdf_objcompresslevel|,
-|pdf_image_hicolor|, and various other parameters that must be fixed
-before any PDF output happens.
-
-Here also the PDF file is opened by |ensure_pdf_open| and the PDF header
-is written.
-
-@p procedure check_pdfversion;
-begin
- if not pdf_version_written then begin
- pdf_version_written := true;
- if pdf_major_version < 1 then begin
- print_err("pdfTeX error (invalid pdfmajorversion)");
- print_ln;
- help2 ("The pdfmajorversion must be 1 or greater.")@/
- ("I changed this to 1.");
- int_error (pdf_major_version);
- pdf_major_version := 1;
- end;
- if (pdf_minor_version < 0) or (pdf_minor_version > 9) then begin
- print_err("pdfTeX error (invalid 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_major_version := pdf_major_version;
- fixed_pdf_minor_version := pdf_minor_version;
- fixed_gamma := fix_int(pdf_gamma, 0, 1000000);
- fixed_image_gamma := fix_int(pdf_image_gamma, 0, 1000000);
- fixed_image_hicolor := fix_int(pdf_image_hicolor, 0, 1);
- fixed_image_apply_gamma := fix_int(pdf_image_apply_gamma, 0, 1);
- fixed_pdf_objcompresslevel := fix_int(pdf_objcompresslevel, 0, 3);
- fixed_pdf_draftmode := fix_int(pdf_draftmode, 0, 1);
- fixed_inclusion_copy_font := fix_int(pdf_inclusion_copy_font, 0, 1);
- if ((fixed_pdf_major_version > 1) or (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 PDF-1.5 or greater. Object streams disabled now.", true, true);
- fixed_pdf_objcompresslevel := 0;
- end;
- pdf_os_enable := false;
- end;
- ensure_pdf_open;
- fix_pdfoutput;
- pdf_print("%PDF-");
- pdf_print_int(fixed_pdf_major_version);
- pdf_print(".");
- pdf_print_int_ln(fixed_pdf_minor_version);
- pdf_print("%");
- pdf_out(208); {'P' + 128}
- pdf_out(212); {'T' + 128}
- pdf_out(197); {'E' + 128}
- pdf_out(216); {'X' + 128}
- pdf_print_nl;
- end
- else begin
- if (fixed_pdf_minor_version <> pdf_minor_version)
- or (fixed_pdf_major_version <> pdf_major_version) then
- pdf_error("setup",
- "PDF version cannot be changed after data is written to the PDF file");
- end;
-end;
-
-@ Checks that we have a name for the generated PDF file and that it's open.
-
-@p procedure ensure_pdf_open;
-begin
- if output_file_name <> 0 then
- return;
- if job_name = 0 then
- open_log_file;
- pack_job_name(".pdf");
- if fixed_pdf_draftmode = 0 then
- while not b_open_out(pdf_file) do
- prompt_file_name("file name for output",".pdf");
- 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
-necessary. 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;
- pdf_out(pdf_new_line_char);
- pdf_print_ln("endstream");
- pdf_end_obj;
-end;
-
-@ Basic printing procedures for PDF output are very similar to \TeX\ basic
-printing ones but the output is going to PDF buffer. Subroutines with
-suffix |_ln| append a new-line character to the PDF output.
-
-@d pdf_new_line_char == 10 {new-line character for UNIX platforms}
-
-@d pdf_print_nl == {output a new-line character to PDF buffer}
-pdf_out(pdf_new_line_char)
-
-@d pdf_print_ln(#) == {print out a string to PDF buffer followed by
-a new-line character}
-begin
- pdf_print(#);
- pdf_print_nl;
-end
-
-@d pdf_print_int_ln(#) == {print out an integer to PDF buffer followed by
-a new-line character}
-begin
- pdf_print_int(#);
- pdf_print_nl;
-end
-
-@<Declare procedures that need to be declared forward for \pdfTeX@>=
-procedure pdf_error(t, p: str_number);
-begin
- normalize_selector;
- print_err("pdfTeX error");
- if t <> 0 then begin
- print(" (");
- print(t);
- print(")");
- end;
- print(": "); print(p);
- succumb;
-end;
-
-procedure pdf_warning(t, p: str_number; prepend_nl, append_nl: boolean);
-begin
- if interaction = error_stop_mode then
- wake_up_terminal;
- if prepend_nl then
- print_ln;
- print("pdfTeX warning");
- if t <> 0 then begin
- print(" (");
- print(t);
- print(")");
- end;
- print(": "); print(p);
- if append_nl then
- print_ln;
- if history=spotless then history:=warning_issued;
-end;
-
-procedure pdf_os_get_os_buf(s: integer); {check that |s| bytes more
-fit into |pdf_os_buf|; increase it if required}
-var a: integer;
-begin
- if s > sup_pdf_os_buf_size - pdf_ptr then
- overflow("PDF object stream buffer", pdf_os_buf_size);
- if pdf_ptr + s > pdf_os_buf_size then begin
- a := 0.2 * pdf_os_buf_size;
- if pdf_ptr + s > pdf_os_buf_size + a then
- pdf_os_buf_size := pdf_ptr + s
- else if pdf_os_buf_size < sup_pdf_os_buf_size - a then
- pdf_os_buf_size := pdf_os_buf_size + a
- else
- pdf_os_buf_size := sup_pdf_os_buf_size;
- pdf_os_buf := xrealloc_array(pdf_os_buf, eight_bits, pdf_os_buf_size);
- pdf_buf := pdf_os_buf;
- pdf_buf_size := pdf_os_buf_size;
- end;
-end;
-
-procedure remove_last_space;
-begin
- if (pdf_ptr > 0) and (pdf_buf[pdf_ptr - 1] = 32) then
- decr(pdf_ptr);
-end;
-
-procedure pdf_print_octal(n: integer); {prints an integer in octal form to
-PDF buffer}
-var k:0..23; {index to current digit; we assume that $|n|<10^{23}$}
-begin
- k:=0;
- repeat dig[k]:=n mod 8; n:=n div 8; incr(k);
- until n=0;
- if k = 1 then begin
- pdf_out("0");
- pdf_out("0");
- end;
- if k = 2 then
- pdf_out("0");
- while k>0 do begin
- decr(k);
- pdf_out("0"+dig[k]);
- end;
-end;
-
-procedure pdf_print_char(f: internal_font_number; c: integer);
-{ print out a character to PDF buffer; the character will be printed in octal
- form in the following cases: chars <= 32, backslash (92), left parenthesis
- (40) and right parenthesis (41) }
-begin
- pdf_mark_char(f, c);
- if (c <= 32) or (c = 92) or (c = 40) or (c = 41) or (c > 127) then begin
- pdf_out(92); {output a backslash}
- pdf_print_octal(c);
- end
- else
- pdf_out(c);
-end;
-
-procedure pdf_print(s: str_number); {print out a string to PDF buffer}
-var j: pool_pointer; {current character code position}
- c: integer;
-begin
- j := str_start[s];
- while j < str_start[s + 1] do begin
- c := str_pool[j];
- pdf_out(c);
- incr(j);
- end;
-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[s];
- k := str_start[r];
- while (j < str_start[s + 1]) and (k < str_start[r + 1]) do begin
- if str_pool[j] <> str_pool[k] then
- return;
- incr(j);
- incr(k);
- end;
- str_in_str := true;
-end;
-
-procedure pdf_print_int(n:longinteger); {print out a integer to PDF buffer}
-var k:integer; {index to current digit ($0\le k\le23$); we assume that $|n|<10^{23}$}
-m:longinteger; {used to negate |n| in possibly dangerous cases}
-begin
- k:=0;
- if n<0 then
- begin pdf_out("-");
- 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;
- pdf_room(k);
- while k>0 do begin
- decr(k);
- pdf_quick_out("0"+dig[k]);
- end;
-end;
-
-procedure pdf_print_two(n:integer); {prints two least significant digits in
-decimal form to PDF buffer}
-begin n:=abs(n) mod 100; pdf_out("0"+(n div 10));
-pdf_out("0"+(n mod 10));
-end;
-
-function tokens_to_string(p: pointer): str_number; {return a string from tokens
-list}
-begin
- if selector = new_string then
- pdf_error("tokens", "tokens_to_string() called while selector = new_string");
- old_setting:=selector; selector:=new_string;
- show_token_list(link(p),null,pool_size-pool_ptr);
- selector:=old_setting;
- 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
-accuracy.
-
-@d max_integer == @"7FFFFFFF {$2^{31}-1$}
-@d call_func(#) == begin if # <> 0 then do_nothing end
-
-@<Glob...@>=
-@!one_bp: scaled; {scaled value corresponds to 1bp}
-@!one_hundred_bp: scaled; {scaled value corresponds to 100bp}
-@!one_hundred_inch: scaled; {scaled value corresponds to 100in}
-@!ten_pow: array[0..9] of integer; {$10^0..10^9$}
-@!scaled_out: integer; {amount of |scaled| that was taken out in
-|divide_scaled|}
-@!init_pdf_output: boolean;
-
-@ @<Set init...@>=
-one_bp := 65782; {65781.76}
-one_hundred_bp := 6578176;
-one_hundred_inch := 473628672;
-ten_pow[0] := 1;
-for i := 1 to 9 do
- ten_pow[i] := 10*ten_pow[i - 1];
-init_pdf_output := false;
-
-
-@ The following function divides |s| by |m|. |dd| is number of decimal digits.
-
-@<Declare procedures that need to be declared forward for \pdfTeX@>=
-function divide_scaled(s, m: scaled; dd: integer): scaled;
-var q, r: scaled;
- sign, i: integer;
-begin
- sign := 1;
- if s < 0 then begin
- sign := -sign;
- s := -s;
- end;
- if m < 0 then begin
- sign := -sign;
- m := -m;
- end;
- if m = 0 then
- pdf_error("arithmetic", "divided by zero")
- else if m >= (max_integer div 10) then
- pdf_error("arithmetic", "number too big");
- q := s div m;
- r := s mod m;
- for i := 1 to dd do begin
- q := 10*q + (10*r) div m;
- r := (10*r) mod m;
- end;
- if 2*r >= m then begin
- incr(q);
- r := r - m;
- end;
- scaled_out := sign*(s - (r div ten_pow[dd]));
- divide_scaled := sign*q;
-end;
-
-function round_xn_over_d(@!x:scaled; @!n,@!d:integer):scaled;
-var positive:boolean; {was |x>=0|?}
-@!t,@!u,@!v:nonnegative_integer; {intermediate quantities}
-begin if x>=0 then positive:=true
-else begin negate(x); positive:=false;
- end;
-t:=(x mod @'100000)*n;
-u:=(x div @'100000)*n+(t div @'100000);
-v:=(u mod d)*@'100000 + (t mod @'100000);
-if u div d>=@'100000 then arith_error:=true
-else u:=@'100000*(u div d) + (v div d);
-v := v mod d;
-if 2*v >= d then
- incr(u);
-if positive then
- round_xn_over_d := u
-else
- round_xn_over_d := -u;
-end;
-
-@ Next subroutines are needed for controlling spacing in PDF page description.
-For a given character |c| from a font |f|,
-the procedure |adv_char_width| advances |pdf_h|
-by {\it about\/} the amount |w|, which is the character width.
-But we cannot simply add |w| to |pdf_h|.
-Instead we have to bring the required shift into the same raster,
-on which also the \.{/Widths} array values,
-as they appear in the PDF file, are based.
-The |scaled_out| value is the |w| value moved into this raster.
-The \.{/Widths} values are used by the PDF reader independently
-to update its positions.
-So one has to be sure, that calculations are properly synchronized.
-Currently the \.{/Widths} array values are output
-with one digit after the decimal point,
-therefore the raster on which |adv_char_width| is operating
-is $1/10000$ of the |pdf_font_size|.
-
-For PK fonts things are more complicated,
-as we have to deal with scaling bitmaps as well.
-
-@p
-procedure adv_char_width(f: internal_font_number; c: eight_bits); {update |pdf_h|
-by character width |w| from font |f|}
-var w, s_out: scaled;
- s: integer;
-begin
- w := char_width(f)(char_info(f)(c));
- if isscalable(f) then begin
- if pdf_cur_Tm_a = 0 then begin
- call_func(divide_scaled(w, pdf_font_size[f], 4));
- pdf_delta_h := pdf_delta_h + scaled_out;
- end
- else begin
- s := divide_scaled(round_xn_over_d(w, 1000, 1000 + pdf_cur_Tm_a),
- pdf_font_size[f],
- 4);
- s_out := round_xn_over_d(round_xn_over_d(pdf_font_size[f], abs(s), 10000),
- 1000 + pdf_cur_Tm_a, 1000);
- if s < 0 then
- s_out := -s_out;
- pdf_delta_h := pdf_delta_h + s_out;
- end;
- end else
- pdf_delta_h := pdf_delta_h + get_pk_char_width(f, w);
-end;
-
-procedure pdf_print_real(m, d: integer); {print $m/10^d$ as real}
-begin
- if m < 0 then begin
- pdf_out("-");
- m := -m;
- end;
- pdf_print_int(m div ten_pow[d]);
- m := m mod ten_pow[d];
- if m > 0 then begin
- pdf_out(".");
- decr(d);
- while m < ten_pow[d] do begin
- pdf_out("0");
- decr(d);
- end;
- while m mod 10 = 0 do
- m := m div 10;
- pdf_print_int(m);
- end;
-end;
-
-procedure pdf_print_bp(s: scaled); {print scaled as |bp|}
-begin
- pdf_print_real(divide_scaled(s, one_hundred_bp, fixed_decimal_digits + 2),
- fixed_decimal_digits);
-end;
-
-procedure pdf_print_mag_bp(s: scaled); {take |mag| into account}
-begin
- prepare_mag;
- if mag <> 1000 then
- s := round_xn_over_d(s, mag, 1000);
- pdf_print_bp(s);
-end;
-
-@* \[32c] PDF page description.
-
-@d pdf_x(#) == ((#) - pdf_origin_h) {convert $x$-coordinate from \.{DVI} to
-PDF}
-@d pdf_y(#) == (pdf_origin_v - (#)) {convert $y$-coordinate from \.{DVI} to
-PDF}
-@d dvi_x(#) == ((#) + pdf_origin_h) {convert $x$-coordinate from \.{PDF} to
-DVI}
-@d dvi_y(#) == (pdf_origin_v - (#)) {convert $y$-coordinate from \.{PDF} to
-DVI}
-
-@<Glob...@>=
-@!pdf_f: internal_font_number; {the current font in PDF output page}
-@!pdf_h: scaled; {current horizontal coordinate in PDF output page}
-@!pdf_v: scaled; {current vertical coordinate in PDF output page}
-@!pdf_tj_start_h: scaled; {horizontal coordinate in PDF output page just before \.{TJ} array start}
-@!cur_delta_h: scaled; {horizontal |cur_h| offset from |pdf_tj_start_h|}
-@!pdf_delta_h: scaled; {horizontal offset from |pdf_tj_start_h|}
-@!pdf_origin_h: scaled; {current horizontal origin in PDF output page}
-@!pdf_origin_v: scaled; {current vertical origin in PDF output page}
-@!pdf_doing_string: boolean; {we are writing string to PDF file?}
-@!pdf_doing_text: boolean; {we are writing text section to PDF file?}
-@!min_bp_val: scaled;
-@!min_font_val: scaled; {(TJ array system)}
-@!fixed_pk_resolution: integer;
-@!fixed_decimal_digits: integer;
-@!fixed_gen_tounicode: integer;
-@!fixed_inclusion_copy_font: integer;
-@!pk_scale_factor: integer;
-@!pdf_output_option: integer;
-@!pdf_output_value: integer;
-@!pdf_draftmode_option: integer;
-@!pdf_draftmode_value: integer;
-@!pdf_cur_Tm_a: integer; {|a| value of the current text matrix, i.e., the current
- horizontal scaling factor}
-@!pdf_last_f: internal_font_number; {last font in PDF output page}
-@!pdf_last_fs: internal_font_number; {last font size in PDF output page}
-@!pdf_dummy_font: internal_font_number; {font used to insert artificial interword spaces}
-
-
-@ Following procedures implement low-level subroutines to convert \TeX{}
-internal structures to PDF page description.
-
-@p procedure pdf_set_origin(h, v: scaled); {set the origin to |h|, |v|}
-begin
- if (abs(h - pdf_origin_h) >= min_bp_val) or
- (abs(v - pdf_origin_v) >= min_bp_val) then begin
- pdf_print("1 0 0 1 ");
- pdf_print_bp(h - pdf_origin_h);
- pdf_origin_h := pdf_origin_h + scaled_out;
- pdf_out(" ");
- pdf_print_bp(pdf_origin_v - v);
- pdf_origin_v := pdf_origin_v - scaled_out;
- pdf_print_ln(" cm");
- end;
- pdf_h := pdf_origin_h;
- pdf_tj_start_h := pdf_h;
- pdf_v := pdf_origin_v;
-end;
-
-procedure pdf_set_origin_temp(h, v: scaled); {set the origin to |h|, |v| inside group}
-begin
- if (abs(h - pdf_origin_h) >= min_bp_val) or
- (abs(v - pdf_origin_v) >= min_bp_val) then begin
- pdf_print("1 0 0 1 ");
- pdf_print_bp(h - pdf_origin_h);
- pdf_out(" ");
- pdf_print_bp(pdf_origin_v - v);
- pdf_print_ln(" cm");
- end;
-end;
-
-procedure pdf_end_string; {end the current string}
-begin
- if pdf_doing_string then begin
- pdf_print(")]TJ");
- pdf_doing_string := false;
- end;
-end;
-
-procedure pdf_end_string_nl; {end the current string, with new-line}
-begin
- if pdf_doing_string then begin
- pdf_print_ln(")]TJ");
- pdf_doing_string := false;
- end;
-end;
-
-procedure pdf_set_textmatrix(v, v_out: scaled; f: internal_font_number);
-{set the next starting point to |cur_h|, |cur_v|}
-var pdf_new_Tm_a: integer; {|a| value of the new text matrix}
-begin
- pdf_out(" ");
- if f = pdf_f then
- pdf_new_Tm_a := pdf_cur_Tm_a
- else if not pdf_font_auto_expand[f] then
- pdf_new_Tm_a := 0
- else
- pdf_new_Tm_a := pdf_font_expand_ratio[f];
- if (pdf_new_Tm_a <> 0) or
- ((pdf_new_Tm_a = 0) and (pdf_cur_Tm_a <> 0)) then begin
- pdf_print_real(1000 + pdf_new_Tm_a, 3);
- pdf_print(" 0 0 1 ");
- pdf_print_bp(cur_h - pdf_origin_h);
- pdf_h := pdf_origin_h + scaled_out;
- pdf_out(" ");
- pdf_print_bp(pdf_origin_v - cur_v);
- pdf_v := pdf_origin_v - scaled_out;
- pdf_print(" Tm");
- pdf_cur_Tm_a := pdf_new_Tm_a;
- pdfassert(pdf_cur_Tm_a > -1000);
- end else begin
- pdf_print_bp(cur_h - pdf_tj_start_h); {works only for unexpanded fonts}
- pdf_h := pdf_tj_start_h + scaled_out;
- pdf_out(" ");
- pdf_print_real(v, fixed_decimal_digits); {use |v| and |v_out| to avoid duplicate calculation}
- pdf_v := pdf_v - v_out;
- pdf_print(" Td");
- end;
- pdf_tj_start_h := pdf_h;
- pdf_delta_h := 0;
-end;
-
-procedure pdf_use_font(f: internal_font_number; fontnum: integer);
-{mark |f| as a used font; set |font_used[f]|, |pdf_font_size[f]| and |pdf_font_num[f]|}
-begin
- call_func(divide_scaled(font_size[f], one_hundred_bp, 6));
- pdf_font_size[f] := scaled_out;
- font_used[f] := true;
- pdfassert((fontnum > 0) or ((fontnum < 0) and (pdf_font_num[-fontnum] > 0)));
- 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];
- if not isscalable(b) then
- pdf_error("font expansion", "auto expansion is only possible with scalable fonts");
- if not font_used[b] then
- pdf_init_font(b);
- pdf_font_map[f] := pdf_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, e.g., 'cmr10' and 'cmr10 at 11pt'); 2) |f| has been auto
- expanded from |k|}
- if isscalable(f) then begin
- i := head_tab[obj_type_font];
- while i <> 0 do begin
- k := obj_info(i);
- if isscalable(k) and
- (pdf_font_map[k] = pdf_font_map[f]) and
- (str_eq_str(font_name[k], font_name[f]) or
- (pdf_font_auto_expand[f] and
- (pdf_font_blink[f] <> null_font) and
- str_eq_str(font_name[k], font_name[pdf_font_blink[f]]))) then
- begin
- pdfassert(pdf_font_num[k] <> 0);
- if pdf_font_num[k] < 0 then
- pdf_use_font(f, pdf_font_num[k])
- else
- pdf_use_font(f, -k);
- return;
- end;
- i := obj_link(i);
- end;
- end;
-
- {create a new font object for |f|}
- pdf_create_obj(obj_type_font, f);
- pdf_use_font(f, obj_ptr);
-end;
-
-procedure pdf_init_font_cur_val;
-begin
- pdf_init_font(cur_val);
-end;
-
-procedure pdf_set_font(f: internal_font_number);
-{set the actual font on PDF page}
-label found, found1;
-var p: pointer;
- k: internal_font_number;
-begin
- if not font_used[f] then
- pdf_init_font(f);
- set_ff(f); {set |ff| to the tfm number of the font sharing the font object
- with |f|; |ff| is either |f| or some font with the same tfm name
- at different size and/or expansion}
- k := ff;
- p := pdf_font_list;
- while p <> null do begin
- set_ff(info(p));
- if ff = k then
- goto found;
- p := link(p);
- end;
- pdf_append_list(f)(pdf_font_list); {|f| not found in |pdf_font_list|, append it now}
-found:
- if (k = pdf_last_f) and (font_size[f] = pdf_last_fs) then
- return;
- pdf_print("/F");
- pdf_print_int(k);
- pdf_print_resname_prefix;
- pdf_out(" ");
- pdf_print_real(divide_scaled(font_size[f], one_hundred_bp, 6), 4);
- pdf_print(" Tf");
- pdf_last_f := k;
- pdf_last_fs := font_size[f];
-end;
-
-procedure pdf_begin_text; {begin a text section}
-begin
- pdf_set_origin(0, cur_page_height);
- pdf_print_ln("BT");
- pdf_doing_text := true;
- pdf_f := null_font;
- pdf_last_f := null_font;
- pdf_last_fs := 0;
- pdf_doing_string := false;
- pdf_cur_Tm_a := 0;
-end;
-
-procedure pdf_read_dummy_font;
-begin
- if pdf_dummy_font = null_font then begin
- pdf_dummy_font := read_font_info(null_cs, "dummy-space", "", one_bp);
- pdf_mark_char(pdf_dummy_font, 32);
- end;
-end;
-
-procedure pdf_insert_interword_space;
-{insert an artificial interword space}
-begin
- pdf_read_dummy_font;
- pdf_set_font(pdf_dummy_font);
- pdf_print("( )Tj");
-end;
-
-procedure pdf_begin_string(f: internal_font_number); {begin to draw a string}
-var s_out, v, v_out: scaled;
- s: integer;
- must_end_string: boolean; {must we end the current string?}
- must_insert_space: boolean; {must we insert an interword space?}
-begin
- if not pdf_doing_text then
- pdf_begin_text;
- if f <> pdf_f then begin
- pdf_end_string;
- pdf_set_font(f);
- end;
- if pdf_cur_Tm_a = 0 then begin
- s := divide_scaled(cur_h - (pdf_tj_start_h + pdf_delta_h), pdf_font_size[f], 3);
- s_out := scaled_out;
- end
- else begin
- s := divide_scaled(round_xn_over_d(cur_h - (pdf_tj_start_h + pdf_delta_h), 1000,
- 1000 + pdf_cur_Tm_a),
- pdf_font_size[f],
- 3);
- if abs(s) < @'100000 then begin
- s_out := round_xn_over_d(round_xn_over_d(pdf_font_size[f], abs(s), 1000),
- 1000 + pdf_cur_Tm_a, 1000);
- if s < 0 then
- s_out := -s_out;
- end;
- {no need to calculate |s_out| when |abs(s) >= @'100000|, since the text
- matrix will be reset below}
- end;
- if abs(cur_v - pdf_v) >= min_bp_val then begin
- v := divide_scaled(pdf_v - cur_v, one_hundred_bp,
- fixed_decimal_digits + 2);
- v_out := scaled_out;
- end
- else begin
- v := 0;
- v_out := 0;
- end;
-
- must_insert_space := false;
- must_end_string := false;
-
-@{ print_nl("s_out = "); print_scaled(s_out); @}
-@{ print_nl("space(f) = "); print_scaled(space(f)); @}
-@{ print_nl("space_shrink(f) = "); print_scaled(space_shrink(f)); @}
-@{ print_nl("x_height(f) = "); print_scaled(x_height(f)); @}
-@{ print_nl("v = "); print_scaled(v); @}
-@{ print_nl("v_out = "); print_scaled(v_out); @}
-
- if gen_faked_interword_space and
- pdf_doing_string and
- ((abs(v_out) > 2*x_height(f)) or
- (s_out > space(f) - space_shrink(f)) or
- ((f <> pdf_f) and (v = 0))) then
- begin
- must_insert_space := true;
- end;
-
- if (f <> pdf_f) or (v <> 0) or (abs(s) >= @'100000) or must_insert_space then begin
- must_end_string := true;
- end;
-
- if must_end_string then begin
- pdf_end_string;
- if must_insert_space then begin
- pdf_insert_interword_space; {this will change |pdf_f|}
- pdf_set_font(f);
- end;
- pdf_set_textmatrix(v, v_out, f);
- pdf_f := f;
- s := 0;
- end;
-
- if not pdf_doing_string then begin
- pdf_print(" [");
- if s = 0 then
- pdf_out("(");
- end;
-
- if s <> 0 then begin
- if pdf_doing_string then
- pdf_out(")");
- pdf_print_int(-s);
- pdf_out("(");
- pdf_delta_h := pdf_delta_h + s_out;
- end;
- pdf_doing_string := true;
-end;
-
-procedure pdf_insert_fake_space;
-var s: integer; {to save |gen_faked_interword_space|}
-begin
- s := gen_faked_interword_space;
- gen_faked_interword_space := 0; {to prevent inserting another fake space in |pdf_begin_string|}
-
- pdf_read_dummy_font;
- pdf_begin_string(pdf_dummy_font);
- pdf_print(" ");
- pdf_end_string_nl;
-
- gen_faked_interword_space := s;
-end;
-
-
-procedure pdf_end_text; {end a text section}
-begin
- if pdf_doing_text then begin
- pdf_end_string_nl;
- pdf_print_ln("ET");
- pdf_doing_text := false;
- end;
-end;
-
-procedure pdf_set_rule(x, y, w, h: scaled); {draw a rule}
-begin
- pdf_end_text;
- pdf_print_ln("q");
- if h <= one_bp then begin
- pdf_set_origin_temp(x, y - (h + 1)/2);
- pdf_print("[]0 d 0 J ");
- pdf_print_bp(h); pdf_print(" w 0 0 m ");
- pdf_print_bp(w); pdf_print_ln(" 0 l S");
- end
- else if w <= one_bp then begin
- pdf_set_origin_temp(x + (w + 1)/2, y);
- pdf_print("[]0 d 0 J ");
- pdf_print_bp(w); pdf_print(" w 0 0 m 0 ");
- pdf_print_bp(h); pdf_print_ln(" l S");
- end
- else begin
- pdf_set_origin_temp(x, y);
- pdf_print("0 0 ");
- pdf_print_bp(w); pdf_out(" ");
- pdf_print_bp(h); pdf_print_ln(" re f");
- end;
- pdf_print_ln("Q");
-end;
-
-procedure pdf_rectangle(left, top, right, bottom: scaled); {output a
-rectangle specification to PDF file}
-begin
- prepare_mag;
- pdf_print("/Rect [");
- pdf_print_mag_bp(pdf_x(left)); pdf_out(" ");
- pdf_print_mag_bp(pdf_y(bottom)); pdf_out(" ");
- pdf_print_mag_bp(pdf_x(right)); pdf_out(" ");
- pdf_print_mag_bp(pdf_y(top));
- pdf_print_ln("]");
-end;
-
-{Prints first |len| characters of string |s| (if it's that long).
- There must be a better way to print a substring?}
-procedure slow_print_substr(@!s,@!max_len:integer);
-var j:pool_pointer; {current character code position}
-begin if (s>=str_ptr) or (s<256) then print(s)
-else begin j:=str_start[s];
- while (j<str_start[s+1]) and (j<=str_start[s]+max_len) do
- begin print(so(str_pool[j])); incr(j);
- end;
- end;
- if j<str_start[s+1] then print("..."); {indicate truncation}
-end;
-
-procedure literal(s: str_number; literal_mode: integer; warn: boolean);
-var j: pool_pointer; {current character code position}
-begin
- j:=str_start[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 begin
- print_nl("Non-PDF special ignored!");
- print_nl("<special> ");
- slow_print_substr(s, 64);
- {length of printed line should be <=78; good enough.}
- print_ln;
- end;
- return;
- end;
- j := j + length("PDF:");
- if str_in_str(s, "direct:", length("PDF:")) then begin
- j := j + length("direct:");
- literal_mode := direct_always; end
- else if str_in_str(s, "page:", length("PDF:")) then begin
- j := j + length("page:");
- literal_mode := direct_page; end
- else
- literal_mode := set_origin;
- end;
- case literal_mode of
- set_origin: begin
- pdf_end_text;
- pdf_set_origin(cur_h, cur_v);
- end;
- direct_page:
- pdf_end_text;
- direct_always:
- pdf_end_string_nl;
- othercases confusion("literal1")
- endcases;
- while j<str_start[s+1] do begin
- pdf_out(str_pool[j]);
- incr(j);
- end;
- pdf_print_nl;
-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 usually 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 obj_offset(#) = -2 then obj_offset(#) := -1
-@d is_obj_scheduled(#) == (obj_offset(#) > -2)
-@d is_obj_written(#) == (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_pages == 2 {index of linked list of Pages objects}
-@d obj_type_font == 3 {index of linked list of Fonts objects}
-@d obj_type_outline == 4 {index of linked list of outline objects}
-@d obj_type_dest == 5 {index of linked list of destination objects}
-@d obj_type_obj == 6 {index of linked list of raw objects}
-@d obj_type_xform == 7 {index of linked list of XObject forms}
-@d obj_type_ximage == 8 {index of linked list of XObject image}
-@d obj_type_thread == 9 {index of linked list of num article threads}
-@d head_tab_max == obj_type_thread {max index of |head_tab|}
-
-@# {max number of kids for balanced trees}
-@d pages_tree_kids_max == 6 {max number of kids of Pages tree node}
-@d name_tree_kids_max == 6 {max number of kids of node of name tree for
-name destinations}
-
-@# {when a whatsit node representing annotation is created, words |1..3| are
-width, height and depth of this annotation; after shipping out words |1..4|
-are rectangle specification of annotation. For whatsit node representing
-destination |pdf_left| and |pdf_top| are used for some types of destinations}
-
-@# {coordinates of destinations/threads/annotations (in whatsit node)}
-@d pdf_left(#) == mem[# + 1].sc
-@d pdf_top(#) == mem[# + 2].sc
-@d pdf_right(#) == mem[# + 3].sc
-@d pdf_bottom(#) == mem[# + 4].sc
-
-@# {dimension of destinations/threads/annotations (in whatsit node)}
-@d pdf_width(#) == mem[# + 1].sc
-@d pdf_height(#) == mem[# + 2].sc
-@d pdf_depth(#) == mem[# + 3].sc
-
-@# {data structure for \.{\\pdfliteral}}
-@d pdf_literal_data(#) == link(#+1) {data}
-@d pdf_literal_mode(#) == info(#+1) {mode of resetting the text matrix
- while writing data to the page stream}
-@# {modes of setting the current transformation matrix (CTM)}
-@d set_origin == 0 {end text (ET) if needed, set CTM to current point}
-@d direct_page == 1 {end text (ET) if needed, but don't change the CTM}
-@d direct_always == 2 {don't end text, don't change the CTM}
-@d scan_special == 3 {look into special text}
-
-@# {data structure for \.{\\pdfcolorstack}}
-@d pdf_colorstack_node_size == 3
-@d pdf_colorstack_setter_node_size == 3
-@d pdf_colorstack_getter_node_size == 2
-@d pdf_colorstack_stack(#) == link(#+1) {stack number}
-@d pdf_colorstack_cmd(#) == info(#+1) {command: set, push, pop, current}
-@d pdf_colorstack_data(#) == link(#+2) {data}
-
-@# {color stack commands}
-@d colorstack_set == 0
-@d colorstack_push == 1
-@d colorstack_data == 1 { last value where data field is set }
-@d colorstack_pop == 2
-@d colorstack_current == 3
-
-@# {data structure for \.{\\pdfsetmatrix}}
-@d pdf_setmatrix_node_size == 2
-@d pdf_setmatrix_data(#) == link(#+1) {data}
-
-@# {data structure for \.{\\pdfsave}}
-@d pdf_save_node_size == 2
-
-@# {data structure for \.{\\pdfrestore}}
-@d pdf_restore_node_size == 2
-
-@# {data structure for \.{\\pdfobj} and \.{\\pdfrefobj}}
-@d pdf_refobj_node_size == 2 {size of whatsit node representing the raw object}
-@d pdf_obj_objnum(#) == info(# + 1) {number of the raw object}
-@d obj_data_ptr == obj_aux {pointer to |pdf_mem|}
-@d pdfmem_obj_size == 4 {size of memory in |pdf_mem| which
- |obj_data_ptr| holds}
-@d obj_obj_data(#) == pdf_mem[obj_data_ptr(#) + 0] {object data}
-@d obj_obj_is_stream(#) == pdf_mem[obj_data_ptr(#) + 1] {will this object
- be written as a stream instead of a dictionary?}
-@d obj_obj_stream_attr(#) == pdf_mem[obj_data_ptr(#) + 2] {additional
- object attributes for streams}
-@d obj_obj_is_file(#) == pdf_mem[obj_data_ptr(#) + 3] {data should be
- read from an external file?}
-
-@# {data structure for \.{\\pdfxform} and \.{\\pdfrefxform}}
-@d pdf_refxform_node_size == 5 {size of whatsit node for xform; words 1..3 are
- form dimensions}
-@d pdf_xform_objnum(#) == info(# + 4) {object number}
-@d pdfmem_xform_size == 6 {size of memory in |pdf_mem| which
- |obj_data_ptr| holds}
-@d obj_xform_width(#) == pdf_mem[obj_data_ptr(#) + 0]
-@d obj_xform_height(#) == pdf_mem[obj_data_ptr(#) + 1]
-@d obj_xform_depth(#) == pdf_mem[obj_data_ptr(#) + 2]
-@d obj_xform_box(#) == pdf_mem[obj_data_ptr(#) + 3] {this field holds
- pointer to the corresponding box}
-@d obj_xform_attr(#) == pdf_mem[obj_data_ptr(#) + 4] {additional xform
- attributes}
-@d obj_xform_resources(#) == pdf_mem[obj_data_ptr(#) + 5] {additional xform
- Resources}
-
-@# {data structure for \.{\\pdfximage} and \.{\\pdfrefximage}}
-@d pdf_refximage_node_size == 5 {size of whatsit node for ximage; words 1..3
- are image dimensions}
-@d pdf_ximage_objnum(#) == info(# + 4) {object number}
-@d pdfmem_ximage_size == 5 {size of memory in |pdf_mem| which
- |obj_data_ptr| holds}
-@d obj_ximage_width(#) == pdf_mem[obj_data_ptr(#) + 0]
-@d obj_ximage_height(#) == pdf_mem[obj_data_ptr(#) + 1]
-@d obj_ximage_depth(#) == pdf_mem[obj_data_ptr(#) + 2]
-@d obj_ximage_attr(#) == pdf_mem[obj_data_ptr(#) + 3] {additional ximage attributes}
-@d obj_ximage_data(#) == pdf_mem[obj_data_ptr(#) + 4] {pointer to image data}
-
-@# {data structure of annotations; words 1..4 represent the coordinates of
- the annotation}
-@d obj_annot_ptr == obj_aux {pointer to corresponding whatsit node}
-@d pdf_annot_node_size == 7 {size of whatsit node representing annotation}
-@d pdf_annot_data(#) == info(# + 5) {raw data of general annotations}
-@d pdf_link_attr(#) == info(# + 5) {attributes of link annotations}
-@d pdf_link_action(#) == link(# + 5) {pointer to action structure}
-@d pdf_annot_objnum(#) == mem[# + 6].int {object number of corresponding object}
-@d pdf_link_objnum(#) == mem[# + 6].int {object number of corresponding object}
-
-@# {types of actions}
-@d pdf_action_page == 0 {GoTo action}
-@d pdf_action_goto == 1 {GoTo action}
-@d pdf_action_thread == 2 {Thread action}
-@d pdf_action_user == 3 {user-defined action}
-
-@# {data structure of actions}
-@d pdf_action_size == 3 {size of action structure in |mem|}
-@d pdf_action_type == type {action type}
-@d pdf_action_named_id == subtype {identifier is type of name}
-@d pdf_action_id == link {destination/thread name identifier}
-@d pdf_action_file(#) == info(# + 1) {file name for external action}
-@d pdf_action_new_window(#)== link(# + 1) {open a new window?}
-@d pdf_action_page_tokens(#) == info(# + 2) {specification of GoTo page action}
-@d pdf_action_user_tokens(#) == info(# + 2) {user-defined action string}
-@d pdf_action_refcount(#) == link(# + 2) {counter of references to this action}
-
-@# {data structure of outlines; it's not able to write out outline entries
-before all outline entries are defined, so memory allocated for outline
-entries can't not be deallocated and will stay in memory. For this reason we
-will store data of outline entries in |pdf_mem| instead of |mem|}
-
-@d pdfmem_outline_size == 8 {size of memory in |pdf_mem| which
-|obj_outline_ptr| points to}
-@d obj_outline_count == obj_info{count of all opened children}
-@d obj_outline_ptr == obj_aux {pointer to |pdf_mem|}
-@d obj_outline_title(#) == pdf_mem[obj_outline_ptr(#)]
-@d obj_outline_parent(#) == pdf_mem[obj_outline_ptr(#) + 1]
-@d obj_outline_prev(#) == pdf_mem[obj_outline_ptr(#) + 2]
-@d obj_outline_next(#) == pdf_mem[obj_outline_ptr(#) + 3]
-@d obj_outline_first(#) == pdf_mem[obj_outline_ptr(#) + 4]
-@d obj_outline_last(#) == pdf_mem[obj_outline_ptr(#) + 5]
-@d obj_outline_action_objnum(#) == pdf_mem[obj_outline_ptr(#) + 6] {object number of
-action}
-@d obj_outline_attr(#) == pdf_mem[obj_outline_ptr(#) + 7]
-
-@# {types of destinations}
-@d pdf_dest_xyz == 0
-@d pdf_dest_fit == 1
-@d pdf_dest_fith == 2
-@d pdf_dest_fitv == 3
-@d pdf_dest_fitb == 4
-@d pdf_dest_fitbh == 5
-@d pdf_dest_fitbv == 6
-@d pdf_dest_fitr == 7
-
-@# {data structure of destinations}
-@d obj_dest_ptr == obj_aux {pointer to |pdf_dest_node|}
-@d pdf_dest_node_size == 7 {size of whatsit node for destination;
-words |1..4| hold dest dimensions, word |6| identifier type, subtype
-and identifier of destination, word |6| the corresponding object number}
-@d pdf_dest_type(#) == type(# + 5) {type of destination}
-@d pdf_dest_named_id(#) == subtype(# + 5) {is named identifier?}
-@d pdf_dest_id(#) == link(# + 5) {destination identifier}
-@d pdf_dest_xyz_zoom(#) == info(# + 6) {zoom factor for |destxyz| destination}
-@d pdf_dest_objnum(#) == link(# + 6) {object number of corresponding
-object}
-
-@# {data structure of threads; words 1..4 represent the coordinates of the
- corners}
-@d pdf_thread_node_size == 7
-@d pdf_thread_named_id(#) == subtype(# + 5) {is a named identifier}
-@d pdf_thread_id(#) == link(# + 5) {thread identifier}
-@d pdf_thread_attr(#) == info(# + 6) {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}
-
-@# {data structure of snap node}
-@d snap_node_size == 3
-@d snap_glue_ptr(#) == info(# + 1)
-@d final_skip(#) == mem[# + 2].sc {the amount to skip}
-@# {data structure of snap compensation node}
-@d snapy_comp_ratio(#) == mem[# + 1].int
-
-@<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 = 500000; {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: eight_bits; {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;
-pdf_dummy_font := null_font;
-
-@ 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 := xrealloc_array(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 := xrealloc_array(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_pdfversion;
- 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_pdfversion;
- 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;
- 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 begin
- pdf_print_ln(">>");
- pdf_print_ln("endobj");
- end;
-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:
-
-@d is_hex_char(#) == (((# >= '0') and (# <= '9')) or
- ((# >= 'A') and (# <= 'F')) or
- ((# >= 'a') and (# <= 'f')))
-
-@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(s: str_number); {print out |s| as string in PDF
-output}
-label done;
-var i, j: pool_pointer;
- is_hex_string: boolean;
-begin
- i := str_start[s];
- j := i + length(s) - 1;
- if i > j then begin
- pdf_print("()"); {null string}
- return;
- end;
- if (str_pool[i] = '(') and (str_pool[j] = ')') then begin
- pdf_print(s);
- return;
- end;
- is_hex_string := false;
- if (str_pool[i] <> '<') or (str_pool[j] <> '>') or odd(length(s)) then
- goto done;
- incr(i);
- decr(j);
- while i < j do begin
- if is_hex_char(str_pool[i]) and is_hex_char(str_pool[i + 1]) then
- i := i + 2
- else
- goto done;
- end;
- is_hex_string := true;
-done:
- if is_hex_string then
- pdf_print(s)
- else begin
- pdf_out("(");
- pdf_print(s);
- pdf_out(")");
- end;
-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 font is a new (has not been used yet),
-virtual or real font. The array |pdf_font_type| holds a flag of each used
-font. After initialization the flag of each font is set to |new_font_type|.
-The first time a character of a font is written out, \pdfTeX{} looks for
-the corresponding virtual font. If the corresponding virtual font exists, then
-the font type is set to |virtual_font_type|; otherwise it will be set to
-|real_font_type|. |subst_font_type| indicates fonts that have been substituted
-during adjusting spacing. Such fonts are linked via the |pdf_font_elink| array.
-
-@d new_font_type = 0 {new font (has not been used yet)}
-@d virtual_font_type = 1 {virtual font}
-@d real_font_type = 2 {real font}
-@d subst_font_type = 3 {substituted font}
-
-@<Declare procedures that need to be declared forward for \pdfTeX@>=
-procedure pdf_check_vf_cur_val; forward;
-procedure pdf_init_font_cur_val; forward;
-procedure scan_pdf_ext_toks; forward;
-
-@ @<Glob...@>=
-@!pdf_font_type: ^eight_bits; {the type of font}
-@!pdf_font_attr: ^str_number; {pointer to additional attributes}
-@!pdf_font_nobuiltin_tounicode: ^boolean; {disable generating ToUnicode for this font?}
-
-@ Here come some subroutines to deal with expanded fonts for HZ-algorithm.
-
-@d set_char_and_font(#) ==
-if is_char_node(#) then begin
- c := character(#);
- f := font(#);
-end
-else if type(#) = ligature_node then begin
- c := character(lig_char(#));
- f := font(lig_char(#));
-end
-
-@d non_existent_path == "///..."
-
-@p
-procedure set_tag_code(f: internal_font_number; c: eight_bits; i: integer);
-var fixedi:integer;
-begin
- if is_valid_char(c) then
- begin fixedi := abs(fix_int(i,-7,0));
- if fixedi >= 4 then begin
- if char_tag(char_info(f)(c)) = ext_tag then
- op_byte(char_info(f)(c)) := (op_byte(char_info(f)(c))) - ext_tag;
- fixedi := fixedi - 4;
- end;
- if fixedi >= 2 then begin
- if char_tag(char_info(f)(c)) = list_tag then
- op_byte(char_info(f)(c)) := (op_byte(char_info(f)(c))) - list_tag;
- fixedi := fixedi - 2;
- end;
- if fixedi >= 1 then begin
- if char_tag(char_info(f)(c)) = lig_tag then
- op_byte(char_info(f)(c)) := (op_byte(char_info(f)(c))) - lig_tag;
- end;
- end;
-end;
-
-procedure set_no_ligatures(f: internal_font_number);
-var c:integer;
-begin
- for c := font_bc[f] to font_ec[f] do
- if char_exists(orig_char_info(f)(c)) then
- if char_tag(orig_char_info(f)(c))=lig_tag then
- op_byte(orig_char_info(f)(c)) := (op_byte(orig_char_info(f)(c))) - lig_tag;
-end;
-
-function init_font_base(v: integer): integer;
-var i, j: integer;
-begin
- i := pdf_get_mem(256);
- for j := 0 to 255 do
- pdf_mem[i + j] := v;
- init_font_base := i;
-end;
-
-procedure set_lp_code(f: internal_font_number; c: eight_bits; i: integer);
-begin
- if pdf_font_lp_base[f] = 0 then
- pdf_font_lp_base[f] := init_font_base(0);
- pdf_mem[pdf_font_lp_base[f] + c] := fix_int(i, -1000, 1000);
-end;
-
-procedure set_rp_code(f: internal_font_number; c: eight_bits; i: integer);
-begin
- if pdf_font_rp_base[f] = 0 then
- pdf_font_rp_base[f] := init_font_base(0);
- pdf_mem[pdf_font_rp_base[f] + c] := fix_int(i, -1000, 1000);
-end;
-
-procedure set_ef_code(f: internal_font_number; c: eight_bits; i: integer);
-begin
- if pdf_font_ef_base[f] = 0 then
- pdf_font_ef_base[f] := init_font_base(1000);
- pdf_mem[pdf_font_ef_base[f] + c] := fix_int(i, 0, 1000);
-end;
-
-procedure set_kn_bs_code(f: internal_font_number; c: eight_bits; i: integer);
-begin
- if pdf_font_kn_bs_base[f] = 0 then
- pdf_font_kn_bs_base[f] := init_font_base(0);
- pdf_mem[pdf_font_kn_bs_base[f] + c] := fix_int(i, -1000, 1000);
-end;
-
-procedure set_st_bs_code(f: internal_font_number; c: eight_bits; i: integer);
-begin
- if pdf_font_st_bs_base[f] = 0 then
- pdf_font_st_bs_base[f] := init_font_base(0);
- pdf_mem[pdf_font_st_bs_base[f] + c] := fix_int(i, -1000, 1000);
-end;
-
-procedure set_sh_bs_code(f: internal_font_number; c: eight_bits; i: integer);
-begin
- if pdf_font_sh_bs_base[f] = 0 then
- pdf_font_sh_bs_base[f] := init_font_base(0);
- pdf_mem[pdf_font_sh_bs_base[f] + c] := fix_int(i, -1000, 1000);
-end;
-
-procedure set_kn_bc_code(f: internal_font_number; c: eight_bits; i: integer);
-begin
- if pdf_font_kn_bc_base[f] = 0 then
- pdf_font_kn_bc_base[f] := init_font_base(0);
- pdf_mem[pdf_font_kn_bc_base[f] + c] := fix_int(i, -1000, 1000);
-end;
-
-procedure set_kn_ac_code(f: internal_font_number; c: eight_bits; i: integer);
-begin
- if pdf_font_kn_ac_base[f] = 0 then
- pdf_font_kn_ac_base[f] := init_font_base(0);
- pdf_mem[pdf_font_kn_ac_base[f] + c] := fix_int(i, -1000, 1000);
-end;
-
-procedure adjust_interword_glue(p, g: pointer); {adjust the interword
-glue |g| after a character |p|}
-var kn, st, sh: scaled;
- q, r: pointer;
- c: halfword;
- f: internal_font_number;
-begin
- if not (not is_char_node(g) and type(g) = glue_node) then begin
- pdf_warning("adjust_interword_glue", "g is not a glue", false, false);
- return;
- end;
-
- c := non_char; {no char before interword glue yet}
- set_char_and_font(p) {set |f| and |c| if |p| is a char or ligature}
- else if (type(p) = kern_node) and
- (subtype(p) = auto_kern) and
- (save_tail <> null) then
- begin
- r := save_tail;
- while (link(r) <> null) and (link(r) <> p) do
- r := link(r);
- if (link(r) = p) then
- set_char_and_font(r); {set |f| and |c| if |r| is a char or ligature}
- end;
- if (c = non_char) then
- return;
-
- kn := get_kn_bs_code(f, c);
- st := get_st_bs_code(f, c);
- sh := get_sh_bs_code(f, c);
- if (kn <> 0) or (st <> 0) or (sh <> 0) then begin
- q := new_spec(glue_ptr(g));
- delete_glue_ref(glue_ptr(g));
- width(q) := width(q) + round_xn_over_d(quad(f), kn, 1000);
- stretch(q) := stretch(q) + round_xn_over_d(quad(f), st, 1000);
- shrink(q) := shrink(q) + round_xn_over_d(quad(f), sh, 1000);
- glue_ptr(g) := q;
- end;
-end;
-
-function get_auto_kern(f: internal_font_number; l, r: halfword): pointer;
-{return a pointer to an auto kern node, or |null|}
-var tmp_w: scaled;
- k: integer;
- p: pointer;
-begin
- pdfassert((l >= 0) and (r >= 0));
- get_auto_kern := null;
- if (pdf_append_kern <= 0) and (pdf_prepend_kern <= 0) then
- return;
- tmp_w := 0;
- if (pdf_append_kern > 0) and (l < non_char) then begin
- k := get_kn_ac_code(f, l);
- if k <> 0 then
- tmp_w := round_xn_over_d(quad(f), k, 1000);
- end;
- if (pdf_prepend_kern > 0) and (r < non_char) then begin
- k := get_kn_bc_code(f, r);
- if k <> 0 then
- tmp_w := tmp_w + round_xn_over_d(quad(f), k, 1000);
- end;
- if tmp_w <> 0 then begin
- p := new_kern(tmp_w);
- subtype(p) := auto_kern;
- get_auto_kern := p;
- end;
-end;
-
-
-function expand_font_name(f: internal_font_number; e: integer): str_number;
-var old_setting:0..max_selector; {holds |selector| setting}
-begin
- old_setting:=selector; selector:=new_string;
- print(font_name[f]);
- if e > 0 then
- print("+"); {minus sign will be printed by |print_int|}
- print_int(e);
- selector:=old_setting;
- expand_font_name := make_string;
-end;
-
-function auto_expand_font(f: internal_font_number; e: integer): internal_font_number;
-{creates an expanded font from the base font; doesn't load expanded tfm at all}
-var k: internal_font_number;
- nw, nk, ni, i: integer;
-begin
- k := font_ptr + 1;
- incr(font_ptr);
- if (font_ptr >= font_max) then
- overflow("maximum internal font number (font_max)", font_max);
- font_name[k] := expand_font_name(f, e);
- font_area[k] := font_area[f];
- font_id_text(k) := font_id_text(f);
- hyphen_char[k] := hyphen_char[f];
- skew_char[k] := skew_char[f];
- font_bchar[k] := font_bchar[f];
- font_false_bchar[k] := font_false_bchar[f];
- font_bc[k] := font_bc[f];
- font_ec[k] := font_ec[f];
- font_size[k] := font_size[f];
- font_dsize[k] := font_dsize[f];
- font_params[k] := font_params[f];
- font_glue[k] := font_glue[f];
- bchar_label[k] := bchar_label[f];
-
- char_base[k] := char_base[f];
- height_base[k] := height_base[f];
- depth_base[k] := depth_base[f];
- lig_kern_base[k] := lig_kern_base[f];
- exten_base[k] := exten_base[f];
- param_base[k] := param_base[f];
-
- nw := height_base[f] - width_base[f];
- ni := lig_kern_base[f] - italic_base[f];
- nk := exten_base[f] - (kern_base[f] + kern_base_offset);
- if (fmem_ptr + nw + ni + nk >= font_mem_size) then
- overflow("number of words of font memory (font_mem_size)", font_mem_size);
- width_base[k] := fmem_ptr;
- italic_base[k] := width_base[k] + nw;
- kern_base[k] := italic_base[k] + ni - kern_base_offset;
- fmem_ptr := fmem_ptr + nw + ni + nk;
-
- for i := 0 to nw - 1 do
- font_info[width_base[k] + i].sc :=
- round_xn_over_d(font_info[width_base[f] + i].sc, 1000 + e, 1000);
- for i := 0 to ni - 1 do
- font_info[italic_base[k] + i].sc :=
- round_xn_over_d(font_info[italic_base[f] + i].sc, 1000 + e, 1000);
- for i := 0 to nk - 1 do
- font_info[kern_base[k] + kern_base_offset + i].sc :=
- round_xn_over_d(font_info[kern_base[f] + kern_base_offset + i].sc, 1000 + e, 1000);
-
- auto_expand_font := k;
-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
- if pdf_font_rp_base[f] = 0 then
- pdf_font_rp_base[f] := init_font_base(0);
- if pdf_font_lp_base[f] = 0 then
- pdf_font_lp_base[f] := init_font_base(0);
- if pdf_font_ef_base[f] = 0 then
- pdf_font_ef_base[f] := init_font_base(1000);
- pdf_font_expand_ratio[k] := e;
- pdf_font_step[k] := pdf_font_step[f];
- pdf_font_auto_expand[k] := pdf_font_auto_expand[f];
- pdf_font_blink[k] := f;
- pdf_font_lp_base[k] := pdf_font_lp_base[f];
- pdf_font_rp_base[k] := pdf_font_rp_base[f];
- pdf_font_ef_base[k] := pdf_font_ef_base[f];
-
- if pdf_font_kn_bs_base[f] = 0 then
- pdf_font_kn_bs_base[f] := init_font_base(0);
- if pdf_font_st_bs_base[f] = 0 then
- pdf_font_st_bs_base[f] := init_font_base(0);
- if pdf_font_sh_bs_base[f] = 0 then
- pdf_font_sh_bs_base[f] := init_font_base(0);
- if pdf_font_kn_bc_base[f] = 0 then
- pdf_font_kn_bc_base[f] := init_font_base(0);
- if pdf_font_kn_ac_base[f] = 0 then
- pdf_font_kn_ac_base[f] := init_font_base(0);
- pdf_font_kn_bs_base[k] := pdf_font_kn_bs_base[f];
- pdf_font_st_bs_base[k] := pdf_font_st_bs_base[f];
- pdf_font_sh_bs_base[k] := pdf_font_sh_bs_base[f];
- pdf_font_kn_bc_base[k] := pdf_font_kn_bc_base[f];
- pdf_font_kn_ac_base[k] := pdf_font_kn_ac_base[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|}
-var k: internal_font_number;
-begin
- if fs <> 0 then begin
- for k := font_base + 1 to font_ptr do
- if (font_area[k] <> non_existent_path) and
- str_eq_str(font_name[k], s) and
- (font_size[k] = fs) then
- begin
- flush_str(s);
- tfm_lookup := k;
- return;
- end;
- end
- else begin
- for k := font_base + 1 to font_ptr do
- if (font_area[k] <> non_existent_path) and
- str_eq_str(font_name[k], s) then
- begin
- flush_str(s);
- tfm_lookup := k;
- return;
- end;
- end;
- tfm_lookup := null_font;
-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
- k := auto_expand_font(f, e)
- else
- k := read_font_info(null_cs, s, "", font_size[f]);
- end;
- if k <> null_font then
- 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);
- pdf_font_elink[k] := pdf_font_elink[f];
- pdf_font_elink[f] := k;
- 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
- pdf_font_step[f] := font_step;
- pdf_font_auto_expand[f] := auto_expand;
- if stretch_limit > 0 then
- pdf_font_stretch[f] := get_expand_font(f, stretch_limit);
- if shrink_limit > 0 then
- pdf_font_shrink[f] := get_expand_font(f, -shrink_limit);
- if expand_ratio <> 0 then
- pdf_font_expand_ratio[f] := expand_ratio;
-end;
-
-procedure vf_expand_local_fonts(f: internal_font_number);
-var lf: internal_font_number;
- k: integer;
-begin
- pdfassert(pdf_font_type[f] = virtual_font_type);
- for k := 0 to vf_local_font_num[f] - 1 do begin
- lf := vf_i_fnts[vf_default_font[f] + k];
- set_expand_params(lf, pdf_font_auto_expand[f],
- pdf_font_expand_ratio[pdf_font_stretch[f]],
- -pdf_font_expand_ratio[pdf_font_shrink[f]],
- pdf_font_step[f], pdf_font_expand_ratio[f]);
- if pdf_font_type[lf] = virtual_font_type then
- vf_expand_local_fonts(lf);
- end;
-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 (pdf_font_type[f] <> new_font_type) and (pdf_font_type[f] <> virtual_font_type) 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 pdf_font_type[f] = virtual_font_type then
- vf_expand_local_fonts(f);
- end;
-end;
-
-@ We implement robust letter spacing using virtual font.
-
-@d vf_replace_z ==
-begin
- vf_alpha:=16;
- while vf_z>=@'40000000 do begin
- vf_z:=vf_z div 2;
- vf_alpha:=vf_alpha+vf_alpha;
- end;
- vf_beta:=256 div vf_alpha;
- vf_alpha:=vf_alpha*vf_z;
-end
-
-@p
-function letter_space_font(u: pointer; f: internal_font_number; e: integer): internal_font_number;
-var k: internal_font_number;
- w, r: scaled;
- s: str_number;
- i, nw: integer;
- old_setting:0..max_selector;
- vf_z: integer;
- vf_alpha: integer;
- vf_beta: 1..16;
-begin
- {read a new font and expand the character widths}
- k := read_font_info(u, font_name[f], "", font_size[f]);
- if scan_keyword("nolig") then
- set_no_ligatures(k); {disable ligatures for letter-spaced fonts}
- nw := height_base[k] - width_base[k];
- for i := 0 to nw - 1 do
- font_info[width_base[k] + i].sc :=
- font_info[width_base[k] + i].sc + round_xn_over_d(quad(k), e, 1000);
-
- {append, e.g., '+100ls' to font name}
- flush_str(font_name[k]);
- str_room(length(font_name[k]) + 7); {|abs(e) <= 1000|}
- old_setting := selector;
- selector := new_string;
- print(font_name[k]);
- if e > 0 then
- print("+"); {minus sign will be printed by |print_int|}
- print_int(e);
- print("ls");
- selector := old_setting;
- font_name[k] := make_string;
-
- {create the corresponding virtual font}
- allocvffnts;
- vf_e_fnts[vf_nf] := 0;
- vf_i_fnts[vf_nf] := f;
- incr(vf_nf);
- vf_local_font_num[k] := 1;
- vf_default_font[k] := vf_nf - 1;
- pdf_font_type[k] := virtual_font_type;
-
- vf_z := font_size[f];
- vf_replace_z;
- w := round_xn_over_d(quad(f), e, 2000);
- if w >= 0 then
- tmp_b0 := 0
- else begin
- tmp_b0 := 255;
- w := vf_alpha + w;
- end;
- r := w*vf_beta;
- tmp_b1 := r div vf_z;
- r := r mod vf_z;
- if r = 0 then
- tmp_b2 := 0
- else begin
- r := r * 256;
- tmp_b2 := r div vf_z;
- r := r mod vf_z;
- end;
- if r = 0 then
- tmp_b3 := 0
- else begin
- r := r * 256;
- tmp_b3 := r div vf_z;
- end;
- vf_packet_base[k] := new_vf_packet(k);
- for c := font_bc[k] to font_ec[k] do begin
- str_room(12);
- append_char(right1 + 3);
- append_char(tmp_b0);
- append_char(tmp_b1);
- append_char(tmp_b2);
- append_char(tmp_b3);
- if c < set1 then
- append_char(c)
- else begin
- append_char(set1);
- append_char(c);
- end;
- append_char(right1 + 3);
- append_char(tmp_b0);
- append_char(tmp_b1);
- append_char(tmp_b2);
- append_char(tmp_b3);
- s := make_string;
- storepacket(k, c, s);
- flush_str(s);
- end;
- letter_space_font := k;
-end;
-
-procedure new_letterspaced_font(a: small_number);
-{letter-space a font by creating a virtual font}
-var u:pointer; {user's font identifier}
-@!t:str_number; {name for the frozen font identifier}
-@!old_setting:0..max_selector; {holds |selector| setting}
-@!f, k:internal_font_number;
-begin
- get_r_token; u:=cur_cs;
- if u>=hash_base then t:=text(u)
- else if u>=single_base then
- if u=null_cs then t:="FONT"@+else t:=u-single_base
- else begin old_setting:=selector; selector:=new_string;
- print("FONT"); print(u-active_base); selector:=old_setting;
- @.FONTx@>
- str_room(1); t:=make_string;
- end;
- define(u,set_font,null_font); scan_optional_equals; scan_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;
-
-function is_letterspaced_font(f: internal_font_number): boolean;
-label done;
-var i, j: pool_pointer;
-begin
- is_letterspaced_font := false;
- if pdf_font_type[f] <> virtual_font_type then
- return;
- i := str_start[font_name[f] + 1] - 1;
- j := str_start[font_name[f]];
- if (str_pool[i - 1] <> 'l') or (str_pool[i] <> 's') then
- return;
- i := i - 2;
- while i >= j do begin
- if (str_pool[i] < '0') or (str_pool[i] > '9') then
- goto done;
- i := i - 1;
- end;
-done:
- if i < j then
- return;
- if (str_pool[i] <> '+') and (str_pool[i] <> '-') then
- return;
- is_letterspaced_font := true;
-end;
-
-function copy_font_info(f: internal_font_number): internal_font_number;
-{create a copy of |f| in the font mem}
-var lf, bc, ec, i: halfword;
- k: internal_font_number;
-begin
- if (pdf_font_expand_ratio[f] <> 0) or (pdf_font_step[f] <> 0) then
- pdf_error("\pdfcopyfont", "cannot copy an expanded font");
- if is_letterspaced_font(f) then
- pdf_error("\pdfcopyfont", "cannot copy a letterspaced font");
-
- k := font_ptr + 1;
- incr(font_ptr);
- if (font_ptr >= font_max) then
- overflow("maximum internal font number (font_max)", font_max);
- font_name[k] := font_name[f];
- font_area[k] := non_existent_path; {to avoid interferences with |new_font()| and |tfm_lookup()|}
- hyphen_char[k] := hyphen_char[f];
- skew_char[k] := skew_char[f];
- font_bchar[k] := font_bchar[f];
- font_false_bchar[k] := font_false_bchar[f];
- font_bc[k] := font_bc[f];
- font_ec[k] := font_ec[f];
- font_size[k] := font_size[f];
- font_dsize[k] := font_dsize[f];
- font_params[k] := font_params[f];
- font_glue[k] := font_glue[f];
- bchar_label[k] := bchar_label[f];
-
- {set base addresses}
- bc := font_bc[f];
- ec := font_ec[f];
- char_base[k] := fmem_ptr - bc;
- width_base[k] := char_base[k] + ec + 1;
-
- height_base[k] := width_base[k] + (height_base[f] - width_base[f]);
- depth_base[k] := height_base[k] + (depth_base[f] - height_base[f]);
- italic_base[k] := depth_base[k] + (italic_base[f] - depth_base[f]);
- lig_kern_base[k] := italic_base[k] + (lig_kern_base[f] - italic_base[f]);
- kern_base[k] := lig_kern_base[k] + (kern_base[f] - lig_kern_base[f]);
- exten_base[k] := kern_base[k] + (exten_base[f] - kern_base[f]);
- param_base[k] := exten_base[k] + (param_base[f] - exten_base[f]);
-
- {allocate memory for the new font |k| and copy data from |f|}
- lf := (param_base[f] - char_base[f]) + font_params[f] + 1;
- if (fmem_ptr + lf >= font_mem_size) then
- overflow("number of words of font memory (font_mem_size)", font_mem_size);
- for i := 0 to lf - 1 do
- font_info[char_base[k] + bc + i] := font_info[char_base[f] + bc + i];
- fmem_ptr := fmem_ptr + lf;
-
- copy_font_info := k;
-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}
-@!old_setting:0..max_selector; {holds |selector| setting}
-@!f, k:internal_font_number;
-begin
- get_r_token; u:=cur_cs;
- if u>=hash_base then t:=text(u)
- else if u>=single_base then
- if u=null_cs then t:="FONT"@+else t:=u-single_base
- else begin old_setting:=selector; selector:=new_string;
- print("FONT"); print(u-active_base); selector:=old_setting;
- @.FONTx@>
- str_room(1); t:=make_string;
- end;
- define(u,set_font,null_font); scan_optional_equals; scan_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_used_array = array[0..31] of eight_bits;
-char_map_array = array[0..32] of eight_bits; {move chars in range 0..32}
-fm_entry_ptr = ^integer;
-
-@ @<Glob...@>=
-@!pdf_char_used: ^char_used_array; {to mark used chars}
-@!pdf_font_size: ^scaled; {used size of font in PDF file}
-@!pdf_font_num: ^integer; {mapping between internal font number in \TeX\ and
- font name defined in resources in PDF file}
-@!pdf_font_map: ^fm_entry_ptr; {pointer into AVL tree of font mappings}
-@!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;
-
-@ Here we implement reading information from \.{VF} file.
-
-@d vf_max_packet_length = 10000 {max length of character packet in \.{VF} file}
-@#
-@d do_char = 70 {label to go to typesetting a character of virtual font}
-@#
-@d long_char = 242 {\.{VF} command for general character packet}
-@d vf_id = 202 {identifies \.{VF} files}
-@d put1=133 {typeset a character}
-@d four_cases(#) == #,#+1,#+2,#+3
-@#
-@d tmp_b0 == tmp_w.qqqq.b0
-@d tmp_b1 == tmp_w.qqqq.b1
-@d tmp_b2 == tmp_w.qqqq.b2
-@d tmp_b3 == tmp_w.qqqq.b3
-@d tmp_int == tmp_w.int
-@#
-@d bad_vf(#) == vf_error(font_name[f], #) {quit with an error message telling the vf filename}
-
-@<Glob...@>=
-@!vf_packet_base: ^integer; {base addresses of character packets from virtual fonts}
-@!vf_default_font: ^internal_font_number; {default font in a \.{VF} file}
-@!vf_local_font_num: ^internal_font_number; {number of local fonts in a \.{VF} file}
-@!vf_packet_length: integer; {length of the current packet}
-@!vf_file: byte_file;
-@!vf_nf: internal_font_number; {the local fonts counter}
-@!vf_e_fnts: ^integer; {external font numbers}
-@!vf_i_fnts: ^internal_font_number; {corresponding internal font numbers}
-@!tmp_w: memory_word; {accumulator}
-
-@ @<Set init...@>=
-vf_nf := 0;
-
-@ The |do_vf| procedure attempts to read the \.{VF} file for a font, and sets
-|pdf_font_type| to |real_font_type| if the \.{VF} file could not be found
-or loaded, otherwise sets |pdf_font_type| to |virtual_font_type|. To
-process font definitions in virtual font we call |vf_def_font|.
-
-@p
-procedure vf_error(filename, msg: str_number);
-var old_setting:0..max_selector; {holds print |selector|}
- s: str_number;
-begin
- str_room(length(filename) + 3);
- old_setting:=selector; selector:=new_string;
- print(filename);
- print(".vf");
- s := make_string;
- selector:=old_setting;
- pdf_error(s, msg);
-end;
-
-function vf_byte: eight_bits; {read a byte from |vf_file|}
-var i: integer;
-begin
- i := getc(vf_file);
- if i < 0 then
- pdf_error("vf", "unexpected EOF or error");
- vf_byte := i;
-end;
-
-function vf_read_signed(k: integer): integer;
-{read |k| bytes as an signed integer from \.{VF} file}
-var i: integer;
-begin
- pdfassert((k > 0) and (k <= 4));
- i := vf_byte;
- if i >= 128 then
- i := i - 256;
- decr(k);
- while k > 0 do begin
- i := i*256 + vf_byte;
- decr(k);
- end;
- vf_read_signed := i;
-end;
-
-function vf_read_unsigned(k: integer): integer;
-{read |k| bytes as an unsigned integer from \.{VF} file}
-var i: integer;
-begin
- pdfassert((k > 0) and (k <= 4));
- i := vf_byte;
- if (k = 4) and (i >= 128) then
- bad_vf("number too big");
- decr(k);
- while k > 0 do begin
- i := i*256 + vf_byte;
- decr(k);
- end;
- vf_read_unsigned := i;
-end;
-
-procedure vf_local_font_warning(f, k: internal_font_number; s: str_number);
-{print a warning message if an error occurs during processing local fonts in
-\.{VF} file}
-begin
- print_nl(s);
- print(" in local font ");
- print(font_name[k]);
- print(" in virtual font ");
- print(font_name[f]);
- print(".vf ignored.");
-end;
-
-function vf_def_font(f: internal_font_number): internal_font_number;
-{process a local font in \.{VF} file}
-var k: internal_font_number;
- s: str_number;
- ds, fs: scaled;
- cs: four_quarters;
-begin
- cs.b0 := vf_byte; cs.b1 := vf_byte; cs.b2 := vf_byte; cs.b3 := vf_byte;
- fs := store_scaled_f(vf_read_signed(4), font_size[f]);
- ds := vf_read_signed(4) div @'20;
- tmp_b0 := vf_byte;
- tmp_b1 := vf_byte;
- while tmp_b0 > 0 do begin
- decr(tmp_b0);
- call_func(vf_byte); {skip the font path}
- end;
- str_room(tmp_b1);
- while tmp_b1 > 0 do begin
- decr(tmp_b1);
- append_char(vf_byte);
- end;
- s := make_string;
- k := tfm_lookup(s, fs);
- if k = null_font then
- k := read_font_info(null_cs, s, "", fs);
- if k <> null_font then begin
- if ((cs.b0 <> 0) or (cs.b1 <> 0) or (cs.b2 <> 0) or (cs.b3 <> 0)) and
- ((font_check[k].b0 <> 0) or (font_check[k].b1 <> 0) or
- (font_check[k].b2 <> 0) or (font_check[k].b3 <> 0)) and
- ((cs.b0 <> font_check[k].b0) or (cs.b1 <> font_check[k].b1) or
- (cs.b2 <> font_check[k].b2) or (cs.b3 <> font_check[k].b3)) then
- vf_local_font_warning(f, k, "checksum mismatch");
- if ds <> font_dsize[k] then
- vf_local_font_warning(f, k, "design size mismatch");
- if (pdf_font_step[f] <> 0) then
- set_expand_params(k, pdf_font_auto_expand[f],
- pdf_font_expand_ratio[pdf_font_stretch[f]],
- -pdf_font_expand_ratio[pdf_font_shrink[f]],
- pdf_font_step[f], pdf_font_expand_ratio[f]);
- end;
- vf_def_font := k;
-end;
-
-procedure do_vf(f: internal_font_number); {process \.{VF} file with font internal number |f|}
-var cmd, k, n: integer;
- cc, cmd_length, packet_length: integer;
- tfm_width: scaled;
- s: str_number;
- stack_level: vf_stack_index;
- save_vf_nf: internal_font_number;
-begin
- pdf_font_type[f] := real_font_type;
- if auto_expand_vf(f) then
- return; {auto-expanded virtual font}
- stack_level := 0;
- @<Open |vf_file|, return if not found@>;
- @<Process the preamble@>;@/
- @<Process the font definitions@>;@/
- @<Allocate memory for the new virtual font@>;@/
- while cmd <= long_char do begin@/
- @<Build a character packet@>;@/
- end;
- if cmd <> post then
- bad_vf("POST command expected");
- b_close(vf_file);
- pdf_font_type[f] := virtual_font_type;
-end;
-
-@ @<Open |vf_file|, return if not found@>=
-pack_file_name(font_name[f], "", ".vf");
-if not vf_b_open_in(vf_file) then
- return
-
-@ @<Process the preamble@>=
-if vf_byte <> pre then
- bad_vf("PRE command expected");
-if vf_byte <> vf_id then
- bad_vf("wrong id byte");
-cmd_length := vf_byte;
-for k := 1 to cmd_length do
- call_func(vf_byte); {skip the comment}
-tmp_b0 := vf_byte; tmp_b1 := vf_byte; tmp_b2 := vf_byte; tmp_b3 := vf_byte;
-if ((tmp_b0 <> 0) or (tmp_b1 <> 0) or (tmp_b2 <> 0) or (tmp_b3 <> 0)) and
- ((font_check[f].b0 <> 0) or (font_check[f].b1 <> 0) or
- (font_check[f].b2 <> 0) or (font_check[f].b3 <> 0)) and
- ((tmp_b0 <> font_check[f].b0) or (tmp_b1 <> font_check[f].b1) or
- (tmp_b2 <> font_check[f].b2) or (tmp_b3 <> font_check[f].b3)) then begin
- print_nl("checksum mismatch in font ");
- print(font_name[f]);
- print(".vf ignored");
-end;
-if vf_read_signed(4) div @'20 <> font_dsize[f] then begin
- print_nl("design size mismatch in font ");
- print(font_name[f]);
- print(".vf ignored");
-end;
-update_terminal
-
-@ @<Process the font definitions@>=
-cmd := vf_byte;
-save_vf_nf := vf_nf;
-while (cmd >= fnt_def1) and (cmd <= fnt_def1 + 3) do begin
- allocvffnts;
- vf_e_fnts[vf_nf] := vf_read_unsigned(cmd - fnt_def1 + 1);
- vf_i_fnts[vf_nf] := vf_def_font(f);
- incr(vf_nf);
- cmd := vf_byte;
-end;
-vf_default_font[f] := save_vf_nf;
-vf_local_font_num[f] := vf_nf - save_vf_nf;
-
-@ @<Allocate memory for the new virtual font@>=
- vf_packet_base[f] := new_vf_packet(f)
-
-@ @<Build a character packet@>=
-if cmd = long_char then begin
- packet_length := vf_read_unsigned(4);
- cc := vf_read_unsigned(4);
- if not is_valid_char(cc) then
- bad_vf("invalid character code");
- tfm_width := store_scaled_f(vf_read_signed(4), font_size[f]);
-end
-else begin
- packet_length := cmd;
- cc := vf_byte;
- if not is_valid_char(cc) then
- bad_vf("invalid character code");
- tfm_width := store_scaled_f(vf_read_unsigned(3), font_size[f]);
-end;
-if packet_length < 0 then
- bad_vf("negative packet length");
-if packet_length > vf_max_packet_length then
- bad_vf("packet length too long");
-if tfm_width <> char_width(f)(char_info(f)(cc)) then begin
- print_nl("character width mismatch in font ");
- print(font_name[f]);
- print(".vf ignored");
-end;
-str_room(packet_length);
-while packet_length > 0 do begin
- cmd := vf_byte;
- decr(packet_length);
- @<Cases of \.{DVI} commands that can appear in character packet@>;
- if cmd <> nop then
- append_char(cmd);
- packet_length := packet_length - cmd_length;
- while cmd_length > 0 do begin
- decr(cmd_length);
- append_char(vf_byte);
- end;
-end;
-if stack_level <> 0 then
- bad_vf("more PUSHs than POPs in character packet");
-if packet_length <> 0 then
- bad_vf("invalid packet length or DVI command in packet");
-@<Store the packet being built@>;
-cmd := vf_byte
-
-@ @<Store the packet being built@>=
-s := make_string;
-storepacket(f, cc, s);
-flush_str(s)
-
-@ @<Cases of \.{DVI} commands that can appear in character packet@>=
-if (cmd >= set_char_0) and (cmd <= set_char_0 + 127) then
- cmd_length := 0
-else if ((fnt_num_0 <= cmd) and (cmd <= fnt_num_0 + 63)) or
- ((fnt1 <= cmd) and (cmd <= fnt1 + 3)) then begin
- if cmd >= fnt1 then begin
- k := vf_read_unsigned(cmd - fnt1 + 1);
- packet_length := packet_length - (cmd - fnt1 + 1);
- end
- else
- k := cmd - fnt_num_0;
- if k >= 256 then
- bad_vf("too many local fonts");
- n := 0;
- while (n < vf_local_font_num[f]) and
- (vf_e_fnts[vf_default_font[f] + n] <> k) do
- incr(n);
- if n = vf_local_font_num[f] then
- bad_vf("undefined local font");
- if k <= 63 then
- append_char(fnt_num_0 + k)
- else begin
- append_char(fnt1);
- append_char(k);
- end;
- cmd_length := 0;
- cmd := nop;
-end
-else case cmd of
-set_rule, put_rule: cmd_length := 8;
-four_cases(set1): cmd_length := cmd - set1 + 1;
-four_cases(put1): cmd_length := cmd - put1 + 1;
-four_cases(right1): cmd_length := cmd - right1 + 1;
-four_cases(w1): cmd_length := cmd - w1 + 1;
-four_cases(x1): cmd_length := cmd - x1 + 1;
-four_cases(down1): cmd_length := cmd - down1 + 1;
-four_cases(y1): cmd_length := cmd - y1 + 1;
-four_cases(z1): cmd_length := cmd - z1 + 1;
-four_cases(xxx1): begin
- cmd_length := vf_read_unsigned(cmd - xxx1 + 1);
- packet_length := packet_length - (cmd - xxx1 + 1);
- if cmd_length > vf_max_packet_length then
- bad_vf("packet length too long");
- if cmd_length < 0 then
- bad_vf("string of negative length");
- append_char(xxx1);
- append_char(cmd_length);
- cmd := nop; {|cmd| has been already stored above as |xxx1|}
-end;
-w0, x0, y0, z0, nop:
- cmd_length := 0;
-push, pop: begin
- cmd_length := 0;
- if cmd = push then
- if stack_level = vf_stack_size then
- overflow("virtual font stack size", vf_stack_size)
- else
- incr(stack_level)
- else
- if stack_level = 0 then
- bad_vf("more POPs than PUSHs in character")
- else
- decr(stack_level);
-end;
-othercases
- bad_vf("improver DVI command");
-endcases
-
-@ @p
-procedure pdf_check_vf_cur_val;
-var f: internal_font_number;
-begin
- f := cur_val;
- do_vf(f);
- if pdf_font_type[f] = virtual_font_type then
- pdf_error("font", "command cannot be used with virtual font");
-end;
-
-function auto_expand_vf(f: internal_font_number): boolean;
-{check for a virtual auto-expanded font}
-var bf, lf: internal_font_number;
- e, k: integer;
-begin
- auto_expand_vf := false;
- if (not pdf_font_auto_expand[f]) or (pdf_font_blink[f] = null_font) then
- return; {not an auto-expanded font}
- bf := pdf_font_blink[f];
- if pdf_font_type[bf] = new_font_type then {we must process the base font first}
- do_vf(bf);
- if pdf_font_type[bf] <> virtual_font_type then
- return; {not a virtual font}
-
- e := pdf_font_expand_ratio[f];
- for k := 0 to vf_local_font_num[bf] - 1 do begin
- lf := vf_default_font[bf] + k;
- allocvffnts;
- {copy vf local font numbers:}
- vf_e_fnts[vf_nf] := vf_e_fnts[lf];
- {definition of local vf fonts are expanded from base fonts:}
- vf_i_fnts[vf_nf] := auto_expand_font(vf_i_fnts[lf], e);
- copy_expand_params(vf_i_fnts[vf_nf], vf_i_fnts[lf], e);
- incr(vf_nf);
- end;
- vf_packet_base[f] := vf_packet_base[bf];
- vf_local_font_num[f] := vf_local_font_num[bf];
- vf_default_font[f] := vf_nf - vf_local_font_num[f];
-
- pdf_font_type[f] := virtual_font_type;
- auto_expand_vf := true;
-end;
-
-@ The |do_vf_packet| procedure is called in order to interpret the
-character packet for a virtual character. Such a packet may contain the
-instruction to typeset a character from the same or an other virtual
-font; in such cases |do_vf_packet| calls itself recursively. The
-recursion level, i.e., the number of times this has happened, is kept
-in the global variable |vf_cur_s| and should not exceed |vf_max_recursion|.
-
-@<Constants...@>=
-@!vf_max_recursion=10; {\.{VF} files shouldn't recurse beyond this level}
-@!vf_stack_size=100; {\.{DVI} files shouldn't |push| beyond this depth}
-
-@ @<Types...@>=
-@!vf_stack_index=0..vf_stack_size; {an index into the stack}
-@!vf_stack_record=record
- stack_h, stack_v, stack_w, stack_x, stack_y, stack_z: scaled;
-end;
-
-@ @<Glob...@>=
-@!vf_cur_s: 0..vf_max_recursion; {current recursion level}
-@!vf_stack: array [vf_stack_index] of vf_stack_record;
-@!vf_stack_ptr: vf_stack_index; {pointer into |vf_stack|}
-
-@ @<Set init...@>=
-vf_cur_s := 0;
-vf_stack_ptr := 0;
-
-@ Some functions for processing character packets.
-
-@p function packet_read_signed(k: integer): integer;
-{read |k| bytes as a signed integer from character packet}
-var i: integer;
-begin
- pdfassert((k > 0) and (k <= 4));
- i := packet_byte;
- if i >= 128 then
- i := i - 256;
- decr(k);
- while k > 0 do begin
- i := i*256 + packet_byte;
- decr(k);
- end;
- packet_read_signed := i;
-end;
-
-function packet_read_unsigned(k: integer): integer;
-{read |k| bytes as an unsigned integer from character packet}
-var i: integer;
-begin
- pdfassert((k > 0) and (k <= 4));
- i := packet_byte;
- if (k = 4) and (i >= 128) then
- bad_vf("number too big");
- decr(k);
- while k > 0 do begin
- i := i*256 + packet_byte;
- decr(k);
- end;
- packet_read_unsigned := i;
-end;
-
-function packet_scaled(k: integer; fs: scaled): scaled;
-{get |k| bytes from packet as scaled}
-begin
- packet_scaled := store_scaled_f(packet_read_signed(k), fs);
-end;
-
-procedure do_vf_packet(vf_f: internal_font_number; c: eight_bits); {typeset the
-\.{DVI} commands in the character packet for character |c| in current font |f|}
-label do_char, continue;
-var f, k, n: internal_font_number;
- save_cur_h, save_cur_v: scaled;
- cmd: integer;
- char_move: boolean;
- w, x, y, z: scaled;
- s: str_number;
-begin
- incr(vf_cur_s);
- if vf_cur_s > vf_max_recursion then
- overflow("max level recursion of virtual fonts", vf_max_recursion);
- save_cur_v := cur_v;
- save_cur_h := cur_h;
- push_packet_state; {save pointer and length of the current packet}
- start_packet(vf_f, c); {set pointer and length of the new packet}
- f := vf_i_fnts[vf_default_font[vf_f]];
- w := 0; x := 0; y := 0; z := 0;
- while vf_packet_length > 0 do begin
- cmd := packet_byte;
- @<Do typesetting the \.{DVI} commands in virtual character packet@>;
-continue:
- end;
- pop_packet_state; {restore pointer and length of the previous packet}
- cur_v := save_cur_v;
- cur_h := save_cur_h;
- decr(vf_cur_s);
-end;
-
-@ The following code typesets a character to PDF output.
-
-@d output_one_char(#) == begin
- if pdf_font_type[f] = new_font_type then
- do_vf(f);
- if pdf_font_type[f] = virtual_font_type then
- do_vf_packet(f, #)
- else begin
- pdf_begin_string(f);
- pdf_print_char(f, #);
- adv_char_width(f, #);
- end;
-end
-
-@<Do typesetting the \.{DVI} commands in virtual character packet@>=
-if (cmd >= set_char_0) and (cmd <= set_char_0 + 127) then begin
- if not is_valid_char(cmd) then begin
- char_warning(f, cmd);
- goto continue;
- end;
- c := cmd;
- char_move := true;
- goto do_char;
-end
-else if ((fnt_num_0 <= cmd) and (cmd <= fnt_num_0 + 63)) or (cmd = fnt1) then begin
- if cmd = fnt1 then
- k := packet_byte
- else
- k := cmd - fnt_num_0;
- n := 0;
- while (n < vf_local_font_num[vf_f]) and
- (vf_e_fnts[vf_default_font[vf_f] + n] <> k) do
- incr(n);
- if (n = vf_local_font_num[vf_f]) then
- pdf_error("vf", "local font not found")
- else
- f := vf_i_fnts[vf_default_font[vf_f] + n];
-end
-else case cmd of
-push: begin
- vf_stack[vf_stack_ptr].stack_h := cur_h;
- vf_stack[vf_stack_ptr].stack_v := cur_v;
- vf_stack[vf_stack_ptr].stack_w := w;
- vf_stack[vf_stack_ptr].stack_x := x;
- vf_stack[vf_stack_ptr].stack_y := y;
- vf_stack[vf_stack_ptr].stack_z := z;
- incr(vf_stack_ptr);
-end;
-pop: begin
- decr(vf_stack_ptr);
- cur_h := vf_stack[vf_stack_ptr].stack_h;
- cur_v := vf_stack[vf_stack_ptr].stack_v;
- w := vf_stack[vf_stack_ptr].stack_w;
- x := vf_stack[vf_stack_ptr].stack_x;
- y := vf_stack[vf_stack_ptr].stack_y;
- z := vf_stack[vf_stack_ptr].stack_z;
-end;
-four_cases(set1), four_cases(put1): begin
- if (set1 <= cmd) and (cmd <= set1 + 3) then begin
- tmp_int := packet_read_unsigned(cmd - set1 + 1);
- char_move := true;
- end
- else begin
- tmp_int := packet_read_unsigned(cmd - put1 + 1);
- char_move := false;
- end;
- if not is_valid_char(tmp_int) then begin
- char_warning(f, tmp_int);
- goto continue;
- end;
- c := tmp_int;
- goto do_char;
-end;
-set_rule, put_rule: begin
- rule_ht := packet_scaled(4, font_size[vf_f]);
- rule_wd := packet_scaled(4, font_size[vf_f]);
- if (rule_wd > 0) and (rule_ht > 0) then begin
- pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
- if cmd = set_rule then
- cur_h := cur_h + rule_wd;
- end;
-end;
-four_cases(right1):
- cur_h := cur_h + packet_scaled(cmd - right1 + 1, font_size[vf_f]);
-w0, four_cases(w1): begin
- if cmd > w0 then
- w := packet_scaled(cmd - w0, font_size[vf_f]);
- cur_h := cur_h + w;
-end;
-x0, four_cases(x1): begin
- if cmd > x0 then
- x := packet_scaled(cmd - x0, font_size[vf_f]);
- cur_h := cur_h + x;
-end;
-four_cases(down1):
- cur_v := cur_v + packet_scaled(cmd - down1 + 1, font_size[vf_f]);
-y0, four_cases(y1): begin
- if cmd > y0 then
- y := packet_scaled(cmd - y0, font_size[vf_f]);
- cur_v := cur_v + y;
-end;
-z0, four_cases(z1): begin
- if cmd > z0 then
- z := packet_scaled(cmd - z0, font_size[vf_f]);
- cur_v := cur_v + z;
-end;
-four_cases(xxx1): begin
- tmp_int := packet_read_unsigned(cmd - xxx1 + 1);
- str_room(tmp_int);
- while tmp_int > 0 do begin
- decr(tmp_int);
- append_char(packet_byte);
- end;
- s := make_string;
- literal(s, scan_special, false);
- flush_str(s);
-end;
-othercases pdf_error("vf", "invalid DVI command");
-endcases;
-goto continue;
-do_char:
-if is_valid_char(c) then
- output_one_char(c)
-else
- char_warning(f, c);
-if char_move then
- cur_h := cur_h + char_width(f)(char_info(f)(c))
-
-@* \[32f] PDF shipping out.
-To ship out a \TeX\ box to PDF page description we need to implement
-|pdf_hlist_out|, |pdf_vlist_out| and |pdf_ship_out|, which are equivalent to
-the \TeX' original |hlist_out|, |vlist_out| and |ship_out| resp. But first we
-need to declare some procedures needed in |pdf_hlist_out| and |pdf_vlist_out|.
-
-@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure pdf_out_literal(p:pointer);
-var old_setting:0..max_selector; {holds print |selector|}
- s: str_number;
-begin
- old_setting:=selector; selector:=new_string;
- show_token_list(link(pdf_literal_data(p)),null,pool_size-pool_ptr);
- selector:=old_setting;
- s := make_string;
- literal(s, pdf_literal_mode(p), false);
- flush_str(s);
-end;
-
-procedure pdf_out_colorstack(p:pointer);
-var old_setting: 0..max_selector; {holds print |selector|}
- s: str_number;
- cmd: integer;
- stack_no: integer;
- literal_mode: integer;
-begin
- cmd := pdf_colorstack_cmd(p);
- stack_no := pdf_colorstack_stack(p);
- 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 confusion("pdfcolorstack")
- 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 }
- if pdfsetmatrix(str_start[str_ptr], cur_h, cur_page_height - cur_v) = 1 then begin
- 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);
- end
- else begin
- pdf_error("\pdfsetmatrix", "Unrecognized format.");
- end;
- flush_str(s);
-end;
-
-procedure pdf_out_save(p:pointer);
-begin
- checkpdfsave(cur_h, cur_v);
- literal("q", set_origin, false);
-end;
-
-procedure pdf_out_restore(p:pointer);
-begin
- checkpdfrestore(cur_h, cur_v);
- literal("Q", set_origin, false);
-end;
-
-procedure pdf_special(p: pointer);
-var old_setting:0..max_selector; {holds print |selector|}
- s: str_number;
-begin
- old_setting:=selector; selector:=new_string;
- show_token_list(link(write_tokens(p)),null,pool_size-pool_ptr);
- selector:=old_setting;
- s := make_string;
- literal(s, scan_special, true);
- flush_str(s);
-end;
-
-procedure 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;
-
-@ Similar 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 similar 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 reswitch, move_past, fin_rule, next_p;
-var base_line: scaled; {the baseline coordinate for this box}
-@!left_edge: scaled; {the left coordinate for this box}
-@!save_h: scaled; {what |cur_h| should pop to}
-@!this_box: pointer; {pointer to containing box}
-@!g_order: glue_ord; {applicable order of infinity for glue}
-@!g_sign: normal..shrinking; {selects type of glue}
-@!p: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}
-@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
-@!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);
-incr(cur_s);
-base_line:=cur_v;
-prev_p:=this_box+list_offset;
-@<Initialize |hlist_out| for mixed...@>;
-left_edge:=cur_h;
-@<Create link annotations for the current hbox if needed@>;
-while p<>null do
- @<Output node |p| for |pdf_hlist_out| and move to the next node,
- maintaining the condition |cur_v=base_line|@>;
-@<Finish |hlist_out| for mixed...@>;
-decr(cur_s);
-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) and gen_running_link then
- append_link(this_box, left_edge, base_line, i);
-end
-
-@ @<Output node |p| for |pdf_hlist_out|...@>=
-reswitch: if is_char_node(p) then
- begin
- repeat f:=font(p); c:=character(p);
- if is_valid_char(c) then
- output_one_char(c)
- else
- char_warning(f, c);
- cur_h:=cur_h+char_width(f)(char_info(f)(c));
- prev_p:=link(prev_p); {N.B.: not |prev_p:=p|, |p| might be |lig_trick|}
- p:=link(p);
- until not is_char_node(p);
- end
-else @<Output the non-|char_node| |p| for |pdf_hlist_out|
- and move to the next node@>
-
-@ @<Output the non-|char_node| |p| for |pdf_hlist_out|...@>=
-begin case type(p) of
-hlist_node,vlist_node:@<(\pdfTeX) Output a box in an hlist@>;
-rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
- goto fin_rule;
- end;
-whatsit_node: @<Output the whatsit node |p| in |pdf_hlist_out|@>;
-glue_node: @<(\pdfTeX) Move right or output leaders@>;
-margin_kern_node,
-kern_node:cur_h:=cur_h+width(p);
-math_node: @<Handle a math node in |hlist_out|@>;
-ligature_node: @<Make node |p| look like a |char_node| and |goto reswitch|@>;
-@/@<Cases of |hlist_out| that arise in mixed direction text only@>@;
-othercases do_nothing
-endcases;@/
-goto next_p;
-fin_rule: @<(\pdfTeX) Output a rule in an hlist@>;
-move_past: cur_h:=cur_h+rule_wd;
-next_p:prev_p:=p; p:=link(p);
-end
-
-@ @<(\pdfTeX) Output a box in an hlist@>=
-if list_ptr(p)=null then cur_h:=cur_h+width(p)
-else begin
- cur_v:=base_line+shift_amount(p); {shift the box down}
- temp_ptr:=p; edge:=cur_h+width(p);
- if cur_dir=right_to_left then cur_h:=edge;
- if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
- cur_h:=edge; cur_v:=base_line;
- end
-
-@ @<(\pdfTeX) Output a rule in an hlist@>=
-if is_running(rule_ht) then rule_ht:=height(this_box);
-if is_running(rule_dp) then rule_dp:=depth(this_box);
-rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
-if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
- begin cur_v:=base_line+rule_dp;
- pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
- cur_v:=base_line;
- end
-
-@ @<(\pdfTeX) Move right or output leaders@>=
-begin g:=glue_ptr(p); rule_wd:=width(g)-cur_g;
-if g_sign<>normal then
- begin if g_sign=stretching then
- begin if stretch_order(g)=g_order then
- begin cur_glue:=cur_glue+stretch(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
-@^real multiplication@>
- cur_g:=round(glue_temp);
- end;
- end
- else if shrink_order(g)=g_order then
- begin cur_glue:=cur_glue-shrink(g);
- vet_glue(float(glue_set(this_box))*cur_glue);
- cur_g:=round(glue_temp);
- end;
- end;
-rule_wd:=rule_wd+cur_g;
-if eTeX_ex then @<Handle a glue node for mixed...@>;
-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;
-leader_wd:=width(leader_box);
-if (leader_wd>0)and(rule_wd>0) then
- begin rule_wd:=rule_wd+10; {compensate for floating-point rounding}
- if cur_dir=right_to_left then cur_h:=cur_h-10;
- edge:=cur_h+rule_wd; lx:=0;
- @<Let |cur_h| be the position of the first box, and set |leader_wd+lx|
- to the spacing between corresponding parts of boxes@>;
- while cur_h+leader_wd<=edge do
- @<(\pdfTeX) Output a leader box at |cur_h|,
- then advance |cur_h| by |leader_wd+lx|@>;
- if cur_dir=right_to_left then cur_h:=edge
- else cur_h:=edge-10;
- goto next_p;
- end;
-end
-
-@ @<(\pdfTeX) Output a leader box at |cur_h|, ...@>=
-begin cur_v:=base_line+shift_amount(leader_box);@/
-save_h:=cur_h; temp_ptr:=leader_box;
-if cur_dir=right_to_left then cur_h:=cur_h+leader_wd;
-outer_doing_leaders:=doing_leaders; doing_leaders:=true;
-if type(leader_box)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
-doing_leaders:=outer_doing_leaders;
-cur_v:=base_line;
-cur_h:=save_h+leader_wd+lx;
-end
-
-@ The |pdf_vlist_out| routine is similar to |pdf_hlist_out|, but a bit simpler.
-@p procedure pdf_vlist_out; {output a |pdf_vlist_node| box}
-label move_past, fin_rule, next_p;
-var left_edge: scaled; {the left coordinate for this box}
-@!top_edge: scaled; {the top coordinate for this box}
-@!save_v: scaled; {what |cur_v| should pop to}
-@!this_box: pointer; {pointer to containing box}
-@!g_order: glue_ord; {applicable order of infinity for glue}
-@!g_sign: normal..shrinking; {selects type of glue}
-@!p:pointer; {current position in the vlist}
-@!leader_box:pointer; {the leader box being replicated}
-@!leader_ht:scaled; {height of leader box being replicated}
-@!lx:scaled; {extra space between leader boxes}
-@!outer_doing_leaders:boolean; {were we doing leaders?}
-@!edge:scaled; {bottom boundary of leader space}
-@!glue_temp:real; {glue value before rounding}
-@!cur_glue:real; {glue seen so far}
-@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
-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);
-incr(cur_s);
-left_edge:=cur_h; cur_v:=cur_v-height(this_box); top_edge:=cur_v;
-@<Create thread for the current vbox if needed@>;
-while p<>null do
- @<Output node |p| for |pdf_vlist_out| and move to the next node,
- maintaining the condition |cur_h=left_edge|@>;
-decr(cur_s);
-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:=link(p);
-end
-
-@ @<Output the non-|char_node| |p| for |pdf_vlist_out|@>=
-begin case type(p) of
-hlist_node,vlist_node:@<(\pdfTeX) Output a box in a vlist@>;
-rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
- goto fin_rule;
- end;
-whatsit_node: @<Output the whatsit node |p| in |pdf_vlist_out|@>;
-glue_node: @<(\pdfTeX) Move down or output leaders@>;
-kern_node:cur_v:=cur_v+width(p);
-othercases do_nothing
-endcases;@/
-goto next_p;
-fin_rule: @<(\pdfTeX) Output a rule in a vlist, |goto next_p|@>;
-move_past: cur_v:=cur_v+rule_ht;
-end
-
-@ @<(\pdfTeX) Output a box in a vlist@>=
-if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p)
-else begin cur_v:=cur_v+height(p); save_v:=cur_v;
- if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p)
- else cur_h:=left_edge+shift_amount(p); {shift the box right}
- temp_ptr:=p;
- if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
- cur_v:=save_v+depth(p); cur_h:=left_edge;
- end
-
-@ @<(\pdfTeX) Output a rule in a vlist...@>=
-if is_running(rule_wd) then rule_wd:=width(this_box);
-rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
-cur_v:=cur_v+rule_ht;
-if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
- begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd;
- pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
- cur_h:=left_edge;
- 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 if cur_dir=right_to_left then
- cur_h:=left_edge-shift_amount(leader_box)
- else cur_h:=left_edge+shift_amount(leader_box);
-cur_v:=cur_v+height(leader_box); save_v:=cur_v;
-temp_ptr:=leader_box;
-outer_doing_leaders:=doing_leaders; doing_leaders:=true;
-if type(leader_box)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
-doing_leaders:=outer_doing_leaders;
-cur_h:=left_edge;
-cur_v:=save_v-height(leader_box)+leader_ht+lx;
-end
-
-@ |fix_pdfoutput| freezes |pdfoutput| when something has been written to
-the output.
-
-@p procedure fix_pdfoutput;
-begin
- if not fixed_pdfoutput_set then begin
- fixed_pdfoutput := pdf_output;
- fixed_pdfoutput_set := true;
- end
- else if fixed_pdfoutput <> pdf_output then
- pdf_error("setup",
- "\pdfoutput can only be changed before anything is written to the output");
- if fixed_pdfoutput_set then fix_pdf_draftmode;
-end;
-
-@ |fix_pdf_draftmode| freezes |pdfdraftmode| when something has been written to
-the output and also switches some things off when draftmode is on.
-@p procedure fix_pdf_draftmode;
-begin
- if not fixed_pdf_draftmode_set then begin
- fixed_pdf_draftmode := pdf_draftmode;
- fixed_pdf_draftmode_set := true;
- end
- else if fixed_pdf_draftmode <> pdf_draftmode then
- pdf_error("setup",
- "\pdfdraftmode can only be changed before anything is written to the output");
- if fixed_pdf_draftmode_set and fixed_pdf_draftmode > 0 then begin
- fixed_pdf_draftmode_set := true;
- pdf_compress_level := 0;
- fixed_pdf_objcompresslevel := 0;
- end;
-end;
-
-@ |substr_of_str| is used in |pdf_ship_out| and |pdf_print_info|.
-@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[t];
- while (k < str_start[t+1] - length(s)) do begin
- j:=str_start[s];
- kk:=k;
- while (j < str_start[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;
-
-@ |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}
-s: pool_pointer; {index into |str_pool|}
-mediabox_given: boolean;
-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|}
-pdf_last_resources: integer; {pointer to most recently generated Resources object}
-begin if tracing_output>0 then
- begin print_nl(""); print_ln;
- print("Completed box being shipped out");
-@.Completed box...@>
- end;
-if not init_pdf_output then begin
- @<Initialize variables for \.{PDF} output@>;
- init_pdf_output := true;
-end;
-is_shipping_page := shipping_page;
-if shipping_page then begin
- if term_offset>max_print_line-9 then print_ln
- else if (term_offset>0)or(file_offset>0) then print_char(" ");
- print_char("["); j:=9;
- while (count(j)=0)and(j>0) do decr(j);
- for k:=0 to j do
- begin print_int(count(k));
- if k<j then print_char(".");
- end;
- update_terminal;
-end;
-if tracing_output>0 then
- begin if shipping_page then print_char("]");
- begin_diagnostic; show_box(p); end_diagnostic(true);
- end;
-@<(\pdfTeX) Ship box |p| out@>;
-if eTeX_ex then @<Check for LR anomalies at the end of |ship_out|@>;
-if (tracing_output<=0) and shipping_page then print_char("]");
-dead_cycles:=0;
-update_terminal; {progress report}
-@<Flush the box from memory, showing statistics if requested@>;
-end;
-
-@ @<(\pdfTeX) Ship box |p| out@>=
-@<Update the values of |max_h| and |max_v|; but if the page is too large,
- |goto done|@>;
-@<Initialize variables as |pdf_ship_out| begins@>;
-if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
-if shipping_page then
- incr(total_pages);
-cur_s:=-1;
-@<Finish shipping@>;
-done:
-
-@ @<Initialize variables as |pdf_ship_out| begins@>=
-fix_pdfoutput;
-temp_ptr:=p;
-prepare_mag;
-pdf_last_resources := pdf_new_objnum;
-pdf_page_group_val := 0;
-@<Reset resource lists@>;
-if not shipping_page then begin
- pdf_xform_width := width(p);
- pdf_xform_height := height(p);
- pdf_xform_depth := depth(p);
- pdf_begin_dict(pdf_cur_form, 0);
- pdf_last_stream := pdf_cur_form;
- cur_v := height(p);
- cur_h := 0;
- pdf_origin_h := 0;
- pdf_origin_v := pdf_xform_height + pdf_xform_depth;
-end
-else begin
- @<Calculate page dimensions and margins@>;
- 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;
- cur_h := cur_h_offset;
- cur_v := height(p) + cur_v_offset;
- pdf_origin_h := 0;
- pdf_origin_v := cur_page_height;
- @<Reset PDF mark lists@>;
-end;
-if not shipping_page then begin
- @<Write out Form stream header@>;
-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 page dimensions and margins@>=
-cur_h_offset := pdf_h_origin + h_offset;
-cur_v_offset := pdf_v_origin + v_offset;
-if pdf_page_width <> 0 then
- cur_page_width := pdf_page_width
-else
- cur_page_width := width(p) + 2*cur_h_offset;
-if pdf_page_height <> 0 then
- cur_page_height := pdf_page_height
-else
- cur_page_height := height(p) + depth(p) + 2*cur_v_offset
-
-@ Here we write out the header for Form.
-
-@<Write out Form stream header@>=
-pdf_print_ln("/Type /XObject");
-pdf_print_ln("/Subtype /Form");
-if obj_xform_attr(pdf_cur_form) <> null then begin
- pdf_print_toks_ln(obj_xform_attr(pdf_cur_form));
- delete_toks(obj_xform_attr(pdf_cur_form));
-end;
-pdf_print("/BBox [");
-pdf_print("0 0 ");
-pdf_print_bp(pdf_xform_width); pdf_out(" ");
-pdf_print_bp(pdf_xform_height + pdf_xform_depth); pdf_print_ln("]");
-pdf_print_ln("/FormType 1");
-pdf_print_ln("/Matrix [1 0 0 1 0 0]");
-pdf_indirect_ln("Resources", pdf_last_resources)
-
-@ @<Start stream of page/form contents@>=
-pdf_begin_stream;
-if shipping_page then begin
- @<Adjust transformation matrix for the magnification ratio@>;
-end;
-pdfshipoutbegin(shipping_page);
-if shipping_page then
- pdf_out_colorstack_startpage;
-
-@ @<Adjust transformation matrix for the magnification ratio@>=
-prepare_mag;
-if mag <> 1000 then begin
- pdf_print_real(mag, 3);
- pdf_print(" 0 0 ");
- pdf_print_real(mag, 3);
- pdf_print_ln(" 0 0 cm");
-end
-
-@ @<Finish shipping@>=
-@<Finish stream of page/form contents@>;
-if shipping_page then begin
- @<Write out page object@>;
-end;
-@<Write out resource lists@>;
-if shipping_page then begin
- @<Write out pending PDF marks@>;
-end;
-@<Write out resources dictionary@>;
-@<Flush resource lists@>;
-if shipping_page then begin
- @<Flush PDF mark lists@>;
-end
-
-@ @<Finish stream of page/form contents@>=
-pdf_end_text;
-pdfshipoutend(shipping_page);
-pdf_end_stream
-
-@ @<Write out resource lists@>=
-@<Write out pending raw objects@>;
-@<Write out pending forms@>;
-@<Write out pending images@>
-
-@ @<Write out resources dictionary@>=
-pdf_begin_dict(pdf_last_resources, 1);
-@<Print additional resources@>;
-@<Generate font resources@>;
-@<Generate XObject resources@>;
-@<Generate ProcSet@>;
-pdf_end_dict
-
-@ @<Print additional resources@>=
-if shipping_page then begin
- if pdf_page_resources <> null then
- pdf_print_toks_ln(pdf_page_resources);
-end
-else begin
- if obj_xform_resources(pdf_cur_form) <> null then begin
- pdf_print_toks_ln(obj_xform_resources(pdf_cur_form));
- delete_toks(obj_xform_resources(pdf_cur_form));
- end;
-end
-
-@ In the end of shipping out a page we reset all the lists holding objects
-have been created during the page shipping.
-
-@d delete_toks(#) == begin delete_token_ref(#); # := null; end
-
-@<Flush resource lists@>=
-flush_list(pdf_font_list);
-flush_list(pdf_obj_list);
-flush_list(pdf_xform_list);
-flush_list(pdf_ximage_list)
-
-@ @<Flush PDF mark lists@>=
-flush_list(pdf_annot_list);
-flush_list(pdf_link_list);
-flush_list(pdf_dest_list);
-flush_list(pdf_bead_list)
-
-@ @<Generate font resources@>=
-if pdf_font_list <> null then begin
- pdf_print("/Font << ");
- k := pdf_font_list;
- while k <> null do begin
- pdf_print("/F");
- set_ff(info(k));
- pdf_print_int(ff);
- pdf_print_resname_prefix;
- pdf_out(" ");
- pdf_print_int(pdf_font_num[ff]);
- pdf_print(" 0 R ");
- k := link(k);
- end;
- pdf_print_ln(">>");
- pdf_text_procset := true;
-end
-
-@ @<Generate XObject resources@>=
-if (pdf_xform_list <> null) or (pdf_ximage_list <> null) then begin
- pdf_print("/XObject << ");
- k := pdf_xform_list;
- while k <> null do begin
- pdf_print("/Fm");
- pdf_print_int(obj_info(info(k)));
- pdf_print_resname_prefix;
- pdf_out(" ");
- pdf_print_int(info(k));
- pdf_print(" 0 R ");
- k := link(k);
- end;
- k := pdf_ximage_list;
- while k <> null do begin
- pdf_print("/Im");
- pdf_print_int(obj_info(info(k)));
- pdf_print_resname_prefix;
- pdf_out(" ");
- pdf_print_int(info(k));
- pdf_print(" 0 R ");
- update_image_procset(obj_ximage_data(info(k)));
- k := link(k);
- end;
- pdf_print_ln(">>");
-end
-
-@ @<Generate ProcSet@>=
-pdf_print("/ProcSet [ /PDF");
-if pdf_text_procset then
- pdf_print(" /Text");
-if check_image_b(pdf_image_procset) then
- pdf_print(" /ImageB");
-if check_image_c(pdf_image_procset) then
- pdf_print(" /ImageC");
-if check_image_i(pdf_image_procset) then
- pdf_print(" /ImageI");
-pdf_print_ln(" ]")
-
-@ @<Write out page object@>=
-pdf_begin_dict(pdf_last_page, 1);
-pdf_print_ln("/Type /Page");
-pdf_indirect_ln("Contents", pdf_last_stream);
-pdf_indirect_ln("Resources", pdf_last_resources);
-mediabox_given:=false;
-if pdf_page_attr <> null then begin
- s:=tokens_to_string(pdf_page_attr);
- mediabox_given:=substr_of_str("/MediaBox", s);
- flush_str(s);
-end;
-if not mediabox_given then begin
- pdf_print("/MediaBox [0 0 ");
- pdf_print_mag_bp(cur_page_width); pdf_out(" ");
- pdf_print_mag_bp(cur_page_height);
- pdf_print_ln("]");
-end;
-if pdf_page_attr <> null then
- pdf_print_toks_ln(pdf_page_attr);
-@<Generate parent pages object@>;
-if pdf_page_group_val > 0 then begin
- pdf_print("/Group ");
- pdf_print_int(pdf_page_group_val);
- pdf_print_ln(" 0 R");
-end;
-@<Generate array of annotations or beads in page@>;
-pdf_end_dict
-
-@ @<Generate parent pages object@>=
-if total_pages mod pages_tree_kids_max = 1 then begin
- pdf_create_obj(obj_type_pages, pages_tree_kids_max);
- pdf_last_pages := obj_ptr;
-end;
-pdf_indirect_ln("Parent", pdf_last_pages)
-
-@ @<Generate array of annotations or beads in page@>=
-if (pdf_annot_list <> null) or (pdf_link_list <> null) then begin
- pdf_print("/Annots [ ");
- k := pdf_annot_list;
- while k <> null do begin
- pdf_print_int(info(k));
- pdf_print(" 0 R ");
- k := link(k);
- end;
- k := pdf_link_list;
- while k <> null do begin
- pdf_print_int(info(k));
- pdf_print(" 0 R ");
- k := link(k);
- end;
- pdf_print_ln("]");
-end;
-if pdf_bead_list <> null then begin
- k := pdf_bead_list;
- pdf_print("/B [ ");
- while k <> null do begin
- pdf_print_int(info(k));
- pdf_print(" 0 R ");
- k := link(k);
- end;
- pdf_print_ln("]");
-end
-
-@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure pdf_write_obj(n: integer); {write a raw PDF object}
-var s: str_number;
- f: byte_file;
-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
- cur_name := s;
- cur_area := "";
- cur_ext := "";
- pack_cur_name;
- if not tex_b_openin(f) then begin
- print_nl("! "); print(s); print(" not found.");
- pdf_error("ext5", "cannot open file for embedding");
- end;
- print("<<");
- print(s);
- if not eof(f) then begin {at least one byte available}
- while not eof(f) do
- pdf_out(getc(f));
- if (not obj_obj_is_stream(n)) and (pdf_ptr > 0) and (pdf_buf[pdf_ptr - 1] <> 10) then
- pdf_out(10);
- end;
- print(">>");
- b_close(f);
- 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;
-
-procedure flush_whatsit_node(p: pointer; s: small_number);
-begin
- type(p) := whatsit_node;
- subtype(p) := s;
- if link(p) <> null then
- pdf_error("flush_whatsit_node", "link(p) is not null");
- flush_node_list(p);
-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
-
-@ @<Glob...@>=
-@!saved_pdf_cur_form: integer;
-
-@ 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.
-
-@<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
- saved_pdf_cur_form := pdf_cur_form;
- pdf_cur_form := info(k);
- @<Save resource lists@>;
- @<Reset resource lists@>;
- pdf_ship_out(obj_xform_box(pdf_cur_form), false);
- pdf_cur_form := saved_pdf_cur_form;
- @<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 obj_ximage_attr(n) <> null then begin
- pdf_print_toks_ln(obj_ximage_attr(n));
- delete_toks(obj_ximage_attr(n));
- end;
- if fixed_pdf_draftmode = 0 then write_image(obj_ximage_data(n));
- delete_image(obj_ximage_data(n));
-end;
-
-@ @<Write out pending images@>=
-if pdf_ximage_list <> null then begin
- k := pdf_ximage_list;
- while k <> null do begin
- if not is_obj_written(info(k)) then
- pdf_write_image(info(k));
- k := link(k);
- end;
-end
-
-@ @<Write out pending PDF marks@>=
-pdf_origin_h := 0;
-pdf_origin_v := cur_page_height;
-@<Write out PDF annotations@>;
-@<Write out PDF link annotations@>;
-@<Write out PDF mark destinations@>;
-@<Write out PDF bead rectangle specifications@>
-
-@ @<Write out PDF annotations@>=
-if pdf_annot_list <> null then begin
- k := pdf_annot_list;
- while k <> null do begin
- i := obj_annot_ptr(info(k)); {|i| points to |pdf_annot_node|}
- pdf_begin_dict(info(k), 1);
- pdf_print_ln("/Type /Annot");
- pdf_print_toks_ln(pdf_annot_data(i));
- pdf_rectangle(pdf_left(i), pdf_top(i), pdf_right(i), pdf_bottom(i));
- pdf_end_dict;
- k := link(k);
- end;
-end
-
-@ @<Write out PDF link annotations@>=
-if pdf_link_list <> null then begin
- k := pdf_link_list;
- while k <> null do begin
- i := obj_annot_ptr(info(k));
- pdf_begin_dict(info(k), 1);
- pdf_print_ln("/Type /Annot");
- if pdf_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(pdf_left(i), pdf_top(i), pdf_right(i), pdf_bottom(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 |info = max_halfword| were created by |append_link| and
- must be flushed here, as they are not linked in any list}
- if info(i) = max_halfword then
- flush_whatsit_node(i, pdf_start_link_node);
- k := link(k);
-end
-
-@ @<Write out PDF mark destinations@>=
-if pdf_dest_list <> null then begin
- k := pdf_dest_list;
- while k <> null do begin
- if is_obj_written(info(k)) then
- pdf_error("ext5",
- "destination has been already written (this shouldn't happen)")
- else begin
- i := obj_dest_ptr(info(k));
- if pdf_dest_named_id(i) > 0 then begin
- pdf_begin_dict(info(k), 1);
- pdf_print("/D ");
- end
- else
- pdf_begin_obj(info(k), 1);
- pdf_out("["); pdf_print_int(pdf_last_page); pdf_print(" 0 R ");
- case pdf_dest_type(i) of
- pdf_dest_xyz: begin
- pdf_print("/XYZ ");
- pdf_print_mag_bp(pdf_x(pdf_left(i))); pdf_out(" ");
- pdf_print_mag_bp(pdf_y(pdf_top(i))); pdf_out(" ");
- if pdf_dest_xyz_zoom(i) = null then
- pdf_print("null")
- else begin
- pdf_print_int(pdf_dest_xyz_zoom(i) div 1000);
- pdf_out(".");
- pdf_print_int((pdf_dest_xyz_zoom(i) mod 1000));
- end;
- end;
- pdf_dest_fit:
- pdf_print("/Fit");
- pdf_dest_fith: begin
- pdf_print("/FitH ");
- pdf_print_mag_bp(pdf_y(pdf_top(i)));
- end;
- pdf_dest_fitv: begin
- pdf_print("/FitV ");
- pdf_print_mag_bp(pdf_x(pdf_left(i)));
- end;
- pdf_dest_fitb:
- pdf_print("/FitB");
- pdf_dest_fitbh: begin
- pdf_print("/FitBH ");
- pdf_print_mag_bp(pdf_y(pdf_top(i)));
- end;
- pdf_dest_fitbv: begin
- pdf_print("/FitBV ");
- pdf_print_mag_bp(pdf_x(pdf_left(i)));
- end;
- pdf_dest_fitr: begin
- pdf_print("/FitR ");
- pdf_print_rect_spec(i);
- end;
- othercases pdf_error("ext5", "unknown dest type");
- endcases;
- pdf_print_ln("]");
- if pdf_dest_named_id(i) > 0 then
- pdf_end_dict
- else
- pdf_end_obj;
- end;
- k := link(k);
- end;
-end
-
-@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure pdf_print_rect_spec(r: pointer); {prints a rect spec}
-begin
- pdf_print_mag_bp(pdf_x(pdf_left(r)));
- pdf_out(" ");
- pdf_print_mag_bp(pdf_y(pdf_bottom(r)));
- pdf_out(" ");
- pdf_print_mag_bp(pdf_x(pdf_right(r)));
- pdf_out(" ");
- pdf_print_mag_bp(pdf_y(pdf_top(r)));
-end;
-
-@ @<Write out PDF bead rectangle specifications@>=
-if pdf_bead_list <> null then begin
- k := pdf_bead_list;
- while k <> null do begin
- pdf_new_obj(obj_type_others, 0, 1);
- pdf_out("[");
- i := obj_bead_data(info(k)); {pointer to a whatsit or whatsit-like node}
- pdf_print_rect_spec(i);
- if info(i) = max_halfword then {not a whatsit node, so must be destroyed here}
- flush_whatsit_node(i, pdf_start_thread_node);
- pdf_print_ln("]");
- obj_bead_rect(info(k)) := obj_ptr; {rewrite |obj_bead_data|}
- pdf_end_obj;
- k := link(k);
- end;
-end
-
-@ In the end we must flush PDF objects that cannot be written out
-immediately after shipping out pages.
-
-@ @<Output outlines@>=
-if pdf_first_outline <> 0 then begin
- pdf_new_dict(obj_type_others, 0, 1);
- outlines := obj_ptr;
- l := pdf_first_outline; k := 0;
- repeat
- incr(k);
- a := open_subentries(l);
- if obj_outline_count(l) > 0 then
- k := k + a;
- obj_outline_parent(l) := obj_ptr;
- l := obj_outline_next(l);
- until l = 0;
- pdf_print_ln("/Type /Outlines");
- pdf_indirect_ln("First", pdf_first_outline);
- pdf_indirect_ln("Last", pdf_last_outline);
- pdf_int_entry_ln("Count", k);
- pdf_end_dict;
- @<Output PDF outline entries@>;
-end
-else
- outlines := 0
-
-@ @<Output PDF outline entries@>=
-k := head_tab[obj_type_outline];
-while k <> 0 do begin
- if obj_outline_parent(k) = pdf_parent_outline then begin
- if obj_outline_prev(k) = 0 then
- pdf_first_outline := k;
- if obj_outline_next(k) = 0 then
- pdf_last_outline := k;
- end;
- pdf_begin_dict(k, 1);
- pdf_indirect_ln("Title", obj_outline_title(k));
- pdf_indirect_ln("A", obj_outline_action_objnum(k));
- if obj_outline_parent(k) <> 0 then
- pdf_indirect_ln("Parent", obj_outline_parent(k));
- if obj_outline_prev(k) <> 0 then
- pdf_indirect_ln("Prev", obj_outline_prev(k));
- if obj_outline_next(k) <> 0 then
- pdf_indirect_ln("Next", obj_outline_next(k));
- if obj_outline_first(k) <> 0 then
- pdf_indirect_ln("First", obj_outline_first(k));
- if obj_outline_last(k) <> 0 then
- pdf_indirect_ln("Last", obj_outline_last(k));
- if obj_outline_count(k) <> 0 then
- pdf_int_entry_ln("Count", obj_outline_count(k));
- if obj_outline_attr(k) <> 0 then begin
- pdf_print_toks_ln(obj_outline_attr(k));
- delete_toks(obj_outline_attr(k));
- end;
- pdf_end_dict;
- k := obj_link(k);
-end
-
-@ @<Output article threads@>=
-if head_tab[obj_type_thread] <> 0 then begin
- pdf_new_obj(obj_type_others, 0, 1);
- threads := obj_ptr;
- pdf_out("[");
- k := head_tab[obj_type_thread];
- while k <> 0 do begin
- pdf_print_int(k);
- pdf_print(" 0 R ");
- k := obj_link(k);
- end;
- remove_last_space;
- pdf_print_ln("]");
- pdf_end_obj;
- k := head_tab[obj_type_thread];
- while k <> 0 do begin
- out_thread(k);
- k := obj_link(k);
- end;
-end
-else
- threads := 0
-
-@ Now we are ready to declare our new procedure |ship_out|. It will call
-|pdf_ship_out| if the integer parameter |pdf_output| is positive; otherwise it
-will call |dvi_ship_out|, which is the \TeX\ original |ship_out|.
-
-@p procedure ship_out(p:pointer); {output the box |p|}
-begin
- fix_pdfoutput;
- if pdf_output > 0 then
- pdf_ship_out(p, true)
- else
- dvi_ship_out(p);
-end;
-
-@ @<Initialize variables for \.{PDF} output@>=
-check_pdfversion;
-prepare_mag;
-fixed_decimal_digits := fix_int(pdf_decimal_digits, 0, 4);
-min_bp_val :=
- divide_scaled(one_hundred_bp, ten_pow[fixed_decimal_digits + 2], 0);
-if pdf_pk_resolution = 0 then {if not set from format file or by user}
- pdf_pk_resolution := pk_dpi; {take it from \.{texmf.cnf}}
-fixed_pk_resolution := fix_int(pdf_pk_resolution, 72, 8000);
-pk_scale_factor :=
- divide_scaled(72, fixed_pk_resolution, 5 + fixed_decimal_digits);
-if pdf_pk_mode <> null then begin
- kpse_init_prog('PDFTEX', fixed_pk_resolution,
- make_cstring(tokens_to_string(pdf_pk_mode)), nil);
- flush_string;
-end else
- kpse_init_prog('PDFTEX', fixed_pk_resolution, nil, nil);
-kpse_set_program_enabled (kpse_pk_format, 1, kpse_src_compile);
-set_job_id(year, month, day, time);
-if (pdf_unique_resname > 0) and (pdf_resname_prefix = 0) then
- pdf_resname_prefix := get_resname_prefix
-
-@ Finishing the PDF output file.
-
-The following procedures sort the table of destination names.
-@d get_next_char(#)==
- c@&# := str_pool[j@&#];
- incr(j@&#);
- if (c@&# = 92) and (j@&# < e@&#) then begin
- c@&# := str_pool[j@&#];
- incr(j@&#);
- if (c@&# >= 48) and (c@&# <= 55) then begin
- c@&# := c@&# - 48;
- if (j@&# < e@&#) and (str_pool[j@&#] >= 48)
- and (str_pool[j@&#] <= 55) then begin
- c@&# := 8 * c@&# + str_pool[j@&#] - 48;
- incr(j@&#);
- if (j@&# < e@&#) and (str_pool[j@&#] >= 48)
- and (str_pool[j@&#] <= 55)
- and (c@&# < 32) then begin
- c@&# := 8 * c@&# + str_pool[j@&#] - 48;
- incr(j@&#);
- end;
- end;
- end else begin
- case c@&# of
- 98: c@&# := 8; {`\.b': backspace}
- 102: c@&# := 12; {`\.f': form feed}
- 110: c@&# := 10; {`\.n': line feed}
- 114: c@&# := 13; {`\.r': carriage return}
- 116: c@&# := 9; {`\.t': horizontal tab}
- {nothing to do for `\.{\\}', `\.(', `\.)'}
- othercases do_nothing
- endcases;
- end;
- end
-
-@p function str_less_str(s1, s2: str_number): boolean; {compare two pdf strings}
-var j1, j2, e1, e2: pool_pointer;
- c1, c2: packed_ASCII_code;
-begin
- {Minimal requirement: output of \.{\\pdfescapestring} must be supported.}
- {This implementation also supports all escape sequences}
- {listed in the table `Escape sequences in literal strings'}
- {of the pdf specification.}
- {End-of-line markers are not detected:}
- {The marker is not replaced by `\.{\\n}' or removed if it is escaped.}
- j1 := str_start[s1];
- j2 := str_start[s2];
- e1 := j1 + length(s1);
- e2 := j2 + length(s2);
- while (j1 < e1) and (j2 < e2) do begin
- {get next character of first string}
- get_next_char(1);
- {get next character of second string}
- get_next_char(2);
- {compare characters}
- if c1 < c2 then begin
- str_less_str := true;
- return;
- end
- else if c1 > c2 then begin
- str_less_str := false;
- return;
- end;
- end;
- {compare string lengths}
- if (j1 >= e1) and (j2 < e2) then
- str_less_str := true
- else
- str_less_str := false;
-exit: 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
- print_nl("No pages of output.");
- @.No pages of output@>
- if pdf_gone > 0 then
- garbage_warning;
-end
-else begin
- if fixed_pdf_draftmode = 0 then begin
- pdf_flush; {to make sure that the output file name has been already
- created}
- if total_pages mod pages_tree_kids_max <> 0 then
- obj_info(pdf_last_pages) := total_pages mod pages_tree_kids_max;
- {last pages object may have less than |pages_tree_kids_max| children}
- flush_jbig2_page0_objects; {flush page 0 objects from JBIG2 images, if any}
- @<Check for non-existing pages@>;
- @<Reverse the linked list of Page and Pages objects@>;
- @<Check for non-existing destinations@>;
- @<Output fonts definition@>;
- @<Output pages tree@>;
- @<Output outlines@>;
- @<Output name tree@>;
- @<Output article threads@>;
- @<Output the catalog object@>;
- pdf_print_info; {last candidate for object stream}
- if pdf_os_enable then begin
- pdf_os_switch(true);
- pdf_os_write_objstream;
- pdf_flush;
- pdf_os_switch(false);
- @<Output the cross-reference stream dictionary@>;
- pdf_flush;
- end else begin
- @<Output the |obj_tab|@>;
- end;
- @<Output the trailer@>;
- pdf_flush;
- 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;
- libpdffinish;
- if fixed_pdf_draftmode = 0 then b_close(pdf_file)
- else pdf_warning(0, "\pdfdraftmode enabled, not changing output pdf", true, true)
-end
-
-@ Destinations that have been referenced but don't exists have
-|obj_dest_ptr=null|. Leaving them undefined might cause troubles for
-PDF browsers, so we need to fix them.
-
-@p procedure pdf_fix_dest(k: integer);
-begin
- if obj_dest_ptr(k) <> null then
- return;
- pdf_warning("dest", "", false, false);
- if obj_info(k) < 0 then begin
- print("name{");
- print(-obj_info(k));
- print("}");
- end
- else begin
- print("num");
- print_int(obj_info(k));
- end;
- print(" has been referenced but does not exist, replaced by a fixed one");
- print_ln; print_ln;
- pdf_begin_obj(k, 1);
- pdf_out("[");
- pdf_print_int(head_tab[obj_type_page]);
- pdf_print_ln(" 0 R /Fit]");
- pdf_end_obj;
-end;
-
-@ @<Check for non-existing destinations@>=
-k := head_tab[obj_type_dest];
-while k <> 0 do begin
- pdf_fix_dest(k);
- k := obj_link(k);
-end
-
-@ @<Check for non-existing pages@>=
-k := head_tab[obj_type_page];
-while obj_aux(k) = 0 do begin
- pdf_warning("dest", "Page ", false, false);
- print_int(obj_info(k));
- print(" has been referenced but does not exist!");
- print_ln; print_ln;
- k := obj_link(k);
-end;
-head_tab[obj_type_page] := k
-
-@ @<Reverse the linked list of Page and Pages objects@>=
-k := head_tab[obj_type_page];
-l := 0;
-repeat
- i := obj_link(k);
- obj_link(k) := l;
- l := k;
- k := i;
-until k = 0;
-head_tab[obj_type_page] := l;
-k := head_tab[obj_type_pages];
-pages_tail := k;
-l := 0;
-repeat
- i := obj_link(k);
- obj_link(k) := l;
- l := k;
- k := i;
-until k = 0;
-head_tab[obj_type_pages] := l
-
-@ @<Output fonts definition@>=
-for k := font_base + 1 to font_ptr do
- if font_used[k] and hasfmentry(k) and (pdf_font_num[k] < 0) then begin
- i := -pdf_font_num[k];
- pdfassert(pdf_font_num[i] > 0);
- for j := 0 to 255 do
- if pdf_char_marked(k, j) then
- pdf_mark_char(i, j);
- if (length(pdf_font_attr[i]) = 0) and (length(pdf_font_attr[k]) <> 0) then
- pdf_font_attr[i] := pdf_font_attr[k]
- else if (length(pdf_font_attr[k]) = 0) and (length(pdf_font_attr[i]) <> 0) then
- pdf_font_attr[k] := pdf_font_attr[i]
- else if (length(pdf_font_attr[i]) <> 0) and (length(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
-
-@ We will generate in each single step the parents of all Pages/Page objects in
-the previous level. These new generated Pages object will create a new level of
-the Pages tree. We will repeat this until we have only one Pages object. This
-one will be the Root object.
-
-@<Output pages tree@>=
-a := sys_obj_ptr + 1; {all Pages objects whose children are not Page objects
- should have index greater than |a|}
-l := head_tab[obj_type_pages]; {|l| is the index of current Pages object
- which is being output}
-k := head_tab[obj_type_page]; {|k| is the index of current child of |l|}
-b := 0;
-repeat
- i := 0; {counter of Pages object in current level}
- c := 0; {first Pages object in previous level}
- if obj_link(l) = 0 then
- is_root := true {only Pages object; total pages is
- not greater than |pages_tree_kids_max|}
- else
- is_root := false;
- repeat
- if not is_root then begin
- if i mod pages_tree_kids_max = 0 then begin {create a new Pages object
- for next level}
- pdf_last_pages := pdf_new_objnum;
- if c = 0 then
- c := pdf_last_pages;
- obj_link(pages_tail) := pdf_last_pages;
- pages_tail := pdf_last_pages;
- obj_link(pdf_last_pages) := 0;
- obj_info(pdf_last_pages) := obj_info(l);
- end
- else
- obj_info(pdf_last_pages) := obj_info(pdf_last_pages) +
- obj_info(l);
- end;
- @<Output the current Pages object in this level@>;
- incr(i);
- l := obj_link(l);
- until (l = c);
- b := c;
- if l = 0 then
- goto done;
-until false;
-done:
-
-@ @<Output the current Pages object in this level@>=
-pdf_begin_dict(l, 1);
-pdf_print_ln("/Type /Pages");
-pdf_int_entry_ln("Count", obj_info(l));
-if not is_root then
- pdf_indirect_ln("Parent", pdf_last_pages);
-pdf_print("/Kids [");
-j := 0;
-repeat
- pdf_print_int(k);
- pdf_print(" 0 R ");
- k := obj_link(k);
- incr(j);
-until ((l < a) and (j = obj_info(l))) or
- (k = 0) or ((k = b) and (b <> 0)) or
- (j = pages_tree_kids_max);
-remove_last_space;
-pdf_print_ln("]");
-if k = 0 then begin
- k := head_tab[obj_type_pages];
- head_tab[obj_type_pages] := 0;
-end;
-if is_root and (pdf_pages_attr <> null) then
- pdf_print_toks_ln(pdf_pages_attr);
-pdf_end_dict;
-
-@ The name tree is very similar 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 chosen 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 procedure pdf_print_info; {print info object}
-var s: str_number;
- creator_given, producer_given, creationdate_given, moddate_given, trapped_given: boolean;
-begin
- pdf_new_dict(obj_type_others, 0, 3); {keep Info readable unless explicitly 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 pdf_info_omit_date = 0 then begin
- if not creationdate_given then begin
- @<Print the CreationDate key@>;
- end;
- if not moddate_given then begin
- @<Print the ModDate key@>;
- end;
- end;
- if not trapped_given then begin
- pdf_print_ln("/Trapped /False");
- end;
- if pdf_suppress_ptex_info mod 2 = 0 then begin
- pdf_str_entry_ln("PTEX.Fullbanner", pdftex_banner);
- end;
- pdf_end_dict;
-end;
-
-@ @<Print the Producer key@>=
-pdf_print("/Producer (pdfTeX-");
-pdf_print_int(pdftex_version div 100);
-pdf_out(".");
-pdf_print_int(pdftex_version mod 100);
-pdf_out(".");
-pdf_print(pdftex_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 + 1);
-pdf_print_ln("]");
-pdf_int_entry_ln("Size", obj_ptr + 1);
-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;
-if pdf_trailer_id_toks <> null then
- print_ID_alt(pdf_trailer_id_toks)
-else
- 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;
- if pdf_trailer_id_toks <> null then
- print_ID_alt(pdf_trailer_id_toks)
- else
- 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|}
-
-@ The parameters to |hpack| and |vpack| correspond to \TeX's primitives
-like `\.{\\hbox} \.{to} \.{300pt}', `\.{\\hbox} \.{spread} \.{10pt}'; note
-that `\.{\\hbox}' with no dimension following it is equivalent to
-`\.{\\hbox} \.{spread} \.{0pt}'. The |scan_spec| subroutine scans such
-constructions in the user's input, including the mandatory left brace that
-follows them, and it puts the specification onto |save_stack| so that the
-desired box can later be obtained by executing the following code:
-$$\vbox{\halign{#\hfil\cr
-|save_ptr:=save_ptr-2;|\cr
-|hpack(p,saved(1),saved(0)).|\cr}}$$
-Special care is necessary to ensure that the special |save_stack| codes
-are placed just below the new group code, because scanning can change
-|save_stack| when \.{\\csname} appears.
-
-@p procedure scan_spec(@!c:group_code;@!three_codes:boolean);
- {scans a box specification and left brace}
-label found;
-var @!s:integer; {temporarily saved value}
-@!spec_code:exactly..additional;
-begin if three_codes then s:=saved(0);
-if scan_keyword("to") then spec_code:=exactly
-@.to@>
-else if scan_keyword("spread") then spec_code:=additional
-@.spread@>
-else begin spec_code:=additional; cur_val:=0;
- goto found;
- end;
-scan_normal_dimen;
-found: if three_codes then
- begin saved(0):=s; incr(save_ptr);
- end;
-saved(0):=spec_code; saved(1):=cur_val; save_ptr:=save_ptr+2;
-new_save_level(c); scan_left_brace;
-end;
-
-@ To figure out the glue setting, |hpack| and |vpack| determine how much
-stretchability and shrinkability are present, considering all four orders
-of infinity. The highest order of infinity that has a nonzero coefficient
-is then used as if no other orders were present.
-
-For example, suppose that the given list contains six glue nodes with
-the respective stretchabilities 3pt, 8fill, 5fil, 6pt, $-3$fil, $-8$fill.
-Then the total is essentially 2fil; and if a total additional space of 6pt
-is to be achieved by stretching, the actual amounts of stretch will be
-0pt, 0pt, 15pt, 0pt, $-9$pt, and 0pt, since only `fil' glue will be
-considered. (The `fill' glue is therefore not really stretching infinitely
-with respect to `fil'; nobody would actually want that to happen.)
-
-The arrays |total_stretch| and |total_shrink| are used to determine how much
-glue of each kind is present. A global variable |last_badness| is used
-to implement \.{\\badness}.
-
-@<Glob...@>=
-@!total_stretch, @!total_shrink: array[glue_ord] of scaled;
- {glue found by |hpack| or |vpack|}
-@!last_badness:integer; {badness of the most recently packaged box}
-
-@ If the global variable |adjust_tail| is non-null, the |hpack| routine
-also removes all occurrences of |ins_node|, |mark_node|, and |adjust_node|
-items and appends the resulting material onto the list that ends at
-location |adjust_tail|.
-
-@<Glob...@>=
-@!adjust_tail:pointer; {tail of adjustment list}
-
-@ @<Set init...@>=adjust_tail:=null; last_badness:=0;
-
-@ @<Glob...@>=
-@!pdf_font_blink: ^internal_font_number; {link to base font (used for expanded fonts only)}
-@!pdf_font_elink: ^internal_font_number; {link to expanded fonts (used for base fonts only)}
-@!pdf_font_stretch: ^integer; {link to font expanded by stretch limi}
-@!pdf_font_shrink: ^integer; {link to font expanded by shrink limit}
-@!pdf_font_step: ^integer; {amount of one step of expansion}
-@!pdf_font_expand_ratio: ^integer; {expansion ratio of a particular font}
-@!pdf_font_auto_expand: ^boolean; {this font is auto-expanded?}
-@!pdf_font_lp_base: ^integer; {base of left-protruding factor}
-@!pdf_font_rp_base: ^integer; {base of right-protruding factor}
-@!pdf_font_ef_base: ^integer; {base of font expansion factor}
-@!pdf_font_kn_bs_base: ^integer; {base of kern before space}
-@!pdf_font_st_bs_base: ^integer; {base of stretch before space}
-@!pdf_font_sh_bs_base: ^integer; {base of shrink before space}
-@!pdf_font_kn_bc_base: ^integer; {base of kern before character}
-@!pdf_font_kn_ac_base: ^integer; {base of kern after character}
-@!font_expand_ratio: integer; {current expansion ratio}
-@!last_leftmost_char: pointer;
-@!last_rightmost_char: pointer;
-@!hlist_stack:array[0..max_hlist_stack] of pointer; {stack for |find_protchar_left()| and |find_protchar_right()|}
-@!hlist_stack_level:0..max_hlist_stack; {fill level for |hlist_stack|}
-
-@ @d cal_margin_kern_var(#) ==
-begin
- character(cp) := character(#);
- font(cp) := font(#);
- do_subst_font(cp, 1000);
- if font(cp) <> font(#) then
- margin_kern_stretch := margin_kern_stretch + left_pw(#) - left_pw(cp);
- font(cp) := font(#);
- do_subst_font(cp, -1000);
- if font(cp) <> font(#) then
- margin_kern_shrink := margin_kern_shrink + left_pw(cp) - left_pw(#);
-end
-
-@<Calculate variations of marginal kerns@>=
-begin
- lp := last_leftmost_char;
- rp := last_rightmost_char;
- fast_get_avail(cp);
- if lp <> null then
- cal_margin_kern_var(lp);
- if rp <> null then
- cal_margin_kern_var(rp);
- free_avail(cp);
-end
-
-@ Here is |hpack|, which is place where we do font substituting when
-font expansion is being used. We define some constants used when calling
-|hpack| to deal with font expansion.
-
-@d cal_expand_ratio == 2 {calculate amount for font expansion after breaking
- paragraph into lines}
-@d subst_ex_font == 3 {substitute fonts}
-
-@d substituted = 3 {|subtype| of kern nodes that should be substituted}
-
-@d left_pw(#) == char_pw(#, left_side)
-@d right_pw(#) == char_pw(#, right_side)
-
-@p
-function check_expand_pars(f: internal_font_number): boolean;
-var k: internal_font_number;
-begin
- check_expand_pars := false;
- if (pdf_font_step[f] = 0) or ((pdf_font_stretch[f] = null_font) and
- (pdf_font_shrink[f] = null_font)) then
- return;
- if cur_font_step < 0 then
- cur_font_step := pdf_font_step[f]
- else if cur_font_step <> pdf_font_step[f] then
- pdf_error("font expansion", "using fonts with different step of expansion in one paragraph is not allowed");
- k := pdf_font_stretch[f];
- if k <> null_font then begin
- if max_stretch_ratio < 0 then
- max_stretch_ratio := pdf_font_expand_ratio[k]
- else if max_stretch_ratio <> pdf_font_expand_ratio[k] then
- pdf_error("font expansion", "using fonts with different limit of expansion in one paragraph is not allowed");
- end;
- k := pdf_font_shrink[f];
- if k <> null_font then begin
- if max_shrink_ratio < 0 then
- max_shrink_ratio := -pdf_font_expand_ratio[k]
- else if max_shrink_ratio <> -pdf_font_expand_ratio[k] then
- pdf_error("font expansion", "using fonts with different limit of expansion in one paragraph is not allowed");
- end;
- check_expand_pars := true;
-end;
-
-function char_stretch(f: internal_font_number; c: eight_bits): scaled;
-var k: internal_font_number;
- dw: scaled;
- ef: integer;
-begin
- 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)(char_info(k)(c)) - char_width(f)(char_info(f)(c));
- if dw > 0 then
- char_stretch := round_xn_over_d(dw, ef, 1000);
- end;
-end;
-
-function char_shrink(f: internal_font_number; c: eight_bits): scaled;
-var k: internal_font_number;
- dw: scaled;
- ef: integer;
-begin
- 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)(char_info(f)(c)) - char_width(k)(char_info(k)(c));
- if dw > 0 then
- char_shrink := round_xn_over_d(dw, ef, 1000);
- end;
-end;
-
-function get_kern(f: internal_font_number; lc, rc: eight_bits): scaled;
-label continue;
-var i: four_quarters;
- j: four_quarters;
- k: font_index;
-begin
- get_kern := 0;
- i := char_info(f)(lc);
- if char_tag(i) <> lig_tag then
- return;
- k := lig_kern_start(f)(i);
- j := font_info[k].qqqq;
- if skip_byte(j) <= stop_flag then
- goto continue + 1;
- k := lig_kern_restart(f)(j);
-continue:
- j := font_info[k].qqqq;
-continue + 1:
- if (next_char(j) = rc) and (skip_byte(j) <= stop_flag) and
- (op_byte(j) >= kern_flag)
- then begin
- get_kern := char_kern(f)(j);
- return;
- end;
- if skip_byte(j) = qi(0) then
- incr(k)
- else begin
- if skip_byte(j) >= stop_flag then
- return;
- k := k + qo(skip_byte(j)) + 1;
- end;
- goto continue;
-end;
-
-function kern_stretch(p: pointer): scaled;
-var l, r: pointer;
- d: scaled;
-begin
- kern_stretch := 0;
- if (prev_char_p = null) or (link(prev_char_p) <> p) or (link(p) = null)
- then
- return;
- l := prev_char_p;
- r := link(p);
- if not is_char_node(l) then
- if type(l) = ligature_node then
- l := lig_char(l)
- else
- return;
- if not is_char_node(r) then
- if type(r) = ligature_node then
- r := lig_char(r)
- else
- return;
- if not ((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 (link(prev_char_p) <> p) or (link(p) = null)
- then
- return;
- l := prev_char_p;
- r := link(p);
- if not is_char_node(l) then
- if type(l) = ligature_node then
- l := lig_char(l)
- else
- return;
- if not is_char_node(r) then
- if type(r) = ligature_node then
- r := lig_char(r)
- else
- return;
- if not ((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 := pre_break(p);
- while r <> null do begin
- if is_char_node(r) or (type(r) = ligature_node) then
- do_subst_font(r, ex_ratio);
- r := link(r);
- end;
- r := post_break(p);
- while r <> null do begin
- if is_char_node(r) or (type(r) = ligature_node) then
- do_subst_font(r, ex_ratio);
- r := link(r);
- end;
- return;
- end;
- if is_char_node(p) then
- r := p
- else if type(p) = ligature_node then
- r := lig_char(p)
- else begin
- {|short_display_n(p, 5);|}
- pdf_error("font expansion", "invalid node type");
- end;
- f := font(r);
- ef := get_ef_code(f, character(r));
- if ef = 0 then
- return;
- if (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_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 := link(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 begin
- if type(p) = ligature_node then
- p := lig_char(p)
- else
- return;
- end;
- 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: pointer;
-begin
- k := get_node(margin_kern_node_size);
- type(k) := margin_kern_node;
- subtype(k) := side;
- width(k) := w;
- if p = null then
- pdf_error("margin kerning", "invalid pointer to marginal char node");
- fast_get_avail(margin_char(k));
- character(margin_char(k)) := character(p);
- font(margin_char(k)) := font(p);
- 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|}
-@!i:four_quarters; {font information about a |char_node|}
-@!hd:eight_bits; {height and depth indices for a character}
-font_stretch: scaled;
-font_shrink: scaled;
-k: scaled;
-begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
-subtype(r):=min_quarterword; shift_amount(r):=0;
-q:=r+list_offset; link(q):=p;@/
-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@>;
-if TeXXeT_en then @<Initialize the LR stack@>;
-while p<>null do @<Examine node |p| in the hlist, taking account of its effect
- on the dimensions of the new box, or moving it to the adjustment list;
- then advance |p| to the next node@>;
-if adjust_tail<>null then link(adjust_tail):=null;
-if pre_adjust_tail<>null then link(pre_adjust_tail):=null;
-height(r):=h; depth(r):=d;@/
-@<Determine the value of |width(r)| and the appropriate glue setting;
- then |return| or |goto common_ending|@>;
-common_ending: @<Finish issuing a diagnostic message
- for an overfull or underfull hbox@>;
-exit: if TeXXeT_en then @<Check for LR anomalies at the end of |hpack|@>;
-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);
- free_node(r, box_node_size);
- r := hpack(q, w, subst_ex_font);
-end;
-hpack:=r;
-end;
-
-@ @<Clear dimensions to zero@>=
-d:=0; x:=0;
-total_stretch[normal]:=0; total_shrink[normal]:=0;
-total_stretch[fil]:=0; total_shrink[fil]:=0;
-total_stretch[fill]:=0; total_shrink[fill]:=0;
-total_stretch[filll]:=0; total_shrink[filll]:=0
-
-@ @<Examine node |p| in the hlist, taking account of its effect...@>=
-@^inner loop@>
-begin reswitch: while is_char_node(p) do
- @<Incorporate character dimensions into the dimensions of
- the hbox that will contain~it, then move to the next node@>;
-if p<>null then
- begin case type(p) of
- hlist_node,vlist_node,rule_node,unset_node:
- @<Incorporate box dimensions into the dimensions of
- the hbox that will contain~it@>;
- ins_node,mark_node,adjust_node: if (adjust_tail<>null) or (pre_adjust_tail<> null) then
- @<Transfer node |p| to the adjustment list@>;
- whatsit_node:@<Incorporate a whatsit node into an hbox@>;
- glue_node:@<Incorporate glue into the horizontal totals@>;
- margin_kern_node: begin
- if m = cal_expand_ratio then begin
- f := font(margin_char(p));
- do_subst_font(margin_char(p), 1000);
- if f <> font(margin_char(p)) then
- font_stretch := font_stretch - width(p) -
- char_pw(margin_char(p), subtype(p));
- font(margin_char(p)) := f;
- do_subst_font(margin_char(p), -1000);
- if f <> font(margin_char(p)) then
- font_shrink := font_shrink - width(p) -
- char_pw(margin_char(p), subtype(p));
- font(margin_char(p)) := f;
- end
- else if m = subst_ex_font then begin
- do_subst_font(margin_char(p), font_expand_ratio);
- width(p) := -char_pw(margin_char(p), subtype(p));
- end;
- x := x + width(p);
- end;
- kern_node: begin
- if subtype(p) = normal then begin
- if m = cal_expand_ratio then begin
- font_stretch := font_stretch + kern_stretch(p);
- font_shrink := font_shrink + kern_shrink(p);
- end
- else if m = subst_ex_font then begin
- if font_expand_ratio > 0 then
- k := kern_stretch(p)
- else if font_expand_ratio < 0 then
- k := kern_shrink(p)
- else
- pdfassert(0);
- if k <> 0 then begin
- if is_char_node(link(p)) then
- width(p) := get_kern(font(prev_char_p),
- character(prev_char_p),
- character(link(p)))
- else if type(link(p)) = ligature_node then
- width(p) := get_kern(font(prev_char_p),
- character(prev_char_p),
- character(lig_char(link(p))));
- end;
- end;
- end;
- x := x + width(p);
- end;
- math_node: begin x:=x+width(p);
- if TeXXeT_en then @<Adjust \(t)the LR stack for the |hpack| routine@>;
- end;
- ligature_node: begin
- if m = subst_ex_font then
- do_subst_font(p, font_expand_ratio);
- @<Make node |p| look like a |char_node| and |goto reswitch|@>;
- end;
- disc_node:
- if m = subst_ex_font then
- do_subst_font(p, font_expand_ratio);
- othercases do_nothing
- endcases;@/
- p:=link(p);
- end;
-end
-
-
-@ @<Make node |p| look like a |char_node| and |goto reswitch|@>=
-begin mem[lig_trick]:=mem[lig_char(p)]; link(lig_trick):=link(p);
-p:=lig_trick; goto reswitch;
-end
-
-@ The code here implicitly uses the fact that running dimensions are
-indicated by |null_flag|, which will be ignored in the calculations
-because it is a highly negative number.
-
-@<Incorporate box dimensions into the dimensions of the hbox...@>=
-begin x:=x+width(p);
-if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
-if height(p)-s>h then h:=height(p)-s;
-if depth(p)+s>d then d:=depth(p)+s;
-end
-
-@ The following code is part of \TeX's inner loop; i.e., adding another
-character of text to the user's input will cause each of these instructions
-to be exercised one more time.
-@^inner loop@>
-
-@<Incorporate character dimensions into the dimensions of the hbox...@>=
-begin
-if m >= cal_expand_ratio then begin
- prev_char_p := p;
- case m of
- cal_expand_ratio: begin
- f := font(p);
- add_char_stretch(font_stretch)(character(p));
- add_char_shrink(font_shrink)(character(p));
- end;
- subst_ex_font:
- do_subst_font(p, font_expand_ratio);
- endcases;
-end;
-f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
-x:=x+char_width(f)(i);@/
-s:=char_height(f)(hd);@+if s>h then h:=s;
-s:=char_depth(f)(hd);@+if s>d then d:=s;
-p:=link(p);
-end
-
-@ Although node |q| is not necessarily the immediate predecessor of node |p|,
-it always points to some node in the list preceding |p|. Thus, we can delete
-nodes by moving |q| when necessary. The algorithm takes linear time, and the
-extra computation does not intrude on the inner loop unless it is necessary
-to make a deletion.
-@^inner loop@>
-
-@<Glob...@>=
-@!pre_adjust_tail: pointer;
-
-@ @<Set init...@>=
-pre_adjust_tail := null;
-
-@ Materials in \.{\\vadjust} used with \.{pre} keyword will be appended to
-|pre_adjust_tail| instead of |adjust_tail|.
-
-@d update_adjust_list(#) == begin
- if # = null then
- confusion("pre vadjust");
- link(#) := adjust_ptr(p);
- while link(#) <> null do
- # := link(#);
-end
-
-@<Transfer node |p| to the adjustment list@>=
-begin while link(q)<>p do q:=link(q);
- if type(p) = adjust_node then begin
- if adjust_pre(p) <> 0 then
- update_adjust_list(pre_adjust_tail)
- else
- update_adjust_list(adjust_tail);
- p := link(p); free_node(link(q), small_node_size);
- end
-else begin link(adjust_tail):=p; adjust_tail:=p; p:=link(p);
- end;
-link(q):=p; p:=q;
-end
-
-@ @<Incorporate glue into the horizontal totals@>=
-begin g:=glue_ptr(p); x:=x+width(g);@/
-o:=stretch_order(g); total_stretch[o]:=total_stretch[o]+stretch(g);
-o:=shrink_order(g); total_shrink[o]:=total_shrink[o]+shrink(g);
-if subtype(p)>=a_leaders then
- begin g:=leader_ptr(p);
- if height(g)>h then h:=height(g);
- if depth(g)>d then d:=depth(g);
- end;
-end
-
-@ When we get to the present part of the program, |x| is the natural width
-of the box being packaged.
-
-@<Determine the value of |width(r)| and the appropriate glue setting...@>=
-if m=additional then w:=x+w;
-width(r):=w; x:=w-x; {now |x| is the excess to be made up}
-if x=0 then
- begin glue_sign(r):=normal; glue_order(r):=normal;
- set_glue_ratio_zero(glue_set(r));
- return;
- end
-else if x>0 then @<Determine horizontal glue stretch setting, then |return|
- or \hbox{|goto common_ending|}@>
-else @<Determine horizontal glue shrink setting, then |return|
- or \hbox{|goto common_ending|}@>
-
-@ 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(x, font_stretch, 3);
- 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 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(x, font_shrink, 3);
- 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 o:=normal
-
-@ @<Report an overfull hbox and |goto common_ending|, if...@>=
-if (-x-total_shrink[normal]>hfuzz)or(hbadness<100) then
- begin if (overfull_rule>0)and(-x-total_shrink[normal]>hfuzz) then
- begin while link(q)<>null do q:=link(q);
- link(q):=new_rule;
- width(link(q)):=overfull_rule;
- end;
- print_ln; print_nl("Overfull \hbox (");
-@.Overfull \\hbox...@>
- print_scaled(-x-total_shrink[normal]); print("pt too wide");
- goto common_ending;
- end
-
-@ @<Report a tight hbox and |goto common_ending|, if...@>=
-begin last_badness:=badness(-x,total_shrink[normal]);
-if last_badness>hbadness then
- begin print_ln; print_nl("Tight \hbox (badness "); print_int(last_badness);
-@.Tight \\hbox...@>
- goto common_ending;
- end;
-end
-
-@ The |vpack| subroutine is actually a special case of a slightly more
-general routine called |vpackage|, which has four parameters. The fourth
-parameter, which is |max_dimen| in the case of |vpack|, specifies the
-maximum depth of the page box that is constructed. The depth is first
-computed by the normal rules; if it exceeds this limit, the reference
-point is simply moved down until the limiting depth is attained.
-
-@d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth}
-
-@p function vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled):
- pointer;
-label common_ending, exit;
-var r:pointer; {the box node that will be returned}
-@!w,@!d,@!x:scaled; {width, depth, and natural height}
-@!s:scaled; {shift amount}
-@!g:pointer; {points to a glue specification}
-@!o:glue_ord; {order of infinity}
-begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node;
-subtype(r):=min_quarterword; shift_amount(r):=0;
-list_ptr(r):=p;@/
-w:=0; @<Clear dimensions to zero@>;
-while p<>null do @<Examine node |p| in the vlist, taking account of its effect
- on the dimensions of the new box; then advance |p| to the next node@>;
-width(r):=w;
-if d>l then
- begin x:=x+d-l; depth(r):=l;
- end
-else depth(r):=d;
-@<Determine the value of |height(r)| and the appropriate glue setting;
- then |return| or |goto common_ending|@>;
-common_ending: @<Finish issuing a diagnostic message
- for an overfull or underfull vbox@>;
-exit: vpackage:=r;
-end;
-
-@ @<Examine node |p| in the vlist, taking account of its effect...@>=
-begin if is_char_node(p) then confusion("vpack")
-@:this can't happen vpack}{\quad vpack@>
-else case type(p) of
- hlist_node,vlist_node,rule_node,unset_node:
- @<Incorporate box dimensions into the dimensions of
- the vbox that will contain~it@>;
- whatsit_node:@<Incorporate a whatsit node into a vbox@>;
- glue_node: @<Incorporate glue into the vertical totals@>;
- kern_node: begin x:=x+d+width(p); d:=0;
- end;
- othercases do_nothing
- endcases;
-p:=link(p);
-end
-
-@ @<Incorporate box dimensions into the dimensions of the vbox...@>=
-begin x:=x+d+height(p); d:=depth(p);
-if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
-if width(p)+s>w then w:=width(p)+s;
-end
-
-@ @<Incorporate glue into the vertical totals@>=
-begin x:=x+d; d:=0;@/
-g:=glue_ptr(p); x:=x+width(g);@/
-o:=stretch_order(g); total_stretch[o]:=total_stretch[o]+stretch(g);
-o:=shrink_order(g); total_shrink[o]:=total_shrink[o]+shrink(g);
-if subtype(p)>=a_leaders then
- begin g:=leader_ptr(p);
- if width(g)>w then w:=width(g);
- end;
-end
-
-@ When we get to the present part of the program, |x| is the natural height
-of the box being packaged.
-
-@<Determine the value of |height(r)| and the appropriate glue setting...@>=
-if m=additional then h:=x+h;
-height(r):=h; x:=h-x; {now |x| is the excess to be made up}
-if x=0 then
- begin glue_sign(r):=normal; glue_order(r):=normal;
- set_glue_ratio_zero(glue_set(r));
- return;
- end
-else if x>0 then @<Determine vertical glue stretch setting, then |return|
- or \hbox{|goto common_ending|}@>
-else @<Determine vertical glue shrink setting, then |return|
- or \hbox{|goto common_ending|}@>
-
-@ @<Determine vertical glue stretch setting...@>=
-begin @<Determine the stretch order@>;
-glue_order(r):=o; glue_sign(r):=stretching;
-if total_stretch[o]<>0 then glue_set(r):=unfloat(x/total_stretch[o])
-@^real division@>
-else begin glue_sign(r):=normal;
- set_glue_ratio_zero(glue_set(r)); {there's nothing to stretch}
- end;
-if o=normal then if list_ptr(r)<>null then
- @<Report an underfull vbox and |goto common_ending|, if this box
- is sufficiently bad@>;
-return;
-end
-
-@ @<Report an underfull vbox and |goto common_ending|, if...@>=
-begin last_badness:=badness(x,total_stretch[normal]);
-if last_badness>vbadness then
- begin print_ln;
- if last_badness>100 then print_nl("Underfull")@+else print_nl("Loose");
- print(" \vbox (badness "); print_int(last_badness);
-@.Underfull \\vbox...@>
-@.Loose \\vbox...@>
- goto common_ending;
- end;
-end
-
-@ @<Finish issuing a diagnostic message for an overfull or underfull vbox@>=
-if output_active then print(") has occurred while \output is active")
-else begin if pack_begin_line<>0 then {it's actually negative}
- begin print(") in alignment at lines ");
- print_int(abs(pack_begin_line));
- print("--");
- end
- else print(") detected at line ");
- print_int(line);
- print_ln;@/
- end;
-begin_diagnostic; show_box(r); end_diagnostic(true)
-
-@ @<Determine vertical glue shrink setting...@>=
-begin @<Determine the shrink order@>;
-glue_order(r):=o; glue_sign(r):=shrinking;
-if total_shrink[o]<>0 then glue_set(r):=unfloat((-x)/total_shrink[o])
-@^real division@>
-else begin glue_sign(r):=normal;
- set_glue_ratio_zero(glue_set(r)); {there's nothing to shrink}
- end;
-if (total_shrink[o]<-x)and(o=normal)and(list_ptr(r)<>null) then
- begin last_badness:=1000000;
- set_glue_ratio_one(glue_set(r)); {use the maximum shrinkage}
- @<Report an overfull vbox and |goto common_ending|, if this box
- is sufficiently bad@>;
- end
-else if o=normal then if list_ptr(r)<>null then
- @<Report a tight vbox and |goto common_ending|, if this box
- is sufficiently bad@>;
-return;
-end
-
-@ @<Report an overfull vbox and |goto common_ending|, if...@>=
-if (-x-total_shrink[normal]>vfuzz)or(vbadness<100) then
- begin print_ln; print_nl("Overfull \vbox (");
-@.Overfull \\vbox...@>
- print_scaled(-x-total_shrink[normal]); print("pt too high");
- goto common_ending;
- end
-
-@ @<Report a tight vbox and |goto common_ending|, if...@>=
-begin last_badness:=badness(-x,total_shrink[normal]);
-if last_badness>vbadness then
- begin print_ln; print_nl("Tight \vbox (badness "); print_int(last_badness);
-@.Tight \\vbox...@>
- goto common_ending;
- end;
-end
-
-@ When a box is being appended to the current vertical list, the
-baselineskip calculation is handled by the |append_to_vlist| routine.
-
-@p procedure append_to_vlist(@!b:pointer);
-var d:scaled; {deficiency of space between baselines}
-@!p:pointer; {a new glue node}
-begin if prev_depth>pdf_ignored_dimen then
- begin d:=width(baseline_skip)-prev_depth-height(b);
- if d<line_skip_limit then p:=new_param_glue(line_skip_code)
- else begin p:=new_skip_param(baseline_skip_code);
- width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
- end;
- link(tail):=p; tail:=p;
- end;
-link(tail):=b; tail:=b; prev_depth:=depth(b);
-end;
-
-@* \[34] Data structures for math mode.
-When \TeX\ reads a formula that is enclosed between \.\$'s, it constructs an
-{\sl mlist}, which is essentially a tree structure representing that
-formula. An mlist is a linear sequence of items, but we can regard it as
-a tree structure because mlists can appear within mlists. For example, many
-of the entries can be subscripted or superscripted, and such ``scripts''
-are mlists in their own right.
-
-An entire formula is parsed into such a tree before any of the actual
-typesetting is done, because the current style of type is usually not
-known until the formula has been fully scanned. For example, when the
-formula `\.{\$a+b \\over c+d\$}' is being read, there is no way to tell
-that `\.{a+b}' will be in script size until `\.{\\over}' has appeared.
-
-During the scanning process, each element of the mlist being built is
-classified as a relation, a binary operator, an open parenthesis, etc.,
-or as a construct like `\.{\\sqrt}' that must be built up. This classification
-appears in the mlist data structure.
-
-After a formula has been fully scanned, the mlist is converted to an hlist
-so that it can be incorporated into the surrounding text. This conversion is
-controlled by a recursive procedure that decides all of the appropriate
-styles by a ``top-down'' process starting at the outermost level and working
-in towards the subformulas. The formula is ultimately pasted together using
-combinations of horizontal and vertical boxes, with glue and penalty nodes
-inserted as necessary.
-
-An mlist is represented internally as a linked list consisting chiefly
-of ``noads'' (pronounced ``no-adds''), to distinguish them from the somewhat
-similar ``nodes'' in hlists and vlists. Certain kinds of ordinary nodes are
-allowed to appear in mlists together with the noads; \TeX\ tells the difference
-by means of the |type| field, since a noad's |type| is always greater than
-that of a node. An mlist does not contain character nodes, hlist nodes, vlist
-nodes, math nodes, ligature nodes,
-or unset nodes; in particular, each mlist item appears in the
-variable-size part of |mem|, so the |type| field is always present.
-
-@ Each noad is four or more words long. The first word contains the |type|
-and |subtype| and |link| fields that are already so familiar to us; the
-second, third, and fourth words are called the noad's |nucleus|, |subscr|,
-and |supscr| fields.
-
-Consider, for example, the simple formula `\.{\$x\^2\$}', which would be
-parsed into an mlist containing a single element called an |ord_noad|.
-The |nucleus| of this noad is a representation of `\.x', the |subscr| is
-empty, and the |supscr| is a representation of `\.2'.
-
-The |nucleus|, |subscr|, and |supscr| fields are further broken into
-subfields. If |p| points to a noad, and if |q| is one of its principal
-fields (e.g., |q=subscr(p)|), there are several possibilities for the
-subfields, depending on the |math_type| of |q|.
-
-\yskip\hang|math_type(q)=math_char| means that |fam(q)| refers to one of
-the sixteen font families, and |character(q)| is the number of a character
-within a font of that family, as in a character node.
-
-\yskip\hang|math_type(q)=math_text_char| is similar, but the character is
-unsubscripted and unsuperscripted and it is followed immediately by another
-character from the same font. (This |math_type| setting appears only
-briefly during the processing; it is used to suppress unwanted italic
-corrections.)
-
-\yskip\hang|math_type(q)=empty| indicates a field with no value (the
-corresponding attribute of noad |p| is not present).
-
-\yskip\hang|math_type(q)=sub_box| means that |info(q)| points to a box
-node (either an |hlist_node| or a |vlist_node|) that should be used as the
-value of the field. The |shift_amount| in the subsidiary box node is the
-amount by which that box will be shifted downward.
-
-\yskip\hang|math_type(q)=sub_mlist| means that |info(q)| points to
-an mlist; the mlist must be converted to an hlist in order to obtain
-the value of this field.
-
-\yskip\noindent In the latter case, we might have |info(q)=null|. This
-is not the same as |math_type(q)=empty|; for example, `\.{\$P\_\{\}\$}'
-and `\.{\$P\$}' produce different results (the former will not have the
-``italic correction'' added to the width of |P|, but the ``script skip''
-will be added).
-
-The definitions of subfields given here are evidently wasteful of space,
-since a halfword is being used for the |math_type| although only three
-bits would be needed. However, there are hardly ever many noads present at
-once, since they are soon converted to nodes that take up even more space,
-so we can afford to represent them in whatever way simplifies the
-programming.
-
-@d noad_size=4 {number of words in a normal noad}
-@d nucleus(#)==#+1 {the |nucleus| field of a noad}
-@d supscr(#)==#+2 {the |supscr| field of a noad}
-@d subscr(#)==#+3 {the |subscr| field of a noad}
-@d math_type==link {a |halfword| in |mem|}
-@d fam==font {a |quarterword| in |mem|}
-@d math_char=1 {|math_type| when the attribute is simple}
-@d sub_box=2 {|math_type| when the attribute is a box}
-@d sub_mlist=3 {|math_type| when the attribute is a formula}
-@d math_text_char=4 {|math_type| when italic correction is dubious}
-
-@ Each portion of a formula is classified as Ord, Op, Bin, Rel, Open,
-Close, Punct, or Inner, for purposes of spacing and line breaking. An
-|ord_noad|, |op_noad|, |bin_noad|, |rel_noad|, |open_noad|, |close_noad|,
-|punct_noad|, or |inner_noad| is used to represent portions of the various
-types. For example, an `\.=' sign in a formula leads to the creation of a
-|rel_noad| whose |nucleus| field is a representation of an equals sign
-(usually |fam=0|, |character=@'75|). A formula preceded by \.{\\mathrel}
-also results in a |rel_noad|. When a |rel_noad| is followed by an
-|op_noad|, say, and possibly separated by one or more ordinary nodes (not
-noads), \TeX\ will insert a penalty node (with the current |rel_penalty|)
-just after the formula that corresponds to the |rel_noad|, unless there
-already was a penalty immediately following; and a ``thick space'' will be
-inserted just before the formula that corresponds to the |op_noad|.
-
-A noad of type |ord_noad|, |op_noad|, \dots, |inner_noad| usually
-has a |subtype=normal|. The only exception is that an |op_noad| might
-have |subtype=limits| or |no_limits|, if the normal positioning of
-limits has been overridden for this operator.
-
-@d ord_noad=unset_node+3 {|type| of a noad classified Ord}
-@d op_noad=ord_noad+1 {|type| of a noad classified Op}
-@d bin_noad=ord_noad+2 {|type| of a noad classified Bin}
-@d rel_noad=ord_noad+3 {|type| of a noad classified Rel}
-@d open_noad=ord_noad+4 {|type| of a noad classified Open}
-@d close_noad=ord_noad+5 {|type| of a noad classified Close}
-@d punct_noad=ord_noad+6 {|type| of a noad classified Punct}
-@d inner_noad=ord_noad+7 {|type| of a noad classified Inner}
-@d limits=1 {|subtype| of |op_noad| whose scripts are to be above, below}
-@d no_limits=2 {|subtype| of |op_noad| whose scripts are to be normal}
-
-@ A |radical_noad| is five words long; the fifth word is the |left_delimiter|
-field, which usually represents a square root sign.
-
-A |fraction_noad| is six words long; it has a |right_delimiter| field
-as well as a |left_delimiter|.
-
-Delimiter fields are of type |four_quarters|, and they have four subfields
-called |small_fam|, |small_char|, |large_fam|, |large_char|. These subfields
-represent variable-size delimiters by giving the ``small'' and ``large''
-starting characters, as explained in Chapter~17 of {\sl The \TeX book}.
-@:TeXbook}{\sl The \TeX book@>
-
-A |fraction_noad| is actually quite different from all other noads. Not
-only does it have six words, it has |thickness|, |denominator|, and
-|numerator| fields instead of |nucleus|, |subscr|, and |supscr|. The
-|thickness| is a scaled value that tells how thick to make a fraction
-rule; however, the special value |default_code| is used to stand for the
-|default_rule_thickness| of the current size. The |numerator| and
-|denominator| point to mlists that define a fraction; we always have
-$$\hbox{|math_type(numerator)=math_type(denominator)=sub_mlist|}.$$ The
-|left_delimiter| and |right_delimiter| fields specify delimiters that will
-be placed at the left and right of the fraction. In this way, a
-|fraction_noad| is able to represent all of \TeX's operators \.{\\over},
-\.{\\atop}, \.{\\above}, \.{\\overwithdelims}, \.{\\atopwithdelims}, and
- \.{\\abovewithdelims}.
-
-@d left_delimiter(#)==#+4 {first delimiter field of a noad}
-@d right_delimiter(#)==#+5 {second delimiter field of a fraction noad}
-@d radical_noad=inner_noad+1 {|type| of a noad for square roots}
-@d radical_noad_size=5 {number of |mem| words in a radical noad}
-@d fraction_noad=radical_noad+1 {|type| of a noad for generalized fractions}
-@d fraction_noad_size=6 {number of |mem| words in a fraction noad}
-@d small_fam(#)==mem[#].qqqq.b0 {|fam| for ``small'' delimiter}
-@d small_char(#)==mem[#].qqqq.b1 {|character| for ``small'' delimiter}
-@d large_fam(#)==mem[#].qqqq.b2 {|fam| for ``large'' delimiter}
-@d large_char(#)==mem[#].qqqq.b3 {|character| for ``large'' delimiter}
-@d thickness==width {|thickness| field in a fraction noad}
-@d default_code==@'10000000000 {denotes |default_rule_thickness|}
-@d numerator==supscr {|numerator| field in a fraction noad}
-@d denominator==subscr {|denominator| field in a fraction noad}
-
-@ The global variable |empty_field| is set up for initialization of empty
-fields in new noads. Similarly, |null_delimiter| is for the initialization
-of delimiter fields.
-
-@<Glob...@>=
-@!empty_field:two_halves;
-@!null_delimiter:four_quarters;
-
-@ @<Set init...@>=
-empty_field.rh:=empty; empty_field.lh:=null;@/
-null_delimiter.b0:=0; null_delimiter.b1:=min_quarterword;@/
-null_delimiter.b2:=0; null_delimiter.b3:=min_quarterword;
-
-@ The |new_noad| function creates an |ord_noad| that is completely null.
-
-@p function new_noad:pointer;
-var p:pointer;
-begin p:=get_node(noad_size);
-type(p):=ord_noad; subtype(p):=normal;
-mem[nucleus(p)].hh:=empty_field;
-mem[subscr(p)].hh:=empty_field;
-mem[supscr(p)].hh:=empty_field;
-new_noad:=p;
-end;
-
-@ A few more kinds of noads will complete the set: An |under_noad| has its
-nucleus underlined; an |over_noad| has it overlined. An |accent_noad| places
-an accent over its nucleus; the accent character appears as
-|fam(accent_chr(p))| and |character(accent_chr(p))|. A |vcenter_noad|
-centers its nucleus vertically with respect to the axis of the formula;
-in such noads we always have |math_type(nucleus(p))=sub_box|.
-
-And finally, we have |left_noad| and |right_noad| types, to implement
-\TeX's \.{\\left} and \.{\\right} as well as \eTeX's \.{\\middle}.
-The |nucleus| of such noads is
-replaced by a |delimiter| field; thus, for example, `\.{\\left(}' produces
-a |left_noad| such that |delimiter(p)| holds the family and character
-codes for all left parentheses. A |left_noad| never appears in an mlist
-except as the first element, and a |right_noad| never appears in an mlist
-except as the last element; furthermore, we either have both a |left_noad|
-and a |right_noad|, or neither one is present. The |subscr| and |supscr|
-fields are always |empty| in a |left_noad| and a |right_noad|.
-
-@d under_noad=fraction_noad+1 {|type| of a noad for underlining}
-@d over_noad=under_noad+1 {|type| of a noad for overlining}
-@d accent_noad=over_noad+1 {|type| of a noad for accented subformulas}
-@d accent_noad_size=5 {number of |mem| words in an accent noad}
-@d accent_chr(#)==#+4 {the |accent_chr| field of an accent noad}
-@d vcenter_noad=accent_noad+1 {|type| of a noad for \.{\\vcenter}}
-@d left_noad=vcenter_noad+1 {|type| of a noad for \.{\\left}}
-@d right_noad=left_noad+1 {|type| of a noad for \.{\\right}}
-@d delimiter==nucleus {|delimiter| field in left and right noads}
-@d middle_noad==1 {|subtype| of right noad representing \.{\\middle}}
-@d scripts_allowed(#)==(type(#)>=ord_noad)and(type(#)<left_noad)
-
-@ Math formulas can also contain instructions like \.{\\textstyle} that
-override \TeX's normal style rules. A |style_node| is inserted into the
-data structure to record such instructions; it is three words long, so it
-is considered a node instead of a noad. The |subtype| is either |display_style|
-or |text_style| or |script_style| or |script_script_style|. The
-second and third words of a |style_node| are not used, but they are
-present because a |choice_node| is converted to a |style_node|.
-
-\TeX\ uses even numbers 0, 2, 4, 6 to encode the basic styles
-|display_style|, \dots, |script_script_style|, and adds~1 to get the
-``cramped'' versions of these styles. This gives a numerical order that
-is backwards from the convention of Appendix~G in {\sl The \TeX book\/};
-i.e., a smaller style has a larger numerical value.
-@:TeXbook}{\sl The \TeX book@>
-
-@d style_node=unset_node+1 {|type| of a style node}
-@d style_node_size=3 {number of words in a style node}
-@d display_style=0 {|subtype| for \.{\\displaystyle}}
-@d text_style=2 {|subtype| for \.{\\textstyle}}
-@d script_style=4 {|subtype| for \.{\\scriptstyle}}
-@d script_script_style=6 {|subtype| for \.{\\scriptscriptstyle}}
-@d cramped=1 {add this to an uncramped style if you want to cramp it}
-
-@p function new_style(@!s:small_number):pointer; {create a style node}
-var p:pointer; {the new node}
-begin p:=get_node(style_node_size); type(p):=style_node;
-subtype(p):=s; width(p):=0; depth(p):=0; {the |width| and |depth| are not used}
-new_style:=p;
-end;
-
-@ Finally, the \.{\\mathchoice} primitive creates a |choice_node|, which
-has special subfields |display_mlist|, |text_mlist|, |script_mlist|,
-and |script_script_mlist| pointing to the mlists for each style.
-
-@d choice_node=unset_node+2 {|type| of a choice node}
-@d display_mlist(#)==info(#+1) {mlist to be used in display style}
-@d text_mlist(#)==link(#+1) {mlist to be used in text style}
-@d script_mlist(#)==info(#+2) {mlist to be used in script style}
-@d script_script_mlist(#)==link(#+2) {mlist to be used in scriptscript style}
-
-@p function new_choice:pointer; {create a choice node}
-var p:pointer; {the new node}
-begin p:=get_node(style_node_size); type(p):=choice_node;
-subtype(p):=0; {the |subtype| is not used}
-display_mlist(p):=null; text_mlist(p):=null; script_mlist(p):=null;
-script_script_mlist(p):=null;
-new_choice:=p;
-end;
-
-@ Let's consider now the previously unwritten part of |show_node_list|
-that displays the things that can only be present in mlists; this
-program illustrates how to access the data structures just defined.
-
-In the context of the following program, |p| points to a node or noad that
-should be displayed, and the current string contains the ``recursion history''
-that leads to this point. The recursion history consists of a dot for each
-outer level in which |p| is subsidiary to some node, or in which |p| is
-subsidiary to the |nucleus| field of some noad; the dot is replaced by
-`\.\_' or `\.\^' or `\./' or `\.\\' if |p| is descended from the |subscr|
-or |supscr| or |denominator| or |numerator| fields of noads. For example,
-the current string would be `\.{.\^.\_/}' if |p| points to the |ord_noad| for
-|x| in the (ridiculous) formula
-`\.{\$\\sqrt\{a\^\{\\mathinner\{b\_\{c\\over x+y\}\}\}\}\$}'.
-
-@<Cases of |show_node_list| that arise...@>=
-style_node:print_style(subtype(p));
-choice_node:@<Display choice node |p|@>;
-ord_noad,op_noad,bin_noad,rel_noad,open_noad,close_noad,punct_noad,inner_noad,
- radical_noad,over_noad,under_noad,vcenter_noad,accent_noad,
- left_noad,right_noad:@<Display normal noad |p|@>;
-fraction_noad:@<Display fraction noad |p|@>;
-
-@ Here are some simple routines used in the display of noads.
-
-@<Declare procedures needed for displaying the elements of mlists@>=
-procedure print_fam_and_char(@!p:pointer); {prints family and character}
-begin print_esc("fam"); print_int(fam(p)); print_char(" ");
-print_ASCII(qo(character(p)));
-end;
-@#
-procedure print_delimiter(@!p:pointer); {prints a delimiter as 24-bit hex value}
-var a:integer; {accumulator}
-begin a:=small_fam(p)*256+qo(small_char(p));
-a:=a*@"1000+large_fam(p)*256+qo(large_char(p));
-if a<0 then print_int(a) {this should never happen}
-else print_hex(a);
-end;
-
-@ The next subroutine will descend to another level of recursion when a
-subsidiary mlist needs to be displayed. The parameter |c| indicates what
-character is to become part of the recursion history. An empty mlist is
-distinguished from a field with |math_type(p)=empty|, because these are
-not equivalent (as explained above).
-@^recursion@>
-
-@<Declare procedures needed for displaying...@>=
-procedure@?show_info; forward;@t\2@>@?{|show_node_list(info(temp_ptr))|}
-procedure print_subsidiary_data(@!p:pointer;@!c:ASCII_code);
- {display a noad field}
-begin if cur_length>=depth_threshold then
- begin if math_type(p)<>empty then print(" []");
- end
-else begin append_char(c); {include |c| in the recursion history}
- temp_ptr:=p; {prepare for |show_info| if recursion is needed}
- case math_type(p) of
- math_char: begin print_ln; print_current_string; print_fam_and_char(p);
- end;
- sub_box: show_info; {recursive call}
- sub_mlist: if info(p)=null then
- begin print_ln; print_current_string; print("{}");
- end
- else show_info; {recursive call}
- othercases do_nothing {|empty|}
- endcases;@/
- flush_char; {remove |c| from the recursion history}
- end;
-end;
-
-@ The inelegant introduction of |show_info| in the code above seems better
-than the alternative of using \PASCAL's strange |forward| declaration for a
-procedure with parameters. The \PASCAL\ convention about dropping parameters
-from a post-|forward| procedure is, frankly, so intolerable to the author
-of \TeX\ that he would rather stoop to communication via a global temporary
-variable. (A similar stupidity occurred with respect to |hlist_out| and
-|vlist_out| above, and it will occur with respect to |mlist_to_hlist| below.)
-@^Knuth, Donald Ervin@>
-@:PASCAL}{\PASCAL@>
-
-@p procedure show_info; {the reader will kindly forgive this}
-begin show_node_list(info(temp_ptr));
-end;
-
-@ @<Declare procedures needed for displaying...@>=
-procedure print_style(@!c:integer);
-begin case c div 2 of
-0: print_esc("displaystyle"); {|display_style=0|}
-1: print_esc("textstyle"); {|text_style=2|}
-2: print_esc("scriptstyle"); {|script_style=4|}
-3: print_esc("scriptscriptstyle"); {|script_script_style=6|}
-othercases print("Unknown style!")
-endcases;
-end;
-
-@ @<Display choice node |p|@>=
-begin print_esc("mathchoice");
-append_char("D"); show_node_list(display_mlist(p)); flush_char;
-append_char("T"); show_node_list(text_mlist(p)); flush_char;
-append_char("S"); show_node_list(script_mlist(p)); flush_char;
-append_char("s"); show_node_list(script_script_mlist(p)); flush_char;
-end
-
-@ @<Display normal noad |p|@>=
-begin case type(p) of
-ord_noad: print_esc("mathord");
-op_noad: print_esc("mathop");
-bin_noad: print_esc("mathbin");
-rel_noad: print_esc("mathrel");
-open_noad: print_esc("mathopen");
-close_noad: print_esc("mathclose");
-punct_noad: print_esc("mathpunct");
-inner_noad: print_esc("mathinner");
-over_noad: print_esc("overline");
-under_noad: print_esc("underline");
-vcenter_noad: print_esc("vcenter");
-radical_noad: begin print_esc("radical"); print_delimiter(left_delimiter(p));
- end;
-accent_noad: begin print_esc("accent"); print_fam_and_char(accent_chr(p));
- end;
-left_noad: begin print_esc("left"); print_delimiter(delimiter(p));
- end;
-right_noad: begin if subtype(p)=normal then print_esc("right")
- else print_esc("middle");
- print_delimiter(delimiter(p));
- end;
-end;
-if type(p)<left_noad then
- begin if subtype(p)<>normal then
- if subtype(p)=limits then print_esc("limits")
- else print_esc("nolimits");
- print_subsidiary_data(nucleus(p),".");
- end;
-print_subsidiary_data(supscr(p),"^");
-print_subsidiary_data(subscr(p),"_");
-end
-
-@ @<Display fraction noad |p|@>=
-begin print_esc("fraction, thickness ");
-if thickness(p)=default_code then print("= default")
-else print_scaled(thickness(p));
-if (small_fam(left_delimiter(p))<>0)or@+
- (small_char(left_delimiter(p))<>min_quarterword)or@|
- (large_fam(left_delimiter(p))<>0)or@|
- (large_char(left_delimiter(p))<>min_quarterword) then
- begin print(", left-delimiter "); print_delimiter(left_delimiter(p));
- end;
-if (small_fam(right_delimiter(p))<>0)or@|
- (small_char(right_delimiter(p))<>min_quarterword)or@|
- (large_fam(right_delimiter(p))<>0)or@|
- (large_char(right_delimiter(p))<>min_quarterword) then
- begin print(", right-delimiter "); print_delimiter(right_delimiter(p));
- end;
-print_subsidiary_data(numerator(p),"\");
-print_subsidiary_data(denominator(p),"/");
-end
-
-@ That which can be displayed can also be destroyed.
-
-@<Cases of |flush_node_list| that arise...@>=
-style_node: begin free_node(p,style_node_size); goto done;
- end;
-choice_node:begin flush_node_list(display_mlist(p));
- flush_node_list(text_mlist(p));
- flush_node_list(script_mlist(p));
- flush_node_list(script_script_mlist(p));
- free_node(p,style_node_size); goto done;
- end;
-ord_noad,op_noad,bin_noad,rel_noad,open_noad,close_noad,punct_noad,inner_noad,
- radical_noad,over_noad,under_noad,vcenter_noad,accent_noad:@t@>@;@/
- begin if math_type(nucleus(p))>=sub_box then
- flush_node_list(info(nucleus(p)));
- if math_type(supscr(p))>=sub_box then
- flush_node_list(info(supscr(p)));
- if math_type(subscr(p))>=sub_box then
- flush_node_list(info(subscr(p)));
- if type(p)=radical_noad then free_node(p,radical_noad_size)
- else if type(p)=accent_noad then free_node(p,accent_noad_size)
- else free_node(p,noad_size);
- goto done;
- end;
-left_noad,right_noad: begin free_node(p,noad_size); goto done;
- end;
-fraction_noad: begin flush_node_list(info(numerator(p)));
- flush_node_list(info(denominator(p)));
- free_node(p,fraction_noad_size); goto done;
- end;
-
-@* \[35] Subroutines for math mode.
-In order to convert mlists to hlists, i.e., noads to nodes, we need several
-subroutines that are conveniently dealt with now.
-
-Let us first introduce the macros that make it easy to get at the parameters and
-other font information. A size code, which is a multiple of 16, is added to a
-family number to get an index into the table of internal font numbers
-for each combination of family and size. (Be alert: Size codes get
-larger as the type gets smaller.)
-
-@d text_size=0 {size code for the largest size in a family}
-@d script_size=16 {size code for the medium size in a family}
-@d script_script_size=32 {size code for the smallest size in a family}
-
-@<Basic printing procedures@>=
-procedure print_size(@!s:integer);
-begin if s=text_size then print_esc("textfont")
-else if s=script_size then print_esc("scriptfont")
-else print_esc("scriptscriptfont");
-end;
-
-@ Before an mlist is converted to an hlist, \TeX\ makes sure that
-the fonts in family~2 have enough parameters to be math-symbol
-fonts, and that the fonts in family~3 have enough parameters to be
-math-extension fonts. The math-symbol parameters are referred to by using the
-following macros, which take a size code as their parameter; for example,
-|num1(cur_size)| gives the value of the |num1| parameter for the current size.
-@^parameters for symbols@>
-@^font parameters@>
-
-@d mathsy_end(#)==fam_fnt(2+#)]].sc
-@d mathsy(#)==font_info[#+param_base[mathsy_end
-@d math_x_height==mathsy(5) {height of `\.x'}
-@d math_quad==mathsy(6) {\.{18mu}}
-@d num1==mathsy(8) {numerator shift-up in display styles}
-@d num2==mathsy(9) {numerator shift-up in non-display, non-\.{\\atop}}
-@d num3==mathsy(10) {numerator shift-up in non-display \.{\\atop}}
-@d denom1==mathsy(11) {denominator shift-down in display styles}
-@d denom2==mathsy(12) {denominator shift-down in non-display styles}
-@d sup1==mathsy(13) {superscript shift-up in uncramped display style}
-@d sup2==mathsy(14) {superscript shift-up in uncramped non-display}
-@d sup3==mathsy(15) {superscript shift-up in cramped styles}
-@d sub1==mathsy(16) {subscript shift-down if superscript is absent}
-@d sub2==mathsy(17) {subscript shift-down if superscript is present}
-@d sup_drop==mathsy(18) {superscript baseline below top of large box}
-@d sub_drop==mathsy(19) {subscript baseline below bottom of large box}
-@d delim1==mathsy(20) {size of \.{\\atopwithdelims} delimiters
- in display styles}
-@d delim2==mathsy(21) {size of \.{\\atopwithdelims} delimiters in non-displays}
-@d axis_height==mathsy(22) {height of fraction lines above the baseline}
-@d total_mathsy_params=22
-
-@ The math-extension parameters have similar macros, but the size code is
-omitted (since it is always |cur_size| when we refer to such parameters).
-@^parameters for symbols@>
-@^font parameters@>
-
-@d mathex(#)==font_info[#+param_base[fam_fnt(3+cur_size)]].sc
-@d default_rule_thickness==mathex(8) {thickness of \.{\\over} bars}
-@d big_op_spacing1==mathex(9) {minimum clearance above a displayed op}
-@d big_op_spacing2==mathex(10) {minimum clearance below a displayed op}
-@d big_op_spacing3==mathex(11) {minimum baselineskip above displayed op}
-@d big_op_spacing4==mathex(12) {minimum baselineskip below displayed op}
-@d big_op_spacing5==mathex(13) {padding above and below displayed limits}
-@d total_mathex_params=13
-
-@ We also need to compute the change in style between mlists and their
-subsidiaries. The following macros define the subsidiary style for
-an overlined nucleus (|cramped_style|), for a subscript or a superscript
-(|sub_style| or |sup_style|), or for a numerator or denominator (|num_style|
-or |denom_style|).
-
-@d cramped_style(#)==2*(# div 2)+cramped {cramp the style}
-@d sub_style(#)==2*(# div 4)+script_style+cramped {smaller and cramped}
-@d sup_style(#)==2*(# div 4)+script_style+(# mod 2) {smaller}
-@d num_style(#)==#+2-2*(# div 6) {smaller unless already script-script}
-@d denom_style(#)==2*(# div 2)+cramped+2-2*(# div 6) {smaller, cramped}
-
-@ When the style changes, the following piece of program computes associated
-information:
-
-@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>=
-begin if cur_style<script_style then cur_size:=text_size
-else cur_size:=16*((cur_style-text_style) div 2);
-cur_mu:=x_over_n(math_quad(cur_size),18);
-end
-
-@ Here is a function that returns a pointer to a rule node having a given
-thickness |t|. The rule will extend horizontally to the boundary of the vlist
-that eventually contains it.
-
-@p function fraction_rule(@!t:scaled):pointer;
- {construct the bar for a fraction}
-var p:pointer; {the new node}
-begin p:=new_rule; height(p):=t; depth(p):=0; fraction_rule:=p;
-end;
-
-@ The |overbar| function returns a pointer to a vlist box that consists of
-a given box |b|, above which has been placed a kern of height |k| under a
-fraction rule of thickness |t| under additional space of height |t|.
-
-@p function overbar(@!b:pointer;@!k,@!t:scaled):pointer;
-var p,@!q:pointer; {nodes being constructed}
-begin p:=new_kern(k); link(p):=b; q:=fraction_rule(t); link(q):=p;
-p:=new_kern(t); link(p):=q; overbar:=vpack(p,natural);
-end;
-
-@ The |var_delimiter| function, which finds or constructs a sufficiently
-large delimiter, is the most interesting of the auxiliary functions that
-currently concern us. Given a pointer |d| to a delimiter field in some noad,
-together with a size code |s| and a vertical distance |v|, this function
-returns a pointer to a box that contains the smallest variant of |d| whose
-height plus depth is |v| or more. (And if no variant is large enough, it
-returns the largest available variant.) In particular, this routine will
-construct arbitrarily large delimiters from extensible components, if
-|d| leads to such characters.
-
-The value returned is a box whose |shift_amount| has been set so that
-the box is vertically centered with respect to the axis in the given size.
-If a built-up symbol is returned, the height of the box before shifting
-will be the height of its topmost component.
-
-@p@t\4@>@<Declare subprocedures for |var_delimiter|@>
-function var_delimiter(@!d:pointer;@!s:small_number;@!v:scaled):pointer;
-label found,continue;
-var b:pointer; {the box that will be constructed}
-@!f,@!g: internal_font_number; {best-so-far and tentative font codes}
-@!c,@!x,@!y: quarterword; {best-so-far and tentative character codes}
-@!m,@!n: integer; {the number of extensible pieces}
-@!u: scaled; {height-plus-depth of a tentative character}
-@!w: scaled; {largest height-plus-depth so far}
-@!q: four_quarters; {character info}
-@!hd: eight_bits; {height-depth byte}
-@!r: four_quarters; {extensible pieces}
-@!z: small_number; {runs through font family members}
-@!large_attempt: boolean; {are we trying the ``large'' variant?}
-begin f:=null_font; w:=0; large_attempt:=false;
-z:=small_fam(d); x:=small_char(d);
-loop@+ begin @<Look at the variants of |(z,x)|; set |f| and |c| whenever
- a better character is found; |goto found| as soon as a
- large enough variant is encountered@>;
- if large_attempt then goto found; {there were none large enough}
- large_attempt:=true; z:=large_fam(d); x:=large_char(d);
- end;
-found: if f<>null_font then
- @<Make variable |b| point to a box for |(f,c)|@>
-else begin b:=new_null_box;
- width(b):=null_delimiter_space; {use this width if no delimiter was found}
- end;
-shift_amount(b):=half(height(b)-depth(b)) - axis_height(s);
-var_delimiter:=b;
-end;
-
-@ The search process is complicated slightly by the facts that some of the
-characters might not be present in some of the fonts, and they might not
-be probed in increasing order of height.
-
-@<Look at the variants of |(z,x)|; set |f| and |c|...@>=
-if (z<>0)or(x<>min_quarterword) then
- begin z:=z+s+16;
- repeat z:=z-16; g:=fam_fnt(z);
- if g<>null_font then
- @<Look at the list of characters starting with |x| in
- font |g|; set |f| and |c| whenever
- a better character is found; |goto found| as soon as a
- large enough variant is encountered@>;
- until z<16;
- end
-
-@ @<Look at the list of characters starting with |x|...@>=
-begin y:=x;
-if (qo(y)>=font_bc[g])and(qo(y)<=font_ec[g]) then
- begin continue: q:=char_info(g)(y);
- if char_exists(q) then
- begin if char_tag(q)=ext_tag then
- begin f:=g; c:=y; goto found;
- end;
- hd:=height_depth(q);
- u:=char_height(g)(hd)+char_depth(g)(hd);
- if u>w then
- begin f:=g; c:=y; w:=u;
- if u>=v then goto found;
- end;
- if char_tag(q)=list_tag then
- begin y:=rem_byte(q); goto continue;
- end;
- end;
- end;
-end
-
-@ Here is a subroutine that creates a new box, whose list contains a
-single character, and whose width includes the italic correction for
-that character. The height or depth of the box will be negative, if
-the height or depth of the character is negative; thus, this routine
-may deliver a slightly different result than |hpack| would produce.
-
-@<Declare subprocedures for |var_delimiter|@>=
-function char_box(@!f:internal_font_number;@!c:quarterword):pointer;
-var q:four_quarters;
-@!hd:eight_bits; {|height_depth| byte}
-@!b,@!p:pointer; {the new box and its character node}
-begin q:=char_info(f)(c); hd:=height_depth(q);
-b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q);
-height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd);
-p:=get_avail; character(p):=c; font(p):=f; list_ptr(b):=p; char_box:=b;
-end;
-
-@ When the following code is executed, |char_tag(q)| will be equal to
-|ext_tag| if and only if a built-up symbol is supposed to be returned.
-
-@<Make variable |b| point to a box for |(f,c)|@>=
-if char_tag(q)=ext_tag then
- @<Construct an extensible character in a new box |b|,
- using recipe |rem_byte(q)| and font |f|@>
-else b:=char_box(f,c)
-
-@ When we build an extensible character, it's handy to have the
-following subroutine, which puts a given character on top
-of the characters already in box |b|:
-
-@<Declare subprocedures for |var_delimiter|@>=
-procedure stack_into_box(@!b:pointer;@!f:internal_font_number;
- @!c:quarterword);
-var p:pointer; {new node placed into |b|}
-begin p:=char_box(f,c); link(p):=list_ptr(b); list_ptr(b):=p;
-height(b):=height(p);
-end;
-
-@ Another handy subroutine computes the height plus depth of
-a given character:
-
-@<Declare subprocedures for |var_delimiter|@>=
-function height_plus_depth(@!f:internal_font_number;@!c:quarterword):scaled;
-var q:four_quarters;
-@!hd:eight_bits; {|height_depth| byte}
-begin q:=char_info(f)(c); hd:=height_depth(q);
-height_plus_depth:=char_height(f)(hd)+char_depth(f)(hd);
-end;
-
-@ @<Construct an extensible...@>=
-begin b:=new_null_box;
-type(b):=vlist_node;
-r:=font_info[exten_base[f]+rem_byte(q)].qqqq;@/
-@<Compute the minimum suitable height, |w|, and the corresponding
- number of extension steps, |n|; also set |width(b)|@>;
-c:=ext_bot(r);
-if c<>min_quarterword then stack_into_box(b,f,c);
-c:=ext_rep(r);
-for m:=1 to n do stack_into_box(b,f,c);
-c:=ext_mid(r);
-if c<>min_quarterword then
- begin stack_into_box(b,f,c); c:=ext_rep(r);
- for m:=1 to n do stack_into_box(b,f,c);
- end;
-c:=ext_top(r);
-if c<>min_quarterword then stack_into_box(b,f,c);
-depth(b):=w-height(b);
-end
-
-@ The width of an extensible character is the width of the repeatable
-module. If this module does not have positive height plus depth,
-we don't use any copies of it, otherwise we use as few as possible
-(in groups of two if there is a middle part).
-
-@<Compute the minimum suitable height, |w|, and...@>=
-c:=ext_rep(r); u:=height_plus_depth(f,c);
-w:=0; q:=char_info(f)(c); width(b):=char_width(f)(q)+char_italic(f)(q);@/
-c:=ext_bot(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
-c:=ext_mid(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
-c:=ext_top(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
-n:=0;
-if u>0 then while w<v do
- begin w:=w+u; incr(n);
- if ext_mid(r)<>min_quarterword then w:=w+u;
- end
-
-@ The next subroutine is much simpler; it is used for numerators and
-denominators of fractions as well as for displayed operators and
-their limits above and below. It takes a given box~|b| and
-changes it so that the new box is centered in a box of width~|w|.
-The centering is done by putting \.{\\hss} glue at the left and right
-of the list inside |b|, then packaging the new box; thus, the
-actual box might not really be centered, if it already contains
-infinite glue.
-
-The given box might contain a single character whose italic correction
-has been added to the width of the box; in this case a compensating
-kern is inserted.
-
-@p function rebox(@!b:pointer;@!w:scaled):pointer;
-var p:pointer; {temporary register for list manipulation}
-@!f:internal_font_number; {font in a one-character box}
-@!v:scaled; {width of a character without italic correction}
-begin if (width(b)<>w)and(list_ptr(b)<>null) then
- begin if type(b)=vlist_node then b:=hpack(b,natural);
- p:=list_ptr(b);
- if (is_char_node(p))and(link(p)=null) then
- begin f:=font(p); v:=char_width(f)(char_info(f)(character(p)));
- if v<>width(b) then link(p):=new_kern(width(b)-v);
- end;
- free_node(b,box_node_size);
- b:=new_glue(ss_glue); link(b):=p;
- while link(p)<>null do p:=link(p);
- link(p):=new_glue(ss_glue);
- rebox:=hpack(b,w,exactly);
- end
-else begin width(b):=w; rebox:=b;
- end;
-end;
-
-@ Here is a subroutine that creates a new glue specification from another
-one that is expressed in `\.{mu}', given the value of the math unit.
-
-@d mu_mult(#)==nx_plus_y(n,#,xn_over_d(#,f,@'200000))
-
-@p function math_glue(@!g:pointer;@!m:scaled):pointer;
-var p:pointer; {the new glue specification}
-@!n:integer; {integer part of |m|}
-@!f:scaled; {fraction part of |m|}
-begin n:=x_over_n(m,@'200000); f:=remainder;@/
-if f<0 then
- begin decr(n); f:=f+@'200000;
- end;
-p:=get_node(glue_spec_size);
-width(p):=mu_mult(width(g)); {convert \.{mu} to \.{pt}}
-stretch_order(p):=stretch_order(g);
-if stretch_order(p)=normal then stretch(p):=mu_mult(stretch(g))
-else stretch(p):=stretch(g);
-shrink_order(p):=shrink_order(g);
-if shrink_order(p)=normal then shrink(p):=mu_mult(shrink(g))
-else shrink(p):=shrink(g);
-math_glue:=p;
-end;
-
-@ The |math_kern| subroutine removes |mu_glue| from a kern node, given
-the value of the math unit.
-
-@p procedure math_kern(@!p:pointer;@!m:scaled);
-var @!n:integer; {integer part of |m|}
-@!f:scaled; {fraction part of |m|}
-begin if subtype(p)=mu_glue then
- begin n:=x_over_n(m,@'200000); f:=remainder;@/
- if f<0 then
- begin decr(n); f:=f+@'200000;
- end;
- width(p):=mu_mult(width(p)); subtype(p):=explicit;
- end;
-end;
-
-@ Sometimes it is necessary to destroy an mlist. The following
-subroutine empties the current list, assuming that |abs(mode)=mmode|.
-
-@p procedure flush_math;
-begin flush_node_list(link(head)); flush_node_list(incompleat_noad);
-link(head):=null; tail:=head; incompleat_noad:=null;
-end;
-
-@* \[36] Typesetting math formulas.
-\TeX's most important routine for dealing with formulas is called
-|mlist_to_hlist|. After a formula has been scanned and represented as an
-mlist, this routine converts it to an hlist that can be placed into a box
-or incorporated into the text of a paragraph. There are three implicit
-parameters, passed in global variables: |cur_mlist| points to the first
-node or noad in the given mlist (and it might be |null|); |cur_style| is a
-style code; and |mlist_penalties| is |true| if penalty nodes for potential
-line breaks are to be inserted into the resulting hlist. After
-|mlist_to_hlist| has acted, |link(temp_head)| points to the translated hlist.
-
-Since mlists can be inside mlists, the procedure is recursive. And since this
-is not part of \TeX's inner loop, the program has been written in a manner
-that stresses compactness over efficiency.
-@^recursion@>
-
-@<Glob...@>=
-@!cur_mlist:pointer; {beginning of mlist to be translated}
-@!cur_style:small_number; {style code at current place in the list}
-@!cur_size:small_number; {size code corresponding to |cur_style|}
-@!cur_mu:scaled; {the math unit width corresponding to |cur_size|}
-@!mlist_penalties:boolean; {should |mlist_to_hlist| insert penalties?}
-
-@ The recursion in |mlist_to_hlist| is due primarily to a subroutine
-called |clean_box| that puts a given noad field into a box using a given
-math style; |mlist_to_hlist| can call |clean_box|, which can call
-|mlist_to_hlist|.
-@^recursion@>
-
-The box returned by |clean_box| is ``clean'' in the
-sense that its |shift_amount| is zero.
-
-@p procedure@?mlist_to_hlist; forward;@t\2@>@/
-function clean_box(@!p:pointer;@!s:small_number):pointer;
-label found;
-var q:pointer; {beginning of a list to be boxed}
-@!save_style:small_number; {|cur_style| to be restored}
-@!x:pointer; {box to be returned}
-@!r:pointer; {temporary pointer}
-begin case math_type(p) of
-math_char: begin cur_mlist:=new_noad; mem[nucleus(cur_mlist)]:=mem[p];
- end;
-sub_box: begin q:=info(p); goto found;
- end;
-sub_mlist: cur_mlist:=info(p);
-othercases begin q:=new_null_box; goto found;
- end
-endcases;@/
-save_style:=cur_style; cur_style:=s; mlist_penalties:=false;@/
-mlist_to_hlist; q:=link(temp_head); {recursive call}
-cur_style:=save_style; {restore the style}
-@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
-found: if is_char_node(q)or(q=null) then x:=hpack(q,natural)
- else if (link(q)=null)and(type(q)<=vlist_node)and(shift_amount(q)=0) then
- x:=q {it's already clean}
- else x:=hpack(q,natural);
-@<Simplify a trivial box@>;
-clean_box:=x;
-end;
-
-@ Here we save memory space in a common case.
-
-@<Simplify a trivial box@>=
-q:=list_ptr(x);
-if is_char_node(q) then
- begin r:=link(q);
- if r<>null then if link(r)=null then if not is_char_node(r) then
- if type(r)=kern_node then {unneeded italic correction}
- begin free_node(r,small_node_size); link(q):=null;
- end;
- end
-
-@ It is convenient to have a procedure that converts a |math_char|
-field to an ``unpacked'' form. The |fetch| routine sets |cur_f|, |cur_c|,
-and |cur_i| to the font code, character code, and character information bytes of
-a given noad field. It also takes care of issuing error messages for
-nonexistent characters; in such cases, |char_exists(cur_i)| will be |false|
-after |fetch| has acted, and the field will also have been reset to |empty|.
-
-@p procedure fetch(@!a:pointer); {unpack the |math_char| field |a|}
-begin cur_c:=character(a); cur_f:=fam_fnt(fam(a)+cur_size);
-if cur_f=null_font then
- @<Complain about an undefined family and set |cur_i| null@>
-else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then
- cur_i:=char_info(cur_f)(cur_c)
- else cur_i:=null_character;
- if not(char_exists(cur_i)) then
- begin char_warning(cur_f,qo(cur_c));
- math_type(a):=empty; cur_i:=null_character;
- end;
- end;
-end;
-
-@ @<Complain about an undefined family...@>=
-begin print_err(""); print_size(cur_size); print_char(" ");
-print_int(fam(a)); print(" is undefined (character ");
-print_ASCII(qo(cur_c)); print_char(")");
-help4("Somewhere in the math formula just ended, you used the")@/
-("stated character from an undefined font family. For example,")@/
-("plain TeX doesn't allow \it or \sl in subscripts. Proceed,")@/
-("and I'll try to forget that I needed that character.");
-error; cur_i:=null_character; math_type(a):=empty;
-end
-
-@ The outputs of |fetch| are placed in global variables.
-
-@<Glob...@>=
-@!cur_f:internal_font_number; {the |font| field of a |math_char|}
-@!cur_c:quarterword; {the |character| field of a |math_char|}
-@!cur_i:four_quarters; {the |char_info| of a |math_char|,
- or a lig/kern instruction}
-
-@ We need to do a lot of different things, so |mlist_to_hlist| makes two
-passes over the given mlist.
-
-The first pass does most of the processing: It removes ``mu'' spacing from
-glue, it recursively evaluates all subsidiary mlists so that only the
-top-level mlist remains to be handled, it puts fractions and square roots
-and such things into boxes, it attaches subscripts and superscripts, and
-it computes the overall height and depth of the top-level mlist so that
-the size of delimiters for a |left_noad| and a |right_noad| will be known.
-The hlist resulting from each noad is recorded in that noad's |new_hlist|
-field, an integer field that replaces the |nucleus| or |thickness|.
-@^recursion@>
-
-The second pass eliminates all noads and inserts the correct glue and
-penalties between nodes.
-
-@d new_hlist(#)==mem[nucleus(#)].int {the translation of an mlist}
-
-@ Here is the overall plan of |mlist_to_hlist|, and the list of its
-local variables.
-
-@d done_with_noad=80 {go here when a noad has been fully translated}
-@d done_with_node=81 {go here when a node has been fully converted}
-@d check_dimensions=82 {go here to update |max_h| and |max_d|}
-@d delete_q=83 {go here to delete |q| and move to the next node}
-
-@p@t\4@>@<Declare math construction procedures@>
-procedure mlist_to_hlist;
-label reswitch, check_dimensions, done_with_noad, done_with_node, delete_q,
- done;
-var mlist:pointer; {beginning of the given list}
-@!penalties:boolean; {should penalty nodes be inserted?}
-@!style:small_number; {the given style}
-@!save_style:small_number; {holds |cur_style| during recursion}
-@!q:pointer; {runs through the mlist}
-@!r:pointer; {the most recent noad preceding |q|}
-@!r_type:small_number; {the |type| of noad |r|, or |op_noad| if |r=null|}
-@!t:small_number; {the effective |type| of noad |q| during the second pass}
-@!p,@!x,@!y,@!z: pointer; {temporary registers for list construction}
-@!pen:integer; {a penalty to be inserted}
-@!s:small_number; {the size of a noad to be deleted}
-@!max_h,@!max_d:scaled; {maximum height and depth of the list translated so far}
-@!delta:scaled; {offset between subscript and superscript}
-begin mlist:=cur_mlist; penalties:=mlist_penalties;
-style:=cur_style; {tuck global parameters away as local variables}
-q:=mlist; r:=null; r_type:=op_noad; max_h:=0; max_d:=0;
-@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
-while q<>null do @<Process node-or-noad |q| as much as possible in preparation
- for the second pass of |mlist_to_hlist|, then move to the next
- item in the mlist@>;
-@<Convert \(a)a final |bin_noad| to an |ord_noad|@>;
-@<Make a second pass over the mlist, removing all noads and inserting the
- proper spacing and penalties@>;
-end;
-
-@ We use the fact that no character nodes appear in an mlist, hence
-the field |type(q)| is always present.
-
-@<Process node-or-noad...@>=
-begin @<Do first-pass processing based on |type(q)|; |goto done_with_noad|
- if a noad has been fully processed, |goto check_dimensions| if it
- has been translated into |new_hlist(q)|, or |goto done_with_node|
- if a node has been fully processed@>;
-check_dimensions: z:=hpack(new_hlist(q),natural);
-if height(z)>max_h then max_h:=height(z);
-if depth(z)>max_d then max_d:=depth(z);
-free_node(z,box_node_size);
-done_with_noad: r:=q; r_type:=type(r);
-if r_type=right_noad then
- begin r_type:=left_noad; cur_style:=style; @<Set up the values...@>;
- end;
-done_with_node: q:=link(q);
-end
-
-@ One of the things we must do on the first pass is change a |bin_noad| to
-an |ord_noad| if the |bin_noad| is not in the context of a binary operator.
-The values of |r| and |r_type| make this fairly easy.
-
-@<Do first-pass processing...@>=
-reswitch: delta:=0;
-case type(q) of
-bin_noad: case r_type of
- bin_noad,op_noad,rel_noad,open_noad,punct_noad,left_noad:
- begin type(q):=ord_noad; goto reswitch;
- end;
- othercases do_nothing
- endcases;
-rel_noad,close_noad,punct_noad,right_noad: begin@t@>@;@/
- @<Convert \(a)a final |bin_noad| to an |ord_noad|@>;
- if type(q)=right_noad then goto done_with_noad;
- end;
-@t\4@>@<Cases for noads that can follow a |bin_noad|@>@;
-@t\4@>@<Cases for nodes that can appear in an mlist, after which we
- |goto done_with_node|@>@;
-othercases confusion("mlist1")
-@:this can't happen mlist1}{\quad mlist1@>
-endcases;@/
-@<Convert \(n)|nucleus(q)| to an hlist and attach the sub/superscripts@>
-
-@ @<Convert \(a)a final |bin_noad| to an |ord_noad|@>=
-if r_type=bin_noad then type(r):=ord_noad
-
-@ @<Cases for nodes that can appear in an mlist...@>=
-style_node: begin cur_style:=subtype(q);
- @<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
- goto done_with_node;
- end;
-choice_node: @<Change this node to a style node followed by the correct choice,
- then |goto done_with_node|@>;
-ins_node,mark_node,adjust_node,
- whatsit_node,penalty_node,disc_node: goto done_with_node;
-rule_node: begin if height(q)>max_h then max_h:=height(q);
- if depth(q)>max_d then max_d:=depth(q); goto done_with_node;
- end;
-glue_node: begin @<Convert \(m)math glue to ordinary glue@>;
- goto done_with_node;
- end;
-kern_node: begin math_kern(q,cur_mu); goto done_with_node;
- end;
-
-@ @d choose_mlist(#)==begin p:=#(q); #(q):=null;@+end
-
-@<Change this node to a style node...@>=
-begin case cur_style div 2 of
-0: choose_mlist(display_mlist); {|display_style=0|}
-1: choose_mlist(text_mlist); {|text_style=2|}
-2: choose_mlist(script_mlist); {|script_style=4|}
-3: choose_mlist(script_script_mlist); {|script_script_style=6|}
-end; {there are no other cases}
-flush_node_list(display_mlist(q));
-flush_node_list(text_mlist(q));
-flush_node_list(script_mlist(q));
-flush_node_list(script_script_mlist(q));@/
-type(q):=style_node; subtype(q):=cur_style; width(q):=0; depth(q):=0;
-if p<>null then
- begin z:=link(q); link(q):=p;
- while link(p)<>null do p:=link(p);
- link(p):=z;
- end;
-goto done_with_node;
-end
-
-@ Conditional math glue (`\.{\\nonscript}') results in a |glue_node|
-pointing to |zero_glue|, with |subtype(q)=cond_math_glue|; in such a case
-the node following will be eliminated if it is a glue or kern node and if the
-current size is different from |text_size|. Unconditional math glue
-(`\.{\\muskip}') is converted to normal glue by multiplying the dimensions
-by |cur_mu|.
-@!@:non_script_}{\.{\\nonscript} primitive@>
-
-@<Convert \(m)math glue to ordinary glue@>=
-if subtype(q)=mu_glue then
- begin x:=glue_ptr(q);
- y:=math_glue(x,cur_mu); delete_glue_ref(x); glue_ptr(q):=y;
- subtype(q):=normal;
- end
-else if (cur_size<>text_size)and(subtype(q)=cond_math_glue) then
- begin p:=link(q);
- if p<>null then if (type(p)=glue_node)or(type(p)=kern_node) then
- begin link(q):=link(p); link(p):=null; flush_node_list(p);
- end;
- end
-
-@ @<Cases for noads that can follow a |bin_noad|@>=
-left_noad: goto done_with_noad;
-fraction_noad: begin make_fraction(q); goto check_dimensions;
- end;
-op_noad: begin delta:=make_op(q);
- if subtype(q)=limits then goto check_dimensions;
- end;
-ord_noad: make_ord(q);
-open_noad,inner_noad: do_nothing;
-radical_noad: make_radical(q);
-over_noad: make_over(q);
-under_noad: make_under(q);
-accent_noad: make_math_accent(q);
-vcenter_noad: make_vcenter(q);
-
-@ Most of the actual construction work of |mlist_to_hlist| is done
-by procedures with names
-like |make_fraction|, |make_radical|, etc. To illustrate
-the general setup of such procedures, let's begin with a couple of
-simple ones.
-
-@<Declare math...@>=
-procedure make_over(@!q:pointer);
-begin info(nucleus(q)):=@|
- overbar(clean_box(nucleus(q),cramped_style(cur_style)),@|
- 3*default_rule_thickness,default_rule_thickness);
-math_type(nucleus(q)):=sub_box;
-end;
-
-@ @<Declare math...@>=
-procedure make_under(@!q:pointer);
-var p,@!x,@!y: pointer; {temporary registers for box construction}
-@!delta:scaled; {overall height plus depth}
-begin x:=clean_box(nucleus(q),cur_style);
-p:=new_kern(3*default_rule_thickness); link(x):=p;
-link(p):=fraction_rule(default_rule_thickness);
-y:=vpack(x,natural);
-delta:=height(y)+depth(y)+default_rule_thickness;
-height(y):=height(x); depth(y):=delta-height(y);
-info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
-end;
-
-@ @<Declare math...@>=
-procedure make_vcenter(@!q:pointer);
-var v:pointer; {the box that should be centered vertically}
-@!delta:scaled; {its height plus depth}
-begin v:=info(nucleus(q));
-if type(v)<>vlist_node then confusion("vcenter");
-@:this can't happen vcenter}{\quad vcenter@>
-delta:=height(v)+depth(v);
-height(v):=axis_height(cur_size)+half(delta);
-depth(v):=delta-height(v);
-end;
-
-@ According to the rules in the \.{DVI} file specifications, we ensure alignment
-@^square roots@>
-between a square root sign and the rule above its nucleus by assuming that the
-baseline of the square-root symbol is the same as the bottom of the rule. The
-height of the square-root symbol will be the thickness of the rule, and the
-depth of the square-root symbol should exceed or equal the height-plus-depth
-of the nucleus plus a certain minimum clearance~|clr|. The symbol will be
-placed so that the actual clearance is |clr| plus half the excess.
-
-@<Declare math...@>=
-procedure make_radical(@!q:pointer);
-var x,@!y:pointer; {temporary registers for box construction}
-@!delta,@!clr:scaled; {dimensions involved in the calculation}
-begin x:=clean_box(nucleus(q),cramped_style(cur_style));
-if cur_style<text_style then {display style}
- clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4)
-else begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4);
- end;
-y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+
- default_rule_thickness);
-delta:=depth(y)-(height(x)+depth(x)+clr);
-if delta>0 then clr:=clr+half(delta); {increase the actual clearance}
-shift_amount(y):=-(height(x)+clr);
-link(y):=overbar(x,clr,height(y));
-info(nucleus(q)):=hpack(y,natural); math_type(nucleus(q)):=sub_box;
-end;
-
-@ Slants are not considered when placing accents in math mode. The accenter is
-centered over the accentee, and the accent width is treated as zero with
-respect to the size of the final box.
-
-@<Declare math...@>=
-procedure make_math_accent(@!q:pointer);
-label done,done1;
-var p,@!x,@!y:pointer; {temporary registers for box construction}
-@!a:integer; {address of lig/kern instruction}
-@!c:quarterword; {accent character}
-@!f:internal_font_number; {its font}
-@!i:four_quarters; {its |char_info|}
-@!s:scaled; {amount to skew the accent to the right}
-@!h:scaled; {height of character being accented}
-@!delta:scaled; {space to remove between accent and accentee}
-@!w:scaled; {width of the accentee, not including sub/superscripts}
-begin fetch(accent_chr(q));
-if char_exists(cur_i) then
- begin i:=cur_i; c:=cur_c; f:=cur_f;@/
- @<Compute the amount of skew@>;
- x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
- @<Switch to a larger accent if available and appropriate@>;
- if h<x_height(f) then delta:=h@+else delta:=x_height(f);
- if (math_type(supscr(q))<>empty)or(math_type(subscr(q))<>empty) then
- if math_type(nucleus(q))=math_char then
- @<Swap the subscript and superscript into box |x|@>;
- y:=char_box(f,c);
- shift_amount(y):=s+half(w-width(y));
- width(y):=0; p:=new_kern(-delta); link(p):=x; link(y):=p;
- y:=vpack(y,natural); width(y):=width(x);
- if height(y)<h then @<Make the height of box |y| equal to |h|@>;
- info(nucleus(q)):=y;
- math_type(nucleus(q)):=sub_box;
- end;
-end;
-
-@ @<Make the height of box |y|...@>=
-begin p:=new_kern(h-height(y)); link(p):=list_ptr(y); list_ptr(y):=p;
-height(y):=h;
-end
-
-@ @<Switch to a larger accent if available and appropriate@>=
-loop@+ begin if char_tag(i)<>list_tag then goto done;
- y:=rem_byte(i);
- i:=char_info(f)(y);
- if not char_exists(i) then goto done;
- if char_width(f)(i)>w then goto done;
- c:=y;
- end;
-done:
-
-@ @<Compute the amount of skew@>=
-s:=0;
-if math_type(nucleus(q))=math_char then
- begin fetch(nucleus(q));
- if char_tag(cur_i)=lig_tag then
- begin a:=lig_kern_start(cur_f)(cur_i);
- cur_i:=font_info[a].qqqq;
- if skip_byte(cur_i)>stop_flag then
- begin a:=lig_kern_restart(cur_f)(cur_i);
- cur_i:=font_info[a].qqqq;
- end;
- loop@+ begin if qo(next_char(cur_i))=skew_char[cur_f] then
- begin if op_byte(cur_i)>=kern_flag then
- if skip_byte(cur_i)<=stop_flag then s:=char_kern(cur_f)(cur_i);
- goto done1;
- end;
- if skip_byte(cur_i)>=stop_flag then goto done1;
- a:=a+qo(skip_byte(cur_i))+1;
- cur_i:=font_info[a].qqqq;
- end;
- end;
- end;
-done1:
-
-@ @<Swap the subscript and superscript into box |x|@>=
-begin flush_node_list(x); x:=new_noad;
-mem[nucleus(x)]:=mem[nucleus(q)];
-mem[supscr(x)]:=mem[supscr(q)];
-mem[subscr(x)]:=mem[subscr(q)];@/
-mem[supscr(q)].hh:=empty_field;
-mem[subscr(q)].hh:=empty_field;@/
-math_type(nucleus(q)):=sub_mlist; info(nucleus(q)):=x;
-x:=clean_box(nucleus(q),cur_style); delta:=delta+height(x)-h; h:=height(x);
-end
-
-@ The |make_fraction| procedure is a bit different because it sets
-|new_hlist(q)| directly rather than making a sub-box.
-
-@<Declare math...@>=
-procedure make_fraction(@!q:pointer);
-var p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction}
-@!delta,@!delta1,@!delta2,@!shift_up,@!shift_down,@!clr:scaled;
- {dimensions for box calculations}
-begin if thickness(q)=default_code then thickness(q):=default_rule_thickness;
-@<Create equal-width boxes |x| and |z| for the numerator and denominator,
- and compute the default amounts |shift_up| and |shift_down| by which they
- are displaced from the baseline@>;
-if thickness(q)=0 then @<Adjust \(s)|shift_up| and |shift_down| for the case
- of no fraction line@>
-else @<Adjust \(s)|shift_up| and |shift_down| for the case of a fraction line@>;
-@<Construct a vlist box for the fraction, according to |shift_up| and
- |shift_down|@>;
-@<Put the \(f)fraction into a box with its delimiters, and make |new_hlist(q)|
- point to it@>;
-end;
-
-@ @<Create equal-width boxes |x| and |z| for the numerator and denom...@>=
-x:=clean_box(numerator(q),num_style(cur_style));
-z:=clean_box(denominator(q),denom_style(cur_style));
-if width(x)<width(z) then x:=rebox(x,width(z))
-else z:=rebox(z,width(x));
-if cur_style<text_style then {display style}
- begin shift_up:=num1(cur_size); shift_down:=denom1(cur_size);
- end
-else begin shift_down:=denom2(cur_size);
- if thickness(q)<>0 then shift_up:=num2(cur_size)
- else shift_up:=num3(cur_size);
- end
-
-@ The numerator and denominator must be separated by a certain minimum
-clearance, called |clr| in the following program. The difference between
-|clr| and the actual clearance is twice |delta|.
-
-@<Adjust \(s)|shift_up| and |shift_down| for the case of no fraction line@>=
-begin if cur_style<text_style then clr:=7*default_rule_thickness
-else clr:=3*default_rule_thickness;
-delta:=half(clr-((shift_up-depth(x))-(height(z)-shift_down)));
-if delta>0 then
- begin shift_up:=shift_up+delta;
- shift_down:=shift_down+delta;
- end;
-end
-
-@ In the case of a fraction line, the minimum clearance depends on the actual
-thickness of the line.
-
-@<Adjust \(s)|shift_up| and |shift_down| for the case of a fraction line@>=
-begin if cur_style<text_style then clr:=3*thickness(q)
-else clr:=thickness(q);
-delta:=half(thickness(q));
-delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta));
-delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down));
-if delta1>0 then shift_up:=shift_up+delta1;
-if delta2>0 then shift_down:=shift_down+delta2;
-end
-
-@ @<Construct a vlist box for the fraction...@>=
-v:=new_null_box; type(v):=vlist_node;
-height(v):=shift_up+height(x); depth(v):=depth(z)+shift_down;
-width(v):=width(x); {this also equals |width(z)|}
-if thickness(q)=0 then
- begin p:=new_kern((shift_up-depth(x))-(height(z)-shift_down));
- link(p):=z;
- end
-else begin y:=fraction_rule(thickness(q));@/
- p:=new_kern((axis_height(cur_size)-delta)-@|(height(z)-shift_down));@/
- link(y):=p; link(p):=z;@/
- p:=new_kern((shift_up-depth(x))-(axis_height(cur_size)+delta));
- link(p):=y;
- end;
-link(x):=p; list_ptr(v):=x
-
-@ @<Put the \(f)fraction into a box with its delimiters...@>=
-if cur_style<text_style then delta:=delim1(cur_size)
-else delta:=delim2(cur_size);
-x:=var_delimiter(left_delimiter(q), cur_size, delta); link(x):=v;@/
-z:=var_delimiter(right_delimiter(q), cur_size, delta); link(v):=z;@/
-new_hlist(q):=hpack(x,natural)
-
-@ If the nucleus of an |op_noad| is a single character, it is to be
-centered vertically with respect to the axis, after first being enlarged
-(via a character list in the font) if we are in display style. The normal
-convention for placing displayed limits is to put them above and below the
-operator in display style.
-
-The italic correction is removed from the character if there is a subscript
-and the limits are not being displayed. The |make_op|
-routine returns the value that should be used as an offset between
-subscript and superscript.
-
-After |make_op| has acted, |subtype(q)| will be |limits| if and only if
-the limits have been set above and below the operator. In that case,
-|new_hlist(q)| will already contain the desired final box.
-
-@<Declare math...@>=
-function make_op(@!q:pointer):scaled;
-var delta:scaled; {offset between subscript and superscript}
-@!p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction}
-@!c:quarterword;@+@!i:four_quarters; {registers for character examination}
-@!shift_up,@!shift_down:scaled; {dimensions for box calculation}
-begin if (subtype(q)=normal)and(cur_style<text_style) then
- subtype(q):=limits;
-if math_type(nucleus(q))=math_char then
- begin fetch(nucleus(q));
- if (cur_style<text_style)and(char_tag(cur_i)=list_tag) then {make it larger}
- begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c);
- if char_exists(i) then
- begin cur_c:=c; cur_i:=i; character(nucleus(q)):=c;
- end;
- end;
- delta:=char_italic(cur_f)(cur_i); x:=clean_box(nucleus(q),cur_style);
- if (math_type(subscr(q))<>empty)and(subtype(q)<>limits) then
- width(x):=width(x)-delta; {remove italic correction}
- shift_amount(x):=half(height(x)-depth(x)) - axis_height(cur_size);
- {center vertically}
- math_type(nucleus(q)):=sub_box; info(nucleus(q)):=x;
- end
-else delta:=0;
-if subtype(q)=limits then
- @<Construct a box with limits above and below it, skewed by |delta|@>;
-make_op:=delta;
-end;
-
-@ The following program builds a vlist box |v| for displayed limits. The
-width of the box is not affected by the fact that the limits may be skewed.
-
-@<Construct a box with limits above and below it...@>=
-begin x:=clean_box(supscr(q),sup_style(cur_style));
-y:=clean_box(nucleus(q),cur_style);
-z:=clean_box(subscr(q),sub_style(cur_style));
-v:=new_null_box; type(v):=vlist_node; width(v):=width(y);
-if width(x)>width(v) then width(v):=width(x);
-if width(z)>width(v) then width(v):=width(z);
-x:=rebox(x,width(v)); y:=rebox(y,width(v)); z:=rebox(z,width(v));@/
-shift_amount(x):=half(delta); shift_amount(z):=-shift_amount(x);
-height(v):=height(y); depth(v):=depth(y);
-@<Attach the limits to |y| and adjust |height(v)|, |depth(v)| to
- account for their presence@>;
-new_hlist(q):=v;
-end
-
-@ We use |shift_up| and |shift_down| in the following program for the
-amount of glue between the displayed operator |y| and its limits |x| and
-|z|. The vlist inside box |v| will consist of |x| followed by |y| followed
-by |z|, with kern nodes for the spaces between and around them.
-
-@<Attach the limits to |y| and adjust |height(v)|, |depth(v)|...@>=
-if math_type(supscr(q))=empty then
- begin free_node(x,box_node_size); list_ptr(v):=y;
- end
-else begin shift_up:=big_op_spacing3-depth(x);
- if shift_up<big_op_spacing1 then shift_up:=big_op_spacing1;
- p:=new_kern(shift_up); link(p):=y; link(x):=p;@/
- p:=new_kern(big_op_spacing5); link(p):=x; list_ptr(v):=p;
- height(v):=height(v)+big_op_spacing5+height(x)+depth(x)+shift_up;
- end;
-if math_type(subscr(q))=empty then free_node(z,box_node_size)
-else begin shift_down:=big_op_spacing4-height(z);
- if shift_down<big_op_spacing2 then shift_down:=big_op_spacing2;
- p:=new_kern(shift_down); link(y):=p; link(p):=z;@/
- p:=new_kern(big_op_spacing5); link(z):=p;
- depth(v):=depth(v)+big_op_spacing5+height(z)+depth(z)+shift_down;
- end
-
-@ A ligature found in a math formula does not create a |ligature_node|, because
-there is no question of hyphenation afterwards; the ligature will simply be
-stored in an ordinary |char_node|, after residing in an |ord_noad|.
-
-The |math_type| is converted to |math_text_char| here if we would not want to
-apply an italic correction to the current character unless it belongs
-to a math font (i.e., a font with |space=0|).
-
-No boundary characters enter into these ligatures.
-
-@<Declare math...@>=
-procedure make_ord(@!q:pointer);
-label restart,exit;
-var a:integer; {address of lig/kern instruction}
-@!p,@!r:pointer; {temporary registers for list manipulation}
-begin restart:@t@>@;@/
-if math_type(subscr(q))=empty then if math_type(supscr(q))=empty then
- if math_type(nucleus(q))=math_char then
- begin p:=link(q);
- if p<>null then if (type(p)>=ord_noad)and(type(p)<=punct_noad) then
- if math_type(nucleus(p))=math_char then
- if fam(nucleus(p))=fam(nucleus(q)) then
- begin math_type(nucleus(q)):=math_text_char;
- fetch(nucleus(q));
- if char_tag(cur_i)=lig_tag then
- begin a:=lig_kern_start(cur_f)(cur_i);
- cur_c:=character(nucleus(p));
- cur_i:=font_info[a].qqqq;
- if skip_byte(cur_i)>stop_flag then
- begin a:=lig_kern_restart(cur_f)(cur_i);
- cur_i:=font_info[a].qqqq;
- end;
- loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach
- the kern after~|q|; or if it is a ligature with |cur_c|, combine
- noads |q| and~|p| appropriately; then |return| if the cursor has
- moved past a noad, or |goto restart|@>;
- if skip_byte(cur_i)>=stop_flag then return;
- a:=a+qo(skip_byte(cur_i))+1;
- cur_i:=font_info[a].qqqq;
- end;
- end;
- end;
- end;
-exit:end;
-
-@ Note that a ligature between an |ord_noad| and another kind of noad
-is replaced by an |ord_noad|, when the two noads collapse into one.
-But we could make a parenthesis (say) change shape when it follows
-certain letters. Presumably a font designer will define such
-ligatures only when this convention makes sense.
-
-\chardef\?='174 % vertical line to indicate character retention
-
-@<If instruction |cur_i| is a kern with |cur_c|, ...@>=
-if next_char(cur_i)=cur_c then if skip_byte(cur_i)<=stop_flag then
- if op_byte(cur_i)>=kern_flag then
- begin p:=new_kern(char_kern(cur_f)(cur_i));
- link(p):=link(q); link(q):=p; return;
- end
- else begin check_interrupt; {allow a way out of infinite ligature loop}
- case op_byte(cur_i) of
- qi(1),qi(5): character(nucleus(q)):=rem_byte(cur_i); {\.{=:\?}, \.{=:\?>}}
- qi(2),qi(6): character(nucleus(p)):=rem_byte(cur_i); {\.{\?=:}, \.{\?=:>}}
- qi(3),qi(7),qi(11):begin r:=new_noad; {\.{\?=:\?}, \.{\?=:\?>}, \.{\?=:\?>>}}
- character(nucleus(r)):=rem_byte(cur_i);
- fam(nucleus(r)):=fam(nucleus(q));@/
- link(q):=r; link(r):=p;
- if op_byte(cur_i)<qi(11) then math_type(nucleus(r)):=math_char
- else math_type(nucleus(r)):=math_text_char; {prevent combination}
- end;
- othercases begin link(q):=link(p);
- character(nucleus(q)):=rem_byte(cur_i); {\.{=:}}
- mem[subscr(q)]:=mem[subscr(p)]; mem[supscr(q)]:=mem[supscr(p)];@/
- free_node(p,noad_size);
- end
- endcases;
- if op_byte(cur_i)>qi(3) then return;
- math_type(nucleus(q)):=math_char; goto restart;
- end
-
-@ When we get to the following part of the program, we have ``fallen through''
-from cases that did not lead to |check_dimensions| or |done_with_noad| or
-|done_with_node|. Thus, |q|~points to a noad whose nucleus may need to be
-converted to an hlist, and whose subscripts and superscripts need to be
-appended if they are present.
-
-If |nucleus(q)| is not a |math_char|, the variable |delta| is the amount
-by which a superscript should be moved right with respect to a subscript
-when both are present.
-@^subscripts@>
-@^superscripts@>
-
-@<Convert \(n)|nucleus(q)| to an hlist and attach the sub/superscripts@>=
-case math_type(nucleus(q)) of
-math_char, math_text_char:
- @<Create a character node |p| for |nucleus(q)|, possibly followed
- by a kern node for the italic correction, and set |delta| to the
- italic correction if a subscript is present@>;
-empty: p:=null;
-sub_box: p:=info(nucleus(q));
-sub_mlist: begin cur_mlist:=info(nucleus(q)); save_style:=cur_style;
- mlist_penalties:=false; mlist_to_hlist; {recursive call}
-@^recursion@>
- cur_style:=save_style; @<Set up the values...@>;
- p:=hpack(link(temp_head),natural);
- end;
-othercases confusion("mlist2")
-@:this can't happen mlist2}{\quad mlist2@>
-endcases;@/
-new_hlist(q):=p;
-if (math_type(subscr(q))=empty)and(math_type(supscr(q))=empty) then
- goto check_dimensions;
-make_scripts(q,delta)
-
-@ @<Create a character node |p| for |nucleus(q)|...@>=
-begin fetch(nucleus(q));
-if char_exists(cur_i) then
- begin delta:=char_italic(cur_f)(cur_i); p:=new_character(cur_f,qo(cur_c));
- if (math_type(nucleus(q))=math_text_char)and(space(cur_f)<>0) then
- delta:=0; {no italic correction in mid-word of text font}
- if (math_type(subscr(q))=empty)and(delta<>0) then
- begin link(p):=new_kern(delta); delta:=0;
- end;
- end
-else p:=null;
-end
-
-@ The purpose of |make_scripts(q,delta)| is to attach the subscript and/or
-superscript of noad |q| to the list that starts at |new_hlist(q)|,
-given that the subscript and superscript aren't both empty. The superscript
-will appear to the right of the subscript by a given distance |delta|.
-
-We set |shift_down| and |shift_up| to the minimum amounts to shift the
-baseline of subscripts and superscripts based on the given nucleus.
-
-@<Declare math...@>=
-procedure make_scripts(@!q:pointer;@!delta:scaled);
-var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
-@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
-@!t:small_number; {subsidiary size code}
-begin p:=new_hlist(q);
-if is_char_node(p) then
- begin shift_up:=0; shift_down:=0;
- end
-else begin z:=hpack(p,natural);
- if cur_style<script_style then t:=script_size@+else t:=script_script_size;
- shift_up:=height(z)-sup_drop(t);
- shift_down:=depth(z)+sub_drop(t);
- free_node(z,box_node_size);
- end;
-if math_type(supscr(q))=empty then
- @<Construct a subscript box |x| when there is no superscript@>
-else begin @<Construct a superscript box |x|@>;
- if math_type(subscr(q))=empty then shift_amount(x):=-shift_up
- else @<Construct a sub/superscript combination box |x|, with the
- superscript offset by |delta|@>;
- end;
-if new_hlist(q)=null then new_hlist(q):=x
-else begin p:=new_hlist(q);
- while link(p)<>null do p:=link(p);
- link(p):=x;
- end;
-end;
-
-@ When there is a subscript without a superscript, the top of the subscript
-should not exceed the baseline plus four-fifths of the x-height.
-
-@<Construct a subscript box |x| when there is no superscript@>=
-begin x:=clean_box(subscr(q),sub_style(cur_style));
-width(x):=width(x)+script_space;
-if shift_down<sub1(cur_size) then shift_down:=sub1(cur_size);
-clr:=height(x)-(abs(math_x_height(cur_size)*4) div 5);
-if shift_down<clr then shift_down:=clr;
-shift_amount(x):=shift_down;
-end
-
-@ The bottom of a superscript should never descend below the baseline plus
-one-fourth of the x-height.
-
-@<Construct a superscript box |x|@>=
-begin x:=clean_box(supscr(q),sup_style(cur_style));
-width(x):=width(x)+script_space;
-if odd(cur_style) then clr:=sup3(cur_size)
-else if cur_style<text_style then clr:=sup1(cur_size)
-else clr:=sup2(cur_size);
-if shift_up<clr then shift_up:=clr;
-clr:=depth(x)+(abs(math_x_height(cur_size)) div 4);
-if shift_up<clr then shift_up:=clr;
-end
-
-@ When both subscript and superscript are present, the subscript must be
-separated from the superscript by at least four times |default_rule_thickness|.
-If this condition would be violated, the subscript moves down, after which
-both subscript and superscript move up so that the bottom of the superscript
-is at least as high as the baseline plus four-fifths of the x-height.
-
-@<Construct a sub/superscript combination box |x|...@>=
-begin y:=clean_box(subscr(q),sub_style(cur_style));
-width(y):=width(y)+script_space;
-if shift_down<sub2(cur_size) then shift_down:=sub2(cur_size);
-clr:=4*default_rule_thickness-
- ((shift_up-depth(x))-(height(y)-shift_down));
-if clr>0 then
- begin shift_down:=shift_down+clr;
- clr:=(abs(math_x_height(cur_size)*4) div 5)-(shift_up-depth(x));
- if clr>0 then
- begin shift_up:=shift_up+clr;
- shift_down:=shift_down-clr;
- end;
- end;
-shift_amount(x):=delta; {superscript is |delta| to the right of the subscript}
-p:=new_kern((shift_up-depth(x))-(height(y)-shift_down)); link(x):=p; link(p):=y;
-x:=vpack(x,natural); shift_amount(x):=shift_down;
-end
-
-@ We have now tied up all the loose ends of the first pass of |mlist_to_hlist|.
-The second pass simply goes through and hooks everything together with the
-proper glue and penalties. It also handles the |left_noad| and |right_noad| that
-might be present, since |max_h| and |max_d| are now known. Variable |p| points
-to a node at the current end of the final hlist.
-
-@<Make a second pass over the mlist, ...@>=
-p:=temp_head; link(p):=null; q:=mlist; r_type:=0; cur_style:=style;
-@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
-while q<>null do
- begin @<If node |q| is a style node, change the style and |goto delete_q|;
- otherwise if it is not a noad, put it into the hlist,
- advance |q|, and |goto done|; otherwise set |s| to the size
- of noad |q|, set |t| to the associated type (|ord_noad..
- inner_noad|), and set |pen| to the associated penalty@>;
- @<Append inter-element spacing based on |r_type| and |t|@>;
- @<Append any |new_hlist| entries for |q|, and any appropriate penalties@>;
- if type(q)=right_noad then t:=open_noad;
- r_type:=t;
- delete_q: r:=q; q:=link(q); free_node(r,s);
- done: end
-
-@ Just before doing the big |case| switch in the second pass, the program
-sets up default values so that most of the branches are short.
-
-@<If node |q| is a style node, change the style...@>=
-t:=ord_noad; s:=noad_size; pen:=inf_penalty;
-case type(q) of
-op_noad,open_noad,close_noad,punct_noad,inner_noad: t:=type(q);
-bin_noad: begin t:=bin_noad; pen:=bin_op_penalty;
- end;
-rel_noad: begin t:=rel_noad; pen:=rel_penalty;
- end;
-ord_noad,vcenter_noad,over_noad,under_noad: do_nothing;
-radical_noad: s:=radical_noad_size;
-accent_noad: s:=accent_noad_size;
-fraction_noad: s:=fraction_noad_size;
-left_noad,right_noad: t:=make_left_right(q,style,max_d,max_h);
-style_node: @<Change the current style and |goto delete_q|@>;
-whatsit_node,penalty_node,rule_node,disc_node,adjust_node,ins_node,mark_node,
- glue_node,kern_node:@t@>@;@/
- begin link(p):=q; p:=q; q:=link(q); link(p):=null; goto done;
- end;
-othercases confusion("mlist3")
-@:this can't happen mlist3}{\quad mlist3@>
-endcases
-
-@ The |make_left_right| function constructs a left or right delimiter of
-the required size and returns the value |open_noad| or |close_noad|. The
-|right_noad| and |left_noad| will both be based on the original |style|,
-so they will have consistent sizes.
-
-We use the fact that |right_noad-left_noad=close_noad-open_noad|.
-
-@<Declare math...@>=
-function make_left_right(@!q:pointer;@!style:small_number;
- @!max_d,@!max_h:scaled):small_number;
-var delta,@!delta1,@!delta2:scaled; {dimensions used in the calculation}
-begin cur_style:=style; @<Set up the values...@>;
-delta2:=max_d+axis_height(cur_size);
-delta1:=max_h+max_d-delta2;
-if delta2>delta1 then delta1:=delta2; {|delta1| is max distance from axis}
-delta:=(delta1 div 500)*delimiter_factor;
-delta2:=delta1+delta1-delimiter_shortfall;
-if delta<delta2 then delta:=delta2;
-new_hlist(q):=var_delimiter(delimiter(q),cur_size,delta);
-make_left_right:=type(q)-(left_noad-open_noad); {|open_noad| or |close_noad|}
-end;
-
-@ @<Change the current style and |goto delete_q|@>=
-begin cur_style:=subtype(q); s:=style_node_size;
-@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
-goto delete_q;
-end
-
-@ The inter-element spacing in math formulas depends on an $8\times8$ table that
-\TeX\ preloads as a 64-digit string. The elements of this string have the
-following significance:
-$$\vbox{\halign{#\hfil\cr
-\.0 means no space;\cr
-\.1 means a conditional thin space (\.{\\nonscript\\mskip\\thinmuskip});\cr
-\.2 means a thin space (\.{\\mskip\\thinmuskip});\cr
-\.3 means a conditional medium space
- (\.{\\nonscript\\mskip\\medmuskip});\cr
-\.4 means a conditional thick space
- (\.{\\nonscript\\mskip\\thickmuskip});\cr
-\.* means an impossible case.\cr}}$$
-This is all pretty cryptic, but {\sl The \TeX book\/} explains what is
-supposed to happen, and the string makes it happen.
-@:TeXbook}{\sl The \TeX book@>
-
-A global variable |magic_offset| is computed so that if |a| and |b| are
-in the range |ord_noad..inner_noad|, then |str_pool[a*8+b+magic_offset]|
-is the digit for spacing between noad types |a| and |b|.
-
-If \PASCAL\ had provided a good way to preload constant arrays, this part of
-the program would not have been so strange.
-@:PASCAL}{\PASCAL@>
-
-@d math_spacing=@;@/
-@t\hskip-35pt@>
-"0234000122*4000133**3**344*0400400*000000234000111*1111112341011"
-@t$ \hskip-35pt$@>
-
-@<Glob...@>=
-@!magic_offset:integer; {used to find inter-element spacing}
-
-@ @<Compute the magic offset@>=
-magic_offset:=str_start[math_spacing]-9*ord_noad
-
-@ @<Append inter-element spacing based on |r_type| and |t|@>=
-if r_type>0 then {not the first noad}
- begin case so(str_pool[r_type*8+t+magic_offset]) of
- "0": x:=0;
- "1": if cur_style<script_style then x:=thin_mu_skip_code@+else x:=0;
- "2": x:=thin_mu_skip_code;
- "3": if cur_style<script_style then x:=med_mu_skip_code@+else x:=0;
- "4": if cur_style<script_style then x:=thick_mu_skip_code@+else x:=0;
- othercases confusion("mlist4")
-@:this can't happen mlist4}{\quad mlist4@>
- endcases;
- if x<>0 then
- begin y:=math_glue(glue_par(x),cur_mu);
- z:=new_glue(y); glue_ref_count(y):=null; link(p):=z; p:=z;@/
- subtype(z):=x+1; {store a symbolic subtype}
- end;
- end
-
-@ We insert a penalty node after the hlist entries of noad |q| if |pen|
-is not an ``infinite'' penalty, and if the node immediately following |q|
-is not a penalty node or a |rel_noad| or absent entirely.
-
-@<Append any |new_hlist| entries for |q|, and any appropriate penalties@>=
-if new_hlist(q)<>null then
- begin link(p):=new_hlist(q);
- repeat p:=link(p);
- until link(p)=null;
- end;
-if penalties then if link(q)<>null then if pen<inf_penalty then
- begin r_type:=type(link(q));
- if r_type<>penalty_node then if r_type<>rel_noad then
- begin z:=new_penalty(pen); link(p):=z; p:=z;
- end;
- end
-
-@* \[37] Alignment.
-It's sort of a miracle whenever \.{\\halign} and \.{\\valign} work, because
-they cut across so many of the control structures of \TeX.
-
-Therefore the
-present page is probably not the best place for a beginner to start reading
-this program; it is better to master everything else first.
-
-Let us focus our thoughts on an example of what the input might be, in order
-to get some idea about how the alignment miracle happens. The example doesn't
-do anything useful, but it is sufficiently general to indicate all of the
-special cases that must be dealt with; please do not be disturbed by its
-apparent complexity and meaninglessness.
-$$\vbox{\halign{\.{#}\hfil\cr
-{}\\tabskip 2pt plus 3pt\cr
-{}\\halign to 300pt\{u1\#v1\&\cr
-\hskip 50pt\\tabskip 1pt plus 1fil u2\#v2\&\cr
-\hskip 50pt u3\#v3\\cr\cr
-\hskip 25pt a1\&\\omit a2\&\\vrule\\cr\cr
-\hskip 25pt \\noalign\{\\vskip 3pt\}\cr
-\hskip 25pt b1\\span b2\\cr\cr
-\hskip 25pt \\omit\&c2\\span\\omit\\cr\}\cr}}$$
-Here's what happens:
-
-\yskip
-(0) When `\.{\\halign to 300pt\{}' is scanned, the |scan_spec| routine
-places the 300pt dimension onto the |save_stack|, and an |align_group|
-code is placed above it. This will make it possible to complete the alignment
-when the matching `\.\}' is found.
-
-(1) The preamble is scanned next. Macros in the preamble are not expanded,
-@^preamble@>
-except as part of a tabskip specification. For example, if \.{u2} had been
-a macro in the preamble above, it would have been expanded, since \TeX\
-must look for `\.{minus...}' as part of the tabskip glue. A ``preamble list''
-is constructed based on the user's preamble; in our case it contains the
-following seven items:
-$$\vbox{\halign{\.{#}\hfil\qquad&(#)\hfil\cr
-{}\\glue 2pt plus 3pt&the tabskip preceding column 1\cr
-{}\\alignrecord, width $-\infty$&preamble info for column 1\cr
-{}\\glue 2pt plus 3pt&the tabskip between columns 1 and 2\cr
-{}\\alignrecord, width $-\infty$&preamble info for column 2\cr
-{}\\glue 1pt plus 1fil&the tabskip between columns 2 and 3\cr
-{}\\alignrecord, width $-\infty$&preamble info for column 3\cr
-{}\\glue 1pt plus 1fil&the tabskip following column 3\cr}}$$
-These ``alignrecord'' entries have the same size as an |unset_node|,
-since they will later be converted into such nodes. However, at the
-moment they have no |type| or |subtype| fields; they have |info| fields
-instead, and these |info| fields are initially set to the value |end_span|,
-for reasons explained below. Furthermore, the alignrecord nodes have no
-|height| or |depth| fields; these are renamed |u_part| and |v_part|,
-and they point to token lists for the templates of the alignment.
-For example, the |u_part| field in the first alignrecord points to the
-token list `\.{u1}', i.e., the template preceding the `\.\#' for column~1.
-
-(2) \TeX\ now looks at what follows the \.{\\cr} that ended the preamble.
-It is not `\.{\\noalign}' or `\.{\\omit}', so this input is put back to
-be read again, and the template `\.{u1}' is fed to the scanner. Just
-before reading `\.{u1}', \TeX\ goes into restricted horizontal mode.
-Just after reading `\.{u1}', \TeX\ will see `\.{a1}', and then (when the
-{\.\&} is sensed) \TeX\ will see `\.{v1}'. Then \TeX\ scans an |endv|
-token, indicating the end of a column. At this point an |unset_node| is
-created, containing the contents of the current hlist (i.e., `\.{u1a1v1}').
-The natural width of this unset node replaces the |width| field of the
-alignrecord for column~1; in general, the alignrecords will record the
-maximum natural width that has occurred so far in a given column.
-
-(3) Since `\.{\\omit}' follows the `\.\&', the templates for column~2
-are now bypassed. Again \TeX\ goes into restricted horizontal mode and
-makes an |unset_node| from the resulting hlist; but this time the
-hlist contains simply `\.{a2}'. The natural width of the new unset box
-is remembered in the |width| field of the alignrecord for column~2.
-
-(4) A third |unset_node| is created for column 3, using essentially the
-mechanism that worked for column~1; this unset box contains `\.{u3\\vrule
-v3}'. The vertical rule in this case has running dimensions that will later
-extend to the height and depth of the whole first row, since each |unset_node|
-in a row will eventually inherit the height and depth of its enclosing box.
-
-(5) The first row has now ended; it is made into a single unset box
-comprising the following seven items:
-$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
-{}\\glue 2pt plus 3pt\cr
-{}\\unsetbox for 1 column: u1a1v1\cr
-{}\\glue 2pt plus 3pt\cr
-{}\\unsetbox for 1 column: a2\cr
-{}\\glue 1pt plus 1fil\cr
-{}\\unsetbox for 1 column: u3\\vrule v3\cr
-{}\\glue 1pt plus 1fil\cr}}$$
-The width of this unset row is unimportant, but it has the correct height
-and depth, so the correct baselineskip glue will be computed as the row
-is inserted into a vertical list.
-
-(6) Since `\.{\\noalign}' follows the current \.{\\cr}, \TeX\ appends
-additional material (in this case \.{\\vskip 3pt}) to the vertical list.
-While processing this material, \TeX\ will be in internal vertical
-mode, and |no_align_group| will be on |save_stack|.
-
-(7) The next row produces an unset box that looks like this:
-$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
-{}\\glue 2pt plus 3pt\cr
-{}\\unsetbox for 2 columns: u1b1v1u2b2v2\cr
-{}\\glue 1pt plus 1fil\cr
-{}\\unsetbox for 1 column: {\rm(empty)}\cr
-{}\\glue 1pt plus 1fil\cr}}$$
-The natural width of the unset box that spans columns 1~and~2 is stored
-in a ``span node,'' which we will explain later; the |info| field of the
-alignrecord for column~1 now points to the new span node, and the |info|
-of the span node points to |end_span|.
-
-(8) The final row produces the unset box
-$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
-{}\\glue 2pt plus 3pt\cr
-{}\\unsetbox for 1 column: {\rm(empty)}\cr
-{}\\glue 2pt plus 3pt\cr
-{}\\unsetbox for 2 columns: u2c2v2\cr
-{}\\glue 1pt plus 1fil\cr}}$$
-A new span node is attached to the alignrecord for column 2.
-
-(9) The last step is to compute the true column widths and to change all the
-unset boxes to hboxes, appending the whole works to the vertical list that
-encloses the \.{\\halign}. The rules for deciding on the final widths of
-each unset column box will be explained below.
-
-\yskip\noindent
-Note that as \.{\\halign} is being processed, we fearlessly give up control
-to the rest of \TeX. At critical junctures, an alignment routine is
-called upon to step in and do some little action, but most of the time
-these routines just lurk in the background. It's something like
-post-hypnotic suggestion.
-
-@ We have mentioned that alignrecords contain no |height| or |depth| fields.
-Their |glue_sign| and |glue_order| are pre-empted as well, since it
-is necessary to store information about what to do when a template ends.
-This information is called the |extra_info| field.
-
-@d u_part(#)==mem[#+height_offset].int {pointer to \<u_j> token list}
-@d v_part(#)==mem[#+depth_offset].int {pointer to \<v_j> token list}
-@d extra_info(#)==info(#+list_offset) {info to remember during template}
-
-@ Alignments can occur within alignments, so a small stack is used to access
-the alignrecord information. At each level we have a |preamble| pointer,
-indicating the beginning of the preamble list; a |cur_align| pointer,
-indicating the current position in the preamble list; a |cur_span| pointer,
-indicating the value of |cur_align| at the beginning of a sequence of
-spanned columns; a |cur_loop| pointer, indicating the tabskip glue before
-an alignrecord that should be copied next if the current list is extended;
-and the |align_state| variable, which indicates the nesting of braces so
-that \.{\\cr} and \.{\\span} and tab marks are properly intercepted.
-There also are pointers |cur_head| and |cur_tail| to the head and tail
-of a list of adjustments being moved out from horizontal mode to
-vertical~mode.
-
-The current values of these seven quantities appear in global variables;
-when they have to be pushed down, they are stored in 5-word nodes, and
-|align_ptr| points to the topmost such node.
-
-@d preamble==link(align_head) {the current preamble list}
-@d align_stack_node_size=6 {number of |mem| words to save alignment states}
-
-@<Glob...@>=
-@!cur_align:pointer; {current position in preamble list}
-@!cur_span:pointer; {start of currently spanned columns in preamble list}
-@!cur_loop:pointer; {place to copy when extending a periodic preamble}
-@!align_ptr:pointer; {most recently pushed-down alignment stack node}
-@!cur_head,@!cur_tail:pointer; {adjustment list pointers}
-@!cur_pre_head,@!cur_pre_tail:pointer; {pre-adjustment list pointers}
-
-@ The |align_state| and |preamble| variables are initialized elsewhere.
-
-@<Set init...@>=
-align_ptr:=null; cur_align:=null; cur_span:=null; cur_loop:=null;
-cur_head:=null; cur_tail:=null;
-cur_pre_head:=null; cur_pre_tail:=null;
-
-@ Alignment stack maintenance is handled by a pair of trivial routines
-called |push_alignment| and |pop_alignment|.
-
-@p procedure push_alignment;
-var p:pointer; {the new alignment stack node}
-begin p:=get_node(align_stack_node_size);
-link(p):=align_ptr; info(p):=cur_align;
-llink(p):=preamble; rlink(p):=cur_span;
-mem[p+2].int:=cur_loop; mem[p+3].int:=align_state;
-info(p+4):=cur_head; link(p+4):=cur_tail;
-info(p+5):=cur_pre_head; link(p+5):=cur_pre_tail;
-align_ptr:=p;
-cur_head:=get_avail;
-cur_pre_head:=get_avail;
-end;
-@#
-procedure pop_alignment;
-var p:pointer; {the top alignment stack node}
-begin free_avail(cur_head);
-free_avail(cur_pre_head);
-p:=align_ptr;
-cur_tail:=link(p+4); cur_head:=info(p+4);
-cur_pre_tail:=link(p+5); cur_pre_head:=info(p+5);
-align_state:=mem[p+3].int; cur_loop:=mem[p+2].int;
-cur_span:=rlink(p); preamble:=llink(p);
-cur_align:=info(p); align_ptr:=link(p);
-free_node(p,align_stack_node_size);
-end;
-
-@ \TeX\ has eight procedures that govern alignments: |init_align| and
-|fin_align| are used at the very beginning and the very end; |init_row| and
-|fin_row| are used at the beginning and end of individual rows; |init_span|
-is used at the beginning of a sequence of spanned columns (possibly involving
-only one column); |init_col| and |fin_col| are used at the beginning and
-end of individual columns; and |align_peek| is used after \.{\\cr} to see
-whether the next item is \.{\\noalign}.
-
-We shall consider these routines in the order they are first used during
-the course of a complete \.{\\halign}, namely |init_align|, |align_peek|,
-|init_row|, |init_span|, |init_col|, |fin_col|, |fin_row|, |fin_align|.
-
-@ When \.{\\halign} or \.{\\valign} has been scanned in an appropriate
-mode, \TeX\ calls |init_align|, whose task is to get everything off to a
-good start. This mostly involves scanning the preamble and putting its
-information into the preamble list.
-@^preamble@>
-
-@p @t\4@>@<Declare the procedure called |get_preamble_token|@>@t@>@/
-procedure@?align_peek; forward;@t\2@>@/
-procedure@?normal_paragraph; forward;@t\2@>@/
-procedure init_align;
-label done, done1, done2, continue;
-var save_cs_ptr:pointer; {|warning_index| value for error messages}
-@!p:pointer; {for short-term temporary use}
-begin save_cs_ptr:=cur_cs; {\.{\\halign} or \.{\\valign}, usually}
-push_alignment; align_state:=-1000000; {enter a new alignment level}
-@<Check for improper alignment in displayed math@>;
-push_nest; {enter a new semantic level}
-@<Change current mode to |-vmode| for \.{\\halign}, |-hmode| for \.{\\valign}@>;
-scan_spec(align_group,false);@/
-@<Scan the preamble and record it in the |preamble| list@>;
-new_save_level(align_group);
-if every_cr<>null then begin_token_list(every_cr,every_cr_text);
-align_peek; {look for \.{\\noalign} or \.{\\omit}}
-end;
-
-@ In vertical modes, |prev_depth| already has the correct value. But
-if we are in |mmode| (displayed formula mode), we reach out to the
-enclosing vertical mode for the |prev_depth| value that produces the
-correct baseline calculations.
-
-@<Change current mode...@>=
-if mode=mmode then
- begin mode:=-vmode; prev_depth:=nest[nest_ptr-2].aux_field.sc;
- end
-else if mode>0 then negate(mode)
-
-@ When \.{\\halign} is used as a displayed formula, there should be
-no other pieces of mlists present.
-
-@<Check for improper alignment in displayed math@>=
-if (mode=mmode)and((tail<>head)or(incompleat_noad<>null)) then
- begin print_err("Improper "); print_esc("halign"); print(" inside $$'s");
-@.Improper \\halign...@>
- help3("Displays can use special alignments (like \eqalignno)")@/
- ("only if nothing but the alignment itself is between $$'s.")@/
- ("So I've deleted the formulas that preceded this alignment.");
- error; flush_math;
- end
-
-@ @<Scan the preamble and record it in the |preamble| list@>=
-preamble:=null; cur_align:=align_head; cur_loop:=null; scanner_status:=aligning;
-warning_index:=save_cs_ptr; align_state:=-1000000;
- {at this point, |cur_cmd=left_brace|}
-loop@+ begin @<Append the current tabskip glue to the preamble list@>;
- if cur_cmd=car_ret then goto done; {\.{\\cr} ends the preamble}
- @<Scan preamble text until |cur_cmd| is |tab_mark| or |car_ret|,
- looking for changes in the tabskip glue; append an
- alignrecord to the preamble list@>;
- end;
-done: scanner_status:=normal
-
-@ @<Append the current tabskip glue to the preamble list@>=
-link(cur_align):=new_param_glue(tab_skip_code);
-cur_align:=link(cur_align)
-
-@ @<Scan preamble text until |cur_cmd| is |tab_mark| or |car_ret|...@>=
-@<Scan the template \<u_j>, putting the resulting token list in |hold_head|@>;
-link(cur_align):=new_null_box; cur_align:=link(cur_align); {a new alignrecord}
-info(cur_align):=end_span; width(cur_align):=null_flag;
-u_part(cur_align):=link(hold_head);
-@<Scan the template \<v_j>, putting the resulting token list in |hold_head|@>;
-v_part(cur_align):=link(hold_head)
-
-@ We enter `\.{\\span}' into |eqtb| with |tab_mark| as its command code,
-and with |span_code| as the command modifier. This makes \TeX\ interpret it
-essentially the same as an alignment delimiter like `\.\&', yet it is
-recognizably different when we need to distinguish it from a normal delimiter.
-It also turns out to be useful to give a special |cr_code| to `\.{\\cr}',
-and an even larger |cr_cr_code| to `\.{\\crcr}'.
-
-The end of a template is represented by two ``frozen'' control sequences
-called \.{\\endtemplate}. The first has the command code |end_template|, which
-is |>outer_call|, so it will not easily disappear in the presence of errors.
-The |get_x_token| routine converts the first into the second, which has |endv|
-as its command code.
-
-@d span_code=256 {distinct from any character}
-@d cr_code=257 {distinct from |span_code| and from any character}
-@d cr_cr_code=cr_code+1 {this distinguishes \.{\\crcr} from \.{\\cr}}
-@d end_template_token==cs_token_flag+frozen_end_template
-
-@<Put each of \TeX's primitives into the hash table@>=
-primitive("span",tab_mark,span_code);@/
-@!@:span_}{\.{\\span} primitive@>
-primitive("cr",car_ret,cr_code);
-@!@:cr_}{\.{\\cr} primitive@>
-text(frozen_cr):="cr"; eqtb[frozen_cr]:=eqtb[cur_val];@/
-primitive("crcr",car_ret,cr_cr_code);
-@!@:cr_cr_}{\.{\\crcr} primitive@>
-text(frozen_end_template):="endtemplate"; text(frozen_endv):="endtemplate";
-@.endtemplate@>
-eq_type(frozen_endv):=endv; equiv(frozen_endv):=null_list;
-eq_level(frozen_endv):=level_one;@/
-eqtb[frozen_end_template]:=eqtb[frozen_endv];
-eq_type(frozen_end_template):=end_template;
-
-@ @<Cases of |print_cmd_chr|...@>=
-tab_mark: if chr_code=span_code then print_esc("span")
- else chr_cmd("alignment tab character ");
-car_ret: if chr_code=cr_code then print_esc("cr")
- else print_esc("crcr");
-
-@ The preamble is copied directly, except that \.{\\tabskip} causes a change
-to the tabskip glue, thereby possibly expanding macros that immediately
-follow it. An appearance of \.{\\span} also causes such an expansion.
-
-Note that if the preamble contains `\.{\\global\\tabskip}', the `\.{\\global}'
-token survives in the preamble and the `\.{\\tabskip}' defines new
-tabskip glue (locally).
-
-@<Declare the procedure called |get_preamble_token|@>=
-procedure get_preamble_token;
-label restart;
-begin restart: get_token;
-while (cur_chr=span_code)and(cur_cmd=tab_mark) do
- begin get_token; {this token will be expanded once}
- if cur_cmd>max_command then
- begin expand; get_token;
- end;
- end;
-if cur_cmd=endv then
- fatal_error("(interwoven alignment preambles are not allowed)");
-@.interwoven alignment preambles...@>
-if (cur_cmd=assign_glue)and(cur_chr=glue_base+tab_skip_code) then
- begin scan_optional_equals; scan_glue(glue_val);
- if global_defs>0 then geq_define(glue_base+tab_skip_code,glue_ref,cur_val)
- else eq_define(glue_base+tab_skip_code,glue_ref,cur_val);
- goto restart;
- end;
-end;
-
-@ Spaces are eliminated from the beginning of a template.
-
-@<Scan the template \<u_j>...@>=
-p:=hold_head; link(p):=null;
-loop@+ begin get_preamble_token;
- if cur_cmd=mac_param then goto done1;
- if (cur_cmd<=car_ret)and(cur_cmd>=tab_mark)and(align_state=-1000000) then
- if (p=hold_head)and(cur_loop=null)and(cur_cmd=tab_mark)
- then cur_loop:=cur_align
- else begin print_err("Missing # inserted in alignment preamble");
-@.Missing \# inserted...@>
- help3("There should be exactly one # between &'s, when an")@/
- ("\halign or \valign is being set up. In this case you had")@/
- ("none, so I've put one in; maybe that will work.");
- back_error; goto done1;
- end
- else if (cur_cmd<>spacer)or(p<>hold_head) then
- begin link(p):=get_avail; p:=link(p); info(p):=cur_tok;
- end;
- end;
-done1:
-
-@ @<Scan the template \<v_j>...@>=
-p:=hold_head; link(p):=null;
-loop@+ begin continue: get_preamble_token;
- if (cur_cmd<=car_ret)and(cur_cmd>=tab_mark)and(align_state=-1000000) then
- goto done2;
- if cur_cmd=mac_param then
- begin print_err("Only one # is allowed per tab");
-@.Only one \# is allowed...@>
- help3("There should be exactly one # between &'s, when an")@/
- ("\halign or \valign is being set up. In this case you had")@/
- ("more than one, so I'm ignoring all but the first.");
- error; goto continue;
- end;
- link(p):=get_avail; p:=link(p); info(p):=cur_tok;
- end;
-done2: link(p):=get_avail; p:=link(p);
-info(p):=end_template_token {put \.{\\endtemplate} at the end}
-
-@ The tricky part about alignments is getting the templates into the
-scanner at the right time, and recovering control when a row or column
-is finished.
-
-We usually begin a row after each \.{\\cr} has been sensed, unless that
-\.{\\cr} is followed by \.{\\noalign} or by the right brace that terminates
-the alignment. The |align_peek| routine is used to look ahead and do
-the right thing; it either gets a new row started, or gets a \.{\\noalign}
-started, or finishes off the alignment.
-
-@<Declare the procedure called |align_peek|@>=
-procedure align_peek;
-label restart;
-begin restart: align_state:=1000000;
-repeat get_x_or_protected;
-until cur_cmd<>spacer;
-if cur_cmd=no_align then
- begin scan_left_brace; new_save_level(no_align_group);
- if mode=-vmode then normal_paragraph;
- end
-else if cur_cmd=right_brace then fin_align
-else if (cur_cmd=car_ret)and(cur_chr=cr_cr_code) then
- goto restart {ignore \.{\\crcr}}
-else begin init_row; {start a new row}
- init_col; {start a new column and replace what we peeked at}
- end;
-end;
-
-@ To start a row (i.e., a `row' that rhymes with `dough' but not with `bough'),
-we enter a new semantic level, copy the first tabskip glue, and change
-from internal vertical mode to restricted horizontal mode or vice versa.
-The |space_factor| and |prev_depth| are not used on this semantic level,
-but we clear them to zero just to be tidy.
-
-@p @t\4@>@<Declare the procedure called |init_span|@>@t@>@/
-procedure init_row;
-begin push_nest; mode:=(-hmode-vmode)-mode;
-if mode=-hmode then space_factor:=0 @+else prev_depth:=0;
-tail_append(new_glue(glue_ptr(preamble)));
-subtype(tail):=tab_skip_code+1;@/
-cur_align:=link(preamble); cur_tail:=cur_head; cur_pre_tail:=cur_pre_head;
-init_span(cur_align);
-end;
-
-@ The parameter to |init_span| is a pointer to the alignrecord where the
-next column or group of columns will begin. A new semantic level is
-entered, so that the columns will generate a list for subsequent packaging.
-
-@<Declare the procedure called |init_span|@>=
-procedure init_span(@!p:pointer);
-begin push_nest;
-if mode=-hmode then space_factor:=1000
-else begin prev_depth:=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.
-
-@<Insert the \(v)\<v_j>...@>=
-begin if (scanner_status=aligning) or (cur_align=null) then
- fatal_error("(interwoven alignment preambles are not allowed)");
-@.interwoven alignment preambles...@>
-cur_cmd:=extra_info(cur_align); extra_info(cur_align):=cur_chr;
-if cur_cmd=omit then begin_token_list(omit_template,v_template)
-else begin_token_list(v_part(cur_align),v_template);
-align_state:=1000000; goto restart;
-end
-
-@ The token list |omit_template| just referred to is a constant token
-list that contains the special control sequence \.{\\endtemplate} only.
-
-@<Initialize the special...@>=
-info(omit_template):=end_template_token; {|link(omit_template)=null|}
-
-@ When the |endv| command at the end of a \<v_j> template comes through the
-scanner, things really start to happen; and it is the |fin_col| routine
-that makes them happen. This routine returns |true| if a row as well as a
-column has been finished.
-
-@p function fin_col:boolean;
-label exit;
-var p:pointer; {the alignrecord after the current one}
-@!q,@!r:pointer; {temporary pointers for list manipulation}
-@!s:pointer; {a new span node}
-@!u:pointer; {a new unset box}
-@!w:scaled; {natural width}
-@!o:glue_ord; {order of infinity}
-@!n:halfword; {span counter}
-begin if cur_align=null then confusion("endv");
-q:=link(cur_align);@+if q=null then confusion("endv");
-@:this can't happen endv}{\quad endv@>
-if align_state<500000 then
- fatal_error("(interwoven alignment preambles are not allowed)");
-@.interwoven alignment preambles...@>
-p:=link(q);
-@<If the preamble list has been traversed, check that the row has ended@>;
-if extra_info(cur_align)<>span_code then
- begin unsave; new_save_level(align_group);@/
- @<Package an unset box for the current column and record its width@>;
- @<Copy the tabskip glue between columns@>;
- if extra_info(cur_align)>=cr_code then
- begin fin_col:=true; return;
- end;
- init_span(p);
- end;
-align_state:=1000000;
-repeat get_x_or_protected;
-until cur_cmd<>spacer;
-cur_align:=p;
-init_col; fin_col:=false;
-exit: end;
-
-@ @<If the preamble list has been traversed, check that the row has ended@>=
-if (p=null)and(extra_info(cur_align)<cr_code) then
- if cur_loop<>null then @<Lengthen the preamble periodically@>
- else begin print_err("Extra alignment tab has been changed to ");
-@.Extra alignment tab...@>
- print_esc("cr");
- help3("You have given more \span or & marks than there were")@/
- ("in the preamble to the \halign or \valign now in progress.")@/
- ("So I'll assume that you meant to type \cr instead.");
- extra_info(cur_align):=cr_code; error;
- end
-
-@ @<Lengthen the preamble...@>=
-begin link(q):=new_null_box; p:=link(q); {a new alignrecord}
-info(p):=end_span; width(p):=null_flag; cur_loop:=link(cur_loop);
-@<Copy the templates from node |cur_loop| into node |p|@>;
-cur_loop:=link(cur_loop);
-link(p):=new_glue(glue_ptr(cur_loop));
-subtype(link(p)):=tab_skip_code+1;
-end
-
-@ @<Copy the templates from node |cur_loop| into node |p|@>=
-q:=hold_head; r:=u_part(cur_loop);
-while r<>null do
- begin link(q):=get_avail; q:=link(q); info(q):=info(r); r:=link(r);
- end;
-link(q):=null; u_part(p):=link(hold_head);
-q:=hold_head; r:=v_part(cur_loop);
-while r<>null do
- begin link(q):=get_avail; q:=link(q); info(q):=info(r); r:=link(r);
- end;
-link(q):=null; v_part(p):=link(hold_head)
-
-@ @<Copy the tabskip glue...@>=
-tail_append(new_glue(glue_ptr(link(cur_align))));
-subtype(tail):=tab_skip_code+1
-
-@ @<Package an unset...@>=
-begin if mode=-hmode then
- begin adjust_tail:=cur_tail; pre_adjust_tail:=cur_pre_tail;
- u:=hpack(link(head),natural); w:=width(u);
- cur_tail:=adjust_tail; adjust_tail:=null;
- cur_pre_tail:=pre_adjust_tail; pre_adjust_tail:=null;
- end
-else begin u:=vpackage(link(head),natural,0); w:=height(u);
- end;
-n:=min_quarterword; {this represents a span count of 1}
-if cur_span<>cur_align then @<Update width entry for spanned columns@>
-else if w>width(cur_align) then width(cur_align):=w;
-type(u):=unset_node; span_count(u):=n;@/
-@<Determine the stretch order@>;
-glue_order(u):=o; glue_stretch(u):=total_stretch[o];@/
-@<Determine the shrink order@>;
-glue_sign(u):=o; glue_shrink(u):=total_shrink[o];@/
-pop_nest; link(tail):=u; tail:=u;
-end
-
-@ A span node is a 2-word record containing |width|, |info|, and |link|
-fields. The |link| field is not really a link, it indicates the number of
-spanned columns; the |info| field points to a span node for the same
-starting column, having a greater extent of spanning, or to |end_span|,
-which has the largest possible |link| field; the |width| field holds the
-largest natural width corresponding to a particular set of spanned columns.
-
-A list of the maximum widths so far, for spanned columns starting at a
-given column, begins with the |info| field of the alignrecord for that
-column.
-
-@d span_node_size=2 {number of |mem| words for a span node}
-
-@<Initialize the special list heads...@>=
-link(end_span):=max_quarterword+1; info(end_span):=null;
-
-@ @<Update width entry for spanned columns@>=
-begin q:=cur_span;
-repeat incr(n); q:=link(link(q));
-until q=cur_align;
-if n>max_quarterword then confusion("256 spans"); {this can happen, but won't}
-@^system dependencies@>
-@:this can't happen 256 spans}{\quad 256 spans@>
-q:=cur_span; while link(info(q))<n do q:=info(q);
-if link(info(q))>n then
- begin s:=get_node(span_node_size); info(s):=info(q); link(s):=n;
- info(q):=s; width(s):=w;
- end
-else if width(info(q))<w then width(info(q)):=w;
-end
-
-@ At the end of a row, we append an unset box to the current vlist (for
-\.{\\halign}) or the current hlist (for \.{\\valign}). This unset box
-contains the unset boxes for the columns, separated by the tabskip glue.
-Everything will be set later.
-
-@p procedure fin_row;
-var p:pointer; {the new unset box}
-begin if mode=-hmode then
- begin p:=hpack(link(head),natural);
- pop_nest;
- if cur_pre_head <> cur_pre_tail then
- append_list(cur_pre_head)(cur_pre_tail);
- append_to_vlist(p);
- if cur_head <> cur_tail then
- append_list(cur_head)(cur_tail);
- end
-else begin p:=vpack(link(head),natural); pop_nest;
- link(tail):=p; tail:=p; space_factor:=1000;
- end;
-type(p):=unset_node; glue_stretch(p):=0;
-if every_cr<>null then begin_token_list(every_cr,every_cr_text);
-align_peek;
-end; {note that |glue_shrink(p)=0| since |glue_shrink==shift_amount|}
-
-@ Finally, we will reach the end of the alignment, and we can breathe a
-sigh of relief that memory hasn't overflowed. All the unset boxes will now be
-set so that the columns line up, taking due account of spanned columns.
-
-@p procedure@?do_assignments; forward;@t\2@>@/
-procedure@?resume_after_display; forward;@t\2@>@/
-procedure@?build_page; forward;@t\2@>@/
-procedure fin_align;
-var @!p,@!q,@!r,@!s,@!u,@!v: pointer; {registers for the list operations}
-@!t,@!w:scaled; {width of column}
-@!o:scaled; {shift offset for unset boxes}
-@!n:halfword; {matching span amount}
-@!rule_save:scaled; {temporary storage for |overfull_rule|}
-@!aux_save:memory_word; {temporary storage for |aux|}
-begin if cur_group<>align_group then confusion("align1");
-@:this can't happen align}{\quad align@>
-unsave; {that |align_group| was for individual entries}
-if cur_group<>align_group then confusion("align0");
-unsave; {that |align_group| was for the whole alignment}
-if nest[nest_ptr-1].mode_field=mmode then o:=display_indent
- else o:=0;
-@<Go through the preamble list, determining the column widths and
- changing the alignrecords to dummy unset boxes@>;
-@<Package the preamble list, to determine the actual tabskip glue amounts,
- and let |p| point to this prototype box@>;
-@<Set the glue in all the unset boxes of the current list@>;
-flush_node_list(p); pop_alignment;
-@<Insert the \(c)current list into its environment@>;
-end;@/
-@t\4@>@<Declare the procedure called |align_peek|@>
-
-@ It's time now to dismantle the preamble list and to compute the column
-widths. Let $w_{ij}$ be the maximum of the natural widths of all entries
-that span columns $i$ through $j$, inclusive. The alignrecord for column~$i$
-contains $w_{ii}$ in its |width| field, and there is also a linked list of
-the nonzero $w_{ij}$ for increasing $j$, accessible via the |info| field;
-these span nodes contain the value $j-i+|min_quarterword|$ in their
-|link| fields. The values of $w_{ii}$ were initialized to |null_flag|, which
-we regard as $-\infty$.
-
-The final column widths are defined by the formula
-$$w_j=\max_{1\L i\L j}\biggl( w_{ij}-\sum_{i\L k<j}(t_k+w_k)\biggr),$$
-where $t_k$ is the natural width of the tabskip glue between columns
-$k$ and~$k+1$. However, if $w_{ij}=-\infty$ for all |i| in the range
-|1<=i<=j| (i.e., if every entry that involved column~|j| also involved
-column~|j+1|), we let $w_j=0$, and we zero out the tabskip glue after
-column~|j|.
-
-\TeX\ computes these values by using the following scheme: First $w_1=w_{11}$.
-Then replace $w_{2j}$ by $\max(w_{2j},w_{1j}-t_1-w_1)$, for all $j>1$.
-Then $w_2=w_{22}$. Then replace $w_{3j}$ by $\max(w_{3j},w_{2j}-t_2-w_2)$
-for all $j>2$; and so on. If any $w_j$ turns out to be $-\infty$, its
-value is changed to zero and so is the next tabskip.
-
-@<Go through the preamble list,...@>=
-q:=link(preamble);
-repeat flush_list(u_part(q)); flush_list(v_part(q));
-p:=link(link(q));
-if width(q)=null_flag then
- @<Nullify |width(q)| and the tabskip glue following this column@>;
-if info(q)<>end_span then
- @<Merge the widths in the span nodes of |q| with those of |p|,
- destroying the span nodes of |q|@>;
-type(q):=unset_node; span_count(q):=min_quarterword; height(q):=0;
-depth(q):=0; glue_order(q):=normal; glue_sign(q):=normal;
-glue_stretch(q):=0; glue_shrink(q):=0; q:=p;
-until q=null
-
-@ @<Nullify |width(q)| and the tabskip glue following this column@>=
-begin width(q):=0; r:=link(q); s:=glue_ptr(r);
-if s<>zero_glue then
- begin add_glue_ref(zero_glue); delete_glue_ref(s);
- glue_ptr(r):=zero_glue;
- end;
-end
-
-@ Merging of two span-node lists is a typical exercise in the manipulation of
-linearly linked data structures. The essential invariant in the following
-|repeat| loop is that we want to dispense with node |r|, in |q|'s list,
-and |u| is its successor; all nodes of |p|'s list up to and including |s|
-have been processed, and the successor of |s| matches |r| or precedes |r|
-or follows |r|, according as |link(r)=n| or |link(r)>n| or |link(r)<n|.
-
-@<Merge the widths...@>=
-begin t:=width(q)+width(glue_ptr(link(q)));
-r:=info(q); s:=end_span; info(s):=p; n:=min_quarterword+1;
-repeat width(r):=width(r)-t; u:=info(r);
-while link(r)>n do
- begin s:=info(s); n:=link(info(s))+1;
- end;
-if link(r)<n then
- begin info(r):=info(s); info(s):=r; decr(link(r)); s:=r;
- end
-else begin if width(r)>width(info(s)) then width(info(s)):=width(r);
- free_node(r,span_node_size);
- end;
-r:=u;
-until r=end_span;
-end
-
-@ Now the preamble list has been converted to a list of alternating unset
-boxes and tabskip glue, where the box widths are equal to the final
-column sizes. In case of \.{\\valign}, we change the widths to heights,
-so that a correct error message will be produced if the alignment is
-overfull or underfull.
-
-@<Package the preamble list...@>=
-save_ptr:=save_ptr-2; pack_begin_line:=-mode_line;
-if mode=-vmode then
- begin rule_save:=overfull_rule;
- overfull_rule:=0; {prevent rule from being packaged}
- p:=hpack(preamble,saved(1),saved(0)); overfull_rule:=rule_save;
- end
-else begin q:=link(preamble);
- repeat height(q):=width(q); width(q):=0; q:=link(link(q));
- until q=null;
- p:=vpack(preamble,saved(1),saved(0));
- q:=link(preamble);
- repeat width(q):=height(q); height(q):=0; q:=link(link(q));
- until q=null;
- end;
-pack_begin_line:=0
-
-@ @<Set the glue in all the unset...@>=
-q:=link(head); s:=head;
-while q<>null do
- begin if not is_char_node(q) then
- if type(q)=unset_node then
- @<Set the unset box |q| and the unset boxes in it@>
- else if type(q)=rule_node then
- @<Make the running dimensions in rule |q| extend to the
- boundaries of the alignment@>;
- s:=q; q:=link(q);
- end
-
-@ @<Make the running dimensions in rule |q| extend...@>=
-begin if is_running(width(q)) then width(q):=width(p);
-if is_running(height(q)) then height(q):=height(p);
-if is_running(depth(q)) then depth(q):=depth(p);
-if o<>0 then
- begin r:=link(q); link(q):=null; q:=hpack(q,natural);
- shift_amount(q):=o; link(q):=r; link(s):=q;
- end;
-end
-
-@ The unset box |q| represents a row that contains one or more unset boxes,
-depending on how soon \.{\\cr} occurred in that row.
-
-@<Set the unset box |q| and the unset boxes in it@>=
-begin if mode=-vmode then
- begin type(q):=hlist_node; width(q):=width(p);
- if nest[nest_ptr-1].mode_field=mmode then set_box_lr(q)(dlist); {for |ship_out|}
- end
-else begin type(q):=vlist_node; height(q):=height(p);
- end;
-glue_order(q):=glue_order(p); glue_sign(q):=glue_sign(p);
-glue_set(q):=glue_set(p); shift_amount(q):=o;
-r:=link(list_ptr(q)); s:=link(list_ptr(p));
-repeat @<Set the glue in node |r| and change it from an unset node@>;
-r:=link(link(r)); s:=link(link(s));
-until r=null;
-end
-
-@ A box made from spanned columns will be followed by tabskip glue nodes and
-by empty boxes as if there were no spanning. This permits perfect alignment
-of subsequent entries, and it prevents values that depend on floating point
-arithmetic from entering into the dimensions of any boxes.
-
-@<Set the glue in node |r|...@>=
-n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
-set_box_lr(r)(0); {for |ship_out|}
-while n>min_quarterword do
- begin decr(n);
- @<Append tabskip glue and an empty box to list |u|,
- and update |s| and |t| as the prototype nodes are passed@>;
- end;
-if mode=-vmode then
- @<Make the unset node |r| into an |hlist_node| of width |w|,
- setting the glue as if the width were |t|@>
-else @<Make the unset node |r| into a |vlist_node| of height |w|,
- setting the glue as if the height were |t|@>;
-shift_amount(r):=0;
-if u<>hold_head then {append blank boxes to account for spanned nodes}
- begin link(u):=link(r); link(r):=link(hold_head); r:=u;
- end
-
-@ @<Append tabskip glue and an empty box to list |u|...@>=
-s:=link(s); v:=glue_ptr(s); link(u):=new_glue(v); u:=link(u);
-subtype(u):=tab_skip_code+1; t:=t+width(v);
-if glue_sign(p)=stretching then
- begin if stretch_order(v)=glue_order(p) then
- t:=t+round(float(glue_set(p))*stretch(v));
-@^real multiplication@>
- end
-else if glue_sign(p)=shrinking then
- begin if shrink_order(v)=glue_order(p) then
- t:=t-round(float(glue_set(p))*shrink(v));
- end;
-s:=link(s); link(u):=new_null_box; u:=link(u); t:=t+width(s);
-if mode=-vmode then width(u):=width(s)@+else
- begin type(u):=vlist_node; height(u):=width(s);
- end
-
-@ @<Make the unset node |r| into an |hlist_node| of width |w|...@>=
-begin height(r):=height(q); depth(r):=depth(q);
-if t=width(r) then
- begin glue_sign(r):=normal; glue_order(r):=normal;
- set_glue_ratio_zero(glue_set(r));
- end
-else if t>width(r) then
- begin glue_sign(r):=stretching;
- if glue_stretch(r)=0 then set_glue_ratio_zero(glue_set(r))
- else glue_set(r):=unfloat((t-width(r))/glue_stretch(r));
-@^real division@>
- end
-else begin glue_order(r):=glue_sign(r); glue_sign(r):=shrinking;
- if glue_shrink(r)=0 then set_glue_ratio_zero(glue_set(r))
- else if (glue_order(r)=normal)and(width(r)-t>glue_shrink(r)) then
- set_glue_ratio_one(glue_set(r))
- else glue_set(r):=unfloat((width(r)-t)/glue_shrink(r));
- end;
-width(r):=w; type(r):=hlist_node;
-end
-
-@ @<Make the unset node |r| into a |vlist_node| of height |w|...@>=
-begin width(r):=width(q);
-if t=height(r) then
- begin glue_sign(r):=normal; glue_order(r):=normal;
- set_glue_ratio_zero(glue_set(r));
- end
-else if t>height(r) then
- begin glue_sign(r):=stretching;
- if glue_stretch(r)=0 then set_glue_ratio_zero(glue_set(r))
- else glue_set(r):=unfloat((t-height(r))/glue_stretch(r));
-@^real division@>
- end
-else begin glue_order(r):=glue_sign(r); glue_sign(r):=shrinking;
- if glue_shrink(r)=0 then set_glue_ratio_zero(glue_set(r))
- else if (glue_order(r)=normal)and(height(r)-t>glue_shrink(r)) then
- set_glue_ratio_one(glue_set(r))
- else glue_set(r):=unfloat((height(r)-t)/glue_shrink(r));
- end;
-height(r):=w; type(r):=vlist_node;
-end
-
-@ We now have a completed alignment, in the list that starts at |head|
-and ends at |tail|. This list will be merged with the one that encloses
-it. (In case the enclosing mode is |mmode|, for displayed formulas,
-we will need to insert glue before and after the display; that part of the
-program will be deferred until we're more familiar with such operations.)
-
-In restricted horizontal mode, the |clang| part of |aux| is undefined;
-an over-cautious \PASCAL\ runtime system may complain about this.
-@^dirty \PASCAL@>
-
-@<Insert the \(c)current list into its environment@>=
-aux_save:=aux; p:=link(head); q:=tail; pop_nest;
-if mode=mmode then @<Finish an alignment in a display@>
-else begin aux:=aux_save; link(tail):=p;
- if p<>null then tail:=q;
- if mode=vmode then build_page;
- end
-
-@* \[38] Breaking paragraphs into lines.
-We come now to what is probably the most interesting algorithm of \TeX:
-the mechanism for choosing the ``best possible'' breakpoints that yield
-the individual lines of a paragraph. \TeX's line-breaking algorithm takes
-a given horizontal list and converts it to a sequence of boxes that are
-appended to the current vertical list. In the course of doing this, it
-creates a special data structure containing three kinds of records that are
-not used elsewhere in \TeX. Such nodes are created while a paragraph is
-being processed, and they are destroyed afterwards; thus, the other parts
-of \TeX\ do not need to know anything about how line-breaking is done.
-
-The method used here is based on an approach devised by Michael F. Plass and
-@^Plass, Michael Frederick@>
-@^Knuth, Donald Ervin@>
-the author in 1977, subsequently generalized and improved by the same two
-people in 1980. A detailed discussion appears in {\sl Software---Practice
-and Experience \bf11} (1981), 1119--1184, where it is shown that the
-line-breaking problem can be regarded as a special case of the problem of
-computing the shortest path in an acyclic network. The cited paper includes
-numerous examples and describes the history of line breaking as it has been
-practiced by printers through the ages. The present implementation adds two
-new ideas to the algorithm of 1980: Memory space requirements are considerably
-reduced by using smaller records for inactive nodes than for active ones,
-and arithmetic overflow is avoided by using ``delta distances'' instead of
-keeping track of the total distance from the beginning of the paragraph to the
-current point.
-
-@ The |line_break| procedure should be invoked only in horizontal mode; it
-leaves that mode and places its output into the current vlist of the
-enclosing vertical mode (or internal vertical mode).
-There is one explicit parameter: |d| is true for partial paragraphs
-preceding display math mode; in this case the amount of additional
-penalty inserted before the final line is |display_widow_penalty|
-instead of |widow_penalty|.
-
-There are also a number of implicit parameters: The hlist to be broken
-starts at |link(head)|, and it is nonempty. The value of |prev_graf| in the
-enclosing semantic level tells where the paragraph should begin in the
-sequence of line numbers, in case hanging indentation or \.{\\parshape}
-is in use; |prev_graf| is zero unless this paragraph is being continued
-after a displayed formula. Other implicit parameters, such as the
-|par_shape_ptr| and various penalties to use for hyphenation, etc., appear
-in |eqtb|.
-
-After |line_break| has acted, it will have updated the current vlist and the
-value of |prev_graf|. Furthermore, the global variable |just_box| will
-point to the final box created by |line_break|, so that the width of this
-line can be ascertained when it is necessary to decide whether to use
-|above_display_skip| or |above_display_short_skip| before a displayed formula.
-
-@<Glob...@>=
-@!just_box:pointer; {the |hlist_node| for the last line of the new paragraph}
-
-@ Since |line_break| is a rather lengthy procedure---sort of a small world unto
-itself---we must build it up little by little, somewhat more cautiously
-than we have done with the simpler procedures of \TeX. Here is the
-general outline.
-
-@p@t\4@>@<Declare subprocedures for |line_break|@>
-procedure line_break(@!d:boolean);
-label done,done1,done2,done3,done4,done5,continue;
-var @<Local variables for line breaking@>@;
-begin pack_begin_line:=mode_line; {this is for over/underfull box messages}
-@<Get ready to start line breaking@>;
-@<Find optimal breakpoints@>;
-@<Break the paragraph at the chosen breakpoints, justify the resulting lines
-to the correct widths, and append them to the current vertical list@>;
-@<Clean up the memory by removing the break nodes@>;
-pack_begin_line:=0;
-end;
-@#
-@t\4@>@<Declare \eTeX\ procedures for use by |main_control|@>
-
-@ The first task is to move the list from |head| to |temp_head| and go
-into the enclosing semantic level. We also append the \.{\\parfillskip}
-glue to the end of the paragraph, removing a space (or other glue node) if
-it was there, since spaces usually precede blank lines and instances of
-`\.{\$\$}'. The |par_fill_skip| is preceded by an infinite penalty, so
-it will never be considered as a potential breakpoint.
-
-This code assumes that a |glue_node| and a |penalty_node| occupy the
-same number of |mem|~words.
-@^data structure assumptions@>
-
-@<Get ready to start...@>=
-link(temp_head):=link(head);
-if is_char_node(tail) then tail_append(new_penalty(inf_penalty))
-else if type(tail)<>glue_node then tail_append(new_penalty(inf_penalty))
-else begin type(tail):=penalty_node; delete_glue_ref(glue_ptr(tail));
- flush_node_list(leader_ptr(tail)); penalty(tail):=inf_penalty;
- end;
-link(tail):=new_param_glue(par_fill_skip_code);
-last_line_fill:=link(tail);
-init_cur_lang:=prev_graf mod @'200000;
-init_l_hyf:=prev_graf div @'20000000;
-init_r_hyf:=(prev_graf div @'200000) mod @'100;
-pop_nest;
-
-@ When looking for optimal line breaks, \TeX\ creates a ``break node'' for
-each break that is {\sl feasible}, in the sense that there is a way to end
-a line at the given place without requiring any line to stretch more than
-a given tolerance. A break node is characterized by three things: the position
-of the break (which is a pointer to a |glue_node|, |math_node|, |penalty_node|,
-or |disc_node|); the ordinal number of the line that will follow this
-breakpoint; and the fitness classification of the line that has just
-ended, i.e., |tight_fit|, |decent_fit|, |loose_fit|, or |very_loose_fit|.
-
-@d tight_fit=3 {fitness classification for lines shrinking 0.5 to 1.0 of their
- shrinkability}
-@d loose_fit=1 {fitness classification for lines stretching 0.5 to 1.0 of their
- stretchability}
-@d very_loose_fit=0 {fitness classification for lines stretching more than
- their stretchability}
-@d decent_fit=2 {fitness classification for all other lines}
-
-@ The algorithm essentially determines the best possible way to achieve
-each feasible combination of position, line, and fitness. Thus, it answers
-questions like, ``What is the best way to break the opening part of the
-paragraph so that the fourth line is a tight line ending at such-and-such
-a place?'' However, the fact that all lines are to be the same length
-after a certain point makes it possible to regard all sufficiently large
-line numbers as equivalent, when the looseness parameter is zero, and this
-makes it possible for the algorithm to save space and time.
-
-An ``active node'' and a ``passive node'' are created in |mem| for each
-feasible breakpoint that needs to be considered. Active nodes are three
-words long and passive nodes are two words long. We need active nodes only
-for breakpoints near the place in the paragraph that is currently being
-examined, so they are recycled within a comparatively short time after
-they are created.
-
-@ An active node for a given breakpoint contains six fields:
-
-\yskip\hang|link| points to the next node in the list of active nodes; the
-last active node has |link=last_active|.
-
-\yskip\hang|break_node| points to the passive node associated with this
-breakpoint.
-
-\yskip\hang|line_number| is the number of the line that follows this
-breakpoint.
-
-\yskip\hang|fitness| is the fitness classification of the line ending at this
-breakpoint.
-
-\yskip\hang|type| is either |hyphenated| or |unhyphenated|, depending on
-whether this breakpoint is a |disc_node|.
-
-\yskip\hang|total_demerits| is the minimum possible sum of demerits over all
-lines leading from the beginning of the paragraph to this breakpoint.
-
-\yskip\noindent
-The value of |link(active)| points to the first active node on a linked list
-of all currently active nodes. This list is in order by |line_number|,
-except that nodes with |line_number>easy_line| may be in any order relative
-to each other.
-
-@d active_node_size_normal=3 {number of words in normal active nodes}
-@d fitness==subtype {|very_loose_fit..tight_fit| on final line for this break}
-@d break_node==rlink {pointer to the corresponding passive node}
-@d line_number==llink {line that begins at this breakpoint}
-@d total_demerits(#)==mem[#+2].int {the quantity that \TeX\ minimizes}
-@d unhyphenated=0 {the |type| of a normal active break node}
-@d hyphenated=1 {the |type| of an active node that breaks at a |disc_node|}
-@d last_active==active {the active list ends where it begins}
-
-@ @<Initialize the special list heads...@>=
-type(last_active):=hyphenated; line_number(last_active):=max_halfword;
-subtype(last_active):=0; {the |subtype| is never examined by the algorithm}
-
-@ The passive node for a given breakpoint contains only four fields:
-
-\yskip\hang|link| points to the passive node created just before this one,
-if any, otherwise it is |null|.
-
-\yskip\hang|cur_break| points to the position of this breakpoint in the
-horizontal list for the paragraph being broken.
-
-\yskip\hang|prev_break| points to the passive node that should precede this
-one in an optimal path to this breakpoint.
-
-\yskip\hang|serial| is equal to |n| if this passive node is the |n|th
-one created during the current pass. (This field is used only when
-printing out detailed statistics about the line-breaking calculations.)
-
-\yskip\noindent
-There is a global variable called |passive| that points to the most
-recently created passive node. Another global variable, |printed_node|,
-is used to help print out the paragraph when detailed information about
-the line-breaking computation is being displayed.
-
-@d passive_node_size=2 {number of words in passive nodes}
-@d cur_break==rlink {in passive node, points to position of this breakpoint}
-@d prev_break==llink {points to passive node that should precede this one}
-@d serial==info {serial number for symbolic identification}
-
-@<Glob...@>=
-@!passive:pointer; {most recent node on passive list}
-@!printed_node:pointer; {most recent node that has been printed}
-@!pass_number:halfword; {the number of passive nodes allocated on this pass}
-
-@ The active list also contains ``delta'' nodes that help the algorithm
-compute the badness of individual lines. Such nodes appear only between two
-active nodes, and they have |type=delta_node|. If |p| and |r| are active nodes
-and if |q| is a delta node between them, so that |link(p)=q| and |link(q)=r|,
-then |q| tells the space difference between lines in the horizontal list that
-start after breakpoint |p| and lines that start after breakpoint |r|. In
-other words, if we know the length of the line that starts after |p| and
-ends at our current position, then the corresponding length of the line that
-starts after |r| is obtained by adding the amounts in node~|q|. A delta node
-contains six scaled numbers, since it must record the net change in glue
-stretchability with respect to all orders of infinity. The natural width
-difference appears in |mem[q+1].sc|; the stretch differences in units of
-pt, fil, fill, and filll appear in |mem[q+2..q+5].sc|; and the shrink difference
-appears in |mem[q+6].sc|. The |subtype| field of a delta node is not used.
-
-@d delta_node_size=9 {number of words in a delta node}
-@d delta_node=2 {|type| field in a delta node}
-
-@ As the algorithm runs, it maintains a set of six delta-like registers
-for the length of the line following the first active breakpoint to the
-current position in the given hlist. When it makes a pass through the
-active list, it also maintains a similar set of six registers for the
-length following the active breakpoint of current interest. A third set
-holds the length of an empty line (namely, the sum of \.{\\leftskip} and
-\.{\\rightskip}); and a fourth set is used to create new delta nodes.
-
-When we pass a delta node we want to do operations like
-$$\hbox{\ignorespaces|for
-k:=1 to 6 do cur_active_width[k]:=cur_active_width[k]+mem[q+k].sc|};$$ and we
-want to do this without the overhead of |for| loops. The |do_all_six|
-macro makes such six-tuples convenient.
-
-@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6)
-
-@d do_seven_eight(#) == if pdf_adjust_spacing > 1 then begin #(7);#(8); end
-@d do_all_eight(#) == do_all_six(#); do_seven_eight(#)
-@d do_one_seven_eight(#) == #(1); do_seven_eight(#)
-
-@d total_font_stretch == cur_active_width[7]
-@d total_font_shrink == cur_active_width[8]
-
-@d save_active_width(#) == prev_active_width[#] := active_width[#]
-@d restore_active_width(#) == active_width[#] := prev_active_width[#]
-
-@<Glob...@>=
-@!active_width:array[1..8] of scaled;
- {distance from first active node to~|cur_p|}
-@!cur_active_width:array[1..8] of scaled; {distance from current active node}
-@!background:array[1..8] of scaled; {length of an ``empty'' line}
-@!break_width:array[1..8] of scaled; {length being computed after current break}
-@#
-@!auto_breaking: boolean; {make |auto_breaking| accessible out of |line_break|}
-@!prev_p: pointer; {make |prev_p| accessible out of |line_break|}
-@!first_p: pointer; {to access the first node of the paragraph}
-@!prev_char_p: pointer; {pointer to the previous char of an implicit kern}
-@!next_char_p: pointer; {pointer to the next char of an implicit kern}
-@#
-@!try_prev_break: boolean; {force break at the previous legal breakpoint?}
-@!prev_legal: pointer; {the previous legal breakpoint}
-@!prev_prev_legal: pointer; {to save |prev_p| corresponding to |prev_legal|}
-@!prev_auto_breaking: boolean; {to save |auto_breaking| corresponding to |prev_legal|}
-@!prev_active_width: array[1..8] of scaled; {to save |active_width| corresponding to |prev_legal|}
-@!rejected_cur_p: pointer; {the last |cur_p| that has been rejected}
-@!before_rejected_cur_p: boolean; {|cur_p| is still before |rejected_cur_p|?}
-@#
-@!max_stretch_ratio: integer; {maximal stretch ratio of expanded fonts}
-@!max_shrink_ratio: integer; {maximal shrink ratio of expanded fonts}
-@!cur_font_step: integer; {the current step of expanded fonts}
-
-@ Let's state the principles of the delta nodes more precisely and concisely,
-so that the following programs will be less obscure. For each legal
-breakpoint~|p| in the paragraph, we define two quantities $\alpha(p)$ and
-$\beta(p)$ such that the length of material in a line from breakpoint~|p|
-to breakpoint~|q| is $\gamma+\beta(q)-\alpha(p)$, for some fixed $\gamma$.
-Intuitively, $\alpha(p)$ and $\beta(q)$ are the total length of material from
-the beginning of the paragraph to a point ``after'' a break at |p| and to a
-point ``before'' a break at |q|; and $\gamma$ is the width of an empty line,
-namely the length contributed by \.{\\leftskip} and \.{\\rightskip}.
-
-Suppose, for example, that the paragraph consists entirely of alternating
-boxes and glue skips; let the boxes have widths $x_1\ldots x_n$ and
-let the skips have widths $y_1\ldots y_n$, so that the paragraph can be
-represented by $x_1y_1\ldots x_ny_n$. Let $p_i$ be the legal breakpoint
-at $y_i$; then $\alpha(p_i)=x_1+y_1+\cdots+x_i+y_i$, and $\beta(p_i)=
-x_1+y_1+\cdots+x_i$. To check this, note that the length of material from
-$p_2$ to $p_5$, say, is $\gamma+x_3+y_3+x_4+y_4+x_5=\gamma+\beta(p_5)
--\alpha(p_2)$.
-
-The quantities $\alpha$, $\beta$, $\gamma$ involve glue stretchability and
-shrinkability as well as a natural width. If we were to compute $\alpha(p)$
-and $\beta(p)$ for each |p|, we would need multiple precision arithmetic, and
-the multiprecise numbers would have to be kept in the active nodes.
-\TeX\ avoids this problem by working entirely with relative differences
-or ``deltas.'' Suppose, for example, that the active list contains
-$a_1\,\delta_1\,a_2\,\delta_2\,a_3$, where the |a|'s are active breakpoints
-and the $\delta$'s are delta nodes. Then $\delta_1=\alpha(a_1)-\alpha(a_2)$
-and $\delta_2=\alpha(a_2)-\alpha(a_3)$. If the line breaking algorithm is
-currently positioned at some other breakpoint |p|, the |active_width| array
-contains the value $\gamma+\beta(p)-\alpha(a_1)$. If we are scanning through
-the list of active nodes and considering a tentative line that runs from
-$a_2$ to~|p|, say, the |cur_active_width| array will contain the value
-$\gamma+\beta(p)-\alpha(a_2)$. Thus, when we move from $a_2$ to $a_3$,
-we want to add $\alpha(a_2)-\alpha(a_3)$ to |cur_active_width|; and this
-is just $\delta_2$, which appears in the active list between $a_2$ and
-$a_3$. The |background| array contains $\gamma$. The |break_width| array
-will be used to calculate values of new delta nodes when the active
-list is being updated.
-
-@ Glue nodes in a horizontal list that is being paragraphed are not supposed to
-include ``infinite'' shrinkability; that is why the algorithm maintains
-four registers for stretching but only one for shrinking. If the user tries to
-introduce infinite shrinkability, the shrinkability will be reset to finite
-and an error message will be issued. A boolean variable |no_shrink_error_yet|
-prevents this error message from appearing more than once per paragraph.
-
-@d check_shrinkage(#)==if (shrink_order(#)<>normal)and(shrink(#)<>0) then
- begin #:=finite_shrink(#);
- end
-
-@<Glob...@>=
-@!no_shrink_error_yet:boolean; {have we complained about infinite shrinkage?}
-
-@ @<Declare subprocedures for |line_break|@>=
-function finite_shrink(@!p:pointer):pointer; {recovers from infinite shrinkage}
-var q:pointer; {new glue specification}
-begin if no_shrink_error_yet then
- begin no_shrink_error_yet:=false;
- @!stat if tracing_paragraphs>0 then end_diagnostic(true);@+tats@;
- print_err("Infinite glue shrinkage found in a paragraph");
-@.Infinite glue shrinkage...@>
- help5("The paragraph just ended includes some glue that has")@/
- ("infinite shrinkability, e.g., `\hskip 0pt minus 1fil'.")@/
- ("Such glue doesn't belong there---it allows a paragraph")@/
- ("of any length to fit on one line. But it's safe to proceed,")@/
- ("since the offensive shrinkability has been made finite.");
- error;
- @!stat if tracing_paragraphs>0 then begin_diagnostic;@+tats@;
- end;
-q:=new_spec(p); shrink_order(q):=normal;
-delete_glue_ref(p); finite_shrink:=q;
-end;
-
-@ @<Get ready to start...@>=
-no_shrink_error_yet:=true;@/
-check_shrinkage(left_skip); check_shrinkage(right_skip);@/
-q:=left_skip; r:=right_skip; background[1]:=width(q)+width(r);@/
-background[2]:=0; background[3]:=0; background[4]:=0; background[5]:=0;@/
-background[2+stretch_order(q)]:=stretch(q);@/
-background[2+stretch_order(r)]:=@|background[2+stretch_order(r)]+stretch(r);@/
-background[6]:=shrink(q)+shrink(r);
-if pdf_adjust_spacing > 1 then begin
- background[7] := 0;
- background[8] := 0;
- max_stretch_ratio := -1;
- max_shrink_ratio := -1;
- cur_font_step := -1;
- prev_char_p := null;
-end;
-@<Check for special treatment of last line of paragraph@>;
-
-@ A pointer variable |cur_p| runs through the given horizontal list as we look
-for breakpoints. This variable is global, since it is used both by |line_break|
-and by its subprocedure |try_break|.
-
-Another global variable called |threshold| is used to determine the feasibility
-of individual lines: Breakpoints are feasible if there is a way to reach
-them without creating lines whose badness exceeds |threshold|. (The
-badness is compared to |threshold| before penalties are added, so that
-penalty values do not affect the feasibility of breakpoints, except that
-no break is allowed when the penalty is 10000 or more.) If |threshold|
-is 10000 or more, all legal breaks are considered feasible, since the
-|badness| function specified above never returns a value greater than~10000.
-
-Up to three passes might be made through the paragraph in an attempt to find at
-least one set of feasible breakpoints. On the first pass, we have
-|threshold=pretolerance| and |second_pass=final_pass=false|.
-If this pass fails to find a
-feasible solution, |threshold| is set to |tolerance|, |second_pass| is set
-|true|, and an attempt is made to hyphenate as many words as possible.
-If that fails too, we add |emergency_stretch| to the background
-stretchability and set |final_pass=true|.
-
-@<Glob...@>=
-@!cur_p:pointer; {the current breakpoint under consideration}
-@!second_pass:boolean; {is this our second attempt to break this paragraph?}
-@!final_pass:boolean; {is this our final attempt to break this paragraph?}
-@!threshold:integer; {maximum badness on feasible lines}
-
-@ The heart of the line-breaking procedure is `|try_break|', a subroutine
-that tests if the current breakpoint |cur_p| is feasible, by running
-through the active list to see what lines of text can be made from active
-nodes to~|cur_p|. If feasible breaks are possible, new break nodes are
-created. If |cur_p| is too far from an active node, that node is
-deactivated.
-
-The parameter |pi| to |try_break| is the penalty associated
-with a break at |cur_p|; we have |pi=eject_penalty| if the break is forced,
-and |pi=inf_penalty| if the break is illegal.
-
-The other parameter, |break_type|, is set to |hyphenated| or |unhyphenated|,
-depending on whether or not the current break is at a |disc_node|. The
-end of a paragraph is also regarded as `|hyphenated|'; this case is
-distinguishable by the condition |cur_p=null|.
-
-@d copy_to_cur_active(#)==cur_active_width[#]:=active_width[#]
-@d deactivate=60 {go here when node |r| should be deactivated}
-
-@d cp_skipable(#) == {skipable nodes at the margins during character protrusion}
-(
- not is_char_node(#) and
- (
- (type(#) = ins_node)
- or (type(#) = mark_node)
- or (type(#) = adjust_node)
- or (type(#) = penalty_node)
- or ((type(#) = whatsit_node) and
- (subtype(#) <> pdf_refximage_node) and
- (subtype(#) <> pdf_refxform_node)) {reference to an image or XObject form}
- or ((type(#) = disc_node) and
- (pre_break(#) = null) and
- (post_break(#) = null) and
- (replace_count(#) = 0)) {an empty |disc_node|}
- or ((type(#) = math_node) and (width(#) = 0))
- or ((type(#) = kern_node) and
- ((width(#) = 0) or (subtype(#) = normal)))
- or ((type(#) = glue_node) and (glue_ptr(#) = zero_glue))
- or ((type(#) = hlist_node) and (width(#) = 0) and (height(#) = 0) and
- (depth(#) = 0) and (list_ptr(#) = null))
- )
-)
-
-
-@<Declare subprocedures for |line_break|@>=
-procedure push_node(p: pointer);
-begin
- if hlist_stack_level > max_hlist_stack then
- pdf_error("push_node", "stack overflow");
- hlist_stack[hlist_stack_level] := p;
- hlist_stack_level := hlist_stack_level + 1;
-end;
-
-function pop_node: pointer;
-begin
- hlist_stack_level := hlist_stack_level - 1;
- if hlist_stack_level < 0 then {would point to some bug}
- pdf_error("pop_node", "stack underflow (internal error)");
- pop_node := hlist_stack[hlist_stack_level];
-end;
-
-function find_protchar_left(l: pointer; d: boolean): pointer;
-{searches left to right from list head |l|, returns 1st non-skipable item}
-var t: pointer;
- run: boolean;
-begin
- if (link(l) <> null) and (type(l) = hlist_node) and (width(l) = 0)
- and (height(l) = 0) and (depth(l) = 0) and (list_ptr(l) = null) then
- l := link(l) {for paragraph start with \.{\\parindent = 0pt}}
- else if d then
- while (link(l) <> null) and (not (is_char_node(l) or non_discardable(l))) do
- l := link(l); {std.\ discardables at line break, \TeX book, p 95}
- hlist_stack_level := 0;
- run := true;
- repeat
- t := l;
- while run and (type(l) = hlist_node) and (list_ptr(l) <> null) do begin
- push_node(l);
- l := list_ptr(l);
- end;
- while run and cp_skipable(l) do begin
- while (link(l) = null) and (hlist_stack_level > 0) do begin
- l := pop_node; {don't visit this node again}
- end;
- if link(l) <> null then
- l := link(l)
- else if hlist_stack_level = 0 then run := false
- end;
- until t = l;
- find_protchar_left := l;
-end;
-
-function find_protchar_right(l, r: pointer): pointer;
-{searches right to left from list tail |r| to head |l|, returns 1st non-skipable item}
-var t: pointer;
- run: boolean;
-begin
- find_protchar_right := null;
- if r = null then return;
- hlist_stack_level := 0;
- run := true;
- repeat
- t := r;
- while run and (type(r) = hlist_node) and (list_ptr(r) <> null) do begin
- push_node(l);
- push_node(r);
- l := list_ptr(r);
- r := l;
- while link(r) <> null do
- r := link(r);
- end;
- while run and cp_skipable(r) do begin
- while (r = l) and (hlist_stack_level > 0) do begin
- r := pop_node; {don't visit this node again}
- l := pop_node;
- end;
- if (r <> l) and (r <> null) then
- r := prev_rightmost(l, r)
- else if (r = l) and (hlist_stack_level = 0) then run := false
- end;
- until t = r;
- find_protchar_right := r;
-end;
-
-function total_pw(q, p: pointer): scaled;
-{returns the total width of character protrusion of a line;
-|cur_break(break_node(q))| and |p| is the leftmost resp. rightmost node in the
-horizontal list representing the actual line}
-var l, r: pointer;
- n: integer;
-begin
- if break_node(q) = null then
- l := first_p
- else
- l := cur_break(break_node(q));
- r := prev_rightmost(prev_p, p); {get |link(r)=p|}
- {let's look at the right margin first}
- @{
- short_display_n(r, 2);
- print("&");
- short_display_n(p, 2);
- print_ln;
- @}
- if (p <> null) and (type(p) = disc_node) and (pre_break(p) <> null) then
- {a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break|}
- begin
- r := pre_break(p);
- while link(r) <> null do
- r := link(r);
- end else r := find_protchar_right(l, r);
- {now the left margin}
- @{
- short_display_n(l, 2);
- print_ln;
- breadth_max := 10;
- depth_threshold := 2;
- show_node_list(l);
- print_ln;
- @}
- if (l <> null) and (type(l) = disc_node) then begin
- if post_break(l) <> null then begin
- l := post_break(l); {protrude the first char}
- goto done;
- end else {discard |replace_count(l)| nodes}
- begin
- n := replace_count(l);
- l := link(l);
- while n > 0 do begin
- if link(l) <> null then
- l := link(l);
- decr(n);
- end;
- end;
- end;
- l := find_protchar_left(l, true);
-done:
- total_pw := left_pw(l) + right_pw(r);
-end;
-
-procedure try_break(@!pi:integer;@!break_type:small_number);
-label exit,done,done1,continue,deactivate,found,not_found;
-var r:pointer; {runs through the active list}
-@!margin_kern_stretch: scaled;
-@!margin_kern_shrink: scaled;
-@!lp, rp, cp: pointer;
-@!prev_r:pointer; {stays a step behind |r|}
-@!old_l:halfword; {maximum line number in current equivalence class of lines}
-@!no_break_yet:boolean; {have we found a feasible break at |cur_p|?}
-@<Other local variables for |try_break|@>@;
-begin @<Make sure that |pi| is in the proper range@>;
-no_break_yet:=true; prev_r:=active; old_l:=0;
-do_all_eight(copy_to_cur_active);
-loop@+ begin continue: r:=link(prev_r);
- @<If node |r| is of type |delta_node|, update |cur_active_width|,
- set |prev_r| and |prev_prev_r|, then |goto continue|@>;
- @<If a line number class has ended, create new active nodes for
- the best feasible breaks in that class; then |return|
- if |r=last_active|, otherwise compute the new |line_width|@>;
- @<Consider the demerits for a line from |r| to |cur_p|;
- deactivate node |r| if it should no longer be active;
- then |goto continue| if a line from |r| to |cur_p| is infeasible,
- otherwise record a new feasible break@>;
- end;
-exit: @!stat @<Update the value of |printed_node| for
- symbolic displays@>@+tats@;
-end;
-
-@ @<Other local variables for |try_break|@>=
-@!prev_prev_r:pointer; {a step behind |prev_r|, if |type(prev_r)=delta_node|}
-@!s:pointer; {runs through nodes ahead of |cur_p|}
-@!q:pointer; {points to a new node being created}
-@!v:pointer; {points to a glue specification or a node ahead of |cur_p|}
-@!t:integer; {node count, if |cur_p| is a discretionary node}
-@!f:internal_font_number; {used in character width calculation}
-@!l:halfword; {line number of current active node}
-@!node_r_stays_active:boolean; {should node |r| remain in the active list?}
-@!line_width:scaled; {the current line will be justified to this width}
-@!fit_class:very_loose_fit..tight_fit; {possible fitness class of test line}
-@!b:halfword; {badness of test line}
-@!d:integer; {demerits of test line}
-@!artificial_demerits:boolean; {has |d| been forced to zero?}
-@!save_link:pointer; {temporarily holds value of |link(cur_p)|}
-@!shortfall:scaled; {used in badness calculations}
-
-@ @<Make sure that |pi| is in the proper range@>=
-if abs(pi)>=inf_penalty then
- if pi>0 then return {this breakpoint is inhibited by infinite penalty}
- else pi:=eject_penalty {this breakpoint will be forced}
-
-@ The following code uses the fact that |type(last_active)<>delta_node|.
-
-@d update_width(#)==@|
- cur_active_width[#]:=cur_active_width[#]+mem[r+#].sc
-
-@<If node |r|...@>=
-@^inner loop@>
-if type(r)=delta_node then
- begin do_all_eight(update_width);
- prev_prev_r:=prev_r; prev_r:=r; goto continue;
- end
-
-@ As we consider various ways to end a line at |cur_p|, in a given line number
-class, we keep track of the best total demerits known, in an array with
-one entry for each of the fitness classifications. For example,
-|minimal_demerits[tight_fit]| contains the fewest total demerits of feasible
-line breaks ending at |cur_p| with a |tight_fit| line; |best_place[tight_fit]|
-points to the passive node for the break before~|cur_p| that achieves such
-an optimum; and |best_pl_line[tight_fit]| is the |line_number| field in the
-active node corresponding to |best_place[tight_fit]|. When no feasible break
-sequence is known, the |minimal_demerits| entries will be equal to
-|awful_bad|, which is $2^{30}-1$. Another variable, |minimum_demerits|,
-keeps track of the smallest value in the |minimal_demerits| array.
-
-@d awful_bad==@'7777777777 {more than a billion demerits}
-
-@<Global...@>=
-@!minimal_demerits:array[very_loose_fit..tight_fit] of integer; {best total
- demerits known for current line class and position, given the fitness}
-@!minimum_demerits:integer; {best total demerits known for current line class
- and position}
-@!best_place:array[very_loose_fit..tight_fit] of pointer; {how to achieve
- |minimal_demerits|}
-@!best_pl_line:array[very_loose_fit..tight_fit] of halfword; {corresponding
- line number}
-
-@ @<Get ready to start...@>=
-minimum_demerits:=awful_bad;
-minimal_demerits[tight_fit]:=awful_bad;
-minimal_demerits[decent_fit]:=awful_bad;
-minimal_demerits[loose_fit]:=awful_bad;
-minimal_demerits[very_loose_fit]:=awful_bad;
-
-@ The first part of the following code is part of \TeX's inner loop, so
-we don't want to waste any time. The current active node, namely node |r|,
-contains the line number that will be considered next. At the end of the
-list we have arranged the data structure so that |r=last_active| and
-|line_number(last_active)>old_l|.
-@^inner loop@>
-
-@<If a line number class...@>=
-begin l:=line_number(r);
-if l>old_l then
- begin {now we are no longer in the inner loop}
- if (minimum_demerits<awful_bad)and@|
- ((old_l<>easy_line)or(r=last_active)) then
- @<Create new active nodes for the best feasible breaks
- just found@>;
- if r=last_active then return;
- @<Compute the new line width@>;
- end;
-end
-
-@ It is not necessary to create new active nodes having |minimal_demerits|
-greater than
-|minimum_demerits+abs(adj_demerits)|, since such active nodes will never
-be chosen in the final paragraph breaks. This observation allows us to
-omit a substantial number of feasible breakpoints from further consideration.
-
-@<Create new active nodes...@>=
-begin if no_break_yet then @<Compute the values of |break_width|@>;
-@<Insert a delta node to prepare for breaks at |cur_p|@>;
-if abs(adj_demerits)>=awful_bad-minimum_demerits then
- minimum_demerits:=awful_bad-1
-else minimum_demerits:=minimum_demerits+abs(adj_demerits);
-for fit_class:=very_loose_fit to tight_fit do
- begin if minimal_demerits[fit_class]<=minimum_demerits then
- @<Insert a new active node
- from |best_place[fit_class]| to |cur_p|@>;
- minimal_demerits[fit_class]:=awful_bad;
- end;
-minimum_demerits:=awful_bad;
-@<Insert a delta node to prepare for the next active node@>;
-end
-
-@ When we insert a new active node for a break at |cur_p|, suppose this
-new node is to be placed just before active node |a|; then we essentially
-want to insert `$\delta\,|cur_p|\,\delta^\prime$' before |a|, where
-$\delta=\alpha(a)-\alpha(|cur_p|)$ and $\delta^\prime=\alpha(|cur_p|)-\alpha(a)$
-in the notation explained above. The |cur_active_width| array now holds
-$\gamma+\beta(|cur_p|)-\alpha(a)$; so $\delta$ can be obtained by
-subtracting |cur_active_width| from the quantity $\gamma+\beta(|cur_p|)-
-\alpha(|cur_p|)$. The latter quantity can be regarded as the length of a
-line ``from |cur_p| to |cur_p|''; we call it the |break_width| at |cur_p|.
-
-The |break_width| is usually negative, since it consists of the background
-(which is normally zero) minus the width of nodes following~|cur_p| that are
-eliminated after a break. If, for example, node |cur_p| is a glue node, the
-width of this glue is subtracted from the background; and we also look
-ahead to eliminate all subsequent glue and penalty and kern and math
-nodes, subtracting their widths as well.
-
-Kern nodes do not disappear at a line break unless they are |explicit|.
-
-@d set_break_width_to_background(#)==break_width[#]:=background[#]
-
-@<Compute the values of |break...@>=
-begin no_break_yet:=false; do_all_eight(set_break_width_to_background);
-s:=cur_p;
-if break_type>unhyphenated then if cur_p<>null then
- @<Compute the discretionary |break_width| values@>;
-while s<>null do
- begin if is_char_node(s) then goto done;
- case type(s) of
- glue_node:@<Subtract glue from |break_width|@>;
- penalty_node: do_nothing;
- math_node: break_width[1]:=break_width[1]-width(s);
- kern_node: if subtype(s)<>explicit then goto done
- else break_width[1]:=break_width[1]-width(s);
- othercases goto done
- endcases;@/
- s:=link(s);
- end;
-done: end
-
-@ @<Subtract glue from |break...@>=
-begin v:=glue_ptr(s); break_width[1]:=break_width[1]-width(v);
-break_width[2+stretch_order(v)]:=break_width[2+stretch_order(v)]-stretch(v);
-break_width[6]:=break_width[6]-shrink(v);
-end
-
-@ When |cur_p| is a discretionary break, the length of a line ``from |cur_p| to
-|cur_p|'' has to be defined properly so that the other calculations work out.
-Suppose that the pre-break text at |cur_p| has length $l_0$, the post-break
-text has length $l_1$, and the replacement text has length |l|. Suppose
-also that |q| is the node following the replacement text. Then length of a
-line from |cur_p| to |q| will be computed as $\gamma+\beta(q)-\alpha(|cur_p|)$,
-where $\beta(q)=\beta(|cur_p|)-l_0+l$. The actual length will be the background
-plus $l_1$, so the length from |cur_p| to |cur_p| should be $\gamma+l_0+l_1-l$.
-If the post-break text of the discretionary is empty, a break may also
-discard~|q|; in that unusual case we subtract the length of~|q| and any
-other nodes that will be discarded after the discretionary break.
-
-The value of $l_0$ need not be computed, since |line_break| will put
-it into the global variable |disc_width| before calling |try_break|.
-
-@d reset_disc_width(#) == disc_width[#] := 0
-
-@d add_disc_width_to_break_width(#) ==
- break_width[#] := break_width[#] + disc_width[#]
-
-@d add_disc_width_to_active_width(#) ==
- active_width[#] := active_width[#] + disc_width[#]
-
-@d sub_disc_width_from_active_width(#) ==
- active_width[#] := active_width[#] - disc_width[#]
-
-@d add_char_stretch_end(#) == char_stretch(f, #)
-@d add_char_stretch(#) == # := # + add_char_stretch_end
-
-@d add_char_shrink_end(#) == char_shrink(f, #)
-@d add_char_shrink(#) == # := # + add_char_shrink_end
-
-@d sub_char_stretch_end(#) == char_stretch(f, #)
-@d sub_char_stretch(#) == # := # - sub_char_stretch_end
-
-@d sub_char_shrink_end(#) == char_shrink(f, #)
-@d sub_char_shrink(#) == # := # - sub_char_shrink_end
-
-@d add_kern_stretch_end(#) == kern_stretch(#)
-@d add_kern_stretch(#) == # := # + add_kern_stretch_end
-
-@d add_kern_shrink_end(#) == kern_shrink(#)
-@d add_kern_shrink(#) == # := # + add_kern_shrink_end
-
-@d sub_kern_stretch_end(#) == kern_stretch(#)
-@d sub_kern_stretch(#) == # := # - sub_kern_stretch_end
-
-@d sub_kern_shrink_end(#) == kern_shrink(#)
-@d sub_kern_shrink(#) == # := # - sub_kern_shrink_end
-
-@<Glob...@>=
-@!disc_width: array[1..8] of scaled; {the length of discretionary material preceding a break}
-
-@ @<Compute the discretionary |break...@>=
-begin t:=replace_count(cur_p); v:=cur_p; s:=post_break(cur_p);
-while t>0 do
- begin decr(t); v:=link(v);
- @<Subtract the width of node |v| from |break_width|@>;
- end;
-while s<>null do
- begin @<Add the width of node |s| to |break_width|@>;
- s:=link(s);
- end;
-do_one_seven_eight(add_disc_width_to_break_width);
-if post_break(cur_p)=null then s:=link(v);
- {nodes may be discardable after the break}
-end
-
-@ Replacement texts and discretionary texts are supposed to contain
-only character nodes, kern nodes, ligature nodes, and box or rule nodes.
-
-@<Subtract the width of node |v|...@>=
-if is_char_node(v) then
- begin f:=font(v);
- break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
- if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
- prev_char_p := v;
- sub_char_stretch(break_width[7])(character(v));
- sub_char_shrink(break_width[8])(character(v));
- end;
- end
-else case type(v) of
- ligature_node: begin f:=font(lig_char(v));@/
- break_width[1]:=@|break_width[1]-
- char_width(f)(char_info(f)(character(lig_char(v))));
- if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
- prev_char_p := v;
- sub_char_stretch(break_width[7])(character(lig_char(v)));
- sub_char_shrink(break_width[8])(character(lig_char(v)));
- end;
- end;
- hlist_node,vlist_node,rule_node,kern_node: begin
- break_width[1]:=break_width[1]-width(v);
- if (type(v) = kern_node) and
- (pdf_adjust_spacing > 1) and (subtype(v) = normal)
- then begin
- sub_kern_stretch(break_width[7])(v);
- sub_kern_shrink(break_width[8])(v);
- end;
- end;
- othercases confusion("disc1")
-@:this can't happen disc1}{\quad disc1@>
- endcases
-
-@ @<Add the width of node |s| to |b...@>=
-if is_char_node(s) then
- begin f:=font(s);
- break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
- if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
- prev_char_p := s;
- add_char_stretch(break_width[7])(character(s));
- add_char_shrink(break_width[8])(character(s));
- end;
- end
-else case type(s) of
- ligature_node: begin f:=font(lig_char(s));
- break_width[1]:=break_width[1]+
- char_width(f)(char_info(f)(character(lig_char(s))));
- if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
- prev_char_p := s;
- add_char_stretch(break_width[7])(character(lig_char(s)));
- add_char_shrink(break_width[8])(character(lig_char(s)));
- end;
- end;
- hlist_node,vlist_node,rule_node,kern_node: begin
- break_width[1]:=break_width[1]+width(s);
- if (type(s) = kern_node) and
- (pdf_adjust_spacing > 1) and (subtype(s) = normal)
- then begin
- add_kern_stretch(break_width[7])(s);
- add_kern_shrink(break_width[8])(s);
- end;
- end;
- othercases confusion("disc2")
-@:this can't happen disc2}{\quad disc2@>
- endcases
-
-@ We use the fact that |type(active)<>delta_node|.
-
-@d convert_to_break_width(#)==@|
- mem[prev_r+#].sc:=@|@t\hskip10pt@>mem[prev_r+#].sc
- -cur_active_width[#]+break_width[#]
-@d store_break_width(#)==active_width[#]:=break_width[#]
-@d new_delta_to_break_width(#)==@|
- mem[q+#].sc:=break_width[#]-cur_active_width[#]
-
-@<Insert a delta node to prepare for breaks at |cur_p|@>=
-if type(prev_r)=delta_node then {modify an existing delta node}
- begin do_all_eight(convert_to_break_width);
- end
-else if prev_r=active then {no delta node needed at the beginning}
- begin do_all_eight(store_break_width);
- end
-else begin q:=get_node(delta_node_size); link(q):=r; type(q):=delta_node;@/
- subtype(q):=0; {the |subtype| is not used}
- do_all_eight(new_delta_to_break_width);
- link(prev_r):=q; prev_prev_r:=prev_r; prev_r:=q;
- end
-
-@ When the following code is performed, we will have just inserted at
-least one active node before |r|, so |type(prev_r)<>delta_node|.
-
-@d new_delta_from_break_width(#)==@|mem[q+#].sc:=
- cur_active_width[#]-break_width[#]
-
-@<Insert a delta node to prepare for the next active node@>=
-if r<>last_active then
- begin q:=get_node(delta_node_size); link(q):=r; type(q):=delta_node;@/
- subtype(q):=0; {the |subtype| is not used}
- do_all_eight(new_delta_from_break_width);
- link(prev_r):=q; prev_prev_r:=prev_r; prev_r:=q;
- end
-
-@ When we create an active node, we also create the corresponding
-passive node.
-
-@<Insert a new active node from |best_place[fit_class]| to |cur_p|@>=
-begin q:=get_node(passive_node_size);
-link(q):=passive; passive:=q; cur_break(q):=cur_p;
-@!stat incr(pass_number); serial(q):=pass_number;@+tats@;@/
-prev_break(q):=best_place[fit_class];@/
-q:=get_node(active_node_size); break_node(q):=passive;
-line_number(q):=best_pl_line[fit_class]+1;
-fitness(q):=fit_class; type(q):=break_type;
-total_demerits(q):=minimal_demerits[fit_class];
-if do_last_line_fit then
- @<Store \(a)additional data in the new active node@>;
-link(q):=r; link(prev_r):=q; prev_r:=q;
-@!stat if tracing_paragraphs>0 then
- @<Print a symbolic description of the new break node@>;
-tats@;@/
-end
-
-@ @<Print a symbolic description of the new break node@>=
-begin print_nl("@@@@"); print_int(serial(passive));
-@.\AT!\AT!@>
-print(": line "); print_int(line_number(q)-1);
-print_char("."); print_int(fit_class);
-if break_type=hyphenated then print_char("-");
-print(" t="); print_int(total_demerits(q));
-if do_last_line_fit then @<Print additional data in the new active node@>;
-print(" -> @@@@");
-if prev_break(passive)=null then print_char("0")
-else print_int(serial(prev_break(passive)));
-end
-
-@ The length of lines depends on whether the user has specified
-\.{\\parshape} or \.{\\hangindent}. If |par_shape_ptr| is not null, it
-points to a $(2n+1)$-word record in |mem|, where the |info| in the first
-word contains the value of |n|, and the other $2n$ words contain the left
-margins and line lengths for the first |n| lines of the paragraph; the
-specifications for line |n| apply to all subsequent lines. If
-|par_shape_ptr=null|, the shape of the paragraph depends on the value of
-|n=hang_after|; if |n>=0|, hanging indentation takes place on lines |n+1|,
-|n+2|, \dots, otherwise it takes place on lines 1, \dots, $\vert
-n\vert$. When hanging indentation is active, the left margin is
-|hang_indent|, if |hang_indent>=0|, else it is 0; the line length is
-$|hsize|-\vert|hang_indent|\vert$. The normal setting is
-|par_shape_ptr=null|, |hang_after=1|, and |hang_indent=0|.
-Note that if |hang_indent=0|, the value of |hang_after| is irrelevant.
-@^length of lines@> @^hanging indentation@>
-
-@<Glob...@>=
-@!easy_line:halfword; {line numbers |>easy_line| are equivalent in break nodes}
-@!last_special_line:halfword; {line numbers |>last_special_line| all have
- the same width}
-@!first_width:scaled; {the width of all lines |<=last_special_line|, if
- no \.{\\parshape} has been specified}
-@!second_width:scaled; {the width of all lines |>last_special_line|}
-@!first_indent:scaled; {left margin to go with |first_width|}
-@!second_indent:scaled; {left margin to go with |second_width|}
-
-@ We compute the values of |easy_line| and the other local variables relating
-to line length when the |line_break| procedure is initializing itself.
-
-@<Get ready to start...@>=
-if par_shape_ptr=null then
- if hang_indent=0 then
- begin last_special_line:=0; second_width:=hsize;
- second_indent:=0;
- end
- else @<Set line length parameters in preparation for hanging indentation@>
-else begin last_special_line:=info(par_shape_ptr)-1;
- second_width:=mem[par_shape_ptr+2*(last_special_line+1)].sc;
- second_indent:=mem[par_shape_ptr+2*last_special_line+1].sc;
- end;
-if looseness=0 then easy_line:=last_special_line
-else easy_line:=max_halfword
-
-@ @<Set line length parameters in preparation for hanging indentation@>=
-begin last_special_line:=abs(hang_after);
-if hang_after<0 then
- begin first_width:=hsize-abs(hang_indent);
- if hang_indent>=0 then first_indent:=hang_indent
- else first_indent:=0;
- second_width:=hsize; second_indent:=0;
- end
-else begin first_width:=hsize; first_indent:=0;
- second_width:=hsize-abs(hang_indent);
- if hang_indent>=0 then second_indent:=hang_indent
- else second_indent:=0;
- end;
-end
-
-@ When we come to the following code, we have just encountered the first
-active node~|r| whose |line_number| field contains |l|. Thus we want to
-compute the length of the $l\mskip1mu$th line of the current paragraph. Furthermore,
-we want to set |old_l| to the last number in the class of line numbers
-equivalent to~|l|.
-
-@<Compute the new line width@>=
-if l>easy_line then
- begin line_width:=second_width; old_l:=max_halfword-1;
- end
-else begin old_l:=l;
- if l>last_special_line then line_width:=second_width
- else if par_shape_ptr=null then line_width:=first_width
- else line_width:=mem[par_shape_ptr+2*l@,].sc;
- end
-
-@ The remaining part of |try_break| deals with the calculation of
-demerits for a break from |r| to |cur_p|.
-
-The first thing to do is calculate the badness, |b|. This value will always
-be between zero and |inf_bad+1|; the latter value occurs only in the
-case of lines from |r| to |cur_p| that cannot shrink enough to fit the necessary
-width. In such cases, node |r| will be deactivated.
-We also deactivate node~|r| when a break at~|cur_p| is forced, since future
-breaks must go through a forced break.
-
-@<Consider the demerits for a line from |r| to |cur_p|...@>=
-begin artificial_demerits:=false;@/
-@^inner loop@>
-shortfall:=line_width-cur_active_width[1]; {we're this much too short}
-
-@{
-if pdf_output > 2 then begin
-print_ln;
-if (r <> null) and (break_node(r) <> null) then
- short_display_n(cur_break(break_node(r)), 5);
-print_ln;
-short_display_n(cur_p, 5);
-print_ln;
-end;
-@}
-
-if pdf_protrude_chars > 1 then
- shortfall := shortfall + total_pw(r, cur_p);
-if (pdf_adjust_spacing > 1) and (shortfall <> 0) then begin
- margin_kern_stretch := 0;
- margin_kern_shrink := 0;
- if pdf_protrude_chars > 1 then
- @<Calculate variations of marginal kerns@>;
- if (shortfall > 0) and ((total_font_stretch + margin_kern_stretch) > 0)
- then begin
- if (total_font_stretch + margin_kern_stretch) > shortfall then
- shortfall := ((total_font_stretch + margin_kern_stretch) div
- (max_stretch_ratio div cur_font_step)) div 2
- else
- shortfall := shortfall - (total_font_stretch + margin_kern_stretch);
- end
- else if (shortfall < 0) and ((total_font_shrink + margin_kern_shrink) > 0)
- then begin
- if (total_font_shrink + margin_kern_shrink) > -shortfall then
- shortfall := -((total_font_shrink + margin_kern_shrink) div
- (max_shrink_ratio div cur_font_step)) div 2
- else
- shortfall := shortfall + (total_font_shrink + margin_kern_shrink);
- end;
-end;
-if shortfall>0 then
- @<Set the value of |b| to the badness for stretching the line,
- and compute the corresponding |fit_class|@>
-else @<Set the value of |b| to the badness for shrinking the line,
- and compute the corresponding |fit_class|@>;
-if do_last_line_fit then @<Adjust \(t)the additional data for last line@>;
-found:
-if (b>inf_bad)or(pi=eject_penalty) then
- @<Prepare to deactivate node~|r|, and |goto deactivate| unless
- there is a reason to consider lines of text from |r| to |cur_p|@>
-else begin prev_r:=r;
- if b>threshold then goto continue;
- node_r_stays_active:=true;
- end;
-@<Record a new feasible break@>;
-if node_r_stays_active then goto continue; {|prev_r| has been set to |r|}
-deactivate: @<Deactivate node |r|@>;
-end
-
-@ When a line must stretch, the available stretchability can be found in the
-subarray |cur_active_width[2..5]|, in units of points, fil, fill, and filll.
-
-The present section is part of \TeX's inner loop, and it is most often performed
-when the badness is infinite; therefore it is worth while to make a quick
-test for large width excess and small stretchability, before calling the
-|badness| subroutine.
-@^inner loop@>
-
-@<Set the value of |b| to the badness for stretching...@>=
-if (cur_active_width[3]<>0)or(cur_active_width[4]<>0)or@|
- (cur_active_width[5]<>0) then
- begin if do_last_line_fit then
- begin if cur_p=null then {the last line of a paragraph}
- @<Perform computations for last line and |goto found|@>;
- shortfall:=0;
- end;
- b:=0; fit_class:=decent_fit; {infinite stretch}
- end
-else begin if shortfall>7230584 then if cur_active_width[2]<1663497 then
- begin b:=inf_bad; fit_class:=very_loose_fit; goto done1;
- end;
- b:=badness(shortfall,cur_active_width[2]);
- if b>12 then
- if b>99 then fit_class:=very_loose_fit
- else fit_class:=loose_fit
- else fit_class:=decent_fit;
- done1:
- end
-
-@ Shrinkability is never infinite in a paragraph;
-we can shrink the line from |r| to |cur_p| by at most |cur_active_width[6]|.
-
-@<Set the value of |b| to the badness for shrinking...@>=
-begin if -shortfall>cur_active_width[6] then b:=inf_bad+1
-else b:=badness(-shortfall,cur_active_width[6]);
-if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit;
-end
-
-@ During the final pass, we dare not lose all active nodes, lest we lose
-touch with the line breaks already found. The code shown here makes sure
-that such a catastrophe does not happen, by permitting overfull boxes as
-a last resort. This particular part of \TeX\ was a source of several subtle
-bugs before the correct program logic was finally discovered; readers
-who seek to ``improve'' \TeX\ should therefore think thrice before daring
-to make any changes here.
-@^overfull boxes@>
-
-@<Prepare to deactivate node~|r|, and |goto deactivate| unless...@>=
-begin if final_pass and (minimum_demerits=awful_bad) and@|
- (link(r)=last_active) and
- (prev_r=active) then
- artificial_demerits:=true {set demerits zero, this break is forced}
-else if b>threshold then goto deactivate;
-node_r_stays_active:=false;
-end
-
-@ When we get to this part of the code, the line from |r| to |cur_p| is
-feasible, its badness is~|b|, and its fitness classification is |fit_class|.
-We don't want to make an active node for this break yet, but we will
-compute the total demerits and record them in the |minimal_demerits| array,
-if such a break is the current champion among all ways to get to |cur_p|
-in a given line-number class and fitness class.
-
-@<Record a new feasible break@>=
-if artificial_demerits then d:=0
-else @<Compute the demerits, |d|, from |r| to |cur_p|@>;
-@!stat if tracing_paragraphs>0 then
- @<Print a symbolic description of this feasible break@>;
-tats@;@/
-d:=d+total_demerits(r); {this is the minimum total demerits
- from the beginning to |cur_p| via |r|}
-if d<=minimal_demerits[fit_class] then
- begin minimal_demerits[fit_class]:=d;
- best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
- if do_last_line_fit then
- @<Store \(a)additional data for this feasible break@>;
- if d<minimum_demerits then minimum_demerits:=d;
- end
-
-@ @<Print a symbolic description of this feasible break@>=
-begin if printed_node<>cur_p then
- @<Print the list between |printed_node| and |cur_p|,
- then set |printed_node:=cur_p|@>;
-print_nl("@@");
-@.\AT!@>
-if cur_p=null then print_esc("par")
-else if type(cur_p)<>glue_node then
- begin if type(cur_p)=penalty_node then print_esc("penalty")
- else if type(cur_p)=disc_node then print_esc("discretionary")
- else if type(cur_p)=kern_node then print_esc("kern")
- else print_esc("math");
- end;
-print(" via @@@@");
-if break_node(r)=null then print_char("0")
-else print_int(serial(break_node(r)));
-print(" b=");
-if b>inf_bad then print_char("*")@+else print_int(b);
-@.*\relax@>
-print(" p="); print_int(pi); print(" d=");
-if artificial_demerits then print_char("*")@+else print_int(d);
-end
-
-@ @<Print the list between |printed_node| and |cur_p|...@>=
-begin print_nl("");
-if cur_p=null then short_display(link(printed_node))
-else begin save_link:=link(cur_p);
- link(cur_p):=null; print_nl(""); short_display(link(printed_node));
- link(cur_p):=save_link;
- end;
-printed_node:=cur_p;
-end
-
-@ When the data for a discretionary break is being displayed, we will have
-printed the |pre_break| and |post_break| lists; we want to skip over the
-third list, so that the discretionary data will not appear twice. The
-following code is performed at the very end of |try_break|.
-
-@<Update the value of |printed_node|...@>=
-if cur_p=printed_node then if cur_p<>null then if type(cur_p)=disc_node then
- begin t:=replace_count(cur_p);
- while t>0 do
- begin decr(t); printed_node:=link(printed_node);
- end;
- end
-
-@ @<Compute the demerits, |d|, from |r| to |cur_p|@>=
-begin d:=line_penalty+b;
-if abs(d)>=10000 then d:=100000000@+else d:=d*d;
-if pi<>0 then
- if pi>0 then d:=d+pi*pi
- else if pi>eject_penalty then d:=d-pi*pi;
-if (break_type=hyphenated)and(type(r)=hyphenated) then
- if cur_p<>null then d:=d+double_hyphen_demerits
- else d:=d+final_hyphen_demerits;
-if abs(fit_class-fitness(r))>1 then d:=d+adj_demerits;
-end
-
-@ When an active node disappears, we must delete an adjacent delta node if the
-active node was at the beginning or the end of the active list, or if it
-was surrounded by delta nodes. We also must preserve the property that
-|cur_active_width| represents the length of material from |link(prev_r)|
-to~|cur_p|.
-
-@d combine_two_deltas(#)==@|mem[prev_r+#].sc:=mem[prev_r+#].sc+mem[r+#].sc
-@d downdate_width(#)==@|cur_active_width[#]:=cur_active_width[#]-
- mem[prev_r+#].sc
-
-@<Deactivate node |r|@>=
-link(prev_r):=link(r); free_node(r,active_node_size);
-if prev_r=active then @<Update the active widths, since the first active
- node has been deleted@>
-else if type(prev_r)=delta_node then
- begin r:=link(prev_r);
- if r=last_active then
- begin do_all_eight(downdate_width);
- link(prev_prev_r):=last_active;
- free_node(prev_r,delta_node_size); prev_r:=prev_prev_r;
- end
- else if type(r)=delta_node then
- begin do_all_eight(update_width);
- do_all_eight(combine_two_deltas);
- link(prev_r):=link(r); free_node(r,delta_node_size);
- end;
- end
-
-@ The following code uses the fact that |type(last_active)<>delta_node|. If the
-active list has just become empty, we do not need to update the
-|active_width| array, since it will be initialized when an active
-node is next inserted.
-
-@d update_active(#)==active_width[#]:=active_width[#]+mem[r+#].sc
-
-@<Update the active widths,...@>=
-begin r:=link(active);
-if type(r)=delta_node then
- begin do_all_eight(update_active);
- do_all_eight(copy_to_cur_active);
- link(active):=link(r); free_node(r,delta_node_size);
- end;
-end
-
-@* \[39] Breaking paragraphs into lines, continued.
-So far we have gotten a little way into the |line_break| routine, having
-covered its important |try_break| subroutine. Now let's consider the
-rest of the process.
-
-The main loop of |line_break| traverses the given hlist,
-starting at |link(temp_head)|, and calls |try_break| at each legal
-breakpoint. A variable called |auto_breaking| is set to true except
-within math formulas, since glue nodes are not legal breakpoints when
-they appear in formulas.
-
-The current node of interest in the hlist is pointed to by |cur_p|. Another
-variable, |prev_p|, is usually one step behind |cur_p|, but the real
-meaning of |prev_p| is this: If |type(cur_p)=glue_node| then |cur_p| is a legal
-breakpoint if and only if |auto_breaking| is true and |prev_p| does not
-point to a glue node, penalty node, explicit kern node, or math node.
-
-The following declarations provide for a few other local variables that are
-used in special calculations.
-
-@<Local variables for line breaking@>=
-@!q,@!r,@!s,@!prev_s:pointer; {miscellaneous nodes of temporary interest}
-@!f:internal_font_number; {used when calculating character widths}
-
-@ The `\ignorespaces|loop|\unskip' in the following code is performed at most
-thrice per call of |line_break|, since it is actually a pass over the
-entire paragraph.
-
-@<Find optimal breakpoints@>=
-threshold:=pretolerance;
-if threshold>=0 then
- begin @!stat if tracing_paragraphs>0 then
- begin begin_diagnostic; print_nl("@@firstpass");@+end;@;@+tats@;@/
- second_pass:=false; final_pass:=false;
- end
-else begin threshold:=tolerance; second_pass:=true;
- final_pass:=(emergency_stretch<=0);
- @!stat if tracing_paragraphs>0 then begin_diagnostic;@+tats@;
- end;
-loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
- if second_pass then @<Initialize for hyphenating a paragraph@>;
- @<Create an active breakpoint representing the beginning of the paragraph@>;
- cur_p:=link(temp_head); auto_breaking:=true;@/
- prev_p:=cur_p; {glue at beginning is not a legal breakpoint}
- prev_char_p := null;
- prev_legal := null;
- rejected_cur_p := null;
- try_prev_break := false;
- before_rejected_cur_p := false;
- first_p := cur_p; {to access the first node of paragraph as the first active
- node has |break_node=null|}
- while (cur_p<>null)and(link(active)<>last_active) do
- @<Call |try_break| if |cur_p| is a legal breakpoint;
- on the second pass, also try to hyphenate the next
- word, if |cur_p| is a glue node;
- then advance |cur_p| to the next node of the paragraph
- that could possibly be a legal breakpoint@>;
- if cur_p=null then
- @<Try the final line break at the end of the paragraph,
- and |goto done| if the desired breakpoints have been found@>;
- @<Clean up the memory by removing the break nodes@>;
- if not second_pass then
- begin@!stat if tracing_paragraphs>0 then print_nl("@@secondpass");@;@+tats@/
- threshold:=tolerance; second_pass:=true; final_pass:=(emergency_stretch<=0);
- end {if at first you don't succeed, \dots}
- else begin @!stat if tracing_paragraphs>0 then
- print_nl("@@emergencypass");@;@+tats@/
- background[2]:=background[2]+emergency_stretch; final_pass:=true;
- end;
- end;
-done: @!stat if tracing_paragraphs>0 then
- begin end_diagnostic(true); normalize_selector;
- end;@+tats@/
-if do_last_line_fit then @<Adjust \(t)the final line of the paragraph@>;
-
-@ The active node that represents the starting point does not need a
-corresponding passive node.
-
-@d store_background(#)==active_width[#]:=background[#]
-
-@<Create an active breakpoint representing the beginning of the paragraph@>=
-q:=get_node(active_node_size);
-type(q):=unhyphenated; fitness(q):=decent_fit;
-link(q):=last_active; break_node(q):=null;
-line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
-if do_last_line_fit then
- @<Initialize additional fields of the first active node@>;
-do_all_eight(store_background);@/
-passive:=null; printed_node:=temp_head; pass_number:=0;
-font_in_short_display:=null_font
-
-@ @<Clean...@>=
-q:=link(active);
-while q<>last_active do
- begin cur_p:=link(q);
- if type(q)=delta_node then free_node(q,delta_node_size)
- else free_node(q,active_node_size);
- q:=cur_p;
- end;
-q:=passive;
-while q<>null do
- begin cur_p:=link(q);
- free_node(q,passive_node_size);
- q:=cur_p;
- end
-
-@ Here is the main switch in the |line_break| routine, where legal breaks
-are determined. As we move through the hlist, we need to keep the |active_width|
-array up to date, so that the badness of individual lines is readily calculated
-by |try_break|. It is convenient to use the short name |act_width| for
-the component of active width that represents real width as opposed to glue.
-
-@d act_width==active_width[1] {length from first active node to current node}
-@d kern_break==begin if not is_char_node(link(cur_p)) and auto_breaking then
- if type(link(cur_p))=glue_node then try_break(0,unhyphenated);
- act_width:=act_width+width(cur_p);
- end
-
-@<Call |try_break| if |cur_p| is a legal breakpoint...@>=
-begin if is_char_node(cur_p) then
- @<Advance \(c)|cur_p| to the node following the present
- string of characters@>;
-case type(cur_p) of
-hlist_node,vlist_node,rule_node: act_width:=act_width+width(cur_p);
-whatsit_node: @<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>;
-glue_node: begin @<If node |cur_p| is a legal breakpoint, call |try_break|;
- then update the active widths by including the glue in |glue_ptr(cur_p)|@>;
- if second_pass and auto_breaking then
- @<Try to hyphenate the following word@>;
- end;
-kern_node: if subtype(cur_p)=explicit then kern_break
- else begin
- act_width:=act_width+width(cur_p);
- if (pdf_adjust_spacing > 1) and (subtype(cur_p) = normal) then begin
- add_kern_stretch(active_width[7])(cur_p);
- add_kern_shrink(active_width[8])(cur_p);
- end;
- end;
-ligature_node: begin f:=font(lig_char(cur_p));
- act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
- if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
- prev_char_p := cur_p;
- add_char_stretch(active_width[7])(character(lig_char(cur_p)));
- add_char_shrink(active_width[8])(character(lig_char(cur_p)));
- end;
- end;
-disc_node: @<Try to break after a discretionary fragment, then |goto done5|@>;
-math_node: begin if subtype(cur_p)<L_code then auto_breaking:=odd(subtype(cur_p));
- kern_break;
- end;
-penalty_node: try_break(penalty(cur_p),unhyphenated);
-mark_node,ins_node,adjust_node: do_nothing;
-othercases confusion("paragraph")
-@:this can't happen paragraph}{\quad paragraph@>
-endcases;@/
-prev_p:=cur_p; cur_p:=link(cur_p);
-done5:end
-
-@ The code that passes over the characters of words in a paragraph is
-part of \TeX's inner loop, so it has been streamlined for speed. We use
-the fact that `\.{\\parfillskip}' glue appears at the end of each paragraph;
-it is therefore unnecessary to check if |link(cur_p)=null| when |cur_p| is a
-character node.
-@^inner loop@>
-
-@<Advance \(c)|cur_p| to the node following the present string...@>=
-begin prev_p:=cur_p;
-repeat f:=font(cur_p);
-act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
-if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
- prev_char_p := cur_p;
- add_char_stretch(active_width[7])(character(cur_p));
- add_char_shrink(active_width[8])(character(cur_p));
-end;
-cur_p:=link(cur_p);
-until not is_char_node(cur_p);
-end
-
-@ When node |cur_p| is a glue node, we look at |prev_p| to see whether or not
-a breakpoint is legal at |cur_p|, as explained above.
-
-@<If node |cur_p| is a legal breakpoint, call...@>=
-if auto_breaking then
- begin if is_char_node(prev_p) then try_break(0,unhyphenated)
- else if precedes_break(prev_p) then try_break(0,unhyphenated)
- else if (type(prev_p)=kern_node)and(subtype(prev_p)<>explicit) then
- try_break(0,unhyphenated);
- end;
-check_shrinkage(glue_ptr(cur_p)); q:=glue_ptr(cur_p);
-act_width:=act_width+width(q);@|
-active_width[2+stretch_order(q)]:=@|
- active_width[2+stretch_order(q)]+stretch(q);@/
-active_width[6]:=active_width[6]+shrink(q)
-
-@ The following code knows that discretionary texts contain
-only character nodes, kern nodes, box nodes, rule nodes, and ligature nodes.
-
-@<Try to break after a discretionary fragment...@>=
-begin s:=pre_break(cur_p);
-do_one_seven_eight(reset_disc_width);
-if s=null then try_break(ex_hyphen_penalty,hyphenated)
-else begin repeat @<Add the width of node |s| to |disc_width|@>;
- s:=link(s);
- until s=null;
- do_one_seven_eight(add_disc_width_to_active_width);
- try_break(hyphen_penalty,hyphenated);
- do_one_seven_eight(sub_disc_width_from_active_width);
- end;
-r:=replace_count(cur_p); s:=link(cur_p);
-while r>0 do
- begin @<Add the width of node |s| to |act_width|@>;
- decr(r); s:=link(s);
- end;
-prev_p:=cur_p; cur_p:=s; goto done5;
-end
-
-@ @<Add the width of node |s| to |disc_width|@>=
-if is_char_node(s) then
- begin f:=font(s);
- disc_width[1]:=disc_width[1]+char_width(f)(char_info(f)(character(s)));
- if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
- prev_char_p := s;
- add_char_stretch(disc_width[7])(character(s));
- add_char_shrink(disc_width[8])(character(s));
- end;
- end
-else case type(s) of
- ligature_node: begin f:=font(lig_char(s));
- disc_width[1]:=disc_width[1]+
- char_width(f)(char_info(f)(character(lig_char(s))));
- if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
- prev_char_p := s;
- add_char_stretch(disc_width[7])(character(lig_char(s)));
- add_char_shrink(disc_width[8])(character(lig_char(s)));
- end;
- end;
- hlist_node,vlist_node,rule_node,kern_node: begin
- disc_width[1]:=disc_width[1]+width(s);
- if (type(s) = kern_node) and
- (pdf_adjust_spacing > 1) and (subtype(s) = normal)
- then begin
- add_kern_stretch(disc_width[7])(s);
- add_kern_shrink(disc_width[8])(s);
- end;
- end;
- othercases confusion("disc3")
-@:this can't happen disc3}{\quad disc3@>
- endcases
-
-@ @<Add the width of node |s| to |act_width|@>=
-if is_char_node(s) then
- begin f:=font(s);
- act_width:=act_width+char_width(f)(char_info(f)(character(s)));
- if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
- prev_char_p := s;
- add_char_stretch(active_width[7])(character(s));
- add_char_shrink(active_width[8])(character(s));
- end;
- end
-else case type(s) of
- ligature_node: begin f:=font(lig_char(s));
- act_width:=act_width+
- char_width(f)(char_info(f)(character(lig_char(s))));
- if (pdf_adjust_spacing > 1) and check_expand_pars(f) then begin
- prev_char_p := s;
- add_char_stretch(active_width[7])(character(lig_char(s)));
- add_char_shrink(active_width[8])(character(lig_char(s)));
- end;
- end;
- hlist_node,vlist_node,rule_node,kern_node: begin
- act_width:=act_width+width(s);
- if (type(s) = kern_node) and
- (pdf_adjust_spacing > 1) and (subtype(s) = normal)
- then begin
- add_kern_stretch(active_width[7])(s);
- add_kern_shrink(active_width[8])(s);
- end;
- end;
- othercases confusion("disc4")
-@:this can't happen disc4}{\quad disc4@>
- endcases
-
-@ The forced line break at the paragraph's end will reduce the list of
-breakpoints so that all active nodes represent breaks at |cur_p=null|.
-On the first pass, we insist on finding an active node that has the
-correct ``looseness.'' On the final pass, there will be at least one active
-node, and we will match the desired looseness as well as we can.
-
-The global variable |best_bet| will be set to the active node for the best
-way to break the paragraph, and a few other variables are used to
-help determine what is best.
-
-@<Glob...@>=
-@!best_bet:pointer; {use this passive node and its predecessors}
-@!fewest_demerits:integer; {the demerits associated with |best_bet|}
-@!best_line:halfword; {line number following the last line of the new paragraph}
-@!actual_looseness:integer; {the difference between |line_number(best_bet)|
- and the optimum |best_line|}
-@!line_diff:integer; {the difference between the current line number and
- the optimum |best_line|}
-
-@ @<Try the final line break at the end of the paragraph...@>=
-begin try_break(eject_penalty,hyphenated);
-if link(active)<>last_active then
- begin @<Find an active node with fewest demerits@>;
- if looseness=0 then goto done;
- @<Find the best active node for the desired looseness@>;
- if (actual_looseness=looseness)or final_pass then goto done;
- end;
-end
-
-@ @<Find an active node...@>=
-r:=link(active); fewest_demerits:=awful_bad;
-repeat if type(r)<>delta_node then if total_demerits(r)<fewest_demerits then
- begin fewest_demerits:=total_demerits(r); best_bet:=r;
- end;
-r:=link(r);
-until r=last_active;
-best_line:=line_number(best_bet)
-
-@ The adjustment for a desired looseness is a slightly more complicated
-version of the loop just considered. Note that if a paragraph is broken
-into segments by displayed equations, each segment will be subject to the
-looseness calculation, independently of the other segments.
-
-@<Find the best active node...@>=
-begin r:=link(active); actual_looseness:=0;
-repeat if type(r)<>delta_node then
- begin line_diff:=line_number(r)-best_line;
- if ((line_diff<actual_looseness)and(looseness<=line_diff))or@|
- ((line_diff>actual_looseness)and(looseness>=line_diff)) then
- begin best_bet:=r; actual_looseness:=line_diff;
- fewest_demerits:=total_demerits(r);
- end
- else if (line_diff=actual_looseness)and@|
- (total_demerits(r)<fewest_demerits) then
- begin best_bet:=r; fewest_demerits:=total_demerits(r);
- end;
- end;
-r:=link(r);
-until r=last_active;
-best_line:=line_number(best_bet);
-end
-
-@ Once the best sequence of breakpoints has been found (hurray), we call on the
-procedure |post_line_break| to finish the remainder of the work.
-(By introducing this subprocedure, we are able to keep |line_break|
-from getting extremely long.)
-
-@<Break the paragraph at the chosen...@>=
-post_line_break(d)
-
-@ The total number of lines that will be set by |post_line_break|
-is |best_line-prev_graf-1|. The last breakpoint is specified by
-|break_node(best_bet)|, and this passive node points to the other breakpoints
-via the |prev_break| links. The finishing-up phase starts by linking the
-relevant passive nodes in forward order, changing |prev_break| to
-|next_break|. (The |next_break| fields actually reside in the same memory
-space as the |prev_break| fields did, but we give them a new name because
-of their new significance.) Then the lines are justified, one by one.
-
-@d next_break==prev_break {new name for |prev_break| after links are reversed}
-
-@<Declare subprocedures for |line_break|@>=
-procedure post_line_break(@!d:boolean);
-label done,done1;
-var q,@!r,@!s:pointer; {temporary registers for list manipulation}
- p, k: pointer;
- w: scaled;
- glue_break: boolean; {was a break at glue?}
- ptmp: pointer;
-@!disc_break:boolean; {was the current break at a discretionary node?}
-@!post_disc_break:boolean; {and did it have a nonempty post-break part?}
-@!cur_width:scaled; {width of line number |cur_line|}
-@!cur_indent:scaled; {left margin of line number |cur_line|}
-@!t:quarterword; {used for replacement counts in discretionary nodes}
-@!pen:integer; {use when calculating penalties between lines}
-@!cur_line: halfword; {the current line number being justified}
-@!LR_ptr:pointer; {stack of LR codes}
-begin LR_ptr:=LR_save;
-@<Reverse the links of the relevant passive nodes, setting |cur_p| to the
- first breakpoint@>;
-cur_line:=prev_graf+1;
-repeat @<Justify the line ending at breakpoint |cur_p|, and append it to the
- current vertical list, together with associated penalties and other
- insertions@>;
-incr(cur_line); cur_p:=next_break(cur_p);
-if cur_p<>null then if not post_disc_break then
- @<Prune unwanted nodes at the beginning of the next line@>;
-until cur_p=null;
-if (cur_line<>best_line)or(link(temp_head)<>null) then
- confusion("line breaking");
-@:this can't happen line breaking}{\quad line breaking@>
-prev_graf:=best_line-1;
-LR_save:=LR_ptr;
-end;
-
-@ The job of reversing links in a list is conveniently regarded as the job
-of taking items off one stack and putting them on another. In this case we
-take them off a stack pointed to by |q| and having |prev_break| fields;
-we put them on a stack pointed to by |cur_p| and having |next_break| fields.
-Node |r| is the passive node being moved from stack to stack.
-
-@<Reverse the links of the relevant passive nodes...@>=
-q:=break_node(best_bet); cur_p:=null;
-repeat r:=q; q:=prev_break(q); next_break(r):=cur_p; cur_p:=r;
-until q=null
-
-@ Glue and penalty and kern and math nodes are deleted at the beginning of
-a line, except in the anomalous case that the node to be deleted is actually
-one of the chosen breakpoints. Otherwise
-the pruning done here is designed to match
-the lookahead computation in |try_break|, where the |break_width| values
-are computed for non-discretionary breakpoints.
-
-@<Prune unwanted nodes at the beginning of the next line@>=
-begin r:=temp_head;
-loop@+ begin q:=link(r);
- if q=cur_break(cur_p) then goto done1;
- {|cur_break(cur_p)| is the next breakpoint}
- {now |q| cannot be |null|}
- if is_char_node(q) then goto done1;
- if non_discardable(q) then goto done1;
- if type(q)=kern_node then if subtype(q)<>explicit then goto done1;
- r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node|, or |penalty_node|}
- if type(q)=math_node then if TeXXeT_en then
- @<Adjust \(t)the LR stack for the |post_line_break| routine@>;
- end;
-done1: if r<>temp_head then
- begin link(r):=null; flush_node_list(link(temp_head));
- link(temp_head):=q;
- end;
-end
-
-@ The current line to be justified appears in a horizontal list starting
-at |link(temp_head)| and ending at |cur_break(cur_p)|. If |cur_break(cur_p)| is
-a glue node, we reset the glue to equal the |right_skip| glue; otherwise
-we append the |right_skip| glue at the right. If |cur_break(cur_p)| is a
-discretionary node, we modify the list so that the discretionary break
-is compulsory, and we set |disc_break| to |true|. We also append
-the |left_skip| glue at the left of the line, unless it is zero.
-
-@<Justify the line ending at breakpoint |cur_p|, and append it...@>=
-if TeXXeT_en then
- @<Insert LR nodes at the beginning of the current line and adjust
- the LR stack based on LR nodes in this line@>;
-@<Modify the end of the line to reflect the nature of the break and to include
- \.{\\rightskip}; also set the proper value of |disc_break|@>;
-if TeXXeT_en then @<Insert LR nodes at the end of the current line@>;
-@<Put the \(l)\.{\\leftskip} glue at the left and detach this line@>;
-@<Call the packaging subroutine, setting |just_box| to the justified box@>;
-@<Append the new box to the current vertical list, followed by the list of
- special nodes taken out of the box by the packager@>;
-@<Append a penalty node, if a nonzero penalty is appropriate@>
-
-@ At the end of the following code, |q| will point to the final node on the
-list about to be justified.
-
-@<Modify the end of the line...@>=
-q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
-glue_break := false;
-if q<>null then {|q| cannot be a |char_node|}
- if type(q)=glue_node then
- begin delete_glue_ref(glue_ptr(q));
- glue_ptr(q):=right_skip;
- subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
- glue_break := true;
- goto done;
- end
- else begin if type(q)=disc_node then
- @<Change discretionary to compulsory and set
- |disc_break:=true|@>
- else if type(q)=kern_node then width(q):=0
- else if type(q)=math_node then
- begin width(q):=0;
- if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>;
- end;
- end
-else begin q:=temp_head;
- while link(q)<>null do q:=link(q);
- end;
-done:
-
-{at this point |q| is the rightmost breakpoint; the only exception is the case
-of a discretionary break with non-empty |pre_break|, then |q| has been changed
-to the last node of the |pre_break| list}
-
-if pdf_protrude_chars > 0 then begin
- if disc_break and (is_char_node(q) or (type(q) <> disc_node))
- {|q| has been reset to the last node of |pre_break|}
- then begin
- p := q;
- ptmp := p;
- end else begin
- p := prev_rightmost(link(temp_head), q); {get |link(p) = q|}
- ptmp := p;
- p := find_protchar_right(link(temp_head), p);
- end;
- @{
- short_display_n(p, 1);
- print_ln;
- @}
- w := right_pw(p);
- if w <> 0 then {we have found a marginal kern, append it after |ptmp|}
- begin
- k := new_margin_kern(-w, last_rightmost_char, right_side);
- link(k) := link(ptmp);
- link(ptmp) := k;
- if (ptmp = q) then
- q := link(q);
- end;
-end;
-
-{if |q| was not a breakpoint at glue and has been reset to |rightskip| then
- we append |rightskip| after |q| now}
-if not glue_break then begin
- @<Put the \(r)\.{\\rightskip} glue after node |q|@>;
-end;
-
-@ @<Change discretionary to compulsory...@>=
-begin t:=replace_count(q);
-@<Destroy the |t| nodes following |q|, and
- make |r| point to the following node@>;
-if post_break(q)<>null then @<Transplant the post-break list@>;
-if pre_break(q)<>null then @<Transplant the pre-break list@>;
-link(q):=r; disc_break:=true;
-end
-
-@ @<Destroy the |t| nodes following |q|...@>=
-if t=0 then r:=link(q)
-else begin r:=q;
- while t>1 do
- begin r:=link(r); decr(t);
- end;
- s:=link(r);
- r:=link(s); link(s):=null;
- flush_node_list(link(q)); replace_count(q):=0;
- end
-
-@ We move the post-break list from inside node |q| to the main list by
-re\-attaching it just before the present node |r|, then resetting |r|.
-
-@<Transplant the post-break list@>=
-begin s:=post_break(q);
-while link(s)<>null do s:=link(s);
-link(s):=r; r:=post_break(q); post_break(q):=null; post_disc_break:=true;
-end
-
-@ We move the pre-break list from inside node |q| to the main list by
-re\-attaching it just after the present node |q|, then resetting |q|.
-
-@<Transplant the pre-break list@>=
-begin s:=pre_break(q); link(q):=s;
-while link(s)<>null do s:=link(s);
-pre_break(q):=null; q:=s;
-end
-
-@ @<Put the \(r)\.{\\rightskip} glue after node |q|@>=
-r:=new_param_glue(right_skip_code); link(r):=link(q); link(q):=r; q:=r
-
-@ The following code begins with |q| at the end of the list to be
-justified. It ends with |q| at the beginning of that list, and with
-|link(temp_head)| pointing to the remainder of the paragraph, if any.
-
-@<Put the \(l)\.{\\leftskip} glue at the left...@>=
-r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
-{at this point |q| is the leftmost node; all discardable nodes have been discarded}
-if pdf_protrude_chars > 0 then begin
- p := q;
- p := find_protchar_left(p, false); {no more discardables}
- w := left_pw(p);
- if w <> 0 then begin
- k := new_margin_kern(-w, last_leftmost_char, left_side);
- link(k) := q;
- q := k;
- end;
-end;
-if left_skip<>zero_glue then
- begin r:=new_param_glue(left_skip_code);
- link(r):=q; q:=r;
- end
-
-@ @<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;
-
-@ @<Append the new box to the current vertical list...@>=
-if pdf_each_line_height <> pdf_ignored_dimen then
- height(just_box) := pdf_each_line_height;
-if pdf_each_line_depth <> pdf_ignored_dimen then
- depth(just_box) := pdf_each_line_depth;
-if (pdf_first_line_height <> pdf_ignored_dimen) and (cur_line = prev_graf + 1) then
- height(just_box) := pdf_first_line_height;
-if (pdf_last_line_depth <> pdf_ignored_dimen) and (cur_line + 1 = best_line) then
- depth(just_box) := pdf_last_line_depth;
-if pre_adjust_head <> pre_adjust_tail then
- append_list(pre_adjust_head)(pre_adjust_tail);
-pre_adjust_tail := null;
-append_to_vlist(just_box);
-if adjust_head <> adjust_tail then
- append_list(adjust_head)(adjust_tail);
-adjust_tail := null
-
-@ Now |q| points to the hlist that represents the current line of the
-paragraph. We need to compute the appropriate line width, pack the
-line into a box of this size, and shift the box by the appropriate
-amount of indentation.
-
-@<Call the packaging subroutine...@>=
-if cur_line>last_special_line then
- begin cur_width:=second_width; cur_indent:=second_indent;
- end
-else if par_shape_ptr=null then
- begin cur_width:=first_width; cur_indent:=first_indent;
- end
-else begin cur_width:=mem[par_shape_ptr+2*cur_line].sc;
- cur_indent:=mem[par_shape_ptr+2*cur_line-1].sc;
- end;
-adjust_tail:=adjust_head;
-pre_adjust_tail := pre_adjust_head;
-if pdf_adjust_spacing > 0 then
- just_box := hpack(q, cur_width, cal_expand_ratio)
-else
- just_box := hpack(q, cur_width, exactly);
-shift_amount(just_box):=cur_indent
-
-@ Penalties between the lines of a paragraph come from club and widow lines,
-from the |inter_line_penalty| parameter, and from lines that end at
-discretionary breaks. Breaking between lines of a two-line paragraph gets
-both club-line and widow-line penalties. The local variable |pen| will
-be set to the sum of all relevant penalties for the current line, except
-that the final line is never penalized.
-
-@<Append a penalty node, if a nonzero penalty is appropriate@>=
-if cur_line+1<>best_line then
- begin q:=inter_line_penalties_ptr;
- if q<>null then
- begin r:=cur_line;
- if r>penalty(q) then r:=penalty(q);
- pen:=penalty(q+r);
- end
- else pen:=inter_line_penalty;
- q:=club_penalties_ptr;
- if q<>null then
- begin r:=cur_line-prev_graf;
- if r>penalty(q) then r:=penalty(q);
- pen:=pen+penalty(q+r);
- end
- else if cur_line=prev_graf+1 then pen:=pen+club_penalty;
- if d then q:=display_widow_penalties_ptr
- else q:=widow_penalties_ptr;
- if q<>null then
- begin r:=best_line-cur_line-1;
- if r>penalty(q) then r:=penalty(q);
- pen:=pen+penalty(q+r);
- end
- else if cur_line+2=best_line then
- if d then pen:=pen+display_widow_penalty
- else pen:=pen+widow_penalty;
- if disc_break then pen:=pen+broken_penalty;
- if pen<>0 then
- begin r:=new_penalty(pen);
- link(tail):=r; tail:=r;
- end;
- end
-
-@* \[40] Pre-hyphenation.
-When the line-breaking routine is unable to find a feasible sequence of
-breakpoints, it makes a second pass over the paragraph, attempting to
-hyphenate the hyphenatable words. The goal of hyphenation is to insert
-discretionary material into the paragraph so that there are more
-potential places to break.
-
-The general rules for hyphenation are somewhat complex and technical,
-because we want to be able to hyphenate words that are preceded or
-followed by punctuation marks, and because we want the rules to work
-for languages other than English. We also must contend with the fact
-that hyphens might radically alter the ligature and kerning structure
-of a word.
-
-A sequence of characters will be considered for hyphenation only if it
-belongs to a ``potentially hyphenatable part'' of the current paragraph.
-This is a sequence of nodes $p_0p_1\ldots p_m$ where $p_0$ is a glue node,
-$p_1\ldots p_{m-1}$ are either character or ligature or whatsit or
-implicit kern or text direction nodes, and $p_m$ is a glue or penalty or
-insertion or adjust
-or mark or whatsit or explicit kern node. (Therefore hyphenation is
-disabled by boxes, math formulas, and discretionary nodes already inserted
-by the user.) The ligature nodes among $p_1\ldots p_{m-1}$ are effectively
-expanded into the original non-ligature characters; the kern nodes and
-whatsits are ignored. Each character |c| is now classified as either a
-nonletter (if |lc_code(c)=0|), a lowercase letter (if
-|lc_code(c)=c|), or an uppercase letter (otherwise); an uppercase letter
-is treated as if it were |lc_code(c)| for purposes of hyphenation. The
-characters generated by $p_1\ldots p_{m-1}$ may begin with nonletters; let
-$c_1$ be the first letter that is not in the middle of a ligature. Whatsit
-nodes preceding $c_1$ are ignored; a whatsit found after $c_1$ will be the
-terminating node $p_m$. All characters that do not have the same font as
-$c_1$ will be treated as nonletters. The |hyphen_char| for that font
-must be between 0 and 255, otherwise hyphenation will not be attempted.
-\TeX\ looks ahead for as many consecutive letters $c_1\ldots c_n$ as
-possible; however, |n| must be less than 64, so a character that would
-otherwise be $c_{64}$ is effectively not a letter. Furthermore $c_n$ must
-not be in the middle of a ligature. In this way we obtain a string of
-letters $c_1\ldots c_n$ that are generated by nodes $p_a\ldots p_b$, where
-|1<=a<=b+1<=m|. If |n>=l_hyf+r_hyf|, this string qualifies for hyphenation;
-however, |uc_hyph| must be positive, if $c_1$ is uppercase.
-
-The hyphenation process takes place in three stages. First, the candidate
-sequence $c_1\ldots c_n$ is found; then potential positions for hyphens
-are determined by referring to hyphenation tables; and finally, the nodes
-$p_a\ldots p_b$ are replaced by a new sequence of nodes that includes the
-discretionary breaks found.
-
-Fortunately, we do not have to do all this calculation very often, because
-of the way it has been taken out of \TeX's inner loop. For example, when
-the second edition of the author's 700-page book {\sl Seminumerical
-Algorithms} was typeset by \TeX, only about 1.2 hyphenations needed to be
-@^Knuth, Donald Ervin@>
-tried per paragraph, since the line breaking algorithm needed to use two
-passes on only about 5 per cent of the paragraphs.
-
-@<Initialize for hyphenating...@>=
-begin @!init if trie_not_ready then init_trie;@+tini@;@/
-cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
-set_hyph_index;
-end
-
-@ The letters $c_1\ldots c_n$ that are candidates for hyphenation are placed
-into an array called |hc|; the number |n| is placed into |hn|; pointers to
-nodes $p_{a-1}$ and~$p_b$ in the description above are placed into variables
-|ha| and |hb|; and the font number is placed into |hf|.
-
-@<Glob...@>=
-@!hc:array[0..65] of 0..256; {word to be hyphenated}
-@!hn:0..64; {the number of positions occupied in |hc|;
- not always a |small_number|}
-@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
-@!hf:internal_font_number; {font number of the letters in |hc|}
-@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase}
-@!hyf_char:integer; {hyphen character of the relevant font}
-@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest}
-@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes}
-@!hyf_bchar:halfword; {boundary character after $c_n$}
-
-@ Hyphenation routines need a few more local variables.
-
-@<Local variables for line...@>=
-@!j:small_number; {an index into |hc| or |hu|}
-@!c:0..255; {character being considered for hyphenation}
-
-@ When the following code is activated, the |line_break| procedure is in its
-second pass, and |cur_p| points to a glue node.
-
-@<Try to hyphenate...@>=
-begin prev_s:=cur_p; s:=link(prev_s);
-if s<>null then
- begin @<Skip to node |ha|, or |goto done1| if no hyphenation
- should be attempted@>;
- if l_hyf+r_hyf>63 then goto done1;
- @<Skip to node |hb|, putting letters into |hu| and |hc|@>;
- @<Check that the nodes following |hb| permit hyphenation and that at least
- |l_hyf+r_hyf| letters have been found, otherwise |goto done1|@>;
- hyphenate;
- end;
-done1: end
-
-@ @<Declare subprocedures for |line_break|@>=
-@t\4@>@<Declare the function called |reconstitute|@>
-procedure hyphenate;
-label common_ending,done,found,found1,found2,not_found,exit;
-var @<Local variables for hyphenation@>@;
-begin @<Find hyphen locations for the word in |hc|, or |return|@>;
-@<If no hyphens were found, |return|@>;
-@<Replace nodes |ha..hb| by a sequence of nodes that includes
- the discretionary hyphens@>;
-exit:end;
-
-@ The first thing we need to do is find the node |ha| just before the
-first letter.
-
-@<Skip to node |ha|, or |goto done1|...@>=
-loop@+ begin if is_char_node(s) then
- begin c:=qo(character(s)); hf:=font(s);
- end
- else if type(s)=ligature_node then
- if lig_ptr(s)=null then goto continue
- else begin q:=lig_ptr(s); c:=qo(character(q)); hf:=font(q);
- end
- else if (type(s)=kern_node)and(subtype(s)=normal) then goto continue
- else if (type(s)=math_node)and(subtype(s)>=L_code) then goto continue
- else if type(s)=whatsit_node then
- begin @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>;
- goto continue;
- end
- else goto done1;
- set_lc_code(c);
- if hc[0]<>0 then
- if (hc[0]=c)or(uc_hyph>0) then goto done2
- else goto done1;
-continue: prev_s:=s; s:=link(prev_s);
- end;
-done2: hyf_char:=hyphen_char[hf];
-if hyf_char<0 then goto done1;
-if hyf_char>255 then goto done1;
-ha:=prev_s
-
-@ The word to be hyphenated is now moved to the |hu| and |hc| arrays.
-
-@<Skip to node |hb|, putting letters...@>=
-hn:=0;
-loop@+ begin if is_char_node(s) then
- begin if font(s)<>hf then goto done3;
- hyf_bchar:=character(s); c:=qo(hyf_bchar);
- set_lc_code(c);
- if hc[0]=0 then goto done3;
- if hn=63 then goto done3;
- hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=hc[0]; hyf_bchar:=non_char;
- end
- else if type(s)=ligature_node then
- @<Move the characters of a ligature node to |hu| and |hc|;
- but |goto done3| if they are not all letters@>
- else if (type(s)=kern_node)and(subtype(s)=normal) then
- begin hb:=s;
- hyf_bchar:=font_bchar[hf];
- end
- else goto done3;
- s:=link(s);
- end;
-done3:
-
-@ We let |j| be the index of the character being stored when a ligature node
-is being expanded, since we do not want to advance |hn| until we are sure
-that the entire ligature consists of letters. Note that it is possible
-to get to |done3| with |hn=0| and |hb| not set to any value.
-
-@<Move the characters of a ligature node to |hu| and |hc|...@>=
-begin if font(lig_char(s))<>hf then goto done3;
-j:=hn; q:=lig_ptr(s);@+if q>null then hyf_bchar:=character(q);
-while q>null do
- begin c:=qo(character(q));
- set_lc_code(c);
- if hc[0]=0 then goto done3;
- if j=63 then goto done3;
- incr(j); hu[j]:=c; hc[j]:=hc[0];@/
- q:=link(q);
- end;
-hb:=s; hn:=j;
-if odd(subtype(s)) then hyf_bchar:=font_bchar[hf]@+else hyf_bchar:=non_char;
-end
-
-@ @<Check that the nodes following |hb| permit hyphenation...@>=
-if hn<l_hyf+r_hyf then goto done1; {|l_hyf| and |r_hyf| are |>=1|}
-loop@+ begin if not(is_char_node(s)) then
- case type(s) of
- ligature_node: do_nothing;
- kern_node: if subtype(s)<>normal then goto done4;
- whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node:
- goto done4;
- math_node: if subtype(s)>=L_code then goto done4@+else goto done1;
- othercases goto done1
- endcases;
- s:=link(s);
- end;
-done4:
-
-@* \[41] Post-hyphenation.
-If a hyphen may be inserted between |hc[j]| and |hc[j+1]|, the hyphenation
-procedure will set |hyf[j]| to some small odd number. But before we look
-at \TeX's hyphenation procedure, which is independent of the rest of the
-line-breaking algorithm, let us consider what we will do with the hyphens
-it finds, since it is better to work on this part of the program before
-forgetting what |ha| and |hb|, etc., are all about.
-
-@<Glob...@>=
-@!hyf:array [0..64] of 0..9; {odd values indicate discretionary hyphens}
-@!init_list:pointer; {list of punctuation characters preceding the word}
-@!init_lig:boolean; {does |init_list| represent a ligature?}
-@!init_lft:boolean; {if so, did the ligature involve a left boundary?}
-
-@ @<Local variables for hyphenation@>=
-@!i,@!j,@!l:0..65; {indices into |hc| or |hu|}
-@!q,@!r,@!s:pointer; {temporary registers for list manipulation}
-@!bchar:halfword; {boundary character of hyphenated word, or |non_char|}
-
-@ \TeX\ will never insert a hyphen that has fewer than
-\.{\\lefthyphenmin} letters before it or fewer than
-\.{\\righthyphenmin} after it; hence, a short word has
-comparatively little chance of being hyphenated. If no hyphens have
-been found, we can save time by not having to make any changes to the
-paragraph.
-
-@<If no hyphens were found, |return|@>=
-for j:=l_hyf to hn-r_hyf do if odd(hyf[j]) then goto found1;
-return;
-found1:
-
-@ If hyphens are in fact going to be inserted, \TeX\ first deletes the
-subsequence of nodes between |ha| and~|hb|. An attempt is made to
-preserve the effect that implicit boundary characters and punctuation marks
-had on ligatures inside the hyphenated word, by storing a left boundary or
-preceding character in |hu[0]| and by storing a possible right boundary
-in |bchar|. We set |j:=0| if |hu[0]| is to be part of the reconstruction;
-otherwise |j:=1|.
-The variable |s| will point to the tail of the current hlist, and
-|q| will point to the node following |hb|, so that
-things can be hooked up after we reconstitute the hyphenated word.
-
-@<Replace nodes |ha..hb| by a sequence of nodes...@>=
-q:=link(hb); link(hb):=null; r:=link(ha); link(ha):=null; bchar:=hyf_bchar;
-if is_char_node(ha) then
- if font(ha)<>hf then goto found2
- else begin init_list:=ha; init_lig:=false; hu[0]:=qo(character(ha));
- end
-else if type(ha)=ligature_node then
- if font(lig_char(ha))<>hf then goto found2
- else begin init_list:=lig_ptr(ha); init_lig:=true; init_lft:=(subtype(ha)>1);
- hu[0]:=qo(character(lig_char(ha)));
- if init_list=null then if init_lft then
- begin hu[0]:=256; init_lig:=false;
- end; {in this case a ligature will be reconstructed from scratch}
- free_node(ha,small_node_size);
- end
-else begin {no punctuation found; look for left boundary}
- if not is_char_node(r) then if type(r)=ligature_node then
- if subtype(r)>1 then goto found2;
- j:=1; s:=ha; init_list:=null; goto common_ending;
- end;
-s:=cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|}
-while link(s)<>ha do s:=link(s);
-j:=0; goto common_ending;
-found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null;
-common_ending: flush_node_list(r);
-@<Reconstitute nodes for the hyphenated word, inserting discretionary hyphens@>;
-flush_list(init_list)
-
-@ We must now face the fact that the battle is not over, even though the
-{\def\!{\kern-1pt}%
-hyphens have been found: The process of reconstituting a word can be nontrivial
-because ligatures might change when a hyphen is present. {\sl The \TeX book\/}
-discusses the difficulties of the word ``difficult'', and
-the discretionary material surrounding a
-hyphen can be considerably more complex than that. Suppose
-\.{abcdef} is a word in a font for which the only ligatures are \.{b\!c},
-\.{c\!d}, \.{d\!e}, and \.{e\!f}. If this word permits hyphenation
-between \.b and \.c, the two patterns with and without hyphenation are
-$\.a\,\.b\,\.-\,\.{c\!d}\,\.{e\!f}$ and $\.a\,\.{b\!c}\,\.{d\!e}\,\.f$.
-Thus the insertion of a hyphen might cause effects to ripple arbitrarily
-far into the rest of the word. A further complication arises if additional
-hyphens appear together with such rippling, e.g., if the word in the
-example just given could also be hyphenated between \.c and \.d; \TeX\
-avoids this by simply ignoring the additional hyphens in such weird cases.}
-
-Still further complications arise in the presence of ligatures that do not
-delete the original characters. When punctuation precedes the word being
-hyphenated, \TeX's method is not perfect under all possible scenarios,
-because punctuation marks and letters can propagate information back and forth.
-For example, suppose the original pre-hyphenation pair
-\.{*a} changes to \.{*y} via a \.{\?=:} ligature, which changes to \.{xy}
-via a \.{=:\?} ligature; if $p_{a-1}=\.x$ and $p_a=\.y$, the reconstitution
-procedure isn't smart enough to obtain \.{xy} again. In such cases the
-font designer should include a ligature that goes from \.{xa} to \.{xy}.
-
-@ The processing is facilitated by a subroutine called |reconstitute|. Given
-a string of characters $x_j\ldots x_n$, there is a smallest index $m\ge j$
-such that the ``translation'' of $x_j\ldots x_n$ by ligatures and kerning
-has the form $y_1\ldots y_t$ followed by the translation of $x_{m+1}\ldots x_n$,
-where $y_1\ldots y_t$ is some nonempty sequence of character, ligature, and
-kern nodes. We call $x_j\ldots x_m$ a ``cut prefix'' of $x_j\ldots x_n$.
-For example, if $x_1x_2x_3=\.{fly}$, and if the font contains `fl' as a
-ligature and a kern between `fl' and `y', then $m=2$, $t=2$, and $y_1$ will
-be a ligature node for `fl' followed by an appropriate kern node~$y_2$.
-In the most common case, $x_j$~forms no ligature with $x_{j+1}$ and we
-simply have $m=j$, $y_1=x_j$. If $m<n$ we can repeat the procedure on
-$x_{m+1}\ldots x_n$ until the entire translation has been found.
-
-The |reconstitute| function returns the integer $m$ and puts the nodes
-$y_1\ldots y_t$ into a linked list starting at |link(hold_head)|,
-getting the input $x_j\ldots x_n$ from the |hu| array. If $x_j=256$,
-we consider $x_j$ to be an implicit left boundary character; in this
-case |j| must be strictly less than~|n|. There is a
-parameter |bchar|, which is either 256 or an implicit right boundary character
-assumed to be present just following~$x_n$. (The value |hu[n+1]| is never
-explicitly examined, but the algorithm imagines that |bchar| is there.)
-
-If there exists an index |k| in the range $j\le k\le m$ such that |hyf[k]|
-is odd and such that the result of |reconstitute| would have been different
-if $x_{k+1}$ had been |hchar|, then |reconstitute| sets |hyphen_passed|
-to the smallest such~|k|. Otherwise it sets |hyphen_passed| to zero.
-
-A special convention is used in the case |j=0|: Then we assume that the
-translation of |hu[0]| appears in a special list of charnodes starting at
-|init_list|; moreover, if |init_lig| is |true|, then |hu[0]| will be
-a ligature character, involving a left boundary if |init_lft| is |true|.
-This facility is provided for cases when a hyphenated
-word is preceded by punctuation (like single or double quotes) that might
-affect the translation of the beginning of the word.
-
-@<Glob...@>=
-@!hyphen_passed:small_number; {first hyphen in a ligature, if any}
-
-@ @<Declare the function called |reconstitute|@>=
-function reconstitute(@!j,@!n:small_number;@!bchar,@!hchar:halfword):
- small_number;
-label continue,done;
-var @!p:pointer; {temporary register for list manipulation}
-@!t:pointer; {a node being appended to}
-@!q:four_quarters; {character information or a lig/kern instruction}
-@!cur_rh:halfword; {hyphen character for ligature testing}
-@!test_char:halfword; {hyphen or other character for ligature testing}
-@!w:scaled; {amount of kerning}
-@!k:font_index; {position of current lig/kern instruction}
-begin hyphen_passed:=0; t:=hold_head; w:=0; link(hold_head):=null;
- {at this point |ligature_present=lft_hit=rt_hit=false|}
-@<Set up data structures with the cursor following position |j|@>;
-continue:@<If there's a ligature or kern at the cursor position, update the data
- structures, possibly advancing~|j|; continue until the cursor moves@>;
-@<Append a ligature and/or kern to the translation;
- |goto continue| if the stack of inserted ligatures is nonempty@>;
-reconstitute:=j;
-end;
-
-@ The reconstitution procedure shares many of the global data structures
-by which \TeX\ has processed the words before they were hyphenated.
-There is an implied ``cursor'' between characters |cur_l| and |cur_r|;
-these characters will be tested for possible ligature activity. If
-|ligature_present| then |cur_l| is a ligature character formed from the
-original characters following |cur_q| in the current translation list.
-There is a ``ligature stack'' between the cursor and character |j+1|,
-consisting of pseudo-ligature nodes linked together by their |link| fields.
-This stack is normally empty unless a ligature command has created a new
-character that will need to be processed later. A pseudo-ligature is
-a special node having a |character| field that represents a potential
-ligature and a |lig_ptr| field that points to a |char_node| or is |null|.
-We have
-$$|cur_r|=\cases{|character(lig_stack)|,&if |lig_stack>null|;\cr
- |qi(hu[j+1])|,&if |lig_stack=null| and |j<n|;\cr
- bchar,&if |lig_stack=null| and |j=n|.\cr}$$
-
-@<Glob...@>=
-@!cur_l,@!cur_r:halfword; {characters before and after the cursor}
-@!cur_q:pointer; {where a ligature should be detached}
-@!lig_stack:pointer; {unfinished business to the right of the cursor}
-@!ligature_present:boolean; {should a ligature node be made for |cur_l|?}
-@!lft_hit,@!rt_hit:boolean; {did we hit a ligature with a boundary character?}
-
-@ @d append_charnode_to_t(#)== begin link(t):=get_avail; t:=link(t);
- font(t):=hf; character(t):=#;
- end
-@d set_cur_r==begin if j<n then cur_r:=qi(hu[j+1])@+else cur_r:=bchar;
- if odd(hyf[j]) then cur_rh:=hchar@+else cur_rh:=non_char;
- end
-
-@<Set up data structures with the cursor following position |j|@>=
-cur_l:=qi(hu[j]); cur_q:=t;
-if j=0 then
- begin ligature_present:=init_lig; p:=init_list;
- if ligature_present then lft_hit:=init_lft;
- while p>null do
- begin append_charnode_to_t(character(p)); p:=link(p);
- end;
- end
-else if cur_l<non_char then append_charnode_to_t(cur_l);
-lig_stack:=null; set_cur_r
-
-@ We may want to look at the lig/kern program twice, once for a hyphen
-and once for a normal letter. (The hyphen might appear after the letter
-in the program, so we'd better not try to look for both at once.)
-
-@<If there's a ligature or kern at the cursor position, update...@>=
-if cur_l=non_char then
- begin k:=bchar_label[hf];
- if k=non_address then goto done@+else q:=font_info[k].qqqq;
- end
-else begin q:=char_info(hf)(cur_l);
- if char_tag(q)<>lig_tag then goto done;
- k:=lig_kern_start(hf)(q); q:=font_info[k].qqqq;
- if skip_byte(q)>stop_flag then
- begin k:=lig_kern_restart(hf)(q); q:=font_info[k].qqqq;
- end;
- end; {now |k| is the starting address of the lig/kern program}
-if cur_rh<non_char then test_char:=cur_rh@+else test_char:=cur_r;
-loop@+begin if next_char(q)=test_char then if skip_byte(q)<=stop_flag then
- if cur_rh<non_char then
- begin hyphen_passed:=j; hchar:=non_char; cur_rh:=non_char;
- goto continue;
- end
- else begin if hchar<non_char then if odd(hyf[j]) then
- begin hyphen_passed:=j; hchar:=non_char;
- end;
- if op_byte(q)<kern_flag then
- @<Carry out a ligature replacement, updating the cursor structure
- and possibly advancing~|j|; |goto continue| if the cursor doesn't
- advance, otherwise |goto done|@>;
- w:=char_kern(hf)(q); goto done; {this kern will be inserted below}
- end;
- if skip_byte(q)>=stop_flag then
- if cur_rh=non_char then goto done
- else begin cur_rh:=non_char; goto continue;
- end;
- k:=k+qo(skip_byte(q))+1; q:=font_info[k].qqqq;
- end;
-done:
-
-@ @d wrap_lig(#)==if ligature_present then
- begin p:=new_ligature(hf,cur_l,link(cur_q));
- if lft_hit then
- begin subtype(p):=2; lft_hit:=false;
- end;
- if # then if lig_stack=null then
- begin incr(subtype(p)); rt_hit:=false;
- end;
- link(cur_q):=p; t:=p; ligature_present:=false;
- end
-@d pop_lig_stack==begin if lig_ptr(lig_stack)>null then
- begin link(t):=lig_ptr(lig_stack); {this is a charnode for |hu[j+1]|}
- t:=link(t); incr(j);
- end;
- p:=lig_stack; lig_stack:=link(p); free_node(p,small_node_size);
- if lig_stack=null then set_cur_r@+else cur_r:=character(lig_stack);
- end {if |lig_stack| isn't |null| we have |cur_rh=non_char|}
-
-@<Append a ligature and/or kern to the translation...@>=
-wrap_lig(rt_hit);
-if w<>0 then
- begin link(t):=new_kern(w); t:=link(t); w:=0;
- end;
-if lig_stack>null then
- begin cur_q:=t; cur_l:=character(lig_stack); ligature_present:=true;
- pop_lig_stack; goto continue;
- end
-
-@ @<Carry out a ligature replacement, updating the cursor structure...@>=
-begin if cur_l=non_char then lft_hit:=true;
-if j=n then if lig_stack=null then rt_hit:=true;
-check_interrupt; {allow a way out in case there's an infinite ligature loop}
-case op_byte(q) of
-qi(1),qi(5):begin cur_l:=rem_byte(q); {\.{=:\?}, \.{=:\?>}}
- ligature_present:=true;
- end;
-qi(2),qi(6):begin cur_r:=rem_byte(q); {\.{\?=:}, \.{\?=:>}}
- if lig_stack>null then character(lig_stack):=cur_r
- else begin lig_stack:=new_lig_item(cur_r);
- if j=n then bchar:=non_char
- else begin p:=get_avail; lig_ptr(lig_stack):=p;
- character(p):=qi(hu[j+1]); font(p):=hf;
- end;
- end;
- end;
-qi(3):begin cur_r:=rem_byte(q); {\.{\?=:\?}}
- p:=lig_stack; lig_stack:=new_lig_item(cur_r); link(lig_stack):=p;
- end;
-qi(7),qi(11):begin wrap_lig(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
- cur_q:=t; cur_l:=rem_byte(q); ligature_present:=true;
- end;
-othercases begin cur_l:=rem_byte(q); ligature_present:=true; {\.{=:}}
- if lig_stack>null then pop_lig_stack
- else if j=n then goto done
- else begin append_charnode_to_t(cur_r); incr(j); set_cur_r;
- end;
- end
-endcases;
-if op_byte(q)>qi(4) then if op_byte(q)<>qi(7) then goto done;
-goto continue;
-end
-
-@ Okay, we're ready to insert the potential hyphenations that were found.
-When the following program is executed, we want to append the word
-|hu[1..hn]| after node |ha|, and node |q| should be appended to the result.
-During this process, the variable |i| will be a temporary
-index into |hu|; the variable |j| will be an index to our current position
-in |hu|; the variable |l| will be the counterpart of |j|, in a discretionary
-branch; the variable |r| will point to new nodes being created; and
-we need a few new local variables:
-
-@<Local variables for hyph...@>=
-@!major_tail,@!minor_tail:pointer; {the end of lists in the main and
- discretionary branches being reconstructed}
-@!c:ASCII_code; {character temporarily replaced by a hyphen}
-@!c_loc:0..63; {where that character came from}
-@!r_count:integer; {replacement count for discretionary}
-@!hyf_node:pointer; {the hyphen, if it exists}
-
-@ When the following code is performed, |hyf[0]| and |hyf[hn]| will be zero.
-
-@<Reconstitute nodes for the hyphenated word...@>=
-repeat l:=j; j:=reconstitute(j,hn,bchar,qi(hyf_char))+1;
-if hyphen_passed=0 then
- begin link(s):=link(hold_head);
- while link(s)>null do s:=link(s);
- if odd(hyf[j-1]) then
- begin l:=j; hyphen_passed:=j-1; link(hold_head):=null;
- end;
- end;
-if hyphen_passed>0 then
- @<Create and append a discretionary node as an alternative to the
- unhyphenated word, and continue to develop both branches until they
- become equivalent@>;
-until j>hn;
-link(s):=q
-
-@ In this repeat loop we will insert another discretionary if |hyf[j-1]| is
-odd, when both branches of the previous discretionary end at position |j-1|.
-Strictly speaking, we aren't justified in doing this, because we don't know
-that a hyphen after |j-1| is truly independent of those branches. But in almost
-all applications we would rather not lose a potentially valuable hyphenation
-point. (Consider the word `difficult', where the letter `c' is in position |j|.)
-
-@d advance_major_tail==begin major_tail:=link(major_tail); incr(r_count);
- end
-
-@<Create and append a discretionary node as an alternative...@>=
-repeat r:=get_node(small_node_size);
-link(r):=link(hold_head); type(r):=disc_node;
-major_tail:=r; r_count:=0;
-while link(major_tail)>null do advance_major_tail;
-i:=hyphen_passed; hyf[i]:=0;
-@<Put the \(c)characters |hu[l..i]| and a hyphen into |pre_break(r)|@>;
-@<Put the \(c)characters |hu[i+1..@,]| into |post_break(r)|, appending to this
- list and to |major_tail| until synchronization has been achieved@>;
-@<Move pointer |s| to the end of the current list, and set |replace_count(r)|
- appropriately@>;
-hyphen_passed:=j-1; link(hold_head):=null;
-until not odd(hyf[j-1])
-
-@ The new hyphen might combine with the previous character via ligature
-or kern. At this point we have |l-1<=i<j| and |i<hn|.
-
-@<Put the \(c)characters |hu[l..i]| and a hyphen into |pre_break(r)|@>=
-minor_tail:=null; pre_break(r):=null; hyf_node:=new_character(hf,hyf_char);
-if hyf_node<>null then
- begin incr(i); c:=hu[i]; hu[i]:=hyf_char; free_avail(hyf_node);
- end;
-while l<=i do
- begin l:=reconstitute(l,i,font_bchar[hf],non_char)+1;
- if link(hold_head)>null then
- begin if minor_tail=null then pre_break(r):=link(hold_head)
- else link(minor_tail):=link(hold_head);
- minor_tail:=link(hold_head);
- while link(minor_tail)>null do minor_tail:=link(minor_tail);
- end;
- end;
-if hyf_node<>null then
- begin hu[i]:=c; {restore the character in the hyphen position}
- l:=i; decr(i);
- end
-
-@ The synchronization algorithm begins with |l=i+1<=j|.
-
-@<Put the \(c)characters |hu[i+1..@,]| into |post_break(r)|...@>=
-minor_tail:=null; post_break(r):=null; c_loc:=0;
-if bchar_label[hf]<>non_address then {put left boundary at beginning of new line}
- begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256;
- end;
-while l<j do
- begin repeat l:=reconstitute(l,hn,bchar,non_char)+1;
- if c_loc>0 then
- begin hu[c_loc]:=c; c_loc:=0;
- end;
- if link(hold_head)>null then
- begin if minor_tail=null then post_break(r):=link(hold_head)
- else link(minor_tail):=link(hold_head);
- minor_tail:=link(hold_head);
- while link(minor_tail)>null do minor_tail:=link(minor_tail);
- end;
- until l>=j;
- while l>j do
- @<Append characters of |hu[j..@,]| to |major_tail|, advancing~|j|@>;
- end
-
-@ @<Append characters of |hu[j..@,]|...@>=
-begin j:=reconstitute(j,hn,bchar,non_char)+1;
-link(major_tail):=link(hold_head);
-while link(major_tail)>null do advance_major_tail;
-end
-
-@ Ligature insertion can cause a word to grow exponentially in size. Therefore
-we must test the size of |r_count| here, even though the hyphenated text
-was at most 63 characters long.
-
-@<Move pointer |s| to the end of the current list...@>=
-if r_count>127 then {we have to forget the discretionary hyphen}
- begin link(s):=link(r); link(r):=null; flush_node_list(r);
- end
-else begin link(s):=r; replace_count(r):=r_count;
- end;
-s:=major_tail
-
-@* \[42] Hyphenation.
-When a word |hc[1..hn]| has been set up to contain a candidate for hyphenation,
-\TeX\ first looks to see if it is in the user's exception dictionary. If not,
-hyphens are inserted based on patterns that appear within the given word,
-using an algorithm due to Frank~M. Liang.
-@^Liang, Franklin Mark@>
-
-Let's consider Liang's method first, since it is much more interesting than the
-exception-lookup routine. The algorithm begins by setting |hyf[j]| to zero
-for all |j|, and invalid characters are inserted into |hc[0]|
-and |hc[hn+1]| to serve as delimiters. Then a reasonably fast method is
-used to see which of a given set of patterns occurs in the word
-|hc[0..(hn+1)]|. Each pattern $p_1\ldots p_k$ of length |k| has an associated
-sequence of |k+1| numbers $n_0\ldots n_k$; and if the pattern occurs in
-|hc[(j+1)..(j+k)]|, \TeX\ will set |hyf[j+i]:=@tmax@>(hyf[j+i],@t$n_i$@>)| for
-|0<=i<=k|. After this has been done for each pattern that occurs, a
-discretionary hyphen will be inserted between |hc[j]| and |hc[j+1]| when
-|hyf[j]| is odd, as we have already seen.
-
-The set of patterns $p_1\ldots p_k$ and associated numbers $n_0\ldots n_k$
-depends, of course, on the language whose words are being hyphenated, and
-on the degree of hyphenation that is desired. A method for finding
-appropriate |p|'s and |n|'s, from a given dictionary of words and acceptable
-hyphenations, is discussed in Liang's Ph.D. thesis (Stanford University,
-1983); \TeX\ simply starts with the patterns and works from there.
-
-@ The patterns are stored in a compact table that is also efficient for
-retrieval, using a variant of ``trie memory'' [cf.\ {\sl The Art of
-Computer Programming \bf3} (1973), 481--505]. We can find each pattern
-$p_1\ldots p_k$ by letting $z_0$ be one greater than the relevant language
-index and then, for |1<=i<=k|,
-setting |@t$z_i$@>:=trie_link@t$(z_{i-1})+p_i$@>|; the pattern will be
-identified by the number $z_k$. Since all the pattern information is
-packed together into a single |trie_link| array, it is necessary to
-prevent confusion between the data from inequivalent patterns, so another
-table is provided such that |trie_char@t$(z_i)=p_i$@>| for all |i|. There
-is also a table |trie_op|$(z_k)$ to identify the numbers $n_0\ldots n_k$
-associated with $p_1\ldots p_k$.
-
-Comparatively few different number sequences $n_0\ldots n_k$ actually occur,
-since most of the |n|'s are generally zero. Therefore the number sequences
-are encoded in such a way that |trie_op|$(z_k)$ is only one byte long.
-If |trie_op(@t$z_k$@>)<>min_quarterword|, when $p_1\ldots p_k$ has matched
-the letters in |hc[(l-k+1)..l@,]| of language |t|,
-we perform all of the required operations
-for this pattern by carrying out the following little program: Set
-|v:=trie_op(@t$z_k$@>)|. Then set |v:=v+op_start[t]|,
-|hyf[l-hyf_distance[v]]:=@tmax@>(hyf[l-hyf_distance[v]], hyf_num[v])|,
-and |v:=hyf_next[v]|; repeat, if necessary, until |v=min_quarterword|.
-
-@<Types...@>=
-@!trie_pointer=0..trie_size; {an index into |trie|}
-
-@ @d trie_link(#)==trie[#].rh {``downward'' link in a trie}
-@d trie_char(#)==trie[#].b1 {character matched at this trie location}
-@d trie_op(#)==trie[#].b0 {program for hyphenation at this trie location}
-
-@<Glob...@>=
-@!trie:array[trie_pointer] of two_halves; {|trie_link|, |trie_char|, |trie_op|}
-@!hyf_distance:array[1..trie_op_size] of small_number; {position |k-j| of $n_j$}
-@!hyf_num:array[1..trie_op_size] of small_number; {value of $n_j$}
-@!hyf_next:array[1..trie_op_size] of quarterword; {continuation code}
-@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language}
-
-@ @<Local variables for hyph...@>=
-@!z:trie_pointer; {an index into |trie|}
-@!v:integer; {an index into |hyf_distance|, etc.}
-
-@ Assuming that these auxiliary tables have been set up properly, the
-hyphenation algorithm is quite short. In the following code we set |hc[hn+2]|
-to the impossible value 256, in order to guarantee that |hc[hn+3]| will
-never be fetched.
-
-@<Find hyphen locations for the word in |hc|...@>=
-for j:=0 to hn do hyf[j]:=0;
-@<Look for the word |hc[1..hn]| in the exception table, and |goto found| (with
- |hyf| containing the hyphens) if an entry is found@>;
-if trie_char(cur_lang+1)<>qi(cur_lang) then return; {no patterns for |cur_lang|}
-hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters}
-for j:=0 to hn-r_hyf+1 do
- begin z:=trie_link(cur_lang+1)+hc[j]; l:=j;
- while hc[l]=qo(trie_char(z)) do
- begin if trie_op(z)<>min_quarterword then
- @<Store \(m)maximum values in the |hyf| table@>;
- incr(l); z:=trie_link(z)+hc[l];
- end;
- end;
-found: for j:=0 to l_hyf-1 do hyf[j]:=0;
-for j:=0 to r_hyf-1 do hyf[hn-j]:=0
-
-@ @<Store \(m)maximum values in the |hyf| table@>=
-begin v:=trie_op(z);
-repeat v:=v+op_start[cur_lang]; i:=l-hyf_distance[v];
-if hyf_num[v]>hyf[i] then hyf[i]:=hyf_num[v];
-v:=hyf_next[v];
-until v=min_quarterword;
-end
-
-@ The exception table that is built by \TeX's \.{\\hyphenation} primitive is
-organized as an ordered hash table [cf.\ Amble and Knuth, {\sl The Computer
-@^Amble, Ole@> @^Knuth, Donald Ervin@>
-Journal\/ \bf17} (1974), 135--142] using linear probing. If $\alpha$ and
-$\beta$ are words, we will say that $\alpha<\beta$ if $\vert\alpha\vert<
-\vert\beta\vert$ or if $\vert\alpha\vert=\vert\beta\vert$ and
-$\alpha$ is lexicographically smaller than $\beta$. (The notation $\vert
-\alpha\vert$ stands for the length of $\alpha$.) The idea of ordered hashing
-is to arrange the table so that a given word $\alpha$ can be sought by computing
-a hash address $h=h(\alpha)$ and then looking in table positions |h|, |h-1|,
-\dots, until encountering the first word $\L\alpha$. If this word is
-different from $\alpha$, we can conclude that $\alpha$ is not in the table.
-
-The words in the table point to lists in |mem| that specify hyphen positions
-in their |info| fields. The list for $c_1\ldots c_n$ contains the number |k| if
-the word $c_1\ldots c_n$ has a discretionary hyphen between $c_k$ and
-$c_{k+1}$.
-
-@<Types...@>=
-@!hyph_pointer=0..hyph_size; {an index into the ordered hash table}
-
-@ @<Glob...@>=
-@!hyph_word:array[hyph_pointer] of str_number; {exception words}
-@!hyph_list:array[hyph_pointer] of pointer; {lists of hyphen positions}
-@!hyph_count:hyph_pointer; {the number of words in the exception dictionary}
-
-@ @<Local variables for init...@>=
-@!z:hyph_pointer; {runs through the exception dictionary}
-
-@ @<Set init...@>=
-for z:=0 to hyph_size do
- begin hyph_word[z]:=0; hyph_list[z]:=null;
- end;
-hyph_count:=0;
-
-@ The algorithm for exception lookup is quite simple, as soon as we have
-a few more local variables to work with.
-
-@<Local variables for hyph...@>=
-@!h:hyph_pointer; {an index into |hyph_word| and |hyph_list|}
-@!k:str_number; {an index into |str_start|}
-@!u:pool_pointer; {an index into |str_pool|}
-
-@ First we compute the hash code |h|, then we search until we either
-find the word or we don't. Words from different languages are kept
-separate by appending the language code to the string.
-
-@<Look for the word |hc[1...@>=
-h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
-for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_size;
-loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
- |goto not_found|; but if the two strings are equal,
- set |hyf| to the hyphen positions and |goto found|@>;
- if h>0 then decr(h)@+else h:=hyph_size;
- end;
-not_found: decr(hn)
-
-@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
-k:=hyph_word[h]; if k=0 then goto not_found;
-if length(k)<hn then goto not_found;
-if length(k)=hn then
- begin j:=1; u:=str_start[k];
- repeat if so(str_pool[u])<hc[j] then goto not_found;
- if so(str_pool[u])>hc[j] then goto done;
- incr(j); incr(u);
- until j>hn;
- @<Insert hyphens as specified in |hyph_list[h]|@>;
- decr(hn); goto found;
- end;
-done:
-
-@ @<Insert hyphens as specified...@>=
-s:=hyph_list[h];
-while s<>null do
- begin hyf[info(s)]:=1; s:=link(s);
- end
-
-@ @<Search |hyph_list| for pointers to |p|@>=
-for q:=0 to hyph_size do
- begin if hyph_list[q]=p then
- begin print_nl("HYPH("); print_int(q); print_char(")");
- end;
- end
-
-@ We have now completed the hyphenation routine, so the |line_break| procedure
-is finished at last. Since the hyphenation exception table is fresh in our
-minds, it's a good time to deal with the routine that adds new entries to it.
-
-When \TeX\ has scanned `\.{\\hyphenation}', it calls on a procedure named
-|new_hyph_exceptions| to do the right thing.
-
-@d set_cur_lang==if language<=0 then cur_lang:=0
- else if language>255 then cur_lang:=0
- else cur_lang:=language
-
-@p procedure new_hyph_exceptions; {enters new exceptions}
-label reswitch, exit, found, not_found, not_found1;
-var n:0..64; {length of current word; not always a |small_number|}
-@!j:0..64; {an index into |hc|}
-@!h:hyph_pointer; {an index into |hyph_word| and |hyph_list|}
-@!k:str_number; {an index into |str_start|}
-@!p:pointer; {head of a list of hyphen positions}
-@!q:pointer; {used when creating a new node for list |p|}
-@!s,@!t:str_number; {strings being compared or stored}
-@!u,@!v:pool_pointer; {indices into |str_pool|}
-begin scan_left_brace; {a left brace must follow \.{\\hyphenation}}
-set_cur_lang;
-@!init if trie_not_ready then
- begin hyph_index:=0; goto not_found1;
- end;
-tini@/
-set_hyph_index;
-not_found1:
-@<Enter as many hyphenation exceptions as are listed,
-until coming to a right brace; then |return|@>;
-exit:end;
-
-@ @<Enter as many...@>=
-n:=0; p:=null;
-loop@+ begin get_x_token;
- reswitch: case cur_cmd of
- letter,other_char,char_given:@<Append a new letter or hyphen@>;
- char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
- goto reswitch;
- end;
- spacer,right_brace: begin if n>1 then @<Enter a hyphenation exception@>;
- if cur_cmd=right_brace then return;
- n:=0; p:=null;
- end;
- othercases @<Give improper \.{\\hyphenation} error@>
- endcases;
- end
-
-@ @<Give improper \.{\\hyph...@>=
-begin print_err("Improper "); print_esc("hyphenation");
-@.Improper \\hyphenation...@>
- print(" will be flushed");
-help2("Hyphenation exceptions must contain only letters")@/
- ("and hyphens. But continue; I'll forgive and forget.");
-error;
-end
-
-@ @<Append a new letter or hyphen@>=
-if cur_chr="-" then @<Append the value |n| to list |p|@>
-else begin set_lc_code(cur_chr);
- if hc[0]=0 then
- begin print_err("Not a letter");
-@.Not a letter@>
- help2("Letters in \hyphenation words must have \lccode>0.")@/
- ("Proceed; I'll ignore the character I just read.");
- error;
- end
- else if n<63 then
- begin incr(n); hc[n]:=hc[0];
- end;
- end
-
-@ @<Append the value |n| to list |p|@>=
-begin if n<63 then
- begin q:=get_avail; link(q):=p; info(q):=n; p:=q;
- end;
-end
-
-@ @<Enter a hyphenation exception@>=
-begin incr(n); hc[n]:=cur_lang; str_room(n); h:=0;
-for j:=1 to n do
- begin h:=(h+h+hc[j]) mod hyph_size;
- append_char(hc[j]);
- end;
-s:=make_string;
-@<Insert the \(p)pair |(s,p)| into the exception table@>;
-end
-
-@ @<Insert the \(p)pair |(s,p)|...@>=
-if hyph_count=hyph_size then overflow("exception dictionary",hyph_size);
-@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
-incr(hyph_count);
-while hyph_word[h]<>0 do
- begin @<If the string |hyph_word[h]| is less than \(or)or equal to
- |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
- if h>0 then decr(h)@+else h:=hyph_size;
- end;
-hyph_word[h]:=s; hyph_list[h]:=p
-
-@ @<If the string |hyph_word[h]| is less than \(or)...@>=
-k:=hyph_word[h];
-if length(k)<length(s) then goto found;
-if length(k)>length(s) then goto not_found;
-u:=str_start[k]; v:=str_start[s];
-repeat if str_pool[u]<str_pool[v] then goto found;
-if str_pool[u]>str_pool[v] then goto not_found;
-incr(u); incr(v);
-until u=str_start[k+1];
-found:q:=hyph_list[h]; hyph_list[h]:=p; p:=q;@/
-t:=hyph_word[h]; hyph_word[h]:=s; s:=t;
-not_found:
-
-@* \[43] Initializing the hyphenation tables.
-The trie for \TeX's hyphenation algorithm is built from a sequence of
-patterns following a \.{\\patterns} specification. Such a specification
-is allowed only in \.{INITEX}, since the extra memory for auxiliary tables
-and for the initialization program itself would only clutter up the
-production version of \TeX\ with a lot of deadwood.
-
-The first step is to build a trie that is linked, instead of packed
-into sequential storage, so that insertions are readily made.
-After all patterns have been processed, \.{INITEX}
-compresses the linked trie by identifying common subtries. Finally the
-trie is packed into the efficient sequential form that the hyphenation
-algorithm actually uses.
-
-@<Declare subprocedures for |line_break|@>=
-@!init @<Declare procedures for preprocessing hyphenation patterns@>@;
-tini
-
-@ Before we discuss trie building in detail, let's consider the simpler
-problem of creating the |hyf_distance|, |hyf_num|, and |hyf_next| arrays.
-
-Suppose, for example, that \TeX\ reads the pattern `\.{ab2cde1}'. This is
-a pattern of length 5, with $n_0\ldots n_5=0\,0\,2\,0\,0\,1$ in the
-notation above. We want the corresponding |trie_op| code |v| to have
-|hyf_distance[v]=3|, |hyf_num[v]=2|, and |hyf_next[v]=@t$v^\prime$@>|,
-where the auxiliary |trie_op| code $v^\prime$ has
-|hyf_distance[@t$v^\prime$@>]=0|, |hyf_num[@t$v^\prime$@>]=1|, and
-|hyf_next[@t$v^\prime$@>]=min_quarterword|.
-
-\TeX\ computes an appropriate value |v| with the |new_trie_op| subroutine
-below, by setting
-$$\hbox{|@t$v^\prime$@>:=new_trie_op(0,1,min_quarterword)|,\qquad
-|v:=new_trie_op(3,2,@t$v^\prime$@>)|.}$$
-This subroutine looks up its three
-parameters in a special hash table, assigning a new value only if these
-three have not appeared before for the current language.
-
-The hash table is called |trie_op_hash|, and the number of entries it contains
-is |trie_op_ptr|.
-
-@<Glob...@>=
-@!init @!trie_op_hash:array[-trie_op_size..trie_op_size] of 0..trie_op_size;
- {trie op codes for quadruples}
-@!trie_used:array[ASCII_code] of quarterword;
- {largest opcode used so far for this language}
-@!trie_op_lang:array[1..trie_op_size] of ASCII_code;
- {language part of a hashed quadruple}
-@!trie_op_val:array[1..trie_op_size] of quarterword;
- {opcode corresponding to a hashed quadruple}
-@!trie_op_ptr:0..trie_op_size; {number of stored ops so far}
-tini
-
-@ It's tempting to remove the |overflow| stops in the following procedure;
-|new_trie_op| could return |min_quarterword| (thereby simply ignoring
-part of a hyphenation pattern) instead of aborting the job. However, that would
-lead to different hyphenation results on different installations of \TeX\
-using the same patterns. The |overflow| stops are necessary for portability
-of patterns.
-
-@<Declare procedures for preprocessing hyph...@>=
-function new_trie_op(@!d,@!n:small_number;@!v:quarterword):quarterword;
-label exit;
-var h:-trie_op_size..trie_op_size; {trial hash location}
-@!u:quarterword; {trial op code}
-@!l:0..trie_op_size; {pointer to stored data}
-begin h:=abs(n+313*d+361*v+1009*cur_lang) mod (trie_op_size+trie_op_size)
- - trie_op_size;
-loop@+ begin l:=trie_op_hash[h];
- if l=0 then {empty position found for a new op}
- begin if trie_op_ptr=trie_op_size then
- overflow("pattern memory ops",trie_op_size);
- u:=trie_used[cur_lang];
- if u=max_quarterword then
- overflow("pattern memory ops per language",
- max_quarterword-min_quarterword);
- incr(trie_op_ptr); incr(u); trie_used[cur_lang]:=u;
- hyf_distance[trie_op_ptr]:=d;
- hyf_num[trie_op_ptr]:=n; hyf_next[trie_op_ptr]:=v;
- trie_op_lang[trie_op_ptr]:=cur_lang; trie_op_hash[h]:=trie_op_ptr;
- trie_op_val[trie_op_ptr]:=u; new_trie_op:=u; return;
- end;
- if (hyf_distance[l]=d)and(hyf_num[l]=n)and(hyf_next[l]=v)
- and(trie_op_lang[l]=cur_lang) then
- begin new_trie_op:=trie_op_val[l]; return;
- end;
- if h>-trie_op_size then decr(h)@+else h:=trie_op_size;
- end;
-exit:end;
-
-@ After |new_trie_op| has compressed the necessary opcode information,
-plenty of information is available to unscramble the data into the
-final form needed by our hyphenation algorithm.
-
-@<Sort \(t)the hyphenation op tables into proper order@>=
-op_start[0]:=-min_quarterword;
-for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
-for j:=1 to trie_op_ptr do
- trie_op_hash[j]:=op_start[trie_op_lang[j]]+trie_op_val[j]; {destination}
-for j:=1 to trie_op_ptr do while trie_op_hash[j]>j do
- begin k:=trie_op_hash[j];@/
- t:=hyf_distance[k]; hyf_distance[k]:=hyf_distance[j]; hyf_distance[j]:=t;@/
- t:=hyf_num[k]; hyf_num[k]:=hyf_num[j]; hyf_num[j]:=t;@/
- t:=hyf_next[k]; hyf_next[k]:=hyf_next[j]; hyf_next[j]:=t;@/
- trie_op_hash[j]:=trie_op_hash[k]; trie_op_hash[k]:=k;
- end
-
-@ Before we forget how to initialize the data structures that have been
-mentioned so far, let's write down the code that gets them started.
-
-@<Initialize table entries...@>=
-for k:=-trie_op_size to trie_op_size do trie_op_hash[k]:=0;
-for k:=0 to 255 do trie_used[k]:=min_quarterword;
-trie_op_ptr:=0;
-
-@ The linked trie that is used to preprocess hyphenation patterns appears
-in several global arrays. Each node represents an instruction of the form
-``if you see character |c|, then perform operation |o|, move to the
-next character, and go to node |l|; otherwise go to node |r|.''
-The four quantities |c|, |o|, |l|, and |r| are stored in four arrays
-|trie_c|, |trie_o|, |trie_l|, and |trie_r|. The root of the trie
-is |trie_l[0]|, and the number of nodes is |trie_ptr|. Null trie
-pointers are represented by zero. To initialize the trie, we simply
-set |trie_l[0]| and |trie_ptr| to zero. We also set |trie_c[0]| to some
-arbitrary value, since the algorithm may access it.
-
-The algorithms maintain the condition
-$$\hbox{|trie_c[trie_r[z]]>trie_c[z]|\qquad
-whenever |z<>0| and |trie_r[z]<>0|};$$ in other words, sibling nodes are
-ordered by their |c| fields.
-
-@d trie_root==trie_l[0] {root of the linked trie}
-
-@<Glob...@>=
-@!init @!trie_c:packed array[trie_pointer] of packed_ASCII_code;
- {characters to match}
-@t\hskip10pt@>@!trie_o:packed array[trie_pointer] of quarterword;
- {operations to perform}
-@t\hskip10pt@>@!trie_l:packed array[trie_pointer] of trie_pointer;
- {left subtrie links}
-@t\hskip10pt@>@!trie_r:packed array[trie_pointer] of trie_pointer;
- {right subtrie links}
-@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
-@t\hskip10pt@>@!trie_hash:packed array[trie_pointer] of trie_pointer;
- {used to identify equivalent subtries}
-tini
-
-@ Let us suppose that a linked trie has already been constructed.
-Experience shows that we can often reduce its size by recognizing common
-subtries; therefore another hash table is introduced for this purpose,
-somewhat similar to |trie_op_hash|. The new hash table will be
-initialized to zero.
-
-The function |trie_node(p)| returns |p| if |p| is distinct from other nodes
-that it has seen, otherwise it returns the number of the first equivalent
-node that it has seen.
-
-Notice that we might make subtries equivalent even if they correspond to
-patterns for different languages, in which the trie ops might mean quite
-different things. That's perfectly all right.
-
-@<Declare procedures for preprocessing hyph...@>=
-function trie_node(@!p:trie_pointer):trie_pointer; {converts
- to a canonical form}
-label exit;
-var h:trie_pointer; {trial hash location}
-@!q:trie_pointer; {trial trie node}
-begin h:=abs(trie_c[p]+1009*trie_o[p]+@|
- 2718*trie_l[p]+3142*trie_r[p]) mod trie_size;
-loop@+ begin q:=trie_hash[h];
- if q=0 then
- begin trie_hash[h]:=p; trie_node:=p; return;
- end;
- if (trie_c[q]=trie_c[p])and(trie_o[q]=trie_o[p])and@|
- (trie_l[q]=trie_l[p])and(trie_r[q]=trie_r[p]) then
- begin trie_node:=q; return;
- end;
- if h>0 then decr(h)@+else h:=trie_size;
- end;
-exit:end;
-
-@ A neat recursive procedure is now able to compress a trie by
-traversing it and applying |trie_node| to its nodes in ``bottom up''
-fashion. We will compress the entire trie by clearing |trie_hash| to
-zero and then saying `|trie_root:=compress_trie(trie_root)|'.
-@^recursion@>
-
-@<Declare procedures for preprocessing hyph...@>=
-function compress_trie(@!p:trie_pointer):trie_pointer;
-begin if p=0 then compress_trie:=0
-else begin trie_l[p]:=compress_trie(trie_l[p]);
- trie_r[p]:=compress_trie(trie_r[p]);
- compress_trie:=trie_node(p);
- end;
-end;
-
-@ The compressed trie will be packed into the |trie| array using a
-``top-down first-fit'' procedure. This is a little tricky, so the reader
-should pay close attention: The |trie_hash| array is cleared to zero
-again and renamed |trie_ref| for this phase of the operation; later on,
-|trie_ref[p]| will be nonzero only if the linked trie node |p| is the
-smallest character
-in a family and if the characters |c| of that family have been allocated to
-locations |trie_ref[p]+c| in the |trie| array. Locations of |trie| that
-are in use will have |trie_link=0|, while the unused holes in |trie|
-will be doubly linked with |trie_link| pointing to the next larger vacant
-location and |trie_back| pointing to the next smaller one. This double
-linking will have been carried out only as far as |trie_max|, where
-|trie_max| is the largest index of |trie| that will be needed.
-To save time at the low end of the trie, we maintain array entries
-|trie_min[c]| pointing to the smallest hole that is greater than~|c|.
-Another array |trie_taken| tells whether or not a given location is
-equal to |trie_ref[p]| for some |p|; this array is used to ensure that
-distinct nodes in the compressed trie will have distinct |trie_ref|
-entries.
-
-@d trie_ref==trie_hash {where linked trie families go into |trie|}
-@d trie_back(#)==trie[#].lh {backward links in |trie| holes}
-
-@<Glob...@>=
-@!init @!trie_taken:packed array[1..trie_size] of boolean;
- {does a family start here?}
-@t\hskip10pt@>@!trie_min:array[ASCII_code] of trie_pointer;
- {the first possible slot for each character}
-@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
-@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
-tini
-
-@ Each time \.{\\patterns} appears, it contributes further patterns to
-the future trie, which will be built only when hyphenation is attempted or
-when a format file is dumped. The boolean variable |trie_not_ready|
-will change to |false| when the trie is compressed; this will disable
-further patterns.
-
-@<Initialize table entries...@>=
-trie_not_ready:=true; trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
-
-@ Here is how the trie-compression data structures are initialized.
-If storage is tight, it would be possible to overlap |trie_op_hash|,
-|trie_op_lang|, and |trie_op_val| with |trie|, |trie_hash|, and |trie_taken|,
-because we finish with the former just before we need the latter.
-
-@<Get ready to compress the trie@>=
-@<Sort \(t)the hyphenation...@>;
-for p:=0 to trie_size do trie_hash[p]:=0;
-hyph_root:=compress_trie(hyph_root);
-trie_root:=compress_trie(trie_root); {identify equivalent subtries}
-for p:=0 to trie_ptr do trie_ref[p]:=0;
-for p:=0 to 255 do trie_min[p]:=p+1;
-trie_link(0):=1; trie_max:=0
-
-@ The |first_fit| procedure finds the smallest hole |z| in |trie| such that
-a trie family starting at a given node |p| will fit into vacant positions
-starting at |z|. If |c=trie_c[p]|, this means that location |z-c| must
-not already be taken by some other family, and that |z-c+@t$c^\prime$@>|
-must be vacant for all characters $c^\prime$ in the family. The procedure
-sets |trie_ref[p]| to |z-c| when the first fit has been found.
-
-@<Declare procedures for preprocessing hyph...@>=
-procedure first_fit(@!p:trie_pointer); {packs a family into |trie|}
-label not_found,found;
-var h:trie_pointer; {candidate for |trie_ref[p]|}
-@!z:trie_pointer; {runs through holes}
-@!q:trie_pointer; {runs through the family starting at |p|}
-@!c:ASCII_code; {smallest character in the family}
-@!l,@!r:trie_pointer; {left and right neighbors}
-@!ll:1..256; {upper limit of |trie_min| updating}
-begin c:=so(trie_c[p]);
-z:=trie_min[c]; {get the first conceivably good hole}
-loop@+ begin h:=z-c;@/
- @<Ensure that |trie_max>=h+256|@>;
- if trie_taken[h] then goto not_found;
- @<If all characters of the family fit relative to |h|, then
- |goto found|,\30\ otherwise |goto not_found|@>;
- not_found: z:=trie_link(z); {move to the next hole}
- end;
-found: @<Pack the family into |trie| relative to |h|@>;
-end;
-
-@ By making sure that |trie_max| is at least |h+256|, we can be sure that
-|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will
-never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|.
-
-@<Ensure that |trie_max>=h+256|@>=
-if trie_max<h+256 then
- begin if trie_size<=h+256 then overflow("pattern memory",trie_size);
-@:TeX capacity exceeded pattern memory}{\quad pattern memory@>
- repeat incr(trie_max); trie_taken[trie_max]:=false;
- trie_link(trie_max):=trie_max+1; trie_back(trie_max):=trie_max-1;
- until trie_max=h+256;
- end
-
-@ @<If all characters of the family fit relative to |h|...@>=
-q:=trie_r[p];
-while q>0 do
- begin if trie_link(h+so(trie_c[q]))=0 then goto not_found;
- q:=trie_r[q];
- end;
-goto found
-
-@ @<Pack the family into |trie| relative to |h|@>=
-trie_taken[h]:=true; trie_ref[p]:=h; q:=p;
-repeat z:=h+so(trie_c[q]); l:=trie_back(z); r:=trie_link(z);
-trie_back(r):=l; trie_link(l):=r; trie_link(z):=0;
-if l<256 then
- begin if z<256 then ll:=z @+else ll:=256;
- repeat trie_min[l]:=r; incr(l);
- until l=ll;
- end;
-q:=trie_r[q];
-until q=0
-
-@ To pack the entire linked trie, we use the following recursive procedure.
-@^recursion@>
-
-@<Declare procedures for preprocessing hyph...@>=
-procedure trie_pack(@!p:trie_pointer); {pack subtries of a family}
-var q:trie_pointer; {a local variable that need not be saved on recursive calls}
-begin repeat q:=trie_l[p];
-if (q>0)and(trie_ref[q]=0) then
- begin first_fit(q); trie_pack(q);
- end;
-p:=trie_r[p];
-until p=0;
-end;
-
-@ When the whole trie has been allocated into the sequential table, we
-must go through it once again so that |trie| contains the correct
-information. Null pointers in the linked trie will be represented by the
-value~0, which properly implements an ``empty'' family.
-
-@<Move the data into |trie|@>=
-h.rh:=0; h.b0:=min_quarterword; h.b1:=min_quarterword; {|trie_link:=0|,
- |trie_op:=min_quarterword|, |trie_char:=qi(0)|}
-if trie_max=0 then {no patterns were given}
- begin for r:=0 to 256 do trie[r]:=h;
- trie_max:=256;
- end
-else begin if hyph_root>0 then trie_fix(hyph_root);
- if trie_root>0 then trie_fix(trie_root); {this fixes the non-holes in |trie|}
- r:=0; {now we will zero out all the holes}
- repeat s:=trie_link(r); trie[r]:=h; r:=s;
- until r>trie_max;
- end;
-trie_char(0):=qi("?"); {make |trie_char(c)<>c| for all |c|}
-
-@ The fixing-up procedure is, of course, recursive. Since the linked trie
-usually has overlapping subtries, the same data may be moved several
-times; but that causes no harm, and at most as much work is done as it
-took to build the uncompressed trie.
-@^recursion@>
-
-@<Declare procedures for preprocessing hyph...@>=
-procedure trie_fix(@!p:trie_pointer); {moves |p| and its siblings into |trie|}
-var q:trie_pointer; {a local variable that need not be saved on recursive calls}
-@!c:ASCII_code; {another one that need not be saved}
-@!z:trie_pointer; {|trie| reference; this local variable must be saved}
-begin z:=trie_ref[p];
-repeat q:=trie_l[p]; c:=so(trie_c[p]);
-trie_link(z+c):=trie_ref[q]; trie_char(z+c):=qi(c); trie_op(z+c):=trie_o[p];
-if q>0 then trie_fix(q);
-p:=trie_r[p];
-until p=0;
-end;
-
-@ Now let's go back to the easier problem, of building the linked
-trie. When \.{INITEX} has scanned the `\.{\\patterns}' control
-sequence, it calls on |new_patterns| to do the right thing.
-
-@<Declare procedures for preprocessing hyph...@>=
-procedure new_patterns; {initializes the hyphenation pattern data}
-label done, done1;
-var k,@!l:0..64; {indices into |hc| and |hyf|;
- not always in |small_number| range}
-@!digit_sensed:boolean; {should the next digit be treated as a letter?}
-@!v:quarterword; {trie op code}
-@!p,@!q:trie_pointer; {nodes of trie traversed during insertion}
-@!first_child:boolean; {is |p=trie_l[q]|?}
-@!c:ASCII_code; {character being inserted}
-begin if trie_not_ready then
- begin set_cur_lang; scan_left_brace; {a left brace must follow \.{\\patterns}}
- @<Enter all of the patterns into a linked trie, until coming to a right
- brace@>;
- if saving_hyph_codes>0 then
- @<Store hyphenation codes for current language@>;
- end
-else begin print_err("Too late for "); print_esc("patterns");
- help1("All patterns must be given before typesetting begins.");
- error; link(garbage):=scan_toks(false,false); flush_list(def_ref);
- end;
-end;
-
-@ Novices are not supposed to be using \.{\\patterns}, so the error
-messages are terse. (Note that all error messages appear in \TeX's string
-pool, even if they are used only by \.{INITEX}.)
-
-@<Enter all of the patterns into a linked trie...@>=
-k:=0; hyf[0]:=0; digit_sensed:=false;
-loop@+ begin get_x_token;
- case cur_cmd of
- letter,other_char:@<Append a new letter or a hyphen level@>;
- spacer,right_brace: begin if k>0 then
- @<Insert a new pattern into the linked trie@>;
- if cur_cmd=right_brace then goto done;
- k:=0; hyf[0]:=0; digit_sensed:=false;
- end;
- othercases begin print_err("Bad "); print_esc("patterns");
-@.Bad \\patterns@>
- help1("(See Appendix H.)"); error;
- end
- endcases;
- end;
-done:
-
-@ @<Append a new letter or a hyphen level@>=
-if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then
- begin if cur_chr="." then cur_chr:=0 {edge-of-word delimiter}
- else begin cur_chr:=lc_code(cur_chr);
- if cur_chr=0 then
- begin print_err("Nonletter");
-@.Nonletter@>
- help1("(See Appendix H.)"); error;
- end;
- end;
- if k<63 then
- begin incr(k); hc[k]:=cur_chr; hyf[k]:=0; digit_sensed:=false;
- end;
- end
-else if k<63 then
- begin hyf[k]:=cur_chr-"0"; digit_sensed:=true;
- end
-
-@ When the following code comes into play, the pattern $p_1\ldots p_k$
-appears in |hc[1..k]|, and the corresponding sequence of numbers $n_0\ldots
-n_k$ appears in |hyf[0..k]|.
-
-@<Insert a new pattern into the linked trie@>=
-begin @<Compute the trie op code, |v|, and set |l:=0|@>;
-q:=0; hc[0]:=cur_lang;
-while l<=k do
- begin c:=hc[l]; incr(l); p:=trie_l[q]; first_child:=true;
- while (p>0)and(c>so(trie_c[p])) do
- begin q:=p; p:=trie_r[q]; first_child:=false;
- end;
- if (p=0)or(c<so(trie_c[p])) then
- @<Insert a new trie node between |q| and |p|, and
- make |p| point to it@>;
- q:=p; {now node |q| represents $p_1\ldots p_{l-1}$}
- end;
-if trie_o[q]<>min_quarterword then
- begin print_err("Duplicate pattern");
-@.Duplicate pattern@>
- help1("(See Appendix H.)"); error;
- end;
-trie_o[q]:=v;
-end
-
-@ @<Insert a new trie node between |q| and |p|...@>=
-begin if trie_ptr=trie_size then overflow("pattern memory",trie_size);
-@:TeX capacity exceeded pattern memory}{\quad pattern memory@>
-incr(trie_ptr); trie_r[trie_ptr]:=p; p:=trie_ptr; trie_l[p]:=0;
-if first_child then trie_l[q]:=p@+else trie_r[q]:=p;
-trie_c[p]:=si(c); trie_o[p]:=min_quarterword;
-end
-
-@ @<Compute the trie op code, |v|...@>=
-if hc[1]=0 then hyf[0]:=0;
-if hc[k]=0 then hyf[k]:=0;
-l:=k; v:=min_quarterword;
-loop@+ begin if hyf[l]<>0 then v:=new_trie_op(k-l,hyf[l],v);
- if l>0 then decr(l)@+else goto done1;
- end;
-done1:
-
-@ Finally we put everything together: Here is how the trie gets to its
-final, efficient form.
-The following packing routine is rigged so that the root of the linked
-tree gets mapped into location 1 of |trie|, as required by the hyphenation
-algorithm. This happens because the first call of |first_fit| will
-``take'' location~1.
-
-@<Declare procedures for preprocessing hyphenation patterns@>=
-procedure init_trie;
-var @!p:trie_pointer; {pointer for initialization}
-@!j,@!k,@!t:integer; {all-purpose registers for initialization}
-@!r,@!s:trie_pointer; {used to clean up the packed |trie|}
-@!h:two_halves; {template used to zero out |trie|'s holes}
-begin @<Get ready to compress the trie@>;
-if trie_root<>0 then
- begin first_fit(trie_root); trie_pack(trie_root);
- end;
-if hyph_root<>0 then @<Pack all stored |hyph_codes|@>;
-@<Move the data into |trie|@>;
-trie_not_ready:=false;
-end;
-
-@* \[44] Breaking vertical lists into pages.
-The |vsplit| procedure, which implements \TeX's \.{\\vsplit} operation,
-is considerably simpler than |line_break| because it doesn't have to
-worry about hyphenation, and because its mission is to discover a single
-break instead of an optimum sequence of breakpoints. But before we get
-into the details of |vsplit|, we need to consider a few more basic things.
-
-@ A subroutine called |prune_page_top| takes a pointer to a vlist and
-returns a pointer to a modified vlist in which all glue, kern, and penalty nodes
-have been deleted before the first box or rule node. However, the first
-box or rule is actually preceded by a newly created glue node designed so that
-the topmost baseline will be at distance |split_top_skip| from the top,
-whenever this is possible without backspacing.
-
-When the second argument |s| is |false| the deleted nodes are destroyed,
-otherwise they are collected in a list starting at |split_disc|.
-
-In this routine and those that follow, we make use of the fact that a
-vertical list contains no character nodes, hence the |type| field exists
-for each node in the list.
-@^data structure assumptions@>
-
-@d discard_or_move = 60
-@p function prune_page_top(@!p:pointer;@!s:boolean):pointer;
-label discard_or_move;
- {adjust top after page break}
-var prev_p:pointer; {lags one step behind |p|}
-@!q,@!r:pointer; {temporary variables for list manipulation}
-begin prev_p:=temp_head; link(temp_head):=p;
-while p<>null do
- case type(p) of
- hlist_node,vlist_node,rule_node:@<Insert glue for |split_top_skip|
- and set~|p:=null|@>;
- whatsit_node,mark_node,ins_node: begin
- if (type(p) = whatsit_node) and
- ((subtype(p) = pdf_snapy_node) or
- (subtype(p) = pdf_snapy_comp_node)) then
- begin
- print("snap node being discarded");
- goto discard_or_move;
- end;
- prev_p:=p; p:=link(prev_p);
- end;
- glue_node,kern_node,penalty_node: begin
-discard_or_move:
- @{
- print("discard_or_move: ");
- show_node_list(p);
- print_ln;
- @}
- q:=p; p:=link(q); link(q):=null;
- link(prev_p):=p;
- if s then
- begin if split_disc=null then split_disc:=q@+else link(r):=q;
- r:=q;
- end
- else flush_node_list(q);
- end;
- othercases confusion("pruning")
-@:this can't happen pruning}{\quad pruning@>
- endcases;
-prune_page_top:=link(temp_head);
-end;
-
-@ @<Insert glue for |split_top_skip|...@>=
-begin q:=new_skip_param(split_top_skip_code); link(prev_p):=q; link(q):=p;
- {now |temp_ptr=glue_ptr(q)|}
-if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
-else width(temp_ptr):=0;
-p:=null;
-end
-
-@ The next subroutine finds the best place to break a given vertical list
-so as to obtain a box of height~|h|, with maximum depth~|d|.
-A pointer to the beginning of the vertical list is given,
-and a pointer to the optimum breakpoint is returned. The list is effectively
-followed by a forced break, i.e., a penalty node with the |eject_penalty|;
-if the best break occurs at this artificial node, the value |null| is returned.
-
-An array of six |scaled| distances is used to keep track of the height
-from the beginning of the list to the current place, just as in |line_break|.
-In fact, we use one of the same arrays, only changing its name to reflect
-its new significance.
-
-@d active_height==active_width {new name for the six distance variables}
-@d cur_height==active_height[1] {the natural height}
-@d set_height_zero(#)==active_height[#]:=0 {initialize the height to zero}
-@#
-@d update_heights=90 {go here to record glue in the |active_height| table}
-
-@p function vert_break(@!p:pointer; @!h,@!d:scaled):pointer;
- {finds optimum page break}
-label done,not_found,update_heights;
-var prev_p:pointer; {if |p| is a glue node, |type(prev_p)| determines
- whether |p| is a legal breakpoint}
-@!q,@!r:pointer; {glue specifications}
-@!pi:integer; {penalty value}
-@!b:integer; {badness at a trial breakpoint}
-@!least_cost:integer; {the smallest badness plus penalties found so far}
-@!best_place:pointer; {the most recent break that leads to |least_cost|}
-@!prev_dp:scaled; {depth of previous box in the list}
-@!t:small_number; {|type| of the node following a kern}
-begin prev_p:=p; {an initial glue node is not a legal breakpoint}
-least_cost:=awful_bad; do_all_six(set_height_zero); prev_dp:=0;
-loop@+ begin @<If node |p| is a legal breakpoint, check if this break is
- the best known, and |goto done| if |p| is null or
- if the page-so-far is already too full to accept more stuff@>;
- prev_p:=p; p:=link(prev_p);
- end;
-done: vert_break:=best_place;
-end;
-
-@ A global variable |best_height_plus_depth| will be set to the natural size
-of the box that corresponds to the optimum breakpoint found by |vert_break|.
-(This value is used by the insertion-splitting algorithm of the page builder.)
-
-@<Glob...@>=
-@!best_height_plus_depth:scaled; {height of the best box, without stretching or
- shrinking}
-
-@ A subtle point to be noted here is that the maximum depth~|d| might be
-negative, so |cur_height| and |prev_dp| might need to be corrected even
-after a glue or kern node.
-
-@<If node |p| is a legal breakpoint, check...@>=
-if p=null then pi:=eject_penalty
-else @<Use node |p| to update the current height and depth measurements;
- if this node is not a legal breakpoint, |goto not_found|
- or |update_heights|,
- otherwise set |pi| to the associated penalty at the break@>;
-@<Check if node |p| is a new champion breakpoint; then \(go)|goto done|
- if |p| is a forced break or if the page-so-far is already too full@>;
-if (type(p)<glue_node)or(type(p)>kern_node) then goto not_found;
-update_heights: @<Update the current height and depth measurements with
- respect to a glue or kern node~|p|@>;
-not_found: if prev_dp>d then
- begin cur_height:=cur_height+prev_dp-d;
- prev_dp:=d;
- end;
-
-@ @<Use node |p| to update the current height and depth measurements...@>=
-case type(p) of
-hlist_node,vlist_node,rule_node: begin@t@>@;@/
- cur_height:=cur_height+prev_dp+height(p); prev_dp:=depth(p);
- goto not_found;
- end;
-whatsit_node:@<Process whatsit |p| in |vert_break| loop, |goto not_found|@>;
-glue_node: if precedes_break(prev_p) then pi:=0
- else goto update_heights;
-kern_node: begin if link(p)=null then t:=penalty_node
- else t:=type(link(p));
- if t=glue_node then pi:=0@+else goto update_heights;
- end;
-penalty_node: pi:=penalty(p);
-mark_node,ins_node: goto not_found;
-othercases confusion("vertbreak")
-@:this can't happen vertbreak}{\quad vertbreak@>
-endcases
-
-@ @d deplorable==100000 {more than |inf_bad|, but less than |awful_bad|}
-
-@<Check if node |p| is a new champion breakpoint; then \(go)...@>=
-if pi<inf_penalty then
- begin @<Compute the badness, |b|, using |awful_bad|
- if the box is too full@>;
- if b<awful_bad then
- if pi<=eject_penalty then b:=pi
- else if b<inf_bad then b:=b+pi
- else b:=deplorable;
- if b<=least_cost then
- begin best_place:=p; least_cost:=b;
- best_height_plus_depth:=cur_height+prev_dp;
- end;
- if (b=awful_bad)or(pi<=eject_penalty) then goto done;
- end
-
-@ @<Compute the badness, |b|, using |awful_bad| if the box is too full@>=
-if cur_height<h then
- if (active_height[3]<>0) or (active_height[4]<>0) or
- (active_height[5]<>0) then b:=0
- else b:=badness(h-cur_height,active_height[2])
-else if cur_height-h>active_height[6] then b:=awful_bad
-else b:=badness(cur_height-h,active_height[6])
-
-@ Vertical lists that are subject to the |vert_break| procedure should not
-contain infinite shrinkability, since that would permit any amount of
-information to ``fit'' on one page.
-
-@<Update the current height and depth measurements with...@>=
-if type(p)=kern_node then q:=p
-else begin q:=glue_ptr(p);
- active_height[2+stretch_order(q)]:=@|
- active_height[2+stretch_order(q)]+stretch(q);@/
- active_height[6]:=active_height[6]+shrink(q);
- if (shrink_order(q)<>normal)and(shrink(q)<>0) then
- begin@t@>@;@/
- print_err("Infinite glue shrinkage found in box being split");@/
-@.Infinite glue shrinkage...@>
- help4("The box you are \vsplitting contains some infinitely")@/
- ("shrinkable glue, e.g., `\vss' or `\vskip 0pt minus 1fil'.")@/
- ("Such glue doesn't belong there; but you can safely proceed,")@/
- ("since the offensive shrinkability has been made finite.");
- error; r:=new_spec(q); shrink_order(r):=normal; delete_glue_ref(q);
- glue_ptr(p):=r; q:=r;
- end;
- end;
-cur_height:=cur_height+prev_dp+width(q); prev_dp:=0
-
-@ Now we are ready to consider |vsplit| itself. Most of
-its work is accomplished by the two subroutines that we have just considered.
-
-Given the number of a vlist box |n|, and given a desired page height |h|,
-the |vsplit| function finds the best initial segment of the vlist and
-returns a box for a page of height~|h|. The remainder of the vlist, if
-any, replaces the original box, after removing glue and penalties and
-adjusting for |split_top_skip|. Mark nodes in the split-off box are used to
-set the values of |split_first_mark| and |split_bot_mark|; we use the
-fact that |split_first_mark=null| if and only if |split_bot_mark=null|.
-
-The original box becomes ``void'' if and only if it has been entirely
-extracted. The extracted box is ``void'' if and only if the original
-box was void (or if it was, erroneously, an hlist box).
-
-@p @t\4@>@<Declare the function called |do_marks|@>@;
-function vsplit(@!n:halfword; @!h:scaled):pointer;
- {extracts a page of height |h| from box |n|}
-label exit,done;
-var v:pointer; {the box to be split}
-p:pointer; {runs through the vlist}
-q:pointer; {points to where the break occurs}
-begin cur_val:=n; fetch_box(v);
-flush_node_list(split_disc); split_disc:=null;
-if sa_mark<>null then
- if do_marks(vsplit_init,0,sa_mark) then sa_mark:=null;
-if split_first_mark<>null then
- begin delete_token_ref(split_first_mark); split_first_mark:=null;
- delete_token_ref(split_bot_mark); split_bot_mark:=null;
- end;
-@<Dispense with trivial cases of void or bad boxes@>;
-q:=vert_break(list_ptr(v),h,split_max_depth);
-@<Look at all the marks in nodes before the break, and set the final
- link to |null| at the break@>;
-q:=prune_page_top(q,saving_vdiscards>0);
-p:=list_ptr(v); free_node(v,box_node_size);
-if q<>null then q:=vpack(q,natural);
-change_box(q); {the |eq_level| of the box stays the same}
-vsplit:=vpackage(p,h,exactly,split_max_depth);
-exit: end;
-
-@ @<Dispense with trivial cases of void or bad boxes@>=
-if v=null then
- begin vsplit:=null; return;
- end;
-if type(v)<>vlist_node then
- begin print_err(""); print_esc("vsplit"); print(" needs a ");
- print_esc("vbox");
-@:vsplit_}{\.{\\vsplit needs a \\vbox}@>
- help2("The box you are trying to split is an \hbox.")@/
- ("I can't split such a box, so I'll leave it alone.");
- error; vsplit:=null; return;
- end
-
-@ It's possible that the box begins with a penalty node that is the
-``best'' break, so we must be careful to handle this special case correctly.
-
-@<Look at all the marks...@>=
-p:=list_ptr(v);
-if p=q then list_ptr(v):=null
-else loop@+begin if type(p)=mark_node then
- if mark_class(p)<>0 then @<Update the current marks for |vsplit|@>
- else if split_first_mark=null then
- begin split_first_mark:=mark_ptr(p);
- split_bot_mark:=split_first_mark;
- token_ref_count(split_first_mark):=@|
- token_ref_count(split_first_mark)+2;
- end
- else begin delete_token_ref(split_bot_mark);
- split_bot_mark:=mark_ptr(p);
- add_token_ref(split_bot_mark);
- end;
- if link(p)=q then
- begin link(p):=null; goto done;
- end;
- p:=link(p);
- end;
-done:
-
-@* \[45] The page builder.
-When \TeX\ appends new material to its main vlist in vertical mode, it uses
-a method something like |vsplit| to decide where a page ends, except that
-the calculations are done ``on line'' as new items come in.
-The main complication in this process is that insertions must be put
-into their boxes and removed from the vlist, in a more-or-less optimum manner.
-
-We shall use the term ``current page'' for that part of the main vlist that
-is being considered as a candidate for being broken off and sent to the
-user's output routine. The current page starts at |link(page_head)|, and
-it ends at |page_tail|. We have |page_head=page_tail| if this list is empty.
-@^current page@>
-
-Utter chaos would reign if the user kept changing page specifications
-while a page is being constructed, so the page builder keeps the pertinent
-specifications frozen as soon as the page receives its first box or
-insertion. The global variable |page_contents| is |empty| when the
-current page contains only mark nodes and content-less whatsit nodes; it
-is |inserts_only| if the page contains only insertion nodes in addition to
-marks and whatsits. Glue nodes, kern nodes, and penalty nodes are
-discarded until a box or rule node appears, at which time |page_contents|
-changes to |box_there|. As soon as |page_contents| becomes non-|empty|,
-the current |vsize| and |max_depth| are squirreled away into |page_goal|
-and |page_max_depth|; the latter values will be used until the page has
-been forwarded to the user's output routine. The \.{\\topskip} adjustment
-is made when |page_contents| changes to |box_there|.
-
-Although |page_goal| starts out equal to |vsize|, it is decreased by the
-scaled natural height-plus-depth of the insertions considered so far, and by
-the \.{\\skip} corrections for those insertions. Therefore it represents
-the size into which the non-inserted material should fit, assuming that
-all insertions in the current page have been made.
-
-The global variables |best_page_break| and |least_page_cost| correspond
-respectively to the local variables |best_place| and |least_cost| in the
-|vert_break| routine that we have already studied; i.e., they record the
-location and value of the best place currently known for breaking the
-current page. The value of |page_goal| at the time of the best break is
-stored in |best_size|.
-
-@d inserts_only=1
- {|page_contents| when an insert node has been contributed, but no boxes}
-@d box_there=2 {|page_contents| when a box or rule has been contributed}
-
-@<Glob...@>=
-@!page_tail:pointer; {the final node on the current page}
-@!page_contents:empty..box_there; {what is on the current page so far?}
-@!page_max_depth:scaled; {maximum box depth on page being built}
-@!best_page_break:pointer; {break here to get the best page known so far}
-@!least_page_cost:integer; {the score for this currently best page}
-@!best_size:scaled; {its |page_goal|}
-
-@ The page builder has another data structure to keep track of insertions.
-This is a list of four-word nodes, starting and ending at |page_ins_head|.
-That is, the first element of the list is node |r@t$_1$@>=link(page_ins_head)|;
-node $r_j$ is followed by |r@t$_{j+1}$@>=link(r@t$_j$@>)|; and if there are
-|n| items we have |r@t$_{n+1}$@>=page_ins_head|. The |subtype| field of
-each node in this list refers to an insertion number; for example, `\.{\\insert
-250}' would correspond to a node whose |subtype| is |qi(250)|
-(the same as the |subtype| field of the relevant |ins_node|). These |subtype|
-fields are in increasing order, and |subtype(page_ins_head)=
-qi(255)|, so |page_ins_head| serves as a convenient sentinel
-at the end of the list. A record is present for each insertion number that
-appears in the current page.
-
-The |type| field in these nodes distinguishes two possibilities that
-might occur as we look ahead before deciding on the optimum page break.
-If |type(r)=inserting|, then |height(r)| contains the total of the
-height-plus-depth dimensions of the box and all its inserts seen so far.
-If |type(r)=split_up|, then no more insertions will be made into this box,
-because at least one previous insertion was too big to fit on the current
-page; |broken_ptr(r)| points to the node where that insertion will be
-split, if \TeX\ decides to split it, |broken_ins(r)| points to the
-insertion node that was tentatively split, and |height(r)| includes also the
-natural height plus depth of the part that would be split off.
-
-In both cases, |last_ins_ptr(r)| points to the last |ins_node|
-encountered for box |qo(subtype(r))| that would be at least partially
-inserted on the next page; and |best_ins_ptr(r)| points to the last
-such |ins_node| that should actually be inserted, to get the page with
-minimum badness among all page breaks considered so far. We have
-|best_ins_ptr(r)=null| if and only if no insertion for this box should
-be made to produce this optimum page.
-
-The data structure definitions here use the fact that the |@!height| field
-appears in the fourth word of a box node.
-@^data structure assumptions@>
-
-@d page_ins_node_size=4 {number of words for a page insertion node}
-@d inserting=0 {an insertion class that has not yet overflowed}
-@d split_up=1 {an overflowed insertion class}
-@d broken_ptr(#)==link(#+1)
- {an insertion for this class will break here if anywhere}
-@d broken_ins(#)==info(#+1) {this insertion might break at |broken_ptr|}
-@d last_ins_ptr(#)==link(#+2) {the most recent insertion for this |subtype|}
-@d best_ins_ptr(#)==info(#+2) {the optimum most recent insertion}
-
-@<Initialize the special list heads...@>=
-subtype(page_ins_head):=qi(255);
-type(page_ins_head):=split_up; link(page_ins_head):=page_ins_head;
-
-@ An array |page_so_far| records the heights and depths of everything
-on the current page. This array contains six |scaled| numbers, like the
-similar arrays already considered in |line_break| and |vert_break|; and it
-also contains |page_goal| and |page_depth|, since these values are
-all accessible to the user via |set_page_dimen| commands. The
-value of |page_so_far[1]| is also called |page_total|. The stretch
-and shrink components of the \.{\\skip} corrections for each insertion are
-included in |page_so_far|, but the natural space components of these
-corrections are not, since they have been subtracted from |page_goal|.
-
-The variable |page_depth| records the depth of the current page; it has been
-adjusted so that it is at most |page_max_depth|. The variable
-|last_glue| points to the glue specification of the most recent node
-contributed from the contribution list, if this was a glue node; otherwise
-|last_glue=max_halfword|. (If the contribution list is nonempty,
-however, the value of |last_glue| is not necessarily accurate.)
-The variables |last_penalty|, |last_kern|, and |last_node_type|
-are similar. And
-finally, |insert_penalties| holds the sum of the penalties associated with
-all split and floating insertions.
-
-@d page_goal==page_so_far[0] {desired height of information on page being built}
-@d page_total==page_so_far[1] {height of the current page}
-@d page_shrink==page_so_far[6] {shrinkability of the current page}
-@d page_depth==page_so_far[7] {depth of the current page}
-
-@<Glob...@>=
-@!page_so_far:array [0..7] of scaled; {height and glue of the current page}
-@!last_glue:pointer; {used to implement \.{\\lastskip}}
-@!last_penalty:integer; {used to implement \.{\\lastpenalty}}
-@!last_kern:scaled; {used to implement \.{\\lastkern}}
-@!last_node_type:integer; {used to implement \.{\\lastnodetype}}
-@!insert_penalties:integer; {sum of the penalties for insertions
- that were held over}
-
-@ @<Put each...@>=
-primitive("pagegoal",set_page_dimen,0);
-@!@:page_goal_}{\.{\\pagegoal} primitive@>
-primitive("pagetotal",set_page_dimen,1);
-@!@:page_total_}{\.{\\pagetotal} primitive@>
-primitive("pagestretch",set_page_dimen,2);
-@!@:page_stretch_}{\.{\\pagestretch} primitive@>
-primitive("pagefilstretch",set_page_dimen,3);
-@!@:page_fil_stretch_}{\.{\\pagefilstretch} primitive@>
-primitive("pagefillstretch",set_page_dimen,4);
-@!@:page_fill_stretch_}{\.{\\pagefillstretch} primitive@>
-primitive("pagefilllstretch",set_page_dimen,5);
-@!@:page_filll_stretch_}{\.{\\pagefilllstretch} primitive@>
-primitive("pageshrink",set_page_dimen,6);
-@!@:page_shrink_}{\.{\\pageshrink} primitive@>
-primitive("pagedepth",set_page_dimen,7);
-@!@:page_depth_}{\.{\\pagedepth} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-set_page_dimen: case chr_code of
-0: print_esc("pagegoal");
-1: print_esc("pagetotal");
-2: print_esc("pagestretch");
-3: print_esc("pagefilstretch");
-4: print_esc("pagefillstretch");
-5: print_esc("pagefilllstretch");
-6: print_esc("pageshrink");
-othercases print_esc("pagedepth")
-endcases;
-
-@ @d print_plus_end(#)==print(#);@+end
-@d print_plus(#)==if page_so_far[#]<>0 then
- begin print(" plus "); print_scaled(page_so_far[#]); print_plus_end
-
-@p procedure print_totals;
-begin print_scaled(page_total);
-print_plus(2)("");
-print_plus(3)("fil");
-print_plus(4)("fill");
-print_plus(5)("filll");
-if page_shrink<>0 then
- begin print(" minus "); print_scaled(page_shrink);
- end;
-end;
-
-@ @<Show the status of the current page@>=
-if page_head<>page_tail then
- begin print_nl("### current page:");
- if output_active then print(" (held over for next output)");
-@.held over for next output@>
- show_box(link(page_head));
- if page_contents>empty then
- begin print_nl("total height "); print_totals;
-@:total_height}{\.{total height}@>
- print_nl(" goal height "); print_scaled(page_goal);
-@.goal height@>
- r:=link(page_ins_head);
- while r<>page_ins_head do
- begin print_ln; print_esc("insert"); t:=qo(subtype(r));
- print_int(t); print(" adds ");
- if count(t)=1000 then t:=height(r)
- else t:=x_over_n(height(r),1000)*count(t);
- print_scaled(t);
- if type(r)=split_up then
- begin q:=page_head; t:=0;
- repeat q:=link(q);
- if (type(q)=ins_node)and(subtype(q)=subtype(r)) then incr(t);
- until q=broken_ins(r);
- print(", #"); print_int(t); print(" might split");
- end;
- r:=link(r);
- end;
- end;
- end
-
-@ Here is a procedure that is called when the |page_contents| is changing
-from |empty| to |inserts_only| or |box_there|.
-
-@d set_page_so_far_zero(#)==page_so_far[#]:=0
-
-@p procedure freeze_page_specs(@!s:small_number);
-begin page_contents:=s;
-page_goal:=vsize; page_max_depth:=max_depth;
-page_depth:=0; do_all_six(set_page_so_far_zero);
-least_page_cost:=awful_bad;
-@!stat if tracing_pages>0 then
- begin begin_diagnostic;
- print_nl("%% goal height="); print_scaled(page_goal);
-@.goal height@>
- print(", max depth="); print_scaled(page_max_depth);
- end_diagnostic(false);
- end;@;@+tats@;@/
-end;
-
-@ Pages are built by appending nodes to the current list in \TeX's
-vertical mode, which is at the outermost level of the semantic nest. This
-vlist is split into two parts; the ``current page'' that we have been
-talking so much about already, and the ``contribution list'' that receives
-new nodes as they are created. The current page contains everything that
-the page builder has accounted for in its data structures, as described
-above, while the contribution list contains other things that have been
-generated by other parts of \TeX\ but have not yet been
-seen by the page builder.
-The contribution list starts at |link(contrib_head)|, and it ends at the
-current node in \TeX's vertical mode.
-
-When \TeX\ has appended new material in vertical mode, it calls the procedure
-|build_page|, which tries to catch up by moving nodes from the contribution
-list to the current page. This procedure will succeed in its goal of
-emptying the contribution list, unless a page break is discovered, i.e.,
-unless the current page has grown to the point where the optimum next
-page break has been determined. In the latter case, the nodes after the
-optimum break will go back onto the contribution list, and control will
-effectively pass to the user's output routine.
-
-We make |type(page_head)=glue_node|, so that an initial glue node on
-the current page will not be considered a valid breakpoint.
-
-@<Initialize the special list...@>=
-type(page_head):=glue_node; subtype(page_head):=normal;
-
-@ The global variable |output_active| is true during the time the
-user's output routine is driving \TeX.
-
-@<Glob...@>=
-@!output_active:boolean; {are we in the midst of an output routine?}
-
-@ @<Set init...@>=
-output_active:=false; insert_penalties:=0;
-
-@ The page builder is ready to start a fresh page if we initialize
-the following state variables. (However, the page insertion list is initialized
-elsewhere.)
-
-@<Start a new current page@>=
-page_contents:=empty; page_tail:=page_head; link(page_head):=null;@/
-last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
-last_node_type:=-1;
-page_depth:=0; page_max_depth:=0
-
-@ At certain times box 255 is supposed to be void (i.e., |null|),
-or an insertion box is supposed to be ready to accept a vertical list.
-If not, an error message is printed, and the following subroutine
-flushes the unwanted contents, reporting them to the user.
-
-@p procedure box_error(@!n:eight_bits);
-begin error; begin_diagnostic;
-print_nl("The following box has been deleted:");
-@.The following...deleted@>
-show_box(box(n)); end_diagnostic(true);
-flush_node_list(box(n)); box(n):=null;
-end;
-
-@ The following procedure guarantees that a given box register
-does not contain an \.{\\hbox}.
-
-@p procedure ensure_vbox(@!n:eight_bits);
-var p:pointer; {the box register contents}
-begin p:=box(n);
-if p<>null then if type(p)=hlist_node then
- begin print_err("Insertions can only be added to a vbox");
-@.Insertions can only...@>
- help3("Tut tut: You're trying to \insert into a")@/
- ("\box register that now contains an \hbox.")@/
- ("Proceed, and I'll discard its present contents.");
- box_error(n);
- end;
-end;
-
-@ \TeX\ is not always in vertical mode at the time |build_page|
-is called; the current mode reflects what \TeX\ should return to, after
-the contribution list has been emptied. A call on |build_page| should
-be immediately followed by `|goto big_switch|', which is \TeX's central
-control point.
-
-@d contribute=80 {go here to link a node into the current page}
-
-@p @t\4@>@<Declare the procedure called |fire_up|@>@;@/
-procedure build_page; {append contributions to the current page}
-label exit,done,done1,continue,contribute,update_heights;
-var p:pointer; {the node being appended}
-@!q,@!r:pointer; {nodes being examined}
-@!b,@!c:integer; {badness and cost of current page}
-@!pi:integer; {penalty to be added to the badness}
-@!n:min_quarterword..255; {insertion box number}
-@!delta,@!h,@!w:scaled; {sizes used for insertion calculations}
-begin if (link(contrib_head)=null)or output_active then return;
-repeat continue: p:=link(contrib_head);@/
-@<Update the values of |last_glue|, |last_penalty|, and |last_kern|@>;
-@<Move node |p| to the current page; if it is time for a page break,
- put the nodes following the break back onto the contribution list,
- and |return| to the user's output routine if there is one@>;
-until link(contrib_head)=null;
-@<Make the contribution list empty by setting its tail to |contrib_head|@>;
-exit:end;
-
-@ @d contrib_tail==nest[0].tail_field {tail of the contribution list}
-
-@<Make the contribution list empty...@>=
-if nest_ptr=0 then tail:=contrib_head {vertical mode}
-else contrib_tail:=contrib_head {other modes}
-
-@ @<Update the values of |last_glue|...@>=
-if last_glue<>max_halfword then delete_glue_ref(last_glue);
-last_penalty:=0; last_kern:=0;
-last_node_type:=type(p)+1;
-if type(p)=glue_node then
- begin last_glue:=glue_ptr(p); add_glue_ref(last_glue);
- end
-else begin last_glue:=max_halfword;
- if type(p)=penalty_node then last_penalty:=penalty(p)
- else if type(p)=kern_node then last_kern:=width(p);
- end
-
-@ The code here is an example of a many-way switch into routines that
-merge together in different places. Some people call this unstructured
-programming, but the author doesn't see much wrong with it, as long as
-@^Knuth, Donald Ervin@>
-the various labels have a well-understood meaning.
-
-@<Move node |p| to the current page; ...@>=
-@<If the current page is empty and node |p| is to be deleted, |goto done1|;
- otherwise use node |p| to update the state of the current page;
- if this node is an insertion, |goto contribute|; otherwise if this node
- is not a legal breakpoint, |goto contribute| or |update_heights|;
- otherwise set |pi| to the penalty associated with this breakpoint@>;
-@<Check if node |p| is a new champion breakpoint; then \(if)if it is time for
- a page break, prepare for output, and either fire up the user's
- output routine and |return| or ship out the page and |goto done|@>;
-if (type(p)<glue_node)or(type(p)>kern_node) then goto contribute;
-update_heights:@<Update the current page measurements with respect to the
- glue or kern specified by node~|p|@>;
-contribute: @<Make sure that |page_max_depth| is not exceeded@>;
-@<Link node |p| into the current page and |goto done|@>;
-done1:@<Recycle node |p|@>;
-done:
-
-@ @<Link node |p| into the current page and |goto done|@>=
-link(page_tail):=p; page_tail:=p;
-link(contrib_head):=link(p); link(p):=null; goto done
-
-@ @<Recycle node |p|@>=
-link(contrib_head):=link(p); link(p):=null;
-if saving_vdiscards>0 then
- begin if page_disc=null then page_disc:=p@+else link(tail_page_disc):=p;
- tail_page_disc:=p;
- end
-else flush_node_list(p)
-
-@ The title of this section is already so long, it seems best to avoid
-making it more accurate but still longer, by mentioning the fact that a
-kern node at the end of the contribution list will not be contributed until
-we know its successor.
-
-@<If the current page is empty...@>=
-case type(p) of
-hlist_node,vlist_node,rule_node: if page_contents<box_there then
- @<Initialize the current page, insert the \.{\\topskip} glue
- ahead of |p|, and |goto continue|@>
- else @<Prepare to move a box or rule node to the current page,
- then |goto contribute|@>;
-whatsit_node: if (page_contents < box_there) and
- ((subtype(p) = pdf_snapy_node) or
- (subtype(p) = pdf_snapy_comp_node)) then
- begin
- print("snap node being discarded");
- goto done1;
- end
- else @<Prepare to move whatsit |p| to the current page,
- then |goto contribute|@>;
-glue_node: if page_contents<box_there then goto done1
- else if precedes_break(page_tail) then pi:=0
- else goto update_heights;
-kern_node: if page_contents<box_there then goto done1
- else if link(p)=null then return
- else if type(link(p))=glue_node then pi:=0
- else goto update_heights;
-penalty_node: if page_contents<box_there then goto done1@+else pi:=penalty(p);
-mark_node: goto contribute;
-ins_node: @<Append an insertion to the current page and |goto contribute|@>;
-othercases confusion("page")
-@:this can't happen page}{\quad page@>
-endcases
-
-@ @<Initialize the current page, insert the \.{\\topskip} glue...@>=
-begin if page_contents=empty then freeze_page_specs(box_there)
-else page_contents:=box_there;
-q:=new_skip_param(top_skip_code); {now |temp_ptr=glue_ptr(q)|}
-if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
-else width(temp_ptr):=0;
-link(q):=p; link(contrib_head):=q; goto continue;
-end
-
-@ @<Prepare to move a box or rule node to the current page...@>=
-begin page_total:=page_total+page_depth+height(p);
-page_depth:=depth(p);
-goto contribute;
-end
-
-@ @<Make sure that |page_max_depth| is not exceeded@>=
-if page_depth>page_max_depth then
- begin page_total:=@|
- page_total+page_depth-page_max_depth;@/
- page_depth:=page_max_depth;
- end;
-
-@ @<Update the current page measurements with respect to the glue...@>=
-if type(p)=kern_node then q:=p
-else begin q:=glue_ptr(p);
- page_so_far[2+stretch_order(q)]:=@|
- page_so_far[2+stretch_order(q)]+stretch(q);@/
- page_shrink:=page_shrink+shrink(q);
- if (shrink_order(q)<>normal)and(shrink(q)<>0) then
- begin@t@>@;@/
- print_err("Infinite glue shrinkage found on current page");@/
-@.Infinite glue shrinkage...@>
- help4("The page about to be output contains some infinitely")@/
- ("shrinkable glue, e.g., `\vss' or `\vskip 0pt minus 1fil'.")@/
- ("Such glue doesn't belong there; but you can safely proceed,")@/
- ("since the offensive shrinkability has been made finite.");
- error;
- r:=new_spec(q); shrink_order(r):=normal; delete_glue_ref(q);
- glue_ptr(p):=r; q:=r;
- end;
- end;
-page_total:=page_total+page_depth+width(q); page_depth:=0
-
-@ @<Check if node |p| is a new champion breakpoint; then \(if)...@>=
-if pi<inf_penalty then
- begin @<Compute the badness, |b|, of the current page,
- using |awful_bad| if the box is too full@>;
- if b<awful_bad then
- if pi<=eject_penalty then c:=pi
- else if b<inf_bad then c:=b+pi+insert_penalties
- else c:=deplorable
- else c:=b;
- if insert_penalties>=10000 then c:=awful_bad;
- @!stat if tracing_pages>0 then @<Display the page break cost@>;@+tats@;@/
- if c<=least_page_cost then
- begin best_page_break:=p; best_size:=page_goal;
- least_page_cost:=c;
- r:=link(page_ins_head);
- while r<>page_ins_head do
- begin best_ins_ptr(r):=last_ins_ptr(r);
- r:=link(r);
- end;
- end;
- if (c=awful_bad)or(pi<=eject_penalty) then
- begin fire_up(p); {output the current page at the best place}
- if output_active then return; {user's output routine will act}
- goto done; {the page has been shipped out by default output routine}
- end;
- end
-
-@ @<Display the page break cost@>=
-begin begin_diagnostic; print_nl("%");
-print(" t="); print_totals;@/
-print(" g="); print_scaled(page_goal);@/
-print(" b=");
-if b=awful_bad then print_char("*")@+else print_int(b);
-@.*\relax@>
-print(" p="); print_int(pi);
-print(" c=");
-if c=awful_bad then print_char("*")@+else print_int(c);
-if c<=least_page_cost then print_char("#");
-end_diagnostic(false);
-end
-
-@ @<Compute the badness, |b|, of the current page...@>=
-if page_total<page_goal then
- if (page_so_far[3]<>0) or (page_so_far[4]<>0) or@|
- (page_so_far[5]<>0) then b:=0
- else b:=badness(page_goal-page_total,page_so_far[2])
-else if page_total-page_goal>page_shrink then b:=awful_bad
-else b:=badness(page_total-page_goal,page_shrink)
-
-@ @<Append an insertion to the current page and |goto contribute|@>=
-begin if page_contents=empty then freeze_page_specs(inserts_only);
-n:=subtype(p); r:=page_ins_head;
-while n>=subtype(link(r)) do r:=link(r);
-n:=qo(n);
-if subtype(r)<>qi(n) then
- @<Create a page insertion node with |subtype(r)=qi(n)|, and
- include the glue correction for box |n| in the
- current page state@>;
-if type(r)=split_up then insert_penalties:=insert_penalties+float_cost(p)
-else begin last_ins_ptr(r):=p;
- delta:=page_goal-page_total-page_depth+page_shrink;
- {this much room is left if we shrink the maximum}
- if count(n)=1000 then h:=height(p)
- else h:=x_over_n(height(p),1000)*count(n); {this much room is needed}
- if ((h<=0)or(h<=delta))and(height(p)+height(r)<=dimen(n)) then
- begin page_goal:=page_goal-h; height(r):=height(r)+height(p);
- end
- else @<Find the best way to split the insertion, and change
- |type(r)| to |split_up|@>;
- end;
-goto contribute;
-end
-
-@ We take note of the value of \.{\\skip} |n| and the height plus depth
-of \.{\\box}~|n| only when the first \.{\\insert}~|n| node is
-encountered for a new page. A user who changes the contents of \.{\\box}~|n|
-after that first \.{\\insert}~|n| had better be either extremely careful
-or extremely lucky, or both.
-
-@<Create a page insertion node...@>=
-begin q:=get_node(page_ins_node_size); link(q):=link(r); link(r):=q; r:=q;
-subtype(r):=qi(n); type(r):=inserting; ensure_vbox(n);
-if box(n)=null then height(r):=0
-else height(r):=height(box(n))+depth(box(n));
-best_ins_ptr(r):=null;@/
-q:=skip(n);
-if count(n)=1000 then h:=height(r)
-else h:=x_over_n(height(r),1000)*count(n);
-page_goal:=page_goal-h-width(q);@/
-page_so_far[2+stretch_order(q)]:=@|page_so_far[2+stretch_order(q)]+stretch(q);@/
-page_shrink:=page_shrink+shrink(q);
-if (shrink_order(q)<>normal)and(shrink(q)<>0) then
- begin print_err("Infinite glue shrinkage inserted from "); print_esc("skip");
-@.Infinite glue shrinkage...@>
- print_int(n);
- help3("The correction glue for page breaking with insertions")@/
- ("must have finite shrinkability. But you may proceed,")@/
- ("since the offensive shrinkability has been made finite.");
- error;
- end;
-end
-
-@ Here is the code that will split a long footnote between pages, in an
-emergency. The current situation deserves to be recapitulated: Node |p|
-is an insertion into box |n|; the insertion will not fit, in its entirety,
-either because it would make the total contents of box |n| greater than
-\.{\\dimen} |n|, or because it would make the incremental amount of growth
-|h| greater than the available space |delta|, or both. (This amount |h| has
-been weighted by the insertion scaling factor, i.e., by \.{\\count} |n|
-over 1000.) Now we will choose the best way to break the vlist of the
-insertion, using the same criteria as in the \.{\\vsplit} operation.
-
-@<Find the best way to split the insertion...@>=
-begin if count(n)<=0 then w:=max_dimen
-else begin w:=page_goal-page_total-page_depth;
- if count(n)<>1000 then w:=x_over_n(w,count(n))*1000;
- end;
-if w>dimen(n)-height(r) then w:=dimen(n)-height(r);
-q:=vert_break(ins_ptr(p),w,depth(p));
-height(r):=height(r)+best_height_plus_depth;
-@!stat if tracing_pages>0 then @<Display the insertion split cost@>;@+tats@;@/
-if count(n)<>1000 then
- best_height_plus_depth:=x_over_n(best_height_plus_depth,1000)*count(n);
-page_goal:=page_goal-best_height_plus_depth;
-type(r):=split_up; broken_ptr(r):=q; broken_ins(r):=p;
-if q=null then insert_penalties:=insert_penalties+eject_penalty
-else if type(q)=penalty_node then insert_penalties:=insert_penalties+penalty(q);
-end
-
-@ @<Display the insertion split cost@>=
-begin begin_diagnostic; print_nl("% split"); print_int(n);
-@.split@>
-print(" to "); print_scaled(w);
-print_char(","); print_scaled(best_height_plus_depth);@/
-print(" p=");
-if q=null then print_int(eject_penalty)
-else if type(q)=penalty_node then print_int(penalty(q))
-else print_char("0");
-end_diagnostic(false);
-end
-
-@ When the page builder has looked at as much material as could appear before
-the next page break, it makes its decision. The break that gave minimum
-badness will be used to put a completed ``page'' into box 255, with insertions
-appended to their other boxes.
-
-We also set the values of |top_mark|, |first_mark|, and |bot_mark|. The
-program uses the fact that |bot_mark<>null| implies |first_mark<>null|;
-it also knows that |bot_mark=null| implies |top_mark=first_mark=null|.
-
-The |fire_up| subroutine prepares to output the current page at the best
-place; then it fires up the user's output routine, if there is one,
-or it simply ships out the page. There is one parameter, |c|, which represents
-the node that was being contributed to the page when the decision to
-force an output was made.
-
-@<Declare the procedure called |fire_up|@>=
-procedure fire_up(@!c:pointer);
-label exit;
-var p,@!q,@!r,@!s:pointer; {nodes being examined and/or changed}
-@!prev_p:pointer; {predecessor of |p|}
-@!n:min_quarterword..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|}
-begin @<Set the value of |output_penalty|@>;
-if sa_mark<>null then
- if do_marks(fire_up_init,0,sa_mark) then sa_mark:=null;
-if bot_mark<>null then
- begin if top_mark<>null then delete_token_ref(top_mark);
- top_mark:=bot_mark; add_token_ref(top_mark);
- delete_token_ref(first_mark); first_mark:=null;
- end;
-@<Put the \(o)optimal current page into box 255, update |first_mark| and
- |bot_mark|, append insertions to their boxes, and put the
- remaining nodes back on the contribution list@>;
-if sa_mark<>null then
- if do_marks(fire_up_done,0,sa_mark) then sa_mark:=null;
-if (top_mark<>null)and(first_mark=null) then
- begin first_mark:=top_mark; add_token_ref(top_mark);
- end;
-if output_routine<>null then
- if dead_cycles>=max_dead_cycles then
- @<Explain that too many dead cycles have occurred in a row@>
- else @<Fire up the user's output routine and |return|@>;
-@<Perform the default output routine@>;
-exit:end;
-
-@ @<Set the value of |output_penalty|@>=
-if type(best_page_break)=penalty_node then
- begin geq_word_define(int_base+output_penalty_code,penalty(best_page_break));
- penalty(best_page_break):=inf_penalty;
- end
-else geq_word_define(int_base+output_penalty_code,inf_penalty)
-
-@ As the page is finally being prepared for output,
-pointer |p| runs through the vlist, with |prev_p| trailing behind;
-pointer |q| is the tail of a list of insertions that
-are being held over for a subsequent page.
-
-@<Put the \(o)optimal current page into box 255...@>=
-if c=best_page_break then best_page_break:=null; {|c| not yet linked in}
-@<Ensure that box 255 is empty before output@>;
-insert_penalties:=0; {this will count the number of insertions held over}
-save_split_top_skip:=split_top_skip;
-if holding_inserts<=0 then
- @<Prepare all the boxes involved in insertions to act as queues@>;
-q:=hold_head; link(q):=null; prev_p:=page_head; p:=link(prev_p);
-while p<>best_page_break do
- begin if type(p)=ins_node then
- begin if holding_inserts<=0 then
- @<Either insert the material specified by node |p| into the
- appropriate box, or hold it for the next page;
- also delete node |p| from the current page@>;
- end
- else if type(p)=mark_node then
- if mark_class(p)<>0 then @<Update the current marks for |fire_up|@>
- else @<Update the values of
- |first_mark| and |bot_mark|@>;
- prev_p:=p; p:=link(prev_p);
- end;
-split_top_skip:=save_split_top_skip;
-@<Break the current page at node |p|, put it in box~255,
- and put the remaining nodes on the contribution list@>;
-@<Delete \(t)the page-insertion nodes@>
-
-@ @<Ensure that box 255 is empty before output@>=
-if box(255)<>null then
- begin print_err(""); print_esc("box"); print("255 is not void");
-@:box255}{\.{\\box255 is not void}@>
- help2("You shouldn't use \box255 except in \output routines.")@/
- ("Proceed, and I'll discard its present contents.");
- box_error(255);
- end
-
-@ @<Update the values of |first_mark| and |bot_mark|@>=
-begin if first_mark=null then
- begin first_mark:=mark_ptr(p);
- add_token_ref(first_mark);
- end;
-if bot_mark<>null then delete_token_ref(bot_mark);
-bot_mark:=mark_ptr(p); add_token_ref(bot_mark);
-end
-
-@ When the following code is executed, the current page runs from node
-|link(page_head)| to node |prev_p|, and the nodes from |p| to |page_tail|
-are to be placed back at the front of the contribution list. Furthermore
-the heldover insertions appear in a list from |link(hold_head)| to |q|; we
-will put them into the current page list for safekeeping while the user's
-output routine is active. We might have |q=hold_head|; and |p=null| if
-and only if |prev_p=page_tail|. Error messages are suppressed within
-|vpackage|, since the box might appear to be overfull or underfull simply
-because the stretch and shrink from the \.{\\skip} registers for inserts
-are not actually present in the box.
-
-@<Break the current page at node |p|, put it...@>=
-if p<>null then
- begin if link(contrib_head)=null then
- if nest_ptr=0 then tail:=page_tail
- else contrib_tail:=page_tail;
- link(page_tail):=link(contrib_head);
- link(contrib_head):=p;
- link(prev_p):=null;
- end;
-save_vbadness:=vbadness; vbadness:=inf_bad;
-save_vfuzz:=vfuzz; vfuzz:=max_dimen; {inhibit error messages}
-box(255):=vpackage(link(page_head),best_size,exactly,page_max_depth);
-vbadness:=save_vbadness; vfuzz:=save_vfuzz;
-if last_glue<>max_halfword then delete_glue_ref(last_glue);
-@<Start a new current page@>; {this sets |last_glue:=max_halfword|}
-if q<>hold_head then
- begin link(page_head):=link(hold_head); page_tail:=q;
- end
-
-@ If many insertions are supposed to go into the same box, we want to know
-the position of the last node in that box, so that we don't need to waste time
-when linking further information into it. The |last_ins_ptr| fields of the
-page insertion nodes are therefore used for this purpose during the
-packaging phase.
-
-@<Prepare all the boxes involved in insertions to act as queues@>=
-begin r:=link(page_ins_head);
-while r<>page_ins_head do
- begin if best_ins_ptr(r)<>null then
- begin n:=qo(subtype(r)); ensure_vbox(n);
- if box(n)=null then box(n):=new_null_box;
- p:=box(n)+list_offset;
- while link(p)<>null do p:=link(p);
- last_ins_ptr(r):=p;
- end;
- r:=link(r);
- end;
-end
-
-@ @<Delete \(t)the page-insertion nodes@>=
-r:=link(page_ins_head);
-while r<>page_ins_head do
- begin q:=link(r); free_node(r,page_ins_node_size); r:=q;
- end;
-link(page_ins_head):=page_ins_head
-
-@ We will set |best_ins_ptr:=null| and package the box corresponding to
-insertion node~|r|, just after making the final insertion into that box.
-If this final insertion is `|split_up|', the remainder after splitting
-and pruning (if any) will be carried over to the next page.
-
-@<Either insert the material specified by node |p| into...@>=
-begin r:=link(page_ins_head);
-while subtype(r)<>subtype(p) do r:=link(r);
-if best_ins_ptr(r)=null then wait:=true
-else begin wait:=false; s:=last_ins_ptr(r); link(s):=ins_ptr(p);
- if best_ins_ptr(r)=p then
- @<Wrap up the box specified by node |r|, splitting node |p| if
- called for; set |wait:=true| if node |p| holds a remainder after
- splitting@>
- else begin while link(s)<>null do s:=link(s);
- last_ins_ptr(r):=s;
- end;
- end;
-@<Either append the insertion node |p| after node |q|, and remove it
- from the current page, or delete |node(p)|@>;
-end
-
-@ @<Wrap up the box specified by node |r|, splitting node |p| if...@>=
-begin if type(r)=split_up then
- if (broken_ins(r)=p)and(broken_ptr(r)<>null) then
- begin while link(s)<>broken_ptr(r) do s:=link(s);
- link(s):=null;
- split_top_skip:=split_top_ptr(p);
- ins_ptr(p):=prune_page_top(broken_ptr(r),false);
- if ins_ptr(p)<>null then
- begin temp_ptr:=vpack(ins_ptr(p),natural);
- height(p):=height(temp_ptr)+depth(temp_ptr);
- free_node(temp_ptr,box_node_size); wait:=true;
- end;
- end;
-best_ins_ptr(r):=null;
-n:=qo(subtype(r));
-temp_ptr:=list_ptr(box(n));
-free_node(box(n),box_node_size);
-box(n):=vpack(temp_ptr,natural);
-end
-
-@ @<Either append the insertion node |p|...@>=
-link(prev_p):=link(p); link(p):=null;
-if wait then
- begin link(q):=p; q:=p; incr(insert_penalties);
- end
-else begin delete_glue_ref(split_top_ptr(p));
- free_node(p,ins_node_size);
- end;
-p:=prev_p
-
-@ The list of heldover insertions, running from |link(page_head)| to
-|page_tail|, must be moved to the contribution list when the user has
-specified no output routine.
-
-@<Perform the default output routine@>=
-begin if link(page_head)<>null then
- begin if link(contrib_head)=null then
- if nest_ptr=0 then tail:=page_tail@+else contrib_tail:=page_tail
- else link(page_tail):=link(contrib_head);
- link(contrib_head):=link(page_head);
- link(page_head):=null; page_tail:=page_head;
- end;
-flush_node_list(page_disc); page_disc:=null;
-ship_out(box(255)); box(255):=null;
-end
-
-@ @<Explain that too many dead cycles have occurred in a row@>=
-begin print_err("Output loop---"); print_int(dead_cycles);
-@.Output loop...@>
-print(" consecutive dead cycles");
-help3("I've concluded that your \output is awry; it never does a")@/
-("\shipout, so I'm shipping \box255 out myself. Next time")@/
-("increase \maxdeadcycles if you want me to be more patient!"); error;
-end
-
-@ @<Fire up the user's output routine and |return|@>=
-begin output_active:=true;
-incr(dead_cycles);
-push_nest; mode:=-vmode; prev_depth:=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 255 is empty after output@>;
-if tail<>head then {current list goes after heldover insertions}
- begin link(page_tail):=link(head);
- page_tail:=tail;
- end;
-if link(page_head)<>null then {and both go before heldover contributions}
- begin if link(contrib_head)=null then contrib_tail:=page_tail;
- link(page_tail):=link(contrib_head);
- link(contrib_head):=link(page_head);
- link(page_head):=null; page_tail:=page_head;
- end;
-flush_node_list(page_disc); page_disc:=null;
-pop_nest; build_page;
-end
-
-@ @<Recover from an unbalanced output routine@>=
-begin print_err("Unbalanced output routine");
-@.Unbalanced output routine@>
-help2("Your sneaky output routine has problematic {'s and/or }'s.")@/
-("I can't handle that very well; good luck."); error;
-repeat get_token;
-until loc=null;
-end {loops forever if reading from a file, since |null=min_halfword<=0|}
-
-@ @<Ensure that box 255 is empty after output@>=
-if box(255)<>null then
- begin print_err("Output routine didn't use all of ");
- print_esc("box"); print_int(255);
-@.Output routine didn't use...@>
- help3("Your \output commands should empty \box255,")@/
- ("e.g., by saying `\shipout\box255'.")@/
- ("Proceed; I'll discard its present contents.");
- box_error(255);
- end
-
-@* \[46] The chief executive.
-We come now to the |main_control| routine, which contains the master
-switch that causes all the various pieces of \TeX\ to do their things,
-in the right order.
-
-In a sense, this is the grand climax of the program: It applies all the
-tools that we have worked so hard to construct. In another sense, this is
-the messiest part of the program: It necessarily refers to other pieces
-of code all over the place, so that a person can't fully understand what is
-going on without paging back and forth to be reminded of conventions that
-are defined elsewhere. We are now at the hub of the web, the central nervous
-system that touches most of the other parts and ties them together.
-@^brain@>
-
-The structure of |main_control| itself is quite simple. There's a label
-called |big_switch|, at which point the next token of input is fetched
-using |get_x_token|. Then the program branches at high speed into one of
-about 100 possible directions, based on the value of the current
-mode and the newly fetched command code; the sum |abs(mode)+cur_cmd|
-indicates what to do next. For example, the case `|vmode+letter|' arises
-when a letter occurs in vertical mode (or internal vertical mode); this
-case leads to instructions that initialize a new paragraph and enter
-horizontal mode.
-
-The big |case| statement that contains this multiway switch has been labeled
-|reswitch|, so that the program can |goto reswitch| when the next token
-has already been fetched. Most of the cases are quite short; they call
-an ``action procedure'' that does the work for that case, and then they
-either |goto reswitch| or they ``fall through'' to the end of the |case|
-statement, which returns control back to |big_switch|. Thus, |main_control|
-is not an extremely large procedure, in spite of the multiplicity of things
-it must do; it is small enough to be handled by \PASCAL\ compilers that put
-severe restrictions on procedure size.
-@!@^action procedure@>
-
-One case is singled out for special treatment, because it accounts for most
-of \TeX's activities in typical applications. The process of reading simple
-text and converting it into |char_node| records, while looking for ligatures
-and kerns, is part of \TeX's ``inner loop''; the whole program runs
-efficiently when its inner loop is fast, so this part has been written
-with particular care.
-
-@ We shall concentrate first on the inner loop of |main_control|, deferring
-consideration of the other cases until later.
-@^inner loop@>
-
-@d big_switch=60 {go here to branch on the next token of input}
-@d main_loop=70 {go here to typeset a string of consecutive characters}
-@d main_loop_wrapup=80 {go here to finish a character or ligature}
-@d main_loop_move=90 {go here to advance the ligature cursor}
-@d main_loop_move_lig=95 {same, when advancing past a generated ligature}
-@d main_loop_lookahead=100 {go here to bring in another character, if any}
-@d main_lig_loop=110 {go here to check for ligatures or kerning}
-@d append_normal_space=120 {go here to append a normal space between words}
-
-@p @t\4@>@<Declare action procedures for use by |main_control|@>@;
-@t\4@>@<Declare the procedure called |handle_right_brace|@>@;
-procedure main_control; {governs \TeX's activities}
-label big_switch,reswitch,main_loop,main_loop_wrapup,
- main_loop_move,main_loop_move+1,main_loop_move+2,main_loop_move_lig,
- main_loop_lookahead,main_loop_lookahead+1,
- main_lig_loop,main_lig_loop+1,main_lig_loop+2,
- append_normal_space,exit;
-var@!t:integer; {general-purpose temporary variable}
-tmp_k1, tmp_k2: pointer; {for testing whether an auto kern should be inserted}
-begin if every_job<>null then begin_token_list(every_job,every_job_text);
-big_switch: get_x_token;@/
-reswitch: @<Give diagnostic information, if requested@>;
-case abs(mode)+cur_cmd of
-hmode+letter,hmode+other_char,hmode+char_given: goto main_loop;
-hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end;
-hmode+no_boundary: begin get_x_token;
- if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
- (cur_cmd=char_num) then cancel_boundary:=true;
- goto reswitch;
- end;
-hmode+spacer:
- if (space_factor = 1000) or (pdf_adjust_interword_glue > 0) then
- goto append_normal_space
- else app_space;
-hmode+ex_space,mmode+ex_space: goto append_normal_space;
-@t\4@>@<Cases of |main_control| that are not part of the inner loop@>@;
-end; {of the big |case| statement}
-goto big_switch;
-main_loop:@<Append character |cur_chr| and the following characters (if~any)
- to the current hlist in the current font; |goto reswitch| when
- a non-character has been fetched@>;
-append_normal_space:@<Append a normal inter-word space to the current list,
- then |goto big_switch|@>;
-exit:end;
-
-@ When a new token has just been fetched at |big_switch|, we have an
-ideal place to monitor \TeX's activity.
-@^debugging@>
-
-@<Give diagnostic information, if requested@>=
-if interrupt<>0 then if OK_to_interrupt then
- begin back_input; check_interrupt; goto big_switch;
- end;
-@!debug if panicking then check_mem(false);@+@;@+gubed
-if tracing_commands>0 then show_cur_cmd_chr
-
-@ The following part of the program was first written in a structured
-manner, according to the philosophy that ``premature optimization is
-the root of all evil.'' Then it was rearranged into pieces of
-spaghetti so that the most common actions could proceed with little or
-no redundancy.
-
-The original unoptimized form of this algorithm resembles the
-|reconstitute| procedure, which was described earlier in connection with
-hyphenation. Again we have an implied ``cursor'' between characters
-|cur_l| and |cur_r|. The main difference is that the |lig_stack| can now
-contain a charnode as well as pseudo-ligatures; that stack is now
-usually nonempty, because the next character of input (if any) has been
-appended to it. In |main_control| we have
-$$|cur_r|=\cases{|character(lig_stack)|,&if |lig_stack>null|;\cr
- |font_bchar[cur_font]|,&otherwise;\cr}$$
-except when |character(lig_stack)=font_false_bchar[cur_font]|.
-Several additional global variables are needed.
-
-@<Glob...@>=
-@!main_f:internal_font_number; {the current font}
-@!main_i:four_quarters; {character information bytes for |cur_l|}
-@!main_j:four_quarters; {ligature/kern command}
-@!main_k:font_index; {index into |font_info|}
-@!main_p:pointer; {temporary register for list manipulation}
-@!main_s:integer; {space factor value}
-@!bchar:halfword; {boundary character of current font, or |non_char|}
-@!false_bchar:halfword; {nonexistent character matching |bchar|, or |non_char|}
-@!cancel_boundary:boolean; {should the left boundary be ignored?}
-@!ins_disc:boolean; {should we insert a discretionary node?}
-
-@ The boolean variables of the main loop are normally false, and always reset
-to false before the loop is left. That saves us the extra work of initializing
-each time.
-
-@<Set init...@>=
-ligature_present:=false; cancel_boundary:=false; lft_hit:=false; rt_hit:=false;
-ins_disc:=false;
-
-@ We leave the |space_factor| unchanged if |sf_code(cur_chr)=0|; otherwise we
-set it equal to |sf_code(cur_chr)|, except that it should never change
-from a value less than 1000 to a value exceeding 1000. The most common
-case is |sf_code(cur_chr)=1000|, so we want that case to be fast.
-
-The overall structure of the main loop is presented here. Some program labels
-are inside the individual sections.
-@^inner loop@>
-
-@d adjust_space_factor==@t@>@;@/
- main_s:=sf_code(cur_chr);
- 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|...@>=
-adjust_space_factor;@/
-save_tail := null;
-main_f:=cur_font;
-bchar:=font_bchar[main_f]; false_bchar:=font_false_bchar[main_f];
-if mode>0 then if language<>clang then fix_language;
-fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_l:=qi(cur_chr);
-character(lig_stack):=cur_l;@/
-cur_q:=tail;
-tmp_k1 := get_auto_kern(main_f, non_char, cur_l);
-@<If |tmp_k1| is not null then append that kern@>;
-if cancel_boundary then
- begin cancel_boundary:=false; main_k:=non_address;
- end
-else main_k:=bchar_label[main_f];
-if main_k=non_address then goto main_loop_move+2; {no left boundary processing}
-cur_r:=cur_l; cur_l:=non_char;
-goto main_lig_loop+1; {begin with cursor after left boundary}
-@#
-main_loop_wrapup:@<Make a ligature node, if |ligature_present|;
- insert a null discretionary, if appropriate@>;
-main_loop_move:@<If the cursor is immediately followed by the right boundary,
- |goto reswitch|; if it's followed by an invalid character, |goto big_switch|;
- otherwise move the cursor one step to the right and |goto main_lig_loop|@>;
-main_loop_lookahead:@<Look ahead for another character, or leave |lig_stack|
- empty if there's none there@>;
-main_lig_loop:@<If there's a ligature/kern command relevant to |cur_l| and
- |cur_r|, adjust the text appropriately; exit to |main_loop_wrapup|@>;
-main_loop_move_lig:@<Move the cursor past a pseudo-ligature, then
- |goto main_loop_lookahead| or |main_lig_loop|@>
-
-@ If |link(cur_q)| is nonnull when |wrapup| is invoked, |cur_q| points to
-the list of characters that were consumed while building the ligature
-character~|cur_l|.
-
-A discretionary break is not inserted for an explicit hyphen when we are in
-restricted horizontal mode. In particular, this avoids putting discretionary
-nodes inside of other discretionaries.
-@^inner loop@>
-
-@d pack_lig(#)== {the parameter is either |rt_hit| or |false|}
- begin main_p:=new_ligature(main_f,cur_l,link(cur_q));
- if lft_hit then
- begin subtype(main_p):=2; lft_hit:=false;
- end;
- if # then if lig_stack=null then
- begin incr(subtype(main_p)); rt_hit:=false;
- end;
- if pdf_prepend_kern > 0 then
- tmp_k2 := get_auto_kern(main_f, non_char, cur_l)
- else
- tmp_k2 := null;
- if tmp_k2 = null then begin
- link(cur_q):=main_p; tail:=main_p; ligature_present:=false;
- end
- else begin
- link(cur_q) := tmp_k2;
- link(tmp_k2) := main_p;
- tail := main_p;
- ligature_present := false;
- end
- end
-
-@d wrapup(#)==if cur_l<non_char then
- begin if link(cur_q)>null then
- if character(tail)=qi(hyphen_char[main_f]) then ins_disc:=true;
- if ligature_present then pack_lig(#);
- if ins_disc then
- begin ins_disc:=false;
- if mode>0 then tail_append(new_disc);
- end;
- end
-
-@<Make a ligature node, if |ligature_present|;...@>=
-wrapup(rt_hit)
-
-@ @<If the cursor is immediately followed by the right boundary...@>=
-@^inner loop@>
-if lig_stack=null then goto reswitch;
-cur_q:=tail; cur_l:=character(lig_stack);
-main_loop_move+1:if not is_char_node(lig_stack) then goto main_loop_move_lig;
-main_loop_move+2:if(cur_chr<font_bc[main_f])or(cur_chr>font_ec[main_f]) then
- begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
- end;
-main_i:=char_info(main_f)(cur_l);
-if not char_exists(main_i) then
- begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
- end;
-link(tail):=lig_stack; tail:=lig_stack {|main_loop_lookahead| is next}
-
-@ Here we are at |main_loop_move_lig|.
-When we begin this code we have |cur_q=tail| and |cur_l=character(lig_stack)|.
-
-@<Move the cursor past a pseudo-ligature...@>=
-main_p:=lig_ptr(lig_stack);
-if main_p>null then tail_append(main_p); {append a single character}
-temp_ptr:=lig_stack; lig_stack:=link(temp_ptr);
-free_node(temp_ptr,small_node_size);
-main_i:=char_info(main_f)(cur_l); ligature_present:=true;
-if lig_stack=null then
- if main_p>null then goto main_loop_lookahead
- else cur_r:=bchar
-else cur_r:=character(lig_stack);
-goto main_lig_loop
-
-@ The result of \.{\\char} can participate in a ligature or kern, so we must
-look ahead for it.
-
-@<Look ahead for another character...@>=
-get_next; {set only |cur_cmd| and |cur_chr|, for speed}
-if cur_cmd=letter then goto main_loop_lookahead+1;
-if cur_cmd=other_char then goto main_loop_lookahead+1;
-if cur_cmd=char_given then goto main_loop_lookahead+1;
-x_token; {now expand and set |cur_cmd|, |cur_chr|, |cur_tok|}
-if cur_cmd=letter then goto main_loop_lookahead+1;
-if cur_cmd=other_char then goto main_loop_lookahead+1;
-if cur_cmd=char_given then goto main_loop_lookahead+1;
-if cur_cmd=char_num then
- begin scan_char_num; cur_chr:=cur_val; goto main_loop_lookahead+1;
- end;
-if cur_cmd=no_boundary then bchar:=non_char;
-cur_r:=bchar; lig_stack:=null; goto main_lig_loop;
-main_loop_lookahead+1: adjust_space_factor;
-fast_get_avail(lig_stack); font(lig_stack):=main_f;
-cur_r:=qi(cur_chr); character(lig_stack):=cur_r;
-if cur_r=false_bchar then cur_r:=non_char {this prevents spurious ligatures}
-
-@ Even though comparatively few characters have a lig/kern program, several
-of the instructions here count as part of \TeX's inner loop, since a
-@^inner loop@>
-potentially long sequential search must be performed. For example, tests with
-Computer Modern Roman showed that about 40 per cent of all characters
-actually encountered in practice had a lig/kern program, and that about four
-lig/kern commands were investigated for every such character.
-
-At the beginning of this code we have |main_i=char_info(main_f)(cur_l)|.
-
-@<If there's a ligature/kern command...@>=
-tmp_k1 := get_auto_kern(main_f, cur_l, cur_r);
-@<If |tmp_k1| is not null then append that kern@>;
-if char_tag(main_i)<>lig_tag then goto main_loop_wrapup;
-if cur_r=non_char then goto main_loop_wrapup;
-main_k:=lig_kern_start(main_f)(main_i); main_j:=font_info[main_k].qqqq;
-if skip_byte(main_j)<=stop_flag then goto main_lig_loop+2;
-main_k:=lig_kern_restart(main_f)(main_j);
-main_lig_loop+1:main_j:=font_info[main_k].qqqq;
-main_lig_loop+2:if next_char(main_j)=cur_r then
- if skip_byte(main_j)<=stop_flag then
- @<Do ligature or kern command, returning to |main_lig_loop|
- or |main_loop_wrapup| or |main_loop_move|@>;
-if skip_byte(main_j)=qi(0) then incr(main_k)
-else begin if skip_byte(main_j)>=stop_flag then goto main_loop_wrapup;
- main_k:=main_k+qo(skip_byte(main_j))+1;
- end;
-goto main_lig_loop+1
-
-@ @<If |tmp_k1| is not null then append that kern@>=
-if tmp_k1 <> null then begin
- wrapup(rt_hit);
- save_tail := tail;
- tail_append(tmp_k1);
- goto main_loop_move;
-end
-
-@ When a ligature or kern instruction matches a character, we know from
-|read_font_info| that the character exists in the font, even though we
-haven't verified its existence in the normal way.
-
-This section could be made into a subroutine, if the code inside
-|main_control| needs to be shortened.
-
-\chardef\?='174 % vertical line to indicate character retention
-
-@<Do ligature or kern command...@>=
-begin if op_byte(main_j)>=kern_flag then
- begin wrapup(rt_hit);
- tail_append(new_kern(char_kern(main_f)(main_j))); goto main_loop_move;
- end;
-if cur_l=non_char then lft_hit:=true
-else if lig_stack=null then rt_hit:=true;
-check_interrupt; {allow a way out in case there's an infinite ligature loop}
-case op_byte(main_j) of
-qi(1),qi(5):begin cur_l:=rem_byte(main_j); {\.{=:\?}, \.{=:\?>}}
- main_i:=char_info(main_f)(cur_l); ligature_present:=true;
- end;
-qi(2),qi(6):begin cur_r:=rem_byte(main_j); {\.{\?=:}, \.{\?=:>}}
- if lig_stack=null then {right boundary character is being consumed}
- begin lig_stack:=new_lig_item(cur_r); bchar:=non_char;
- end
- else if is_char_node(lig_stack) then {|link(lig_stack)=null|}
- begin main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
- lig_ptr(lig_stack):=main_p;
- end
- else character(lig_stack):=cur_r;
- end;
-qi(3):begin cur_r:=rem_byte(main_j); {\.{\?=:\?}}
- main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
- link(lig_stack):=main_p;
- end;
-qi(7),qi(11):begin wrapup(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
- cur_q:=tail; cur_l:=rem_byte(main_j);
- main_i:=char_info(main_f)(cur_l); ligature_present:=true;
- end;
-othercases begin cur_l:=rem_byte(main_j); ligature_present:=true; {\.{=:}}
- if lig_stack=null then goto main_loop_wrapup
- else goto main_loop_move+1;
- end
-endcases;
-if op_byte(main_j)>qi(4) then
- if op_byte(main_j)<>qi(7) then goto main_loop_wrapup;
-if cur_l<non_char then goto main_lig_loop;
-main_k:=bchar_label[main_f]; goto main_lig_loop+1;
-end
-
-@ The occurrence of blank spaces is almost part of \TeX's inner loop,
-@^inner loop@>
-since we usually encounter about one space for every five non-blank characters.
-Therefore |main_control| gives second-highest priority to ordinary spaces.
-
-When a glue parameter like \.{\\spaceskip} is set to `\.{0pt}', we will
-see to it later that the corresponding glue specification is precisely
-|zero_glue|, not merely a pointer to some specification that happens
-to be full of zeroes. Therefore it is simple to test whether a glue parameter
-is zero or~not.
-
-@<Append a normal inter-word space...@>=
-if space_skip=zero_glue then
- begin @<Find the glue specification, |main_p|, for
- text spaces in the current font@>;
- temp_ptr:=new_glue(main_p);
- end
-else temp_ptr:=new_param_glue(space_skip_code);
-if pdf_adjust_interword_glue > 0 then
- adjust_interword_glue(tail, temp_ptr);
-link(tail):=temp_ptr; tail:=temp_ptr;
-goto big_switch
-
-@ Having |font_glue| allocated for each text font saves both time and memory.
-If any of the three spacing parameters are subsequently changed by the
-use of \.{\\fontdimen}, the |find_font_dimen| procedure deallocates the
-|font_glue| specification allocated here.
-
-@<Find the glue specification...@>=
-begin main_p:=font_glue[cur_font];
-if main_p=null then
- begin main_p:=new_spec(zero_glue); main_k:=param_base[cur_font]+space_code;
- width(main_p):=font_info[main_k].sc; {that's |space(cur_font)|}
- stretch(main_p):=font_info[main_k+1].sc; {and |space_stretch(cur_font)|}
- shrink(main_p):=font_info[main_k+2].sc; {and |space_shrink(cur_font)|}
- font_glue[cur_font]:=main_p;
- end;
-end
-
-@ @<Declare act...@>=
-procedure app_space; {handle spaces when |space_factor<>1000|}
-var@!q:pointer; {glue node}
-begin if (space_factor>=2000)and(xspace_skip<>zero_glue) then
- q:=new_param_glue(xspace_skip_code)
-else begin if space_skip<>zero_glue then main_p:=space_skip
- else @<Find the glue specification...@>;
- main_p:=new_spec(main_p);
- @<Modify the glue specification in |main_p| according to the space factor@>;
- q:=new_glue(main_p); glue_ref_count(main_p):=null;
- end;
-link(tail):=q; tail:=q;
-end;
-
-@ @<Modify the glue specification in |main_p| according to the space factor@>=
-if space_factor>=2000 then width(main_p):=width(main_p)+extra_space(cur_font);
-stretch(main_p):=xn_over_d(stretch(main_p),space_factor,1000);
-shrink(main_p):=xn_over_d(shrink(main_p),1000,space_factor)
-
-@ Whew---that covers the main loop. We can now proceed at a leisurely
-pace through the other combinations of possibilities.
-
-@d any_mode(#)==vmode+#,hmode+#,mmode+# {for mode-independent commands}
-
-@<Cases of |main_control| that are not part of the inner loop@>=
-any_mode(relax),vmode+spacer,mmode+spacer,mmode+no_boundary:do_nothing;
-any_mode(ignore_spaces): begin
- if cur_chr = 0 then begin
- @<Get the next non-blank non-call...@>;
- goto reswitch;
- end
- else begin
- t:=scanner_status;
- scanner_status:=normal;
- get_next;
- scanner_status:=t;
- if cur_cs < hash_base then
- cur_cs := prim_lookup(cur_cs-single_base)
- else
- cur_cs := prim_lookup(text(cur_cs));
- if cur_cs<>undefined_primitive then begin
- cur_cmd := prim_eq_type(cur_cs);
- cur_chr := prim_equiv(cur_cs);
- cur_tok := cs_token_flag+prim_eqtb_base+cur_cs;
- goto reswitch;
- end;
- end;
- end;
-vmode+stop: if its_all_over then return; {this is the only way out}
-@t\4@>@<Forbidden cases detected in |main_control|@>@+@,any_mode(mac_param):
- report_illegal_case;
-@<Math-only cases in non-math modes, or vice versa@>: insert_dollar_sign;
-@t\4@>@<Cases of |main_control| that build boxes and lists@>@;
-@t\4@>@<Cases of |main_control| that don't depend on |mode|@>@;
-@t\4@>@<Cases of |main_control| that are for extensions to \TeX@>@;
-
-@ Here is a list of cases where the user has probably gotten into or out of math
-mode by mistake. \TeX\ will insert a dollar sign and rescan the current token.
-
-@d non_math(#)==vmode+#,hmode+#
-
-@<Math-only cases in non-math modes...@>=
-non_math(sup_mark), non_math(sub_mark), non_math(math_char_num),
-non_math(math_given), non_math(math_comp), non_math(delim_num),
-non_math(left_right), non_math(above), non_math(radical),
-non_math(math_style), non_math(math_choice), non_math(vcenter),
-non_math(non_script), non_math(mkern), non_math(limit_switch),
-non_math(mskip), non_math(math_accent),
-mmode+endv, mmode+par_end, mmode+stop, mmode+vskip, mmode+un_vbox,
-mmode+valign, mmode+hrule
-
-@ @<Declare action...@>=
-procedure insert_dollar_sign;
-begin back_input; cur_tok:=math_shift_token+"$";
-print_err("Missing $ inserted");
-@.Missing \$ inserted@>
-help2("I've inserted a begin-math/end-math symbol since I think")@/
-("you left one out. Proceed, with fingers crossed."); ins_error;
-end;
-
-@ When erroneous situations arise, \TeX\ usually issues an error message
-specific to the particular error. For example, `\.{\\noalign}' should
-not appear in any mode, since it is recognized by the |align_peek| routine
-in all of its legitimate appearances; a special error message is given
-when `\.{\\noalign}' occurs elsewhere. But sometimes the most appropriate
-error message is simply that the user is not allowed to do what he or she
-has attempted. For example, `\.{\\moveleft}' is allowed only in vertical mode,
-and `\.{\\lower}' only in non-vertical modes. Such cases are enumerated
-here and in the other sections referred to under `See also \dots.'
-
-@<Forbidden cases...@>=
-vmode+vmove,hmode+hmove,mmode+hmove,any_mode(last_item),
-
-@ The `|you_cant|' procedure prints a line saying that the current command
-is illegal in the current mode; it identifies these things symbolically.
-
-@<Declare action...@>=
-procedure you_cant;
-begin print_err("You can't use `");
-@.You can't use x in y mode@>
-print_cmd_chr(cur_cmd,cur_chr);
-print("' in "); print_mode(mode);
-end;
-
-@ @<Declare act...@>=
-procedure report_illegal_case;
-begin you_cant;
-help4("Sorry, but I'm not programmed to handle this case;")@/
-("I'll just pretend that you didn't ask for it.")@/
-("If you're in the wrong mode, you might be able to")@/
-("return to the right one by typing `I}' or `I$' or `I\par'.");@/
-error;
-end;
-
-@ Some operations are allowed only in privileged modes, i.e., in cases
-that |mode>0|. The |privileged| function is used to detect violations
-of this rule; it issues an error message and returns |false| if the
-current |mode| is negative.
-
-@<Declare act...@>=
-function privileged:boolean;
-begin if mode>0 then privileged:=true
-else begin report_illegal_case; privileged:=false;
- end;
-end;
-
-@ Either \.{\\dump} or \.{\\end} will cause |main_control| to enter the
-endgame, since both of them have `|stop|' as their command code.
-
-@<Put each...@>=
-primitive("end",stop,0);@/
-@!@:end_}{\.{\\end} primitive@>
-primitive("dump",stop,1);@/
-@!@:dump_}{\.{\\dump} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-stop:if chr_code=1 then print_esc("dump")@+else print_esc("end");
-
-@ We don't want to leave |main_control| immediately when a |stop| command
-is sensed, because it may be necessary to invoke an \.{\\output} routine
-several times before things really grind to a halt. (The output routine
-might even say `\.{\\gdef\\end\{...\}}', to prolong the life of the job.)
-Therefore |its_all_over| is |true| only when the current page
-and contribution list are empty, and when the last output was not a
-``dead cycle.''
-
-@<Declare act...@>=
-function its_all_over:boolean; {do this when \.{\\end} or \.{\\dump} occurs}
-label exit;
-begin if privileged then
- begin if (page_head=page_tail)and(head=tail)and(dead_cycles=0) then
- begin its_all_over:=true; return;
- end;
- back_input; {we will try to end again after ejecting residual material}
- tail_append(new_null_box);
- width(tail):=hsize;
- tail_append(new_glue(fill_glue));
- tail_append(new_penalty(-@'10000000000));@/
- build_page; {append \.{\\hbox to \\hsize\{\}\\vfill\\penalty-'10000000000}}
- end;
-its_all_over:=false;
-exit:end;
-
-@* \[47] Building boxes and lists.
-The most important parts of |main_control| are concerned with \TeX's
-chief mission of box-making. We need to control the activities that put
-entries on vlists and hlists, as well as the activities that convert
-those lists into boxes. All of the necessary machinery has already been
-developed; it remains for us to ``push the buttons'' at the right times.
-
-@ As an introduction to these routines, let's consider one of the simplest
-cases: What happens when `\.{\\hrule}' occurs in vertical mode, or
-`\.{\\vrule}' in horizontal mode or math mode? The code in |main_control|
-is short, since the |scan_rule_spec| routine already does most of what is
-required; thus, there is no need for a special action procedure.
-
-Note that baselineskip calculations are disabled after a rule in vertical
-mode, by setting |prev_depth:=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("hskip",hskip,skip_code);@/
-@!@:hskip_}{\.{\\hskip} primitive@>
-primitive("hfil",hskip,fil_code);
-@!@:hfil_}{\.{\\hfil} primitive@>
-primitive("hfill",hskip,fill_code);@/
-@!@:hfill_}{\.{\\hfill} primitive@>
-primitive("hss",hskip,ss_code);
-@!@:hss_}{\.{\\hss} primitive@>
-primitive("hfilneg",hskip,fil_neg_code);@/
-@!@:hfil_neg_}{\.{\\hfilneg} primitive@>
-primitive("vskip",vskip,skip_code);@/
-@!@:vskip_}{\.{\\vskip} primitive@>
-primitive("vfil",vskip,fil_code);
-@!@:vfil_}{\.{\\vfil} primitive@>
-primitive("vfill",vskip,fill_code);@/
-@!@:vfill_}{\.{\\vfill} primitive@>
-primitive("vss",vskip,ss_code);
-@!@:vss_}{\.{\\vss} primitive@>
-primitive("vfilneg",vskip,fil_neg_code);@/
-@!@:vfil_neg_}{\.{\\vfilneg} primitive@>
-primitive("mskip",mskip,mskip_code);@/
-@!@:mskip_}{\.{\\mskip} primitive@>
-primitive("kern",kern,explicit);
-@!@:kern_}{\.{\\kern} primitive@>
-primitive("mkern",mkern,mu_glue);@/
-@!@:mkern_}{\.{\\mkern} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-hskip: case chr_code of
- skip_code:print_esc("hskip");
- fil_code:print_esc("hfil");
- fill_code:print_esc("hfill");
- ss_code:print_esc("hss");
- othercases print_esc("hfilneg")
- endcases;
-vskip: case chr_code of
- skip_code:print_esc("vskip");
- fil_code:print_esc("vfil");
- fill_code:print_esc("vfill");
- ss_code:print_esc("vss");
- othercases print_esc("vfilneg")
- endcases;
-mskip: print_esc("mskip");
-kern: print_esc("kern");
-mkern: print_esc("mkern");
-
-@ All the work relating to glue creation has been relegated to the
-following subroutine. It does not call |build_page|, because it is
-used in at least one place where that would be a mistake.
-
-@<Declare action...@>=
-procedure append_glue;
-var s:small_number; {modifier of skip command}
-begin s:=cur_chr;
-case s of
-fil_code: cur_val:=fil_glue;
-fill_code: cur_val:=fill_glue;
-ss_code: cur_val:=ss_glue;
-fil_neg_code: cur_val:=fil_neg_glue;
-skip_code: scan_glue(glue_val);
-mskip_code: scan_glue(mu_val);
-end; {now |cur_val| points to the glue specification}
-tail_append(new_glue(cur_val));
-if s>=skip_code then
- begin decr(glue_ref_count(cur_val));
- if s>skip_code then subtype(tail):=mu_glue;
- end;
-end;
-
-@ @<Declare act...@>=
-procedure append_kern;
-var s:quarterword; {|subtype| of the kern node}
-begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
-tail_append(new_kern(cur_val)); subtype(tail):=s;
-end;
-
-@ Many of the actions related to box-making are triggered by the appearance
-of braces in the input. For example, when the user says `\.{\\hbox}
-\.{to} \.{100pt\{$\langle\,\hbox{\rm hlist}\,\rangle$\}}' in vertical mode,
-the information about the box size (100pt, |exactly|) is put onto |save_stack|
-with a level boundary word just above it, and |cur_group:=adjusted_hbox_group|;
-\TeX\ enters restricted horizontal mode to process the hlist. The right
-brace eventually causes |save_stack| to be restored to its former state,
-at which time the information about the box size (100pt, |exactly|) is
-available once again; a box is packaged and we leave restricted horizontal
-mode, appending the new box to the current list of the enclosing mode
-(in this case to the current list of vertical mode), followed by any
-vertical adjustments that were removed from the box by |hpack|.
-
-The next few sections of the program are therefore concerned with the
-treatment of left and right curly braces.
-
-@ If a left brace occurs in the middle of a page or paragraph, it simply
-introduces a new level of grouping, and the matching right brace will not have
-such a drastic effect. Such grouping affects neither the mode nor the
-current list.
-
-@<Cases of |main_control| that build...@>=
-non_math(left_brace): new_save_level(simple_group);
-any_mode(begin_group): new_save_level(semi_simple_group);
-any_mode(end_group): if cur_group=semi_simple_group then unsave
- else off_save;
-
-@ We have to deal with errors in which braces and such things are not
-properly nested. Sometimes the user makes an error of commission by
-inserting an extra symbol, but sometimes the user makes an error of omission.
-\TeX\ can't always tell one from the other, so it makes a guess and tries
-to avoid getting into a loop.
-
-The |off_save| routine is called when the current group code is wrong. It tries
-to insert something into the user's input that will help clean off
-the top level.
-
-@<Declare act...@>=
-procedure off_save;
-var p:pointer; {inserted token}
-begin if cur_group=bottom_level then
- @<Drop current token and complain that it was unmatched@>
-else begin back_input; p:=get_avail; link(temp_head):=p;
- print_err("Missing ");
- @<Prepare to insert a token that matches |cur_group|,
- and print what it is@>;
- print(" inserted"); ins_list(link(temp_head));
- help5("I've inserted something that you may have forgotten.")@/
- ("(See the <inserted text> above.)")@/
- ("With luck, this will get me unwedged. But if you")@/
- ("really didn't forget anything, try typing `2' now; then")@/
- ("my insertion and my current dilemma will both disappear.");
- error;
- end;
-end;
-
-@ At this point, |link(temp_head)=p|, a pointer to an empty one-word node.
-
-@<Prepare to insert a token that matches |cur_group|...@>=
-case cur_group of
-semi_simple_group: begin info(p):=cs_token_flag+frozen_end_group;
- print_esc("endgroup");
-@.Missing \\endgroup inserted@>
- end;
-math_shift_group: begin info(p):=math_shift_token+"$"; print_char("$");
-@.Missing \$ inserted@>
- end;
-math_left_group: begin info(p):=cs_token_flag+frozen_right; link(p):=get_avail;
- p:=link(p); info(p):=other_token+"."; print_esc("right.");
-@.Missing \\right\hbox{.} inserted@>
-@^null delimiter@>
- end;
-othercases begin info(p):=right_brace_token+"}"; print_char("}");
-@.Missing \} inserted@>
- end
-endcases
-
-@ @<Drop current token and complain that it was unmatched@>=
-begin print_err("Extra "); print_cmd_chr(cur_cmd,cur_chr);
-@.Extra x@>
-help1("Things are pretty mixed up, but I think the worst is over.");@/
-error;
-end
-
-@ The routine for a |right_brace| character branches into many subcases,
-since a variety of things may happen, depending on |cur_group|. Some
-types of groups are not supposed to be ended by a right brace; error
-messages are given in hopes of pinpointing the problem. Most branches
-of this routine will be filled in later, when we are ready to understand
-them; meanwhile, we must prepare ourselves to deal with such errors.
-
-@<Cases of |main_control| that build...@>=
-any_mode(right_brace): handle_right_brace;
-
-@ @<Declare the procedure called |handle_right_brace|@>=
-procedure handle_right_brace;
-var p,@!q:pointer; {for short-term use}
-@!d:scaled; {holds |split_max_depth| in |insert_group|}
-@!f:integer; {holds |floating_penalty| in |insert_group|}
-begin case cur_group of
-simple_group: unsave;
-bottom_level: begin print_err("Too many }'s");
-@.Too many \}'s@>
- help2("You've closed more groups than you opened.")@/
- ("Such booboos are generally harmless, so keep going."); error;
- end;
-semi_simple_group,math_shift_group,math_left_group: extra_right_brace;
-@t\4@>@<Cases of |handle_right_brace| where a |right_brace| triggers
- a delayed action@>@;
-othercases confusion("rightbrace")
-@:this can't happen rightbrace}{\quad rightbrace@>
-endcases;
-end;
-
-@ @<Declare act...@>=
-procedure extra_right_brace;
-begin print_err("Extra }, or forgotten ");
-@.Extra \}, or forgotten x@>
-case cur_group of
-semi_simple_group: print_esc("endgroup");
-math_shift_group: print_char("$");
-math_left_group: print_esc("right");
-end;@/
-help5("I've deleted a group-closing symbol because it seems to be")@/
-("spurious, as in `$x}$'. But perhaps the } is legitimate and")@/
-("you forgot something else, as in `\hbox{$x}'. In such cases")@/
-("the way to recover is to insert both the forgotten and the")@/
-("deleted material, e.g., by typing `I$}'."); error;
-incr(align_state);
-end;
-
-@ Here is where we clear the parameters that are supposed to revert to their
-default values after every paragraph and when internal vertical mode is entered.
-
-@<Declare act...@>=
-procedure normal_paragraph;
-begin if looseness<>0 then eq_word_define(int_base+looseness_code,0);
-if hang_indent<>0 then eq_word_define(dimen_base+hang_indent_code,0);
-if hang_after<>1 then eq_word_define(int_base+hang_after_code,1);
-if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
-if inter_line_penalties_ptr<>null then
- eq_define(inter_line_penalties_loc,shape_ref,null);
-end;
-
-@ Now let's turn to the question of how \.{\\hbox} is treated. We actually
-need to consider also a slightly larger context, since constructions like
-`\.{\\setbox3=}\penalty0\.{\\hbox...}' and
-`\.{\\leaders}\penalty0\.{\\hbox...}' and
-`\.{\\lower3.8pt\\hbox...}'
-are supposed to invoke quite
-different actions after the box has been packaged. Conversely,
-constructions like `\.{\\setbox3=}' can be followed by a variety of
-different kinds of boxes, and we would like to encode such things in an
-efficient way.
-
-In other words, there are two problems: to represent the context of a box,
-and to represent its type.
-
-The first problem is solved by putting a ``context code'' on the |save_stack|,
-just below the two entries that give the dimensions produced by |scan_spec|.
-The context code is either a (signed) shift amount, or it is a large
-integer |>=box_flag|, where |box_flag=@t$2^{30}$@>|. Codes |box_flag| through
-|global_box_flag-1| represent `\.{\\setbox0}' through `\.{\\setbox32767}';
-codes |global_box_flag| through |ship_out_flag-1| represent
-`\.{\\global\\setbox0}' through `\.{\\global\\setbox32767}';
-code |ship_out_flag| represents `\.{\\shipout}'; and codes |leader_flag|
-through |leader_flag+2| represent `\.{\\leaders}', `\.{\\cleaders}',
-and `\.{\\xleaders}'.
-
-The second problem is solved by giving the command code |make_box| to all
-control sequences that produce a box, and by using the following |chr_code|
-values to distinguish between them: |box_code|, |copy_code|, |last_box_code|,
-|vsplit_code|, |vtop_code|, |vtop_code+vmode|, and |vtop_code+hmode|, where
-the latter two are used to denote \.{\\vbox} and \.{\\hbox}, respectively.
-
-@d box_flag==@'10000000000 {context code for `\.{\\setbox0}'}
-@d global_box_flag==@'10000100000 {context code for `\.{\\global\\setbox0}'}
-@d ship_out_flag==@'10000200000 {context code for `\.{\\shipout}'}
-@d leader_flag==@'10000200001 {context code for `\.{\\leaders}'}
-@d box_code=0 {|chr_code| for `\.{\\box}'}
-@d copy_code=1 {|chr_code| for `\.{\\copy}'}
-@d last_box_code=2 {|chr_code| for `\.{\\lastbox}'}
-@d vsplit_code=3 {|chr_code| for `\.{\\vsplit}'}
-@d vtop_code=4 {|chr_code| for `\.{\\vtop}'}
-
-@<Put each...@>=
-primitive("moveleft",hmove,1);
-@!@:move_left_}{\.{\\moveleft} primitive@>
-primitive("moveright",hmove,0);@/
-@!@:move_right_}{\.{\\moveright} primitive@>
-primitive("raise",vmove,1);
-@!@:raise_}{\.{\\raise} primitive@>
-primitive("lower",vmove,0);
-@!@:lower_}{\.{\\lower} primitive@>
-@#
-primitive("box",make_box,box_code);
-@!@:box_}{\.{\\box} primitive@>
-primitive("copy",make_box,copy_code);
-@!@:copy_}{\.{\\copy} primitive@>
-primitive("lastbox",make_box,last_box_code);
-@!@:last_box_}{\.{\\lastbox} primitive@>
-primitive("vsplit",make_box,vsplit_code);
-@!@:vsplit_}{\.{\\vsplit} primitive@>
-primitive("vtop",make_box,vtop_code);@/
-@!@:vtop_}{\.{\\vtop} primitive@>
-primitive("vbox",make_box,vtop_code+vmode);
-@!@:vbox_}{\.{\\vbox} primitive@>
-primitive("hbox",make_box,vtop_code+hmode);@/
-@!@:hbox_}{\.{\\hbox} primitive@>
-primitive("shipout",leader_ship,a_leaders-1); {|ship_out_flag=leader_flag-1|}
-@!@:ship_out_}{\.{\\shipout} primitive@>
-primitive("leaders",leader_ship,a_leaders);
-@!@:leaders_}{\.{\\leaders} primitive@>
-primitive("cleaders",leader_ship,c_leaders);
-@!@:c_leaders_}{\.{\\cleaders} primitive@>
-primitive("xleaders",leader_ship,x_leaders);
-@!@:x_leaders_}{\.{\\xleaders} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-hmove: if chr_code=1 then print_esc("moveleft")@+else print_esc("moveright");
-vmove: if chr_code=1 then print_esc("raise")@+else print_esc("lower");
-make_box: case chr_code of
- box_code: print_esc("box");
- copy_code: print_esc("copy");
- last_box_code: print_esc("lastbox");
- vsplit_code: print_esc("vsplit");
- vtop_code: print_esc("vtop");
- vtop_code+vmode: print_esc("vbox");
- othercases print_esc("hbox")
- endcases;
-leader_ship: if chr_code=a_leaders then print_esc("leaders")
- else if chr_code=c_leaders then print_esc("cleaders")
- else if chr_code=x_leaders then print_esc("xleaders")
- else print_esc("shipout");
-
-@ Constructions that require a box are started by calling |scan_box| with
-a specified context code. The |scan_box| routine verifies
-that a |make_box| command comes next and then it calls |begin_box|.
-
-@<Cases of |main_control| that build...@>=
-vmode+hmove,hmode+vmove,mmode+vmove: begin t:=cur_chr;
- scan_normal_dimen;
- if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
- end;
-any_mode(leader_ship): scan_box(leader_flag-a_leaders+cur_chr);
-any_mode(make_box): begin_box(0);
-
-@ The global variable |cur_box| will point to a newly made box. If the box
-is void, we will have |cur_box=null|. Otherwise we will have
-|type(cur_box)=hlist_node| or |vlist_node| or |rule_node|; the |rule_node|
-case can occur only with leaders.
-
-@<Glob...@>=
-@!cur_box:pointer; {box to be placed into its context}
-
-@ The |box_end| procedure does the right thing with |cur_box|, if
-|box_context| represents the context as explained above.
-
-@<Declare act...@>=
-procedure box_end(@!box_context:integer);
-var p:pointer; {|ord_noad| for new box in math mode}
-@!a:small_number; {global prefix}
-begin if box_context<box_flag then @<Append box |cur_box| to the current list,
- shifted by |box_context|@>
-else if box_context<ship_out_flag then @<Store \(c)|cur_box| in a box register@>
-else if cur_box<>null then
- if box_context>ship_out_flag then @<Append a new leader node that
- uses |cur_box|@>
- else ship_out(cur_box);
-end;
-
-@ The global variable |adjust_tail| will be non-null if and only if the
-current box might include adjustments that should be appended to the
-current vertical list.
-
-@<Append box |cur_box| to the current...@>=
-begin if cur_box<>null then
- begin shift_amount(cur_box):=box_context;
- if abs(mode)=vmode then
- begin
- if pre_adjust_tail <> null then begin
- if pre_adjust_head <> pre_adjust_tail then
- append_list(pre_adjust_head)(pre_adjust_tail);
- pre_adjust_tail := null;
- end;
- append_to_vlist(cur_box);
- if adjust_tail <> null then begin
- if adjust_head <> adjust_tail then
- append_list(adjust_head)(adjust_tail);
- adjust_tail := null;
- end;
- if mode>0 then build_page;
- end
- else begin if abs(mode)=hmode then space_factor:=1000
- else begin p:=new_noad;
- math_type(nucleus(p)):=sub_box;
- info(nucleus(p)):=cur_box; cur_box:=p;
- end;
- link(tail):=cur_box; tail:=cur_box;
- end;
- end;
-end
-
-@ @<Store \(c)|cur_box| in a box register@>=
-begin if box_context<global_box_flag then
- begin cur_val:=box_context-box_flag; a:=0;
- end
-else begin cur_val:=box_context-global_box_flag; a:=4;
- end;
-if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
-else sa_def_box;
-end
-
-@ @<Append a new leader node ...@>=
-begin @<Get the next non-blank non-relax...@>;
-if ((cur_cmd=hskip)and(abs(mode)<>vmode))or@|
- ((cur_cmd=vskip)and(abs(mode)=vmode)) then
- begin append_glue; subtype(tail):=box_context-(leader_flag-a_leaders);
- leader_ptr(tail):=cur_box;
- end
-else begin print_err("Leaders not followed by proper glue");
-@.Leaders not followed by...@>
- help3("You should say `\leaders <box or rule><hskip or vskip>'.")@/
- ("I found the <box or rule>, but there's no suitable")@/
- ("<hskip or vskip>, so I'm ignoring these leaders."); back_error;
- flush_node_list(cur_box);
- end;
-end
-
-@ Now that we can see what eventually happens to boxes, we can consider
-the first steps in their creation. The |begin_box| routine is called when
-|box_context| is a context specification, |cur_chr| specifies the type of
-box desired, and |cur_cmd=make_box|.
-
-@<Declare act...@>=
-procedure begin_box(@!box_context:integer);
-label exit, done;
-var @!p,@!q:pointer; {run through the current list}
-@!r:pointer; {running behind |p|}
-@!fm:boolean; {a final \.{\\beginM} \.{\\endM} node pair?}
-@!tx:pointer; {effective tail node}
-@!m:quarterword; {the length of a replacement list}
-@!k:halfword; {0 or |vmode| or |hmode|}
-@!n:halfword; {a box number}
-begin case cur_chr of
-box_code: begin scan_register_num; fetch_box(cur_box);
- change_box(null); {the box becomes void, at the same level}
- end;
-copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
- end;
-last_box_code: @<If the current list ends with a box node, delete it from
- the list and make |cur_box| point to it; otherwise set |cur_box:=null|@>;
-vsplit_code: @<Split off part of a vertical box, make |cur_box| point to it@>;
-othercases @<Initiate the construction of an hbox or vbox, then |return|@>
-endcases;@/
-box_end(box_context); {in simple cases, we use the box immediately}
-exit:end;
-
-@ Note that the condition |not is_char_node(tail)| implies that |head<>tail|,
-since |head| is a one-word node.
-
-@d fetch_effective_tail_eTeX(#)== {extract |tx|,
- drop \.{\\beginM} \.{\\endM} pair}
-q:=head; p:=null;
-repeat r:=p; p:=q; fm:=false;
-if not is_char_node(q) then
- if type(q)=disc_node then
- begin for m:=1 to replace_count(q) do p:=link(p);
- if p=tx then #;
- end
- else if (type(q)=math_node)and(subtype(q)=begin_M_code) then fm:=true;
-q:=link(p);
-until q=tx; {found |r|$\to$|p|$\to$|q=tx|}
-q:=link(tx); link(p):=q; link(tx):=null;
-if q=null then if fm then confusion("tail1")
-@:this can't happen tail1}{\quad tail1@>
- else tail:=p
-else if fm then {|r|$\to$|p=begin_M|$\to$|q=end_M|}
- begin tail:=r; link(r):=null; flush_node_list(p);@+end
-@#
-@d check_effective_tail(#)==find_effective_tail_eTeX
-@d fetch_effective_tail==fetch_effective_tail_eTeX
-
-@<If the current list ends with a box node, delete it...@>=
-begin cur_box:=null;
-if abs(mode)=mmode then
- begin you_cant; help1("Sorry; this \lastbox will be void."); error;
- end
-else if (mode=vmode)and(head=tail) then
- begin you_cant;
- help2("Sorry...I usually can't take things from the current page.")@/
- ("This \lastbox will therefore be void."); error;
- end
-else begin check_effective_tail(goto done);
- if not is_char_node(tx) then
- if (type(tx)=hlist_node)or(type(tx)=vlist_node) then
- @<Remove the last box, unless it's part of a discretionary@>;
- done:end;
-end
-
-@ @<Remove the last box...@>=
-begin fetch_effective_tail(goto done);
-cur_box:=tx; shift_amount(cur_box):=0;
-end
-
-@ Here we deal with things like `\.{\\vsplit 13 to 100pt}'.
-
-@<Split off part of a vertical box, make |cur_box| point to it@>=
-begin scan_register_num; n:=cur_val;
-if not scan_keyword("to") then
-@.to@>
- begin print_err("Missing `to' inserted");
-@.Missing `to' inserted@>
- help2("I'm working on `\vsplit<box number> to <dimen>';")@/
- ("will look for the <dimen> next."); error;
- end;
-scan_normal_dimen;
-cur_box:=vsplit(n,cur_val);
-end
-
-@ Here is where we enter restricted horizontal mode or internal vertical
-mode, in order to make a box.
-
-@<Initiate the construction of an hbox or vbox, then |return|@>=
-begin k:=cur_chr-vtop_code; saved(0):=box_context;
-if k=hmode then
- if (box_context<box_flag)and(abs(mode)=vmode) then
- scan_spec(adjusted_hbox_group,true)
- else scan_spec(hbox_group,true)
-else begin if k=vmode then scan_spec(vbox_group,true)
- else begin scan_spec(vtop_group,true); k:=vmode;
- end;
- normal_paragraph;
- end;
-push_nest; mode:=-k;
-if k=vmode then
- begin prev_depth:=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 end_graf; package(0);
- end;
-vtop_group: begin end_graf; package(vtop_code);
- end;
-
-@ @<Declare action...@>=
-procedure package(@!c:small_number);
-var h:scaled; {height of box}
-@!p:pointer; {first node in a box}
-@!d:scaled; {max depth}
-begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3;
-if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1))
-else begin cur_box:=vpackage(link(head),saved(2),saved(1),d);
- if c=vtop_code then @<Readjust the height and depth of |cur_box|,
- for \.{\\vtop}@>;
- end;
-pop_nest; box_end(saved(0));
-end;
-
-@ The height of a `\.{\\vtop}' box is inherited from the first item on its list,
-if that item is an |hlist_node|, |vlist_node|, or |rule_node|; otherwise
-the \.{\\vtop} height is zero.
-
-
-@<Readjust the height...@>=
-begin h:=0; p:=list_ptr(cur_box);
-if p<>null then if type(p)<=rule_node then h:=height(p);
-depth(cur_box):=depth(cur_box)-h+height(cur_box); height(cur_box):=h;
-end
-
-@ Here is a really small patch to add a new primitive called
-\.{\\quitvmode}. In vertical modes, it is identical to \.{\\indent},
-but in horizontal and math modes it is really a no-op (as opposed to
-\.{\\indent}, which executes the |indent_in_hmode| procedure).
-
-A paragraph begins when horizontal-mode material occurs in vertical mode,
-or when the paragraph is explicitly started by `\.{\\quitvmode}',
-`\.{\\indent}' or `\.{\\noindent}'.
-
-@<Put each...@>=
-primitive("indent",start_par,1);
-@!@:indent_}{\.{\\indent} primitive@>
-primitive("noindent",start_par,0);
-@!@:no_indent_}{\.{\\noindent} primitive@>
-primitive("quitvmode",start_par,2);
-@!@:quit_vmode_}{\.{\\quitvmode} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-start_par: if chr_code=0 then print_esc("noindent")@+ else if chr_code=1 then print_esc("indent")@+ else print_esc("quitvmode");
-
-@ @<Cases of |main_control| that build...@>=
-vmode+start_par: new_graf(cur_chr>0);
-vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
- vmode+math_shift,vmode+un_hbox,vmode+vrule,
- vmode+accent,vmode+discretionary,vmode+hskip,vmode+valign,
- vmode+ex_space,vmode+no_boundary:@t@>@;@/
- begin back_input; new_graf(true);
- end;
-
-@ @<Declare act...@>=
-function norm_min(@!h:integer):small_number;
-begin if h<=0 then norm_min:=1@+else if h>=63 then norm_min:=63@+
-else norm_min:=h;
-end;
-@#
-procedure new_graf(@!indented:boolean);
-begin prev_graf:=0;
-if (mode=vmode)or(head<>tail) then
- tail_append(new_param_glue(par_skip_code));
-push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
-prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
- *@'200000+cur_lang;
-if indented then
- begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
- end;
-if every_par<>null then begin_token_list(every_par,every_par_text);
-if nest_ptr=1 then build_page; {put |par_skip| glue on current page}
-end;
-
-@ @<Cases of |main_control| that build...@>=
-hmode+start_par,mmode+start_par: if cur_chr<>2 then indent_in_hmode;
-
-@ @<Declare act...@>=
-procedure indent_in_hmode;
-var p,@!q:pointer;
-begin if cur_chr>0 then {\.{\\indent}}
- begin p:=new_null_box; width(p):=par_indent;
- if abs(mode)=hmode then space_factor:=1000
- else begin q:=new_noad; math_type(nucleus(q)):=sub_box;
- info(nucleus(q)):=p; p:=q;
- end;
- tail_append(p);
- end;
-end;
-
-@ A paragraph ends when a |par_end| command is sensed, or when we are in
-horizontal mode when reaching the right brace of vertical-mode routines
-like \.{\\vbox}, \.{\\insert}, or \.{\\output}.
-
-@<Cases of |main_control| that build...@>=
-vmode+par_end: begin normal_paragraph;
- if mode>0 then build_page;
- end;
-hmode+par_end: begin if align_state<0 then off_save; {this tries to
- recover from an alignment that didn't end properly}
- end_graf; {this takes us to the enclosing mode, if |mode>0|}
- if mode=vmode then build_page;
- end;
-hmode+stop,hmode+vskip,hmode+hrule,hmode+un_vbox,hmode+halign: head_for_vmode;
-
-@ @<Declare act...@>=
-procedure head_for_vmode;
-begin if mode<0 then
- if cur_cmd<>hrule then off_save
- else begin print_err("You can't use `");
- print_esc("hrule"); print("' here except with leaders");
-@.You can't use \\hrule...@>
- help2("To put a horizontal rule in an hbox or an alignment,")@/
- ("you should use \leaders or \hrulefill (see The TeXbook).");
- error;
- end
-else begin back_input; cur_tok:=par_token; back_input; token_type:=inserted;
- end;
-end;
-
-@ @<Declare act...@>=
-procedure end_graf;
-begin if mode=hmode then
- begin if head=tail then pop_nest {null paragraphs are ignored}
- else line_break(false);
- if LR_save<>null then
- begin flush_list(LR_save); LR_save:=null;
- end;
- normal_paragraph;
- error_count:=0;
- end;
-end;
-
-@ Insertion and adjustment and mark nodes are constructed by the following
-pieces of the program.
-
-@<Cases of |main_control| that build...@>=
-any_mode(insert),hmode+vadjust,mmode+vadjust: begin_insert_or_adjust;
-any_mode(mark): make_mark;
-
-@ @<Forbidden...@>=
-vmode+vadjust,
-
-@ @<Declare act...@>=
-procedure begin_insert_or_adjust;
-begin if cur_cmd=vadjust then cur_val:=255
-else begin scan_eight_bit_int;
- if cur_val=255 then
- begin print_err("You can't "); print_esc("insert"); print_int(255);
-@.You can't \\insert255@>
- help1("I'm changing to \insert0; box 255 is special.");
- error; cur_val:=0;
- end;
- end;
-saved(0) := cur_val;
-if (cur_cmd = vadjust) and scan_keyword("pre") then
- saved(1) := 1
-else
- saved(1) := 0;
-save_ptr := save_ptr + 2;
-new_save_level(insert_group); scan_left_brace; normal_paragraph;
-push_nest; mode:=-vmode; prev_depth:=pdf_ignored_dimen;
-end;
-
-@ @<Cases of |handle...@>=
-insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q);
- d:=split_max_depth; f:=floating_penalty; unsave; save_ptr := save_ptr - 2;
- {now |saved(0)| is the insertion number, or 255 for |vadjust|}
- p:=vpack(link(head),natural); pop_nest;
- if saved(0)<255 then
- begin tail_append(get_node(ins_node_size));
- type(tail):=ins_node; subtype(tail):=qi(saved(0));
- height(tail):=height(p)+depth(p); ins_ptr(tail):=list_ptr(p);
- split_top_ptr(tail):=q; depth(tail):=d; float_cost(tail):=f;
- end
- else begin tail_append(get_node(small_node_size));
- type(tail):=adjust_node;@/
- adjust_pre(tail) := saved(1); {the |subtype| is used for |adjust_pre|}
- adjust_ptr(tail):=list_ptr(p); delete_glue_ref(q);
- end;
- free_node(p,box_node_size);
- if nest_ptr=0 then build_page;
- end;
-output_group: @<Resume the page builder...@>;
-
-@ @<Declare act...@>=
-procedure make_mark;
-var p:pointer; {new node}
-@!c:halfword; {the mark class}
-begin if cur_chr=0 then c:=0
-else begin scan_register_num; c:=cur_val;
- end;
-p:=scan_toks(false,true); p:=get_node(small_node_size);
-mark_class(p):=c;
-type(p):=mark_node; subtype(p):=0; {the |subtype| is not used}
-mark_ptr(p):=def_ref; link(tail):=p; tail:=p;
-end;
-
-@ Penalty nodes get into a list via the |break_penalty| command.
-@^penalties@>
-
-@<Cases of |main_control| that build...@>=
-any_mode(break_penalty): append_penalty;
-
-@ @<Declare action...@>=
-procedure append_penalty;
-begin scan_int; tail_append(new_penalty(cur_val));
-if mode=vmode then build_page;
-end;
-
-@ The |remove_item| command removes a penalty, kern, or glue node if it
-appears at the tail of the current list, using a brute-force linear scan.
-Like \.{\\lastbox}, this command is not allowed in vertical mode (except
-internal vertical mode), since the current list in vertical mode is sent
-to the page builder. But if we happen to be able to implement it in
-vertical mode, we do.
-
-@<Cases of |main_control| that build...@>=
-any_mode(remove_item): delete_last;
-
-@ When |delete_last| is called, |cur_chr| is the |type| of node that
-will be deleted, if present.
-
-@<Declare action...@>=
-procedure delete_last;
-label exit;
-var @!p,@!q:pointer; {run through the current list}
-@!r:pointer; {running behind |p|}
-@!fm:boolean; {a final \.{\\beginM} \.{\\endM} node pair?}
-@!tx:pointer; {effective tail node}
-@!m:quarterword; {the length of a replacement list}
-begin if (mode=vmode)and(tail=head) then
- @<Apologize for inability to do the operation now,
- unless \.{\\unskip} follows non-glue@>
-else begin check_effective_tail(return);
- if not is_char_node(tx) then if type(tx)=cur_chr then
- begin fetch_effective_tail(return);
- flush_node_list(tx);
- end;
- end;
-exit:end;
-
-@ @<Apologize for inability to do the operation...@>=
-begin if (cur_chr<>glue_node)or(last_glue<>max_halfword) then
- begin you_cant;
- help2("Sorry...I usually can't take things from the current page.")@/
- ("Try `I\vskip-\lastskip' instead.");
- if cur_chr=kern_node then help_line[0]:=
- ("Try `I\kern-\lastkern' instead.")
- else if cur_chr<>glue_node then help_line[0]:=@|
- ("Perhaps you can make the output routine do it.");
- error;
- end;
-end
-
-@ @<Put each...@>=
-primitive("unpenalty",remove_item,penalty_node);@/
-@!@:un_penalty_}{\.{\\unpenalty} primitive@>
-primitive("unkern",remove_item,kern_node);@/
-@!@:un_kern_}{\.{\\unkern} primitive@>
-primitive("unskip",remove_item,glue_node);@/
-@!@:un_skip_}{\.{\\unskip} primitive@>
-primitive("unhbox",un_hbox,box_code);@/
-@!@:un_hbox_}{\.{\\unhbox} primitive@>
-primitive("unhcopy",un_hbox,copy_code);@/
-@!@:un_hcopy_}{\.{\\unhcopy} primitive@>
-primitive("unvbox",un_vbox,box_code);@/
-@!@:un_vbox_}{\.{\\unvbox} primitive@>
-primitive("unvcopy",un_vbox,copy_code);@/
-@!@:un_vcopy_}{\.{\\unvcopy} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-remove_item: if chr_code=glue_node then print_esc("unskip")
- else if chr_code=kern_node then print_esc("unkern")
- else print_esc("unpenalty");
-un_hbox: if chr_code=copy_code then print_esc("unhcopy")
- else print_esc("unhbox");
-un_vbox: if chr_code=copy_code then print_esc("unvcopy")
- @<Cases of |un_vbox| for |print_cmd_chr|@>@/
- else print_esc("unvbox");
-
-@ The |un_hbox| and |un_vbox| commands unwrap one of the 256 current boxes.
-
-@<Cases of |main_control| that build...@>=
-vmode+un_vbox,hmode+un_hbox,mmode+un_hbox: unpackage;
-
-@ @<Declare act...@>=
-procedure unpackage;
-label done, exit;
-var p:pointer; {the box}
- r: pointer; {to remove marginal kern nodes}
-@!c:box_code..copy_code; {should we copy?}
-begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
-c:=cur_chr; scan_register_num; fetch_box(p);
-if p=null then return;
-if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@|
- ((abs(mode)=hmode)and(type(p)<>hlist_node)) then
- begin print_err("Incompatible list can't be unboxed");
-@.Incompatible list...@>
- help3("Sorry, Pandora. (You sneaky devil.)")@/
- ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/
- ("And I can't open any boxes in math mode.");@/
- error; return;
- end;
-if c=copy_code then link(tail):=copy_node_list(list_ptr(p))
-else begin link(tail):=list_ptr(p); change_box(null);
- free_node(p,box_node_size);
- end;
-done:
-while link(tail) <> null do begin
- r := link(tail);
- if not is_char_node(r) and (type(r) = margin_kern_node) then begin
- link(tail) := link(r);
- free_avail(margin_char(r));
- free_node(r, margin_kern_node_size);
- end;
- tail:=link(tail);
-end;
-exit:end;
-
-@ @<Forbidden...@>=vmode+ital_corr,
-
-@ Italic corrections are converted to kern nodes when the |ital_corr| command
-follows a character. In math mode the same effect is achieved by appending
-a kern of zero here, since italic corrections are supplied later.
-
-@<Cases of |main_control| that build...@>=
-hmode+ital_corr: append_italic_correction;
-mmode+ital_corr: tail_append(new_kern(0));
-
-@ @<Declare act...@>=
-procedure append_italic_correction;
-label exit;
-var p:pointer; {|char_node| at the tail of the current list}
-@!f:internal_font_number; {the font in the |char_node|}
-begin if tail<>head then
- begin if is_char_node(tail) then p:=tail
- else if type(tail)=ligature_node then p:=lig_char(tail)
- else return;
- f:=font(p);
- tail_append(new_kern(char_italic(f)(char_info(f)(character(p)))));
- subtype(tail):=explicit;
- end;
-exit:end;
-
-@ Discretionary nodes are easy in the common case `\.{\\-}', but in the
-general case we must process three braces full of items.
-
-@<Put each...@>=
-primitive("-",discretionary,1);
-@!@:Single-character primitives -}{\quad\.{\\-}@>
-primitive("discretionary",discretionary,0);
-@!@:discretionary_}{\.{\\discretionary} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-discretionary: if chr_code=1 then
- print_esc("-")@+else print_esc("discretionary");
-
-@ @<Cases of |main_control| that build...@>=
-hmode+discretionary,mmode+discretionary: append_discretionary;
-
-@ The space factor does not change when we append a discretionary node,
-but it starts out as 1000 in the subsidiary lists.
-
-@<Declare act...@>=
-procedure append_discretionary;
-var c:integer; {hyphen character}
-begin tail_append(new_disc);
-if cur_chr=1 then
- begin c:=hyphen_char[cur_font];
- if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c);
- end
-else begin incr(save_ptr); saved(-1):=0; new_save_level(disc_group);
- scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
- end;
-end;
-
-@ The three discretionary lists are constructed somewhat as if they were
-hboxes. A~subroutine called |build_discretionary| handles the transitions.
-(This is sort of fun.)
-
-@<Cases of |handle...@>=
-disc_group: build_discretionary;
-
-@ @<Declare act...@>=
-procedure build_discretionary;
-label done,exit;
-var p,@!q:pointer; {for link manipulation}
-@!n:integer; {length of discretionary list}
-begin unsave;
-@<Prune the current list, if necessary, until it contains only
- |char_node|, |kern_node|, |hlist_node|, |vlist_node|, |rule_node|,
- and |ligature_node| items; set |n| to the length of the list,
- and set |q| to the list's tail@>;
-p:=link(head); pop_nest;
-case saved(-1) of
-0:pre_break(tail):=p;
-1:post_break(tail):=p;
-2:@<Attach list |p| to the current list, and record its length;
- then finish up and |return|@>;
-end; {there are no other cases}
-incr(saved(-1)); new_save_level(disc_group); scan_left_brace;
-push_nest; mode:=-hmode; space_factor:=1000;
-exit:end;
-
-@ @<Attach list |p| to the current...@>=
-begin if (n>0)and(abs(mode)=mmode) then
- begin print_err("Illegal math "); print_esc("discretionary");
-@.Illegal math \\disc...@>
- help2("Sorry: The third part of a discretionary break must be")@/
- ("empty, in math formulas. I had to delete your third part.");
- flush_node_list(p); n:=0; error;
- end
-else link(tail):=p;
-if n<=max_quarterword then replace_count(tail):=n
-else begin print_err("Discretionary list is too long");
-@.Discretionary list is too long@>
- help2("Wow---I never thought anybody would tweak me here.")@/
- ("You can't seriously need such a huge discretionary list?");
- error;
- end;
-if n>0 then tail:=q;
-decr(save_ptr); return;
-end
-
-@ During this loop, |p=link(q)| and there are |n| items preceding |p|.
-
-@<Prune the current list, if necessary...@>=
-q:=head; p:=link(q); n:=0;
-while p<>null do
- begin if not is_char_node(p) then if type(p)>rule_node then
- if type(p)<>kern_node then if type(p)<>ligature_node then
- begin print_err("Improper discretionary list");
-@.Improper discretionary list@>
- help1("Discretionary lists must contain only boxes and kerns.");@/
- error;
- begin_diagnostic;
- print_nl("The following discretionary sublist has been deleted:");
-@.The following...deleted@>
- show_box(p);
- end_diagnostic(true);
- flush_node_list(p); link(q):=null; goto done;
- end;
- q:=p; p:=link(q); incr(n);
- end;
-done:
-
-@ We need only one more thing to complete the horizontal mode routines, namely
-the \.{\\accent} primitive.
-
-@<Cases of |main_control| that build...@>=
-hmode+accent: make_accent;
-
-@ The positioning of accents is straightforward but tedious. Given an accent
-of width |a|, designed for characters of height |x| and slant |s|;
-and given a character of width |w|, height |h|, and slant |t|: We will shift
-the accent down by |x-h|, and we will insert kern nodes that have the effect of
-centering the accent over the character and shifting the accent to the
-right by $\delta={1\over2}(w-a)+h\cdot t-x\cdot s$. If either character is
-absent from the font, we will simply use the other, without shifting.
-
-@<Declare act...@>=
-procedure make_accent;
-var s,@!t: real; {amount of slant}
-@!p,@!q,@!r:pointer; {character, box, and kern nodes}
-@!f:internal_font_number; {relevant font}
-@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above}
-@!i:four_quarters; {character information}
-begin scan_char_num; f:=cur_font; p:=new_character(f,cur_val);
-if p<>null then
- begin x:=x_height(f); s:=slant(f)/float_constant(65536);
-@^real division@>
- a:=char_width(f)(char_info(f)(character(p)));@/
- do_assignments;@/
- @<Create a character node |q| for the next character,
- but set |q:=null| if problems arise@>;
- if q<>null then @<Append the accent with appropriate kerns,
- then set |p:=q|@>;
- link(tail):=p; tail:=p; space_factor:=1000;
- end;
-end;
-
-@ @<Create a character node |q| for the next...@>=
-q:=null; f:=cur_font;
-if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then
- q:=new_character(f,cur_chr)
-else if cur_cmd=char_num then
- begin scan_char_num; q:=new_character(f,cur_val);
- end
-else back_input
-
-@ The kern nodes appended here must be distinguished from other kerns, lest
-they be wiped away by the hyphenation algorithm or by a previous line break.
-
-The two kerns are computed with (machine-dependent) |real| arithmetic, but
-their sum is machine-independent; the net effect is machine-independent,
-because the user cannot remove these nodes nor access them via \.{\\lastkern}.
-
-@<Append the accent with appropriate kerns...@>=
-begin t:=slant(f)/float_constant(65536);
-@^real division@>
-i:=char_info(f)(character(q));
-w:=char_width(f)(i); h:=char_height(f)(height_depth(i));
-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; link(tail):=r; link(r):=p;
-tail:=new_kern(-a-delta); subtype(tail):=acc_kern; link(p):=tail; p:=q;
-end
-
-@ When `\.{\\cr}' or `\.{\\span}' or a tab mark comes through the scanner
-into |main_control|, it might be that the user has foolishly inserted
-one of them into something that has nothing to do with alignment. But it is
-far more likely that a left brace or right brace has been omitted, since
-|get_next| takes actions appropriate to alignment only when `\.{\\cr}'
-or `\.{\\span}' or tab marks occur with |align_state=0|. The following
-program attempts to make an appropriate recovery.
-
-@<Cases of |main_control| that build...@>=
-any_mode(car_ret), any_mode(tab_mark): align_error;
-any_mode(no_align): no_align_error;
-any_mode(omit): omit_error;
-
-@ @<Declare act...@>=
-procedure align_error;
-begin if abs(align_state)>2 then
- @<Express consternation over the fact that no alignment is in progress@>
-else begin back_input;
- if align_state<0 then
- begin print_err("Missing { inserted");
-@.Missing \{ inserted@>
- incr(align_state); cur_tok:=left_brace_token+"{";
- end
- else begin print_err("Missing } inserted");
-@.Missing \} inserted@>
- decr(align_state); cur_tok:=right_brace_token+"}";
- end;
- help3("I've put in what seems to be necessary to fix")@/
- ("the current column of the current alignment.")@/
- ("Try to go on, since this might almost work."); ins_error;
- end;
-end;
-
-@ @<Express consternation...@>=
-begin print_err("Misplaced "); print_cmd_chr(cur_cmd,cur_chr);
-@.Misplaced \&@>
-@.Misplaced \\span@>
-@.Misplaced \\cr@>
-if cur_tok=tab_token+"&" then
- begin help6("I can't figure out why you would want to use a tab mark")@/
- ("here. If you just want an ampersand, the remedy is")@/
- ("simple: Just type `I\&' now. But if some right brace")@/
- ("up above has ended a previous alignment prematurely,")@/
- ("you're probably due for more error messages, and you")@/
- ("might try typing `S' now just to see what is salvageable.");
- end
-else begin help5("I can't figure out why you would want to use a tab mark")@/
- ("or \cr or \span just now. If something like a right brace")@/
- ("up above has ended a previous alignment prematurely,")@/
- ("you're probably due for more error messages, and you")@/
- ("might try typing `S' now just to see what is salvageable.");
- end;
-error;
-end
-
-@ The help messages here contain a little white lie, since \.{\\noalign}
-and \.{\\omit} are allowed also after `\.{\\noalign\{...\}}'.
-
-@<Declare act...@>=
-procedure no_align_error;
-begin print_err("Misplaced "); print_esc("noalign");
-@.Misplaced \\noalign@>
-help2("I expect to see \noalign only after the \cr of")@/
- ("an alignment. Proceed, and I'll ignore this case."); error;
-end;
-procedure omit_error;
-begin print_err("Misplaced "); print_esc("omit");
-@.Misplaced \\omit@>
-help2("I expect to see \omit only after tab marks or the \cr of")@/
- ("an alignment. Proceed, and I'll ignore this case."); error;
-end;
-
-@ We've now covered most of the abuses of \.{\\halign} and \.{\\valign}.
-Let's take a look at what happens when they are used correctly.
-
-@<Cases of |main_control| that build...@>=
-vmode+halign:init_align;
-hmode+valign:@<Cases of |main_control| for |hmode+valign|@>@; init_align;
-mmode+halign: if privileged then
- if cur_group=math_shift_group then init_align
- else off_save;
-vmode+endv,hmode+endv: do_endv;
-
-@ An |align_group| code is supposed to remain on the |save_stack|
-during an entire alignment, until |fin_align| removes it.
-
-A devious user might force an |endv| command to occur just about anywhere;
-we must defeat such hacks.
-
-@<Declare act...@>=
-procedure do_endv;
-begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
-while (input_stack[base_ptr].index_field<>v_template) and
- (input_stack[base_ptr].loc_field=null) and
- (input_stack[base_ptr].state_field=token_list) do decr(base_ptr);
-if (input_stack[base_ptr].index_field<>v_template) or
- (input_stack[base_ptr].loc_field<>null) or
- (input_stack[base_ptr].state_field<>token_list) then
- fatal_error("(interwoven alignment preambles are not allowed)");
-@.interwoven alignment preambles...@>
- if cur_group=align_group then
- begin end_graf;
- if fin_col then fin_row;
- end
-else off_save;
-end;
-
-@ @<Cases of |handle_right_brace|...@>=
-align_group: begin back_input; cur_tok:=cs_token_flag+frozen_cr;
- print_err("Missing "); print_esc("cr"); print(" inserted");
-@.Missing \\cr inserted@>
- help1("I'm guessing that you meant to end an alignment here.");
- ins_error;
- end;
-
-@ @<Cases of |handle_right_brace|...@>=
-no_align_group: begin end_graf; unsave; align_peek;
- end;
-
-@ Finally, \.{\\endcsname} is not supposed to get through to |main_control|.
-
-@<Cases of |main_control| that build...@>=
-any_mode(end_cs_name): cs_error;
-
-@ @<Declare act...@>=
-procedure cs_error;
-begin print_err("Extra "); print_esc("endcsname");
-@.Extra \\endcsname@>
-help1("I'm ignoring this, since I wasn't doing a \csname.");
-error;
-end;
-
-@* \[48] Building math lists.
-The routines that \TeX\ uses to create mlists are similar to those we have
-just seen for the generation of hlists and vlists. But it is necessary to
-make ``noads'' as well as nodes, so the reader should review the
-discussion of math mode data structures before trying to make sense out of
-the following program.
-
-Here is a little routine that needs to be done whenever a subformula
-is about to be processed. The parameter is a code like |math_group|.
-
-@<Declare act...@>=
-procedure push_math(@!c:group_code);
-begin push_nest; mode:=-mmode; incompleat_noad:=null; new_save_level(c);
-end;
-
-@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
-|math_shift| character) is scanned. We must check to see whether this
-`\.\$' is immediately followed by another, in case display math mode is
-called for.
-
-@<Cases of |main_control| that build...@>=
-hmode+math_shift:init_math;
-
-@ @<Declare act...@>=
-@t\4@>@<Declare subprocedures for |init_math|@>@;
-procedure init_math;
-label reswitch,found,not_found,done;
-var w:scaled; {new or partial |pre_display_size|}
-@!j:pointer; {prototype box for display}
-@!x:integer; {new |pre_display_direction|}
-@!l:scaled; {new |display_width|}
-@!s:scaled; {new |display_indent|}
-@!p:pointer; {current node when calculating |pre_display_size|}
-@!q:pointer; {glue specification when calculating |pre_display_size|}
-@!f:internal_font_number; {font in current |char_node|}
-@!n:integer; {scope of paragraph shape specification}
-@!v:scaled; {|w| plus possible glue amount}
-@!d:scaled; {increment to |v|}
-begin get_token; {|get_x_token| would fail on \.{\\ifmmode}\thinspace!}
-if (cur_cmd=math_shift)and(mode>0) then @<Go into display math mode@>
-else begin back_input; @<Go into ordinary math mode@>;
- end;
-end;
-
-@ @<Go into ordinary math mode@>=
-begin push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
-if every_math<>null then begin_token_list(every_math,every_math_text);
-end
-
-@ We get into ordinary math mode from display math mode when `\.{\\eqno}' or
-`\.{\\leqno}' appears. In such cases |cur_chr| will be 0 or~1, respectively;
-the value of |cur_chr| is placed onto |save_stack| for safe keeping.
-
-@<Cases of |main_control| that build...@>=
-mmode+eq_no: if privileged then
- if cur_group=math_shift_group then start_eq_no
- else off_save;
-
-@ @<Put each...@>=
-primitive("eqno",eq_no,0);
-@!@:eq_no_}{\.{\\eqno} primitive@>
-primitive("leqno",eq_no,1);
-@!@:leq_no_}{\.{\\leqno} primitive@>
-
-@ When \TeX\ is in display math mode, |cur_group=math_shift_group|,
-so it is not necessary for the |start_eq_no| procedure to test for
-this condition.
-
-@<Declare act...@>=
-procedure start_eq_no;
-begin saved(0):=cur_chr; incr(save_ptr);
-@<Go into ordinary math mode@>;
-end;
-
-@ @<Cases of |print_cmd_chr|...@>=
-eq_no:if chr_code=1 then print_esc("leqno")@+else print_esc("eqno");
-
-@ @<Forbidden...@>=non_math(eq_no),
-
-@ When we enter display math mode, we need to call |line_break| to
-process the partial paragraph that has just been interrupted by the
-display. Then we can set the proper values of |display_width| and
-|display_indent| and |pre_display_size|.
-
-@<Go into display math mode@>=
-begin j:=null; w:=-max_dimen;
-if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
- @<Prepare for display after an empty paragraph@>
-else begin line_break(true);@/
- @<Calculate the natural width, |w|, by which the characters of the
- final line extend to the right of the reference point,
- plus two ems; or set |w:=max_dimen| if the non-blank information
- on that line is affected by stretching or shrinking@>;
- end;
-{now we are in vertical mode, working on the list that will contain the display}
-@<Calculate the length, |l|, and the shift amount, |s|, of the display lines@>;
-push_math(math_shift_group); mode:=mmode;
-eq_word_define(int_base+cur_fam_code,-1);@/
-eq_word_define(dimen_base+pre_display_size_code,w);
-LR_box:=j;
-if eTeX_ex then eq_word_define(int_base+pre_display_direction_code,x);
-eq_word_define(dimen_base+display_width_code,l);
-eq_word_define(dimen_base+display_indent_code,s);
-if every_display<>null then begin_token_list(every_display,every_display_text);
-if nest_ptr=1 then build_page;
-end
-
-@ @<Calculate the natural width, |w|, by which...@>=
-@<Prepare for display after a non-empty paragraph@>;
-while p<>null do
- begin @<Let |d| be the natural width of node |p|;
- if the node is ``visible,'' |goto found|;
- if the node is glue that stretches or shrinks, set |v:=max_dimen|@>;
- if v<max_dimen then v:=v+d;
- goto not_found;
- found: if v<max_dimen then
- begin v:=v+d; w:=v;
- end
- else begin w:=max_dimen; goto done;
- end;
- not_found: p:=link(p);
- end;
-done:
-@<Finish the natural width computation@>
-
-@ @<Let |d| be the natural width of node |p|...@>=
-reswitch: if is_char_node(p) then
- begin f:=font(p); d:=char_width(f)(char_info(f)(character(p)));
- goto found;
- end;
-case type(p) of
-hlist_node,vlist_node,rule_node: begin d:=width(p); goto found;
- end;
-ligature_node:@<Make node |p| look like a |char_node|...@>;
-margin_kern_node: d:=width(p);
-kern_node: d:=width(p);
-@t\4@>@<Cases of `Let |d| be the natural width' that need special treatment@>@;
-glue_node:@<Let |d| be the natural width of this glue; if stretching
- or shrinking, set |v:=max_dimen|; |goto found| in the case of leaders@>;
-whatsit_node: @<Let |d| be the width of the whatsit |p|@>;
-othercases d:=0
-endcases
-
-@ We need to be careful that |w|, |v|, and |d| do not depend on any |glue_set|
-values, since such values are subject to system-dependent rounding.
-System-dependent numbers are not allowed to infiltrate parameters like
-|pre_display_size|, since \TeX82 is supposed to make the same decisions on all
-machines.
-
-@<Let |d| be the natural width of this glue...@>=
-begin q:=glue_ptr(p); d:=width(q);
-if glue_sign(just_box)=stretching then
- begin if (glue_order(just_box)=stretch_order(q))and@|
- (stretch(q)<>0) then
- v:=max_dimen;
- end
-else if glue_sign(just_box)=shrinking then
- begin if (glue_order(just_box)=shrink_order(q))and@|
- (shrink(q)<>0) then
- v:=max_dimen;
- end;
-if subtype(p)>=a_leaders then goto found;
-end
-
-@ A displayed equation is considered to be three lines long, so we
-calculate the length and offset of line number |prev_graf+2|.
-
-@<Calculate the length, |l|, ...@>=
-if par_shape_ptr=null then
- if (hang_indent<>0)and@|
- (((hang_after>=0)and(prev_graf+2>hang_after))or@|
- (prev_graf+1<-hang_after)) then
- begin l:=hsize-abs(hang_indent);
- if hang_indent>0 then s:=hang_indent@+else s:=0;
- end
- else begin l:=hsize; s:=0;
- end
-else begin n:=info(par_shape_ptr);
- if prev_graf+2>=n then p:=par_shape_ptr+2*n
- else p:=par_shape_ptr+2*(prev_graf+2);
- s:=mem[p-1].sc; l:=mem[p].sc;
- end
-
-@ Subformulas of math formulas cause a new level of math mode to be entered,
-on the semantic nest as well as the save stack. These subformulas arise in
-several ways: (1)~A left brace by itself indicates the beginning of a
-subformula that will be put into a box, thereby freezing its glue and
-preventing line breaks. (2)~A subscript or superscript is treated as a
-subformula if it is not a single character; the same applies to
-the nucleus of things like \.{\\underline}. (3)~The \.{\\left} primitive
-initiates a subformula that will be terminated by a matching \.{\\right}.
-The group codes placed on |save_stack| in these three cases are
-|math_group|, |math_group|, and |math_left_group|, respectively.
-
-Here is the code that handles case (1); the other cases are not quite as
-trivial, so we shall consider them later.
-
-@<Cases of |main_control| that build...@>=
-mmode+left_brace: begin tail_append(new_noad);
- back_input; scan_math(nucleus(tail));
- end;
-
-@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad are
-broken down into subfields called |math_type| and either |info| or
-|(fam,character)|. The job of |scan_math| is to figure out what to place
-in one of these principal fields; it looks at the subformula that
-comes next in the input, and places an encoding of that subformula
-into a given word of |mem|.
-
-@d fam_in_range==((cur_fam>=0)and(cur_fam<16))
-
-@<Declare act...@>=
-procedure scan_math(@!p:pointer);
-label restart,reswitch,exit;
-var c:integer; {math character code}
-begin restart:@<Get the next non-blank non-relax...@>;
-reswitch:case cur_cmd of
-letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
- if c=@'100000 then
- begin @<Treat |cur_chr| as an active character@>;
- goto restart;
- end;
- end;
-char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
- goto reswitch;
- end;
-math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
- end;
-math_given: c:=cur_chr;
-delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
- end;
-othercases @<Scan a subformula enclosed in braces and |return|@>
-endcases;@/
-math_type(p):=math_char; character(p):=qi(c mod 256);
-if (c>=var_code)and fam_in_range then fam(p):=cur_fam
-else fam(p):=(c div 256) mod 16;
-exit:end;
-
-@ An active character that is an |outer_call| is allowed here.
-
-@<Treat |cur_chr|...@>=
-begin cur_cs:=cur_chr+active_base;
-cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
-x_token; back_input;
-end
-
-@ The pointer |p| is placed on |save_stack| while a complex subformula
-is being scanned.
-
-@<Scan a subformula...@>=
-begin back_input; scan_left_brace;@/
-saved(0):=p; incr(save_ptr); push_math(math_group); return;
-end
-
-@ The simplest math formula is, of course, `\.{\${ }\$}', when no noads are
-generated. The next simplest cases involve a single character, e.g.,
-`\.{\$x\$}'. Even though such cases may not seem to be very interesting,
-the reader can perhaps understand how happy the author was when `\.{\$x\$}'
-was first properly typeset by \TeX. The code in this section was used.
-@^Knuth, Donald Ervin@>
-
-@<Cases of |main_control| that build...@>=
-mmode+letter,mmode+other_char,mmode+char_given:
- set_math_char(ho(math_code(cur_chr)));
-mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
- set_math_char(ho(math_code(cur_chr)));
- end;
-mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val);
- end;
-mmode+math_given: set_math_char(cur_chr);
-mmode+delim_num: begin scan_twenty_seven_bit_int;
- set_math_char(cur_val div @'10000);
- end;
-
-@ The |set_math_char| procedure creates a new noad appropriate to a given
-math code, and appends it to the current mlist. However, if the math code
-is sufficiently large, the |cur_chr| is treated as an active character and
-nothing is appended.
-
-@<Declare act...@>=
-procedure set_math_char(@!c:integer);
-var p:pointer; {the new noad}
-begin if c>=@'100000 then
- @<Treat |cur_chr|...@>
-else begin p:=new_noad; math_type(nucleus(p)):=math_char;
- character(nucleus(p)):=qi(c mod 256);
- fam(nucleus(p)):=(c div 256) mod 16;
- if c>=var_code then
- begin if fam_in_range then fam(nucleus(p)):=cur_fam;
- type(p):=ord_noad;
- end
- else type(p):=ord_noad+(c div @'10000);
- link(tail):=p; tail:=p;
- end;
-end;
-
-@ Primitive math operators like \.{\\mathop} and \.{\\underline} are given
-the command code |math_comp|, supplemented by the noad type that they
-generate.
-
-@<Put each...@>=
-primitive("mathord",math_comp,ord_noad);
-@!@:math_ord_}{\.{\\mathord} primitive@>
-primitive("mathop",math_comp,op_noad);
-@!@:math_op_}{\.{\\mathop} primitive@>
-primitive("mathbin",math_comp,bin_noad);
-@!@:math_bin_}{\.{\\mathbin} primitive@>
-primitive("mathrel",math_comp,rel_noad);
-@!@:math_rel_}{\.{\\mathrel} primitive@>
-primitive("mathopen",math_comp,open_noad);
-@!@:math_open_}{\.{\\mathopen} primitive@>
-primitive("mathclose",math_comp,close_noad);
-@!@:math_close_}{\.{\\mathclose} primitive@>
-primitive("mathpunct",math_comp,punct_noad);
-@!@:math_punct_}{\.{\\mathpunct} primitive@>
-primitive("mathinner",math_comp,inner_noad);
-@!@:math_inner_}{\.{\\mathinner} primitive@>
-primitive("underline",math_comp,under_noad);
-@!@:underline_}{\.{\\underline} primitive@>
-primitive("overline",math_comp,over_noad);@/
-@!@:overline_}{\.{\\overline} primitive@>
-primitive("displaylimits",limit_switch,normal);
-@!@:display_limits_}{\.{\\displaylimits} primitive@>
-primitive("limits",limit_switch,limits);
-@!@:limits_}{\.{\\limits} primitive@>
-primitive("nolimits",limit_switch,no_limits);
-@!@:no_limits_}{\.{\\nolimits} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-math_comp: case chr_code of
- ord_noad: print_esc("mathord");
- op_noad: print_esc("mathop");
- bin_noad: print_esc("mathbin");
- rel_noad: print_esc("mathrel");
- open_noad: print_esc("mathopen");
- close_noad: print_esc("mathclose");
- punct_noad: print_esc("mathpunct");
- inner_noad: print_esc("mathinner");
- under_noad: print_esc("underline");
- othercases print_esc("overline")
- endcases;
-limit_switch: if chr_code=limits then print_esc("limits")
- else if chr_code=no_limits then print_esc("nolimits")
- else print_esc("displaylimits");
-
-@ @<Cases of |main_control| that build...@>=
-mmode+math_comp: begin tail_append(new_noad);
- type(tail):=cur_chr; scan_math(nucleus(tail));
- end;
-mmode+limit_switch: math_limit_switch;
-
-@ @<Declare act...@>=
-procedure math_limit_switch;
-label exit;
-begin if head<>tail then if type(tail)=op_noad then
- begin subtype(tail):=cur_chr; return;
- end;
-print_err("Limit controls must follow a math operator");
-@.Limit controls must follow...@>
-help1("I'm ignoring this misplaced \limits or \nolimits command."); error;
-exit:end;
-
-@ Delimiter fields of noads are filled in by the |scan_delimiter| routine.
-The first parameter of this procedure is the |mem| address where the
-delimiter is to be placed; the second tells if this delimiter follows
-\.{\\radical} or not.
-
-@<Declare act...@>=
-procedure scan_delimiter(@!p:pointer;@!r:boolean);
-begin if r then scan_twenty_seven_bit_int
-else begin @<Get the next non-blank non-relax...@>;
- case cur_cmd of
- letter,other_char: cur_val:=del_code(cur_chr);
- delim_num: scan_twenty_seven_bit_int;
- othercases cur_val:=-1
- endcases;
- end;
-if cur_val<0 then @<Report that an invalid delimiter code is being changed
- to null; set~|cur_val:=0|@>;
-small_fam(p):=(cur_val div @'4000000) mod 16;
-small_char(p):=qi((cur_val div @'10000) mod 256);
-large_fam(p):=(cur_val div 256) mod 16;
-large_char(p):=qi(cur_val mod 256);
-end;
-
-@ @<Report that an invalid delimiter...@>=
-begin print_err("Missing delimiter (. inserted)");
-@.Missing delimiter...@>
-help6("I was expecting to see something like `(' or `\{' or")@/
- ("`\}' here. If you typed, e.g., `{' instead of `\{', you")@/
- ("should probably delete the `{' by typing `1' now, so that")@/
- ("braces don't get unbalanced. Otherwise just proceed.")@/
- ("Acceptable delimiters are characters whose \delcode is")@/
- ("nonnegative, or you can use `\delimiter <delimiter code>'.");
-back_error; cur_val:=0;
-end
-
-@ @<Cases of |main_control| that build...@>=
-mmode+radical:math_radical;
-
-@ @<Declare act...@>=
-procedure math_radical;
-begin tail_append(get_node(radical_noad_size));
-type(tail):=radical_noad; subtype(tail):=normal;
-mem[nucleus(tail)].hh:=empty_field;
-mem[subscr(tail)].hh:=empty_field;
-mem[supscr(tail)].hh:=empty_field;
-scan_delimiter(left_delimiter(tail),true); scan_math(nucleus(tail));
-end;
-
-@ @<Cases of |main_control| that build...@>=
-mmode+accent,mmode+math_accent:math_ac;
-
-@ @<Declare act...@>=
-procedure math_ac;
-begin if cur_cmd=accent then
- @<Complain that the user should have said \.{\\mathaccent}@>;
-tail_append(get_node(accent_noad_size));
-type(tail):=accent_noad; subtype(tail):=normal;
-mem[nucleus(tail)].hh:=empty_field;
-mem[subscr(tail)].hh:=empty_field;
-mem[supscr(tail)].hh:=empty_field;
-math_type(accent_chr(tail)):=math_char;
-scan_fifteen_bit_int;
-character(accent_chr(tail)):=qi(cur_val mod 256);
-if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
-else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
-scan_math(nucleus(tail));
-end;
-
-@ @<Complain that the user should have said \.{\\mathaccent}@>=
-begin print_err("Please use "); print_esc("mathaccent");
-print(" for accents in math mode");
-@.Please use \\mathaccent...@>
-help2("I'm changing \accent to \mathaccent here; wish me luck.")@/
- ("(Accents are not the same in formulas as they are in text.)");
-error;
-end
-
-@ @<Cases of |main_control| that build...@>=
-mmode+vcenter: begin scan_spec(vcenter_group,false); normal_paragraph;
- push_nest; mode:=-vmode; prev_depth:=pdf_ignored_dimen;
- if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
- end;
-
-@ @<Cases of |handle...@>=
-vcenter_group: begin end_graf; unsave; save_ptr:=save_ptr-2;
- p:=vpack(link(head),saved(1),saved(0)); pop_nest;
- tail_append(new_noad); type(tail):=vcenter_noad;
- math_type(nucleus(tail)):=sub_box; info(nucleus(tail)):=p;
- end;
-
-@ The routine that inserts a |style_node| holds no surprises.
-
-@<Put each...@>=
-primitive("displaystyle",math_style,display_style);
-@!@:display_style_}{\.{\\displaystyle} primitive@>
-primitive("textstyle",math_style,text_style);
-@!@:text_style_}{\.{\\textstyle} primitive@>
-primitive("scriptstyle",math_style,script_style);
-@!@:script_style_}{\.{\\scriptstyle} primitive@>
-primitive("scriptscriptstyle",math_style,script_script_style);
-@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-math_style: print_style(chr_code);
-
-@ @<Cases of |main_control| that build...@>=
-mmode+math_style: tail_append(new_style(cur_chr));
-mmode+non_script: begin tail_append(new_glue(zero_glue));
- subtype(tail):=cond_math_glue;
- end;
-mmode+math_choice: append_choices;
-
-@ The routine that scans the four mlists of a \.{\\mathchoice} is very
-much like the routine that builds discretionary nodes.
-
-@<Declare act...@>=
-procedure append_choices;
-begin tail_append(new_choice); incr(save_ptr); saved(-1):=0;
-push_math(math_choice_group); scan_left_brace;
-end;
-
-@ @<Cases of |handle_right_brace|...@>=
-math_choice_group: build_choices;
-
-@ @<Declare act...@>=
-@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/
-procedure build_choices;
-label exit;
-var p:pointer; {the current mlist}
-begin unsave; p:=fin_mlist(null);
-case saved(-1) of
-0:display_mlist(tail):=p;
-1:text_mlist(tail):=p;
-2:script_mlist(tail):=p;
-3:begin script_script_mlist(tail):=p; decr(save_ptr); return;
- end;
-end; {there are no other cases}
-incr(saved(-1)); push_math(math_choice_group); scan_left_brace;
-exit:end;
-
-@ Subscripts and superscripts are attached to the previous nucleus by the
-@^superscripts@>@^subscripts@>
-action procedure called |sub_sup|. We use the facts that |sub_mark=sup_mark+1|
-and |subscr(p)=supscr(p)+1|.
-
-@<Cases of |main_control| that build...@>=
-mmode+sub_mark,mmode+sup_mark: sub_sup;
-
-@ @<Declare act...@>=
-procedure sub_sup;
-var t:small_number; {type of previous sub/superscript}
-@!p:pointer; {field to be filled by |scan_math|}
-begin t:=empty; p:=null;
-if tail<>head then if scripts_allowed(tail) then
- begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
- t:=math_type(p);
- end;
-if (p=null)or(t<>empty) then @<Insert a dummy noad to be sub/superscripted@>;
-scan_math(p);
-end;
-
-@ @<Insert a dummy...@>=
-begin tail_append(new_noad);
-p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
-if t<>empty then
- begin if cur_cmd=sup_mark then
- begin print_err("Double superscript");
-@.Double superscript@>
- help1("I treat `x^1^2' essentially like `x^1{}^2'.");
- end
- else begin print_err("Double subscript");
-@.Double subscript@>
- help1("I treat `x_1_2' essentially like `x_1{}_2'.");
- end;
- error;
- end;
-end
-
-@ An operation like `\.{\\over}' causes the current mlist to go into a
-state of suspended animation: |incompleat_noad| points to a |fraction_noad|
-that contains the mlist-so-far as its numerator, while the denominator
-is yet to come. Finally when the mlist is finished, the denominator will
-go into the incompleat fraction noad, and that noad will become the
-whole formula, unless it is surrounded by `\.{\\left}' and `\.{\\right}'
-delimiters.
-
-@d above_code=0 { `\.{\\above}' }
-@d over_code=1 { `\.{\\over}' }
-@d atop_code=2 { `\.{\\atop}' }
-@d delimited_code=3 { `\.{\\abovewithdelims}', etc.}
-
-@<Put each...@>=
-primitive("above",above,above_code);@/
-@!@:above_}{\.{\\above} primitive@>
-primitive("over",above,over_code);@/
-@!@:over_}{\.{\\over} primitive@>
-primitive("atop",above,atop_code);@/
-@!@:atop_}{\.{\\atop} primitive@>
-primitive("abovewithdelims",above,delimited_code+above_code);@/
-@!@:above_with_delims_}{\.{\\abovewithdelims} primitive@>
-primitive("overwithdelims",above,delimited_code+over_code);@/
-@!@:over_with_delims_}{\.{\\overwithdelims} primitive@>
-primitive("atopwithdelims",above,delimited_code+atop_code);
-@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-above: case chr_code of
- over_code:print_esc("over");
- atop_code:print_esc("atop");
- delimited_code+above_code:print_esc("abovewithdelims");
- delimited_code+over_code:print_esc("overwithdelims");
- delimited_code+atop_code:print_esc("atopwithdelims");
- othercases print_esc("above")
- endcases;
-
-@ @<Cases of |main_control| that build...@>=
-mmode+above: math_fraction;
-
-@ @<Declare act...@>=
-procedure math_fraction;
-var c:small_number; {the type of generalized fraction we are scanning}
-begin c:=cur_chr;
-if incompleat_noad<>null then
- @<Ignore the fraction operation and complain about this ambiguous case@>
-else begin incompleat_noad:=get_node(fraction_noad_size);
- type(incompleat_noad):=fraction_noad;
- subtype(incompleat_noad):=normal;
- math_type(numerator(incompleat_noad)):=sub_mlist;
- info(numerator(incompleat_noad)):=link(head);
- mem[denominator(incompleat_noad)].hh:=empty_field;
- mem[left_delimiter(incompleat_noad)].qqqq:=null_delimiter;
- mem[right_delimiter(incompleat_noad)].qqqq:=null_delimiter;@/
- link(head):=null; tail:=head;
- @<Use code |c| to distinguish between generalized fractions@>;
- end;
-end;
-
-@ @<Use code |c|...@>=
-if c>=delimited_code then
- begin scan_delimiter(left_delimiter(incompleat_noad),false);
- scan_delimiter(right_delimiter(incompleat_noad),false);
- end;
-case c mod delimited_code of
-above_code: begin scan_normal_dimen;
- thickness(incompleat_noad):=cur_val;
- end;
-over_code: thickness(incompleat_noad):=default_code;
-atop_code: thickness(incompleat_noad):=0;
-end {there are no other cases}
-
-@ @<Ignore the fraction...@>=
-begin if c>=delimited_code then
- begin scan_delimiter(garbage,false); scan_delimiter(garbage,false);
- end;
-if c mod delimited_code=above_code then scan_normal_dimen;
-print_err("Ambiguous; you need another { and }");
-@.Ambiguous...@>
-help3("I'm ignoring this fraction specification, since I don't")@/
- ("know whether a construction like `x \over y \over z'")@/
- ("means `{x \over y} \over z' or `x \over {y \over z}'.");
-error;
-end
-
-@ At the end of a math formula or subformula, the |fin_mlist| routine is
-called upon to return a pointer to the newly completed mlist, and to
-pop the nest back to the enclosing semantic level. The parameter to
-|fin_mlist|, if not null, points to a |right_noad| that ends the
-current mlist; this |right_noad| has not yet been appended.
-
-@<Declare the function called |fin_mlist|@>=
-function fin_mlist(@!p:pointer):pointer;
-var q:pointer; {the mlist to return}
-begin if incompleat_noad<>null then @<Compleat the incompleat noad@>
-else begin link(tail):=p; q:=link(head);
- end;
-pop_nest; fin_mlist:=q;
-end;
-
-@ @<Compleat...@>=
-begin math_type(denominator(incompleat_noad)):=sub_mlist;
-info(denominator(incompleat_noad)):=link(head);
-if p=null then q:=incompleat_noad
-else begin q:=info(numerator(incompleat_noad));
- if (type(q)<>left_noad)or(delim_ptr=null) then confusion("right");
-@:this can't happen right}{\quad right@>
- info(numerator(incompleat_noad)):=link(delim_ptr);
- link(delim_ptr):=incompleat_noad; link(incompleat_noad):=p;
- end;
-end
-
-@ Now at last we're ready to see what happens when a right brace occurs
-in a math formula. Two special cases are simplified here: Braces are effectively
-removed when they surround a single Ord without sub/superscripts, or when they
-surround an accent that is the nucleus of an Ord atom.
-
-@<Cases of |handle...@>=
-math_group: begin unsave; decr(save_ptr);@/
- math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
- if p<>null then if link(p)=null then
- if type(p)=ord_noad then
- begin if math_type(subscr(p))=empty then
- if math_type(supscr(p))=empty then
- begin mem[saved(0)].hh:=mem[nucleus(p)].hh;
- free_node(p,noad_size);
- end;
- end
- else if type(p)=accent_noad then if saved(0)=nucleus(tail) then
- if type(tail)=ord_noad then @<Replace the tail of the list by |p|@>;
- end;
-
-@ @<Replace the tail...@>=
-begin q:=head; while link(q)<>tail do q:=link(q);
-link(q):=p; free_node(tail,noad_size); tail:=p;
-end
-
-@ We have dealt with all constructions of math mode except `\.{\\left}' and
-`\.{\\right}', so the picture is completed by the following sections of
-the program.
-
-@<Put each...@>=
-primitive("left",left_right,left_noad);
-@!@:left_}{\.{\\left} primitive@>
-primitive("right",left_right,right_noad);
-@!@:right_}{\.{\\right} primitive@>
-text(frozen_right):="right"; eqtb[frozen_right]:=eqtb[cur_val];
-
-@ @<Cases of |print_cmd_chr|...@>=
-left_right: if chr_code=left_noad then print_esc("left")
-@/@<Cases of |left_right| for |print_cmd_chr|@>@/
-else print_esc("right");
-
-@ @<Cases of |main_control| that build...@>=
-mmode+left_right: math_left_right;
-
-@ @<Declare act...@>=
-procedure math_left_right;
-var t:small_number; {|left_noad| or |right_noad|}
-@!p:pointer; {new noad}
-@!q:pointer; {resulting mlist}
-begin t:=cur_chr;
-if (t<>left_noad)and(cur_group<>math_left_group) then
- @<Try to recover from mismatched \.{\\right}@>
-else begin p:=new_noad; type(p):=t;
- scan_delimiter(delimiter(p),false);
- if t=middle_noad then
- begin type(p):=right_noad; subtype(p):=middle_noad;
- end;
- if t=left_noad then q:=p
- else begin q:=fin_mlist(p); unsave; {end of |math_left_group|}
- end;
- if t<>right_noad then
- begin push_math(math_left_group); link(head):=q; tail:=p;
- delim_ptr:=p;
- end
- else begin
- tail_append(new_noad); type(tail):=inner_noad;
- math_type(nucleus(tail)):=sub_mlist;
- info(nucleus(tail)):=q;
- end;
- end;
-end;
-
-@ @<Try to recover from mismatch...@>=
-begin if cur_group=math_shift_group then
- begin scan_delimiter(garbage,false);
- print_err("Extra ");
- if t=middle_noad then
- begin print_esc("middle");
-@.Extra \\middle.@>
- help1("I'm ignoring a \middle that had no matching \left.");
- end
- else begin print_esc("right");
-@.Extra \\right.@>
- help1("I'm ignoring a \right that had no matching \left.");
- end;
- error;
- end
-else off_save;
-end
-
-@ Here is the only way out of math mode.
-
-@<Cases of |main_control| that build...@>=
-mmode+math_shift: if cur_group=math_shift_group then after_math
- else off_save;
-
-@ @<Declare act...@>=
-@t\4@>@<Declare subprocedures for |after_math|@>@;
-procedure after_math;
-var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
-@!danger:boolean; {not enough symbol fonts are present}
-@!m:integer; {|mmode| or |-mmode|}
-@!p:pointer; {the formula}
-@!a:pointer; {box containing equation number}
-@<Local variables for finishing a displayed formula@>@;
-begin danger:=false;
-@<Retrieve the prototype box@>;
-@<Check that the necessary fonts for math symbols are present;
- if not, flush the current math lists and set |danger:=true|@>;
-m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
-if mode=-m then {end of equation number}
- begin @<Check that another \.\$ follows@>;
- cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
- mlist_to_hlist; a:=hpack(link(temp_head),natural);
- set_box_lr(a)(dlist);
- unsave; decr(save_ptr); {now |cur_group=math_shift_group|}
- if saved(0)=1 then l:=true;
- danger:=false;
- @<Retrieve the prototype box@>;
- @<Check that the necessary fonts for math symbols are present;
- if not, flush the current math lists and set |danger:=true|@>;
- m:=mode; p:=fin_mlist(null);
- end
-else a:=null;
-if m<0 then @<Finish math in text@>
-else begin if a=null then @<Check that another \.\$ follows@>;
- @<Finish displayed math@>;
- end;
-end;
-
-@ @<Check that the necessary fonts...@>=
-if (font_params[fam_fnt(2+text_size)]<total_mathsy_params)or@|
- (font_params[fam_fnt(2+script_size)]<total_mathsy_params)or@|
- (font_params[fam_fnt(2+script_script_size)]<total_mathsy_params) then
- begin print_err("Math formula deleted: Insufficient symbol fonts");@/
-@.Math formula deleted...@>
- help3("Sorry, but I can't typeset math unless \textfont 2")@/
- ("and \scriptfont 2 and \scriptscriptfont 2 have all")@/
- ("the \fontdimen values needed in math symbol fonts.");
- error; flush_math; danger:=true;
- end
-else if (font_params[fam_fnt(3+text_size)]<total_mathex_params)or@|
- (font_params[fam_fnt(3+script_size)]<total_mathex_params)or@|
- (font_params[fam_fnt(3+script_script_size)]<total_mathex_params) then
- begin print_err("Math formula deleted: Insufficient extension fonts");@/
- help3("Sorry, but I can't typeset math unless \textfont 3")@/
- ("and \scriptfont 3 and \scriptscriptfont 3 have all")@/
- ("the \fontdimen values needed in math extension fonts.");
- error; flush_math; danger:=true;
- end
-
-@ The |unsave| is done after everything else here; hence an appearance of
-`\.{\\mathsurround}' inside of `\.{\$...\$}' affects the spacing at these
-particular \.\$'s. This is consistent with the conventions of
-`\.{\$\$...\$\$}', since `\.{\\abovedisplayskip}' inside a display affects the
-space above that display.
-
-@<Finish math in text@>=
-begin tail_append(new_math(math_surround,before));
-cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
-link(tail):=link(temp_head);
-while link(tail)<>null do tail:=link(tail);
-tail_append(new_math(math_surround,after));
-space_factor:=1000; unsave;
-end
-
-@ \TeX\ gets to the following part of the program when the first `\.\$' ending
-a display has been scanned.
-
-@<Check that another \.\$ follows@>=
-begin get_x_token;
-if cur_cmd<>math_shift then
- begin print_err("Display math should end with $$");
-@.Display math...with \$\$@>
- help2("The `$' that I just saw supposedly matches a previous `$$'.")@/
- ("So I shall assume that you typed `$$' both times.");
- back_error;
- end;
-end
-
-@ We have saved the worst for last: The fussiest part of math mode processing
-occurs when a displayed formula is being centered and placed with an optional
-equation number.
-
-@<Local variables for finishing...@>=
-@!b:pointer; {box containing the equation}
-@!w:scaled; {width of the equation}
-@!z:scaled; {width of the line}
-@!e:scaled; {width of equation number}
-@!q:scaled; {width of equation number plus space to separate from equation}
-@!d:scaled; {displacement of equation in the line}
-@!s:scaled; {move the line right this much}
-@!g1,@!g2:small_number; {glue parameter codes for before and after}
-@!r:pointer; {kern node used to position the display}
-@!t:pointer; {tail of adjustment list}
-@!pre_t:pointer; {tail of pre-adjustment list}
-
-@ At this time |p| points to the mlist for the formula; |a| is either
-|null| or it points to a box containing the equation number; and we are in
-vertical mode (or internal vertical mode).
-
-@<Finish displayed math@>=
-cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false;
-mlist_to_hlist; p:=link(temp_head);@/
-adjust_tail:=adjust_head; pre_adjust_tail:=pre_adjust_head;
-b:=hpack(p,natural); p:=list_ptr(b);
-t:=adjust_tail; adjust_tail:=null;@/
-pre_t:=pre_adjust_tail; pre_adjust_tail:=null;@/
-w:=width(b); z:=display_width; s:=display_indent;
-if pre_display_direction<0 then s:=-s-z;
-if (a=null)or danger then
- begin e:=0; q:=0;
- end
-else begin e:=width(a); q:=e+math_quad(text_size);
- end;
-if w+q>z then
- @<Squeeze the equation as much as possible; if there is an equation
- number that should go on a separate line by itself,
- set~|e:=0|@>;
-@<Determine the displacement, |d|, of the left edge of the equation, with
- respect to the line size |z|, assuming that |l=false|@>;
-@<Append the glue or equation number preceding the display@>;
-@<Append the display and perhaps also the equation number@>;
-@<Append the glue or equation number following the display@>;
-@<Flush the prototype box@>;
-resume_after_display
-
-@ @<Declare act...@>=
-procedure resume_after_display;
-begin if cur_group<>math_shift_group then confusion("display");
-@:this can't happen display}{\quad display@>
-unsave; prev_graf:=prev_graf+3;
-push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
-prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
- *@'200000+cur_lang;
-@<Scan an optional space@>;
-if nest_ptr=1 then build_page;
-end;
-
-@ The user can force the equation number to go on a separate line
-by causing its width to be zero.
-
-@<Squeeze the equation as much as possible...@>=
-begin if (e<>0)and((w-total_shrink[normal]+q<=z)or@|
- (total_shrink[fil]<>0)or(total_shrink[fill]<>0)or
- (total_shrink[filll]<>0)) then
- begin free_node(b,box_node_size);
- b:=hpack(p,z-q,exactly);
- end
-else begin e:=0;
- if w>z then
- begin free_node(b,box_node_size);
- b:=hpack(p,z,exactly);
- end;
- end;
-w:=width(b);
-end
-
-@ We try first to center the display without regard to the existence of
-the equation number. If that would make it too close (where ``too close''
-means that the space between display and equation number is less than the
-width of the equation number), we either center it in the remaining space
-or move it as far from the equation number as possible. The latter alternative
-is taken only if the display begins with glue, since we assume that the
-user put glue there to control the spacing precisely.
-
-@<Determine the displacement, |d|, of the left edge of the equation...@>=
-set_box_lr(b)(dlist);
-d:=half(z-w);
-if (e>0)and(d<2*e) then {too close}
- begin d:=half(z-w-e);
- if p<>null then if not is_char_node(p) then if type(p)=glue_node then d:=0;
- end
-
-@ If the equation number is set on a line by itself, either before or
-after the formula, we append an infinite penalty so that no page break will
-separate the display from its number; and we use the same size and
-displacement for all three potential lines of the display, even though
-`\.{\\parshape}' may specify them differently.
-
-@<Append the glue or equation number preceding the display@>=
-tail_append(new_penalty(pre_display_penalty));@/
-if (d+s<=pre_display_size)or l then {not enough clearance}
- begin g1:=above_display_skip_code; g2:=below_display_skip_code;
- end
-else begin g1:=above_display_short_skip_code;
- g2:=below_display_short_skip_code;
- end;
-if l and(e=0) then {it follows that |type(a)=hlist_node|}
- begin app_display(j,a,0);
- tail_append(new_penalty(inf_penalty));
- end
-else tail_append(new_param_glue(g1))
-
-@ @<Append the display and perhaps also the equation number@>=
-if e<>0 then
- begin r:=new_kern(z-w-e-d);
- if l then
- begin link(a):=r; link(r):=b; b:=a; d:=0;
- end
- else begin link(b):=r; link(r):=a;
- end;
- b:=hpack(b,natural);
- end;
-app_display(j,b,d)
-
-@ @<Append the glue or equation number following the display@>=
-if (a<>null)and(e=0)and not l then
- begin tail_append(new_penalty(inf_penalty));
- app_display(j,a,z-width(a));
- g2:=0;
- end;
-if t<>adjust_head then {migrating material comes after equation number}
- begin link(tail):=link(adjust_head); tail:=t;
- end;
-if pre_t<>pre_adjust_head then
- begin link(tail):=link(pre_adjust_head); tail:=pre_t;
- end;
-tail_append(new_penalty(post_display_penalty));
-if g2>0 then tail_append(new_param_glue(g2))
-
-@ When \.{\\halign} appears in a display, the alignment routines operate
-essentially as they do in vertical mode. Then the following program is
-activated, with |p| and |q| pointing to the beginning and end of the
-resulting list, and with |aux_save| holding the |prev_depth| value.
-
-@<Finish an alignment in a display@>=
-begin do_assignments;
-if cur_cmd<>math_shift then @<Pontificate about improper alignment in display@>
-else @<Check that another \.\$ follows@>;
-flush_node_list(LR_box);
-pop_nest;
-tail_append(new_penalty(pre_display_penalty));
-tail_append(new_param_glue(above_display_skip_code));
-link(tail):=p;
-if p<>null then tail:=q;
-tail_append(new_penalty(post_display_penalty));
-tail_append(new_param_glue(below_display_skip_code));
-prev_depth:=aux_save.sc; resume_after_display;
-end
-
-@ @<Pontificate...@>=
-begin print_err("Missing $$ inserted");
-@.Missing {\$\$} inserted@>
-help2("Displays can use special alignments (like \eqalignno)")@/
- ("only if nothing but the alignment itself is between $$'s.");
-back_error;
-end
-
-@* \[49] Mode-independent processing.
-The long |main_control| procedure has now been fully specified, except for
-certain activities that are independent of the current mode. These activities
-do not change the current vlist or hlist or mlist; if they change anything,
-it is the value of a parameter or the meaning of a control sequence.
-
-Assignments to values in |eqtb| can be global or local. Furthermore, a
-control sequence can be defined to be `\.{\\long}', `\.{\\protected}',
-or `\.{\\outer}', and it might or might not be expanded. The prefixes
-`\.{\\global}', `\.{\\long}', `\.{\\protected}',
-and `\.{\\outer}' can occur in any order. Therefore we assign binary numeric
-codes, making it possible to accumulate the union of all specified prefixes
-by adding the corresponding codes. (\PASCAL's |set| operations could also
-have been used.)
-
-@<Put each...@>=
-primitive("long",prefix,1);
-@!@:long_}{\.{\\long} primitive@>
-primitive("outer",prefix,2);
-@!@:outer_}{\.{\\outer} primitive@>
-primitive("global",prefix,4);
-@!@:global_}{\.{\\global} primitive@>
-primitive("def",def,0);
-@!@:def_}{\.{\\def} primitive@>
-primitive("gdef",def,1);
-@!@:gdef_}{\.{\\gdef} primitive@>
-primitive("edef",def,2);
-@!@:edef_}{\.{\\edef} primitive@>
-primitive("xdef",def,3);
-@!@:xdef_}{\.{\\xdef} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-prefix: if chr_code=1 then print_esc("long")
- else if chr_code=2 then print_esc("outer")
- @/@<Cases of |prefix| for |print_cmd_chr|@>@/
- else print_esc("global");
-def: if chr_code=0 then print_esc("def")
- else if chr_code=1 then print_esc("gdef")
- else if chr_code=2 then print_esc("edef")
- else print_esc("xdef");
-
-@ Every prefix, and every command code that might or might not be prefixed,
-calls the action procedure |prefixed_command|. This routine accumulates
-a sequence of prefixes until coming to a non-prefix, then it carries out
-the command.
-
-@<Cases of |main_control| that don't...@>=
-any_mode(toks_register),
-any_mode(assign_toks),
-any_mode(assign_int),
-any_mode(assign_dimen),
-any_mode(assign_glue),
-any_mode(assign_mu_glue),
-any_mode(assign_font_dimen),
-any_mode(assign_font_int),
-any_mode(set_aux),
-any_mode(set_prev_graf),
-any_mode(set_page_dimen),
-any_mode(set_page_int),
-any_mode(set_box_dimen),
-any_mode(set_shape),
-any_mode(def_code),
-any_mode(def_family),
-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):prefixed_command;
-
-@ If the user says, e.g., `\.{\\global\\global}', the redundancy is
-silently accepted.
-
-@<Declare act...@>=
-@t\4@>@<Declare subprocedures for |prefixed_command|@>@t@>@;@/
-procedure prefixed_command;
-label done,exit;
-var a:small_number; {accumulated prefix codes so far}
-@!f:internal_font_number; {identifies a font}
-@!j:halfword; {index into a \.{\\parshape} specification}
-@!k:font_index; {index into |font_info|}
-@!p,@!q:pointer; {for temporary short-term use}
-@!n:integer; {ditto}
-@!e:boolean; {should a definition be expanded? or was \.{\\let} not done?}
-begin a:=0;
-while cur_cmd=prefix do
- begin if not odd(a div cur_chr) then a:=a+cur_chr;
- @<Get the next non-blank non-relax...@>;
- if cur_cmd<=max_non_prefixed_command then
- @<Discard erroneous prefixes and |return|@>;
- if tracing_commands>2 then if eTeX_ex then show_cur_cmd_chr;
- end;
-@<Discard the prefixes \.{\\long} and \.{\\outer} if they are irrelevant@>;
-@<Adjust \(f)for the setting of \.{\\globaldefs}@>;
-case cur_cmd of
-@t\4@>@<Assignments@>@;
-othercases confusion("prefix")
-@:this can't happen prefix}{\quad prefix@>
-endcases;
-done: @<Insert a token saved by \.{\\afterassignment}, if any@>;
-exit:end;
-
-@ @<Discard erroneous...@>=
-begin print_err("You can't use a prefix with `");
-@.You can't use a prefix with x@>
-print_cmd_chr(cur_cmd,cur_chr); print_char("'");
-help1("I'll pretend you didn't say \long or \outer or \global.");
-if eTeX_ex then help_line[0]:=@|
- "I'll pretend you didn't say \long or \outer or \global or \protected.";
-back_error; return;
-end
-
-@ @<Discard the prefixes...@>=
-if a>=8 then
- begin j:=protected_token; a:=a-8;
- end
-else j:=0;
-if (cur_cmd<>def)and((a mod 4<>0)or(j<>0)) then
- begin print_err("You can't use `"); print_esc("long"); print("' or `");
- print_esc("outer");
- help1("I'll pretend you didn't say \long or \outer here.");
- if eTeX_ex then
- begin help_line[0]:=@|
- "I'll pretend you didn't say \long or \outer or \protected here.";
- print("' or `"); print_esc("protected");
- end;
- print("' with `");
-@.You can't use \\long...@>
- print_cmd_chr(cur_cmd,cur_chr); print_char("'");
- error;
- end
-
-@ The previous routine does not have to adjust |a| so that |a mod 4=0|,
-since the following routines test for the \.{\\global} prefix as follows.
-
-@d global==(a>=4)
-@d define(#)==if global then geq_define(#)@+else eq_define(#)
-@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
-
-@<Adjust \(f)for the setting of \.{\\globaldefs}@>=
-if global_defs<>0 then
- if global_defs<0 then
- begin if global then a:=a-4;
- end
- else begin if not global then a:=a+4;
- end
-
-@ When a control sequence is to be defined, by \.{\\def} or \.{\\let} or
-something similar, the |get_r_token| routine will substitute a special
-control sequence for a token that is not redefinable.
-
-@<Declare subprocedures for |prefixed_command|@>=
-procedure get_r_token;
-label restart;
-begin restart: repeat get_token;
-until cur_tok<>space_token;
-if (cur_cs=0)or(cur_cs>frozen_control_sequence) then
- begin print_err("Missing control sequence inserted");
-@.Missing control...@>
- help5("Please don't say `\def cs{...}', say `\def\cs{...}'.")@/
- ("I've inserted an inaccessible control sequence so that your")@/
- ("definition will be completed without mixing me up too badly.")@/
- ("You can recover graciously from this error, if you're")@/
- ("careful; see exercise 27.2 in The TeXbook.");
-@:TeXbook}{\sl The \TeX book@>
- if cur_cs=0 then back_input;
- cur_tok:=cs_token_flag+frozen_protection; ins_error; goto restart;
- end;
-end;
-
-@ @<Initialize table entries...@>=
-text(frozen_protection):="inaccessible";
-@.inaccessible@>
-
-@ Here's an example of the way many of the following routines operate.
-(Unfortunately, they aren't all as simple as this.)
-
-@<Assignments@>=
-set_font: define(cur_font_loc,data,cur_chr);
-
-@ When a |def| command has been scanned,
-|cur_chr| is odd if the definition is supposed to be global, and
-|cur_chr>=2| if the definition is supposed to be expanded.
-
-@<Assignments@>=
-def: begin if odd(cur_chr)and not global and(global_defs>=0) then a:=a+4;
- e:=(cur_chr>=2); get_r_token; p:=cur_cs;
- q:=scan_toks(true,e);
- if j<>0 then
- begin q:=get_avail; info(q):=j; link(q):=link(def_ref);
- link(def_ref):=q;
- end;
- define(p,call+(a mod 4),def_ref);
- end;
-
-@ Both \.{\\let} and \.{\\futurelet} share the command code |let|.
-
-@<Put each...@>=
-primitive("let",let,normal);@/
-@!@:let_}{\.{\\let} primitive@>
-primitive("futurelet",let,normal+1);@/
-@!@:future_let_}{\.{\\futurelet} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-let: if chr_code<>normal then print_esc("futurelet")@+else print_esc("let");
-
-@ @<Assignments@>=
-let: begin n:=cur_chr;
- get_r_token; p:=cur_cs;
- if n=normal then
- begin repeat get_token;
- until cur_cmd<>spacer;
- if cur_tok=other_token+"=" then
- begin get_token;
- if cur_cmd=spacer then get_token;
- end;
- end
- else begin get_token; q:=cur_tok; get_token; back_input;
- cur_tok:=q; back_input; {look ahead, then back up}
- end; {note that |back_input| doesn't affect |cur_cmd|, |cur_chr|}
- if cur_cmd>=call then add_token_ref(cur_chr)
- else if (cur_cmd=register)or(cur_cmd=toks_register) then
- if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
- add_sa_ref(cur_chr);
- define(p,cur_cmd,cur_chr);
- end;
-
-@ A \.{\\chardef} creates a control sequence whose |cmd| is |char_given|;
-a \.{\\mathchardef} creates a control sequence whose |cmd| is |math_given|;
-and the corresponding |chr| is the character code or math code. A \.{\\countdef}
-or \.{\\dimendef} or \.{\\skipdef} or \.{\\muskipdef} creates a control
-sequence whose |cmd| is |assign_int| or \dots\ or |assign_mu_glue|, and the
-corresponding |chr| is the |eqtb| location of the internal register in question.
-
-@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
-@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
-@d count_def_code=2 {|shorthand_def| for \.{\\countdef}}
-@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}}
-@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}}
-@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}}
-@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
-
-@<Put each...@>=
-primitive("chardef",shorthand_def,char_def_code);@/
-@!@:char_def_}{\.{\\chardef} primitive@>
-primitive("mathchardef",shorthand_def,math_char_def_code);@/
-@!@:math_char_def_}{\.{\\mathchardef} primitive@>
-primitive("countdef",shorthand_def,count_def_code);@/
-@!@:count_def_}{\.{\\countdef} primitive@>
-primitive("dimendef",shorthand_def,dimen_def_code);@/
-@!@:dimen_def_}{\.{\\dimendef} primitive@>
-primitive("skipdef",shorthand_def,skip_def_code);@/
-@!@:skip_def_}{\.{\\skipdef} primitive@>
-primitive("muskipdef",shorthand_def,mu_skip_def_code);@/
-@!@:mu_skip_def_}{\.{\\muskipdef} primitive@>
-primitive("toksdef",shorthand_def,toks_def_code);@/
-@!@:toks_def_}{\.{\\toksdef} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-shorthand_def: case chr_code of
- char_def_code: print_esc("chardef");
- math_char_def_code: print_esc("mathchardef");
- count_def_code: print_esc("countdef");
- dimen_def_code: print_esc("dimendef");
- skip_def_code: print_esc("skipdef");
- mu_skip_def_code: print_esc("muskipdef");
- othercases print_esc("toksdef")
- endcases;
-char_given: begin print_esc("char"); print_hex(chr_code);
- end;
-math_given: begin print_esc("mathchar"); print_hex(chr_code);
- end;
-
-@ We temporarily define |p| to be |relax|, so that an occurrence of |p|
-while scanning the definition will simply stop the scanning instead of
-producing an ``undefined control sequence'' error or expanding the
-previous meaning. This allows, for instance, `\.{\\chardef\\foo=123\\foo}'.
-
-@<Assignments@>=
-shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256);
- scan_optional_equals;
- case n of
- char_def_code: begin scan_char_num; define(p,char_given,cur_val);
- end;
- math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
- end;
- othercases begin scan_register_num;
- if cur_val>255 then
- begin j:=n-count_def_code; {|int_val..box_val|}
- if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
- find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
- if j=tok_val then j:=toks_register@+else j:=register;
- define(p,j,cur_ptr);
- end
- else
- case n of
- count_def_code: define(p,assign_int,count_base+cur_val);
- dimen_def_code: define(p,assign_dimen,scaled_base+cur_val);
- skip_def_code: define(p,assign_glue,skip_base+cur_val);
- mu_skip_def_code: define(p,assign_mu_glue,mu_skip_base+cur_val);
- toks_def_code: define(p,assign_toks,toks_base+cur_val);
- end; {there are no other cases}
- end
- endcases;
- end;
-
-@ @<Assignments@>=
-read_to_cs: begin j:=cur_chr; scan_int; n:=cur_val;
- if not scan_keyword("to") then
-@.to@>
- begin print_err("Missing `to' inserted");
-@.Missing `to'...@>
- help2("You should have said `\read<number> to \cs'.")@/
- ("I'm going to look for the \cs now."); error;
- end;
- get_r_token;
- p:=cur_cs; read_toks(n,p,j); define(p,call,cur_val);
- end;
-
-@ The token-list parameters, \.{\\output} and \.{\\everypar}, etc., receive
-their values in the following way. (For safety's sake, we place an
-enclosing pair of braces around an \.{\\output} list.)
-
-@<Assignments@>=
-toks_register,assign_toks: begin q:=cur_cs;
- e:=false; {just in case, will be set |true| for sparse array elements}
- if cur_cmd=toks_register then
- if cur_chr=mem_bot then
- begin scan_register_num;
- if cur_val>255 then
- begin find_sa_element(tok_val,cur_val,true);
- cur_chr:=cur_ptr; e:=true;
- end
- else cur_chr:=toks_base+cur_val;
- end
- else e:=true;
- p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
- scan_optional_equals;
- @<Get the next non-blank non-relax non-call token@>;
- if cur_cmd<>left_brace then @<If the right-hand side is a token parameter
- or token register, finish the assignment and |goto done|@>;
- back_input; cur_cs:=q; q:=scan_toks(false,false);
- if link(def_ref)=null then {empty list: revert to the default}
- begin sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
- end
- else begin if (p=output_routine_loc)and not e then {enclose in curlies}
- begin link(q):=get_avail; q:=link(q);
- info(q):=right_brace_token+"}";
- q:=get_avail; info(q):=left_brace_token+"{";
- link(q):=link(def_ref); link(def_ref):=q;
- end;
- sa_define(p,def_ref)(p,call,def_ref);
- end;
- end;
-
-@ @<If the right-hand side is a token parameter...@>=
-if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
- begin if cur_cmd=toks_register then
- if cur_chr=mem_bot then
- begin scan_register_num;
- if cur_val<256 then q:=equiv(toks_base+cur_val)
- else begin find_sa_element(tok_val,cur_val,false);
- if cur_ptr=null then q:=null
- else q:=sa_ptr(cur_ptr);
- end;
- end
- else q:=sa_ptr(cur_chr)
- else q:=equiv(cur_chr);
- if q=null then sa_define(p,null)(p,undefined_cs,null)
- else begin add_token_ref(q); sa_define(p,q)(p,call,q);
- end;
- goto done;
- end
-
-@ Similar routines are used to assign values to the numeric parameters.
-
-@<Assignments@>=
-assign_int: begin p:=cur_chr; scan_optional_equals; scan_int;
- word_define(p,cur_val);
- end;
-assign_dimen: begin p:=cur_chr; scan_optional_equals;
- scan_normal_dimen; word_define(p,cur_val);
- end;
-assign_glue,assign_mu_glue: begin p:=cur_chr; n:=cur_cmd; scan_optional_equals;
- if n=assign_mu_glue then scan_glue(mu_val)@+else scan_glue(glue_val);
- trap_zero_glue;
- define(p,glue_ref,cur_val);
- end;
-
-@ When a glue register or parameter becomes zero, it will always point to
-|zero_glue| because of the following procedure. (Exception: The tabskip
-glue isn't trapped while preambles are being scanned.)
-
-@<Declare subprocedures for |prefixed_command|@>=
-procedure trap_zero_glue;
-begin if (width(cur_val)=0)and(stretch(cur_val)=0)and(shrink(cur_val)=0) then
- begin add_glue_ref(zero_glue);
- delete_glue_ref(cur_val); cur_val:=zero_glue;
- end;
-end;
-
-@ The various character code tables are changed by the |def_code| commands,
-and the font families are declared by |def_family|.
-
-@<Put each...@>=
-primitive("catcode",def_code,cat_code_base);
-@!@:cat_code_}{\.{\\catcode} primitive@>
-primitive("mathcode",def_code,math_code_base);
-@!@:math_code_}{\.{\\mathcode} primitive@>
-primitive("lccode",def_code,lc_code_base);
-@!@:lc_code_}{\.{\\lccode} primitive@>
-primitive("uccode",def_code,uc_code_base);
-@!@:uc_code_}{\.{\\uccode} primitive@>
-primitive("sfcode",def_code,sf_code_base);
-@!@:sf_code_}{\.{\\sfcode} primitive@>
-primitive("delcode",def_code,del_code_base);
-@!@:del_code_}{\.{\\delcode} primitive@>
-primitive("textfont",def_family,math_font_base);
-@!@:text_font_}{\.{\\textfont} primitive@>
-primitive("scriptfont",def_family,math_font_base+script_size);
-@!@:script_font_}{\.{\\scriptfont} primitive@>
-primitive("scriptscriptfont",def_family,math_font_base+script_script_size);
-@!@:script_script_font_}{\.{\\scriptscriptfont} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-def_code: if chr_code=cat_code_base then print_esc("catcode")
- else if chr_code=math_code_base then print_esc("mathcode")
- else if chr_code=lc_code_base then print_esc("lccode")
- else if chr_code=uc_code_base then print_esc("uccode")
- else if chr_code=sf_code_base then print_esc("sfcode")
- else print_esc("delcode");
-def_family: print_size(chr_code-math_font_base);
-
-@ The different types of code values have different legal ranges; the
-following program is careful to check each case properly.
-
-@<Assignments@>=
-def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
- p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
- scan_int;
- if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then
- begin print_err("Invalid code ("); print_int(cur_val);
-@.Invalid code@>
- if p<del_code_base then print("), should be in the range 0..")
- else print("), should be at most ");
- print_int(n);
- help1("I'm going to use 0 instead of that illegal code value.");@/
- error; cur_val:=0;
- end;
- if p<math_code_base then define(p,data,cur_val)
- else if p<del_code_base then define(p,data,hi(cur_val))
- else word_define(p,cur_val);
- end;
-
-@ @<Let |n| be the largest...@>=
-if cur_chr=cat_code_base then n:=max_char_code
-else if cur_chr=math_code_base then n:=@'100000
-else if cur_chr=sf_code_base then n:=@'77777
-else if cur_chr=del_code_base then n:=@'77777777
-else n:=255
-
-@ @<Assignments@>=
-def_family: begin p:=cur_chr; scan_four_bit_int; p:=p+cur_val;
- scan_optional_equals; scan_font_ident; define(p,data,cur_val);
- end;
-
-@ Next we consider changes to \TeX's numeric registers.
-
-@<Assignments@>=
-register,advance,multiply,divide: do_register_command(a);
-
-@ We use the fact that |register<advance<multiply<divide|.
-
-@<Declare subprocedures for |prefixed_command|@>=
-procedure do_register_command(@!a:small_number);
-label found,exit;
-var l,@!q,@!r,@!s:pointer; {for list manipulation}
-@!p:int_val..mu_val; {type of register involved}
-@!e:boolean; {does |l| refer to a sparse array element?}
-@!w:integer; {integer or dimen value of |l|}
-begin q:=cur_cmd;
-e:=false; {just in case, will be set |true| for sparse array elements}
-@<Compute the register location |l| and its type |p|; but |return| if invalid@>;
-if q=register then scan_optional_equals
-else if scan_keyword("by") then do_nothing; {optional `\.{by}'}
-@.by@>
-arith_error:=false;
-if q<multiply then @<Compute result of |register| or
- |advance|, put it in |cur_val|@>
-else @<Compute result of |multiply| or |divide|, put it in |cur_val|@>;
-if arith_error then
- begin print_err("Arithmetic overflow");
-@.Arithmetic overflow@>
- help2("I can't carry out that multiplication or division,")@/
- ("since the result is out of range.");
- if p>=glue_val then delete_glue_ref(cur_val);
- error; return;
- end;
-if p<glue_val then sa_word_define(l,cur_val)
-else begin trap_zero_glue; sa_define(l,cur_val)(l,glue_ref,cur_val);
- end;
-exit: end;
-
-@ Here we use the fact that the consecutive codes |int_val..mu_val| and
-|assign_int..assign_mu_glue| correspond to each other nicely.
-
-@<Compute the register location |l| and its type |p|...@>=
-begin if q<>register then
- begin get_x_token;
- if (cur_cmd>=assign_int)and(cur_cmd<=assign_mu_glue) then
- begin l:=cur_chr; p:=cur_cmd-assign_int; goto found;
- end;
- if cur_cmd<>register then
- begin print_err("You can't use `"); print_cmd_chr(cur_cmd,cur_chr);
-@.You can't use x after ...@>
- print("' after "); print_cmd_chr(q,0);
- help1("I'm forgetting what you said and not changing anything.");
- error; return;
- end;
- end;
-if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
- begin l:=cur_chr; p:=sa_type(l); e:=true;
- end
-else begin p:=cur_chr-mem_bot; scan_register_num;
- if cur_val>255 then
- begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
- end
- else
-case p of
-int_val: l:=cur_val+count_base;
-dimen_val: l:=cur_val+scaled_base;
-glue_val: l:=cur_val+skip_base;
-mu_val: l:=cur_val+mu_skip_base;
-end; {there are no other cases}
- end;
-end;
-found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=eqtb[l].int
-else if e then s:=sa_ptr(l)@+else s:=equiv(l)
-
-@ @<Compute result of |register| or |advance|...@>=
-if p<glue_val then
- begin if p=int_val then scan_int@+else scan_normal_dimen;
- if q=advance then cur_val:=cur_val+w;
- end
-else begin scan_glue(p);
- if q=advance then @<Compute the sum of two glue specs@>;
- end
-
-@ @<Compute the sum of two glue specs@>=
-begin q:=new_spec(cur_val); r:=s;
-delete_glue_ref(cur_val);
-width(q):=width(q)+width(r);
-if stretch(q)=0 then stretch_order(q):=normal;
-if stretch_order(q)=stretch_order(r) then stretch(q):=stretch(q)+stretch(r)
-else if (stretch_order(q)<stretch_order(r))and(stretch(r)<>0) then
- begin stretch(q):=stretch(r); stretch_order(q):=stretch_order(r);
- end;
-if shrink(q)=0 then shrink_order(q):=normal;
-if shrink_order(q)=shrink_order(r) then shrink(q):=shrink(q)+shrink(r)
-else if (shrink_order(q)<shrink_order(r))and(shrink(r)<>0) then
- begin shrink(q):=shrink(r); shrink_order(q):=shrink_order(r);
- end;
-cur_val:=q;
-end
-
-@ @<Compute result of |multiply| or |divide|...@>=
-begin scan_int;
-if p<glue_val then
- if q=multiply then
- if p=int_val then cur_val:=mult_integers(w,cur_val)
- else cur_val:=nx_plus_y(w,cur_val,0)
- else cur_val:=x_over_n(w,cur_val)
-else begin r:=new_spec(s);
- if q=multiply then
- begin width(r):=nx_plus_y(width(s),cur_val,0);
- stretch(r):=nx_plus_y(stretch(s),cur_val,0);
- shrink(r):=nx_plus_y(shrink(s),cur_val,0);
- end
- else begin width(r):=x_over_n(width(s),cur_val);
- stretch(r):=x_over_n(stretch(s),cur_val);
- shrink(r):=x_over_n(shrink(s),cur_val);
- end;
- cur_val:=r;
- end;
-end
-
-@ The processing of boxes is somewhat different, because we may need
-to scan and create an entire box before we actually change the value of the old
-one.
-
-@<Assignments@>=
-set_box: begin scan_register_num;
- if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
- scan_optional_equals;
- if set_box_allowed then scan_box(n)
- else begin print_err("Improper "); print_esc("setbox");
-@.Improper \\setbox@>
- help2("Sorry, \setbox is not allowed after \halign in a display,")@/
- ("or between \accent and an accented character."); error;
- end;
- end;
-
-@ The |space_factor| or |prev_depth| settings are changed when a |set_aux|
-command is sensed. Similarly, |prev_graf| is changed in the presence of
-|set_prev_graf|, and |dead_cycles| or |insert_penalties| in the presence of
-|set_page_int|. These definitions are always global.
-
-When some dimension of a box register is changed, the change isn't exactly
-global; but \TeX\ does not look at the \.{\\global} switch.
-
-@<Assignments@>=
-set_aux:alter_aux;
-set_prev_graf:alter_prev_graf;
-set_page_dimen:alter_page_so_far;
-set_page_int:alter_integer;
-set_box_dimen:alter_box_dimen;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure alter_aux;
-var c:halfword; {|hmode| or |vmode|}
-begin if cur_chr<>abs(mode) then report_illegal_case
-else begin c:=cur_chr; scan_optional_equals;
- if c=vmode then
- begin scan_normal_dimen; prev_depth:=cur_val;
- end
- else begin scan_int;
- if (cur_val<=0)or(cur_val>32767) then
- begin print_err("Bad space factor");
-@.Bad space factor@>
- help1("I allow only values in the range 1..32767 here.");
- int_error(cur_val);
- end
- else space_factor:=cur_val;
- end;
- end;
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure alter_prev_graf;
-var p:0..nest_size; {index into |nest|}
-begin nest[nest_ptr]:=cur_list; p:=nest_ptr;
-while abs(nest[p].mode_field)<>vmode do decr(p);
-scan_optional_equals; scan_int;
-if cur_val<0 then
- begin print_err("Bad "); print_esc("prevgraf");
-@.Bad \\prevgraf@>
- help1("I allow only nonnegative values here.");
- int_error(cur_val);
- end
-else begin nest[p].pg_field:=cur_val; cur_list:=nest[nest_ptr];
- end;
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure alter_page_so_far;
-var c:0..7; {index into |page_so_far|}
-begin c:=cur_chr; scan_optional_equals; scan_normal_dimen;
-page_so_far[c]:=cur_val;
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure alter_integer;
-var c:small_number;
- {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc.}
-begin c:=cur_chr; scan_optional_equals; scan_int;
-if c=0 then dead_cycles:=cur_val
-@/@<Cases for |alter_integer|@>@/
-else insert_penalties:=cur_val;
-end;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure alter_box_dimen;
-var c:small_number; {|width_offset| or |height_offset| or |depth_offset|}
-@!b:pointer; {box register}
-begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
-scan_normal_dimen;
-if b<>null then mem[b+c].sc:=cur_val;
-end;
-
-@ Paragraph shapes are set up in the obvious way.
-
-@<Assignments@>=
-set_shape: begin q:=cur_chr; scan_optional_equals; scan_int; n:=cur_val;
- if n<=0 then p:=null
- else if q>par_shape_loc then
- begin n:=(cur_val div 2)+1; p:=get_node(2*n+1); info(p):=n;
- n:=cur_val; mem[p+1].int:=n; {number of penalties}
- for j:=p+2 to p+n+1 do
- begin scan_int; mem[j].int:=cur_val; {penalty values}
- end;
- if not odd(n) then mem[p+n+2].int:=0; {unused}
- end
- else begin p:=get_node(2*n+1); info(p):=n;
- for j:=1 to n do
- begin scan_normal_dimen;
- mem[p+2*j-1].sc:=cur_val; {indentation}
- scan_normal_dimen;
- mem[p+2*j].sc:=cur_val; {width}
- end;
- end;
- define(q,shape_ref,p);
- end;
-
-@ Here's something that isn't quite so obvious. It guarantees that
-|info(par_shape_ptr)| can hold any positive~|n| for which |get_node(2*n+1)|
-doesn't overflow the memory capacity.
-
-@<Check the ``constant''...@>=
-if 2*max_halfword<mem_top-mem_min then bad:=41;
-
-@ New hyphenation data is loaded by the |hyph_data| command.
-
-@<Put each...@>=
-primitive("hyphenation",hyph_data,0);
-@!@:hyphenation_}{\.{\\hyphenation} primitive@>
-primitive("patterns",hyph_data,1);
-@!@:patterns_}{\.{\\patterns} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-hyph_data: if chr_code=1 then print_esc("patterns")
- else print_esc("hyphenation");
-
-@ @<Assignments@>=
-hyph_data: if cur_chr=1 then
- begin @!init new_patterns; goto done;@;@+tini@/
- print_err("Patterns can be loaded only by INITEX");
-@.Patterns can be...@>
- help0; error;
- repeat get_token; until cur_cmd=right_brace; {flush the patterns}
- return;
- end
- else begin new_hyph_exceptions; goto done;
- end;
-
-@ All of \TeX's parameters are kept in |eqtb| except the font information,
-the interaction mode, and the hyphenation tables; these are strictly global.
-
-@<Assignments@>=
-assign_font_dimen: begin find_font_dimen(true); k:=cur_val;
- scan_optional_equals; scan_normal_dimen; font_info[k].sc:=cur_val;
- end;
-assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
- if n = 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 hyphen_char[f]:=cur_val@+else 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);
- kn_bs_code_base: set_kn_bs_code(f, p, cur_val);
- st_bs_code_base: set_st_bs_code(f, p, cur_val);
- sh_bs_code_base: set_sh_bs_code(f, p, cur_val);
- kn_bc_code_base: set_kn_bc_code(f, p, cur_val);
- kn_ac_code_base: set_kn_ac_code(f, p, cur_val);
- end;
- end;
-end;
-
-@ @<Put each...@>=
-primitive("hyphenchar",assign_font_int,0);
-@!@:hyphen_char_}{\.{\\hyphenchar} primitive@>
-primitive("skewchar",assign_font_int,1);
-@!@:skew_char_}{\.{\\skewchar} primitive@>
-primitive("lpcode",assign_font_int,lp_code_base);
-@!@:lp_code_}{\.{\\lpcode} primitive@>
-primitive("rpcode",assign_font_int,rp_code_base);
-@!@:rp_code_}{\.{\\rpcode} primitive@>
-primitive("efcode",assign_font_int,ef_code_base);
-@!@:ef_code_}{\.{\\efcode} primitive@>
-primitive("tagcode",assign_font_int,tag_code);
-@!@:tag_code_}{\.{\\tagcode} primitive@>
-primitive("knbscode",assign_font_int,kn_bs_code_base);
-@!@:kn_bs_code_}{\.{\\knbscode} primitive@>
-primitive("stbscode",assign_font_int,st_bs_code_base);
-@!@:st_bs_code_}{\.{\\stbscode} primitive@>
-primitive("shbscode",assign_font_int,sh_bs_code_base);
-@!@:sh_bs_code_}{\.{\\shbscode} primitive@>
-primitive("knbccode",assign_font_int,kn_bc_code_base);
-@!@:kn_bc_code_}{\.{\\knbccode} primitive@>
-primitive("knaccode",assign_font_int,kn_ac_code_base);
-@!@:kn_ac_code_}{\.{\\knaccode} primitive@>
-primitive("pdfnoligatures",assign_font_int,no_lig_code);
-@!@:no_lig_code_}{\.{\\pdfnoligatures} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-assign_font_int: case chr_code of
-0: print_esc("hyphenchar");
-1: print_esc("skewchar");
-lp_code_base: print_esc("lpcode");
-rp_code_base: print_esc("rpcode");
-ef_code_base: print_esc("efcode");
-tag_code: print_esc("tagcode");
-kn_bs_code_base: print_esc("knbscode");
-st_bs_code_base: print_esc("stbscode");
-sh_bs_code_base: print_esc("shbscode");
-kn_bc_code_base: print_esc("knbccode");
-kn_ac_code_base: print_esc("knaccode");
-no_lig_code: print_esc("pdfnoligatures");
-endcases;
-
-@ Here is where the information for a new font gets loaded.
-
-@<Assignments@>=
-def_font: new_font(a);
-letterspace_font: new_letterspaced_font(a);
-pdf_copy_font: make_font_copy(a);
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure new_font(@!a:small_number);
-label common_ending;
-var u:pointer; {user's font identifier}
-@!s:scaled; {stated ``at'' size, or negative of scaled magnification}
-@!f:internal_font_number; {runs through existing fonts}
-@!t:str_number; {name for the frozen font identifier}
-@!old_setting:0..max_selector; {holds |selector| setting}
-@!flushable_string:str_number; {string not yet referenced}
-begin if job_name=0 then open_log_file;
- {avoid confusing \.{texput} with the font name}
-@.texput@>
-get_r_token; u:=cur_cs;
-if u>=hash_base then t:=text(u)
-else if u>=single_base then
- if u=null_cs then t:="FONT"@+else t:=u-single_base
-else begin old_setting:=selector; selector:=new_string;
- print("FONT"); print(u-active_base); selector:=old_setting;
-@.FONTx@>
- str_room(1); t:=make_string;
- end;
-define(u,set_font,null_font); scan_optional_equals; scan_file_name;
-@<Scan the font size specification@>;
-@<If this font has already been loaded, set |f| to the internal
- font number and |goto common_ending|@>;
-f:=read_font_info(u,cur_name,cur_area,s);
-common_ending: define(u,set_font,f); eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
-end;
-
-@ @<Scan the font size specification@>=
-name_in_progress:=true; {this keeps |cur_name| from being changed}
-if scan_keyword("at") then @<Put the \(p)(positive) `at' size into |s|@>
-@.at@>
-else if scan_keyword("scaled") then
-@.scaled@>
- begin scan_int; s:=-cur_val;
- if (cur_val<=0)or(cur_val>32768) then
- begin print_err("Illegal magnification has been changed to 1000");@/
-@.Illegal magnification...@>
- help1("The magnification ratio must be between 1 and 32768.");
- int_error(cur_val); s:=-1000;
- end;
- end
-else s:=-1000;
-name_in_progress:=false
-
-@ @<Put the \(p)(positive) `at' size into |s|@>=
-begin scan_normal_dimen; s:=cur_val;
-if (s<=0)or(s>=@'1000000000) then
- begin print_err("Improper `at' size (");
- print_scaled(s); print("pt), replaced by 10pt");
-@.Improper `at' size...@>
- help2("I can only handle fonts at positive sizes that are")@/
- ("less than 2048pt, so I've changed what you said to 10pt.");
- error; s:=10*unity;
- end;
-end
-
-@ When the user gives a new identifier to a font that was previously loaded,
-the new name becomes the font identifier of record. Font names `\.{xyz}' and
-`\.{XYZ}' are considered to be different.
-
-@<If this font has already been loaded...@>=
-flushable_string:=str_ptr-1;
-for f:=font_base+1 to font_ptr do
- if str_eq_str(font_name[f],cur_name)and str_eq_str(font_area[f],cur_area) then
- begin if cur_name=flushable_string then
- begin flush_string; cur_name:=font_name[f];
- end;
- if s>0 then
- begin if s=font_size[f] then goto common_ending;
- end
- else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then
- goto common_ending;
- end
-
-@ @<Cases of |print_cmd_chr|...@>=
-set_font:begin print("select font "); slow_print(font_name[chr_code]);
- if font_size[chr_code]<>font_dsize[chr_code] then
- begin print(" at "); print_scaled(font_size[chr_code]);
- print("pt");
- end;
- end;
-
-@ @<Put each...@>=
-primitive("batchmode",set_interaction,batch_mode);
-@!@:batch_mode_}{\.{\\batchmode} primitive@>
-primitive("nonstopmode",set_interaction,nonstop_mode);
-@!@:nonstop_mode_}{\.{\\nonstopmode} primitive@>
-primitive("scrollmode",set_interaction,scroll_mode);
-@!@:scroll_mode_}{\.{\\scrollmode} primitive@>
-primitive("errorstopmode",set_interaction,error_stop_mode);
-@!@:error_stop_mode_}{\.{\\errorstopmode} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-set_interaction: case chr_code of
- batch_mode: print_esc("batchmode");
- nonstop_mode: print_esc("nonstopmode");
- scroll_mode: print_esc("scrollmode");
- othercases print_esc("errorstopmode")
- endcases;
-
-@ @<Assignments@>=
-set_interaction: new_interaction;
-
-@ @<Declare subprocedures for |prefixed_command|@>=
-procedure new_interaction;
-begin print_ln;
-interaction:=cur_chr;
-@<Initialize the print |selector| based on |interaction|@>;
-if log_opened then selector:=selector+2;
-end;
-
-@ The \.{\\afterassignment} command puts a token into the global
-variable |after_token|. This global variable is examined just after
-every assignment has been performed.
-
-@<Glob...@>=
-@!after_token:halfword; {zero, or a saved token}
-
-@ @<Set init...@>=
-after_token:=0;
-
-@ @<Cases of |main_control| that don't...@>=
-any_mode(after_assignment):begin get_token; after_token:=cur_tok;
- end;
-
-@ @<Insert a token saved by \.{\\afterassignment}, if any@>=
-if after_token<>0 then
- begin cur_tok:=after_token; back_input; after_token:=0;
- end
-
-@ Here is a procedure that might be called `Get the next non-blank non-relax
-non-call non-assignment token'.
-
-@<Declare act...@>=
-procedure do_assignments;
-label exit;
-begin loop begin @<Get the next non-blank non-relax...@>;
- if cur_cmd<=max_non_prefixed_command then return;
- set_box_allowed:=false; prefixed_command; set_box_allowed:=true;
- end;
-exit:end;
-
-@ @<Cases of |main_control| that don't...@>=
-any_mode(after_group):begin get_token; save_for_after(cur_tok);
- end;
-
-@ Files for \.{\\read} are opened and closed by the |in_stream| command.
-
-@<Put each...@>=
-primitive("openin",in_stream,1);
-@!@:open_in_}{\.{\\openin} primitive@>
-primitive("closein",in_stream,0);
-@!@:close_in_}{\.{\\closein} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-in_stream: if chr_code=0 then print_esc("closein")
- else print_esc("openin");
-
-@ @<Cases of |main_control| that don't...@>=
-any_mode(in_stream): open_or_close_in;
-
-@ @<Declare act...@>=
-procedure open_or_close_in;
-var c:0..1; {1 for \.{\\openin}, 0 for \.{\\closein}}
-@!n:0..15; {stream number}
-begin c:=cur_chr; scan_four_bit_int; n:=cur_val;
-if read_open[n]<>closed then
- begin a_close(read_file[n]); read_open[n]:=closed;
- end;
-if c<>0 then
- begin scan_optional_equals; scan_file_name;
- if cur_ext="" then cur_ext:=".tex";
- pack_cur_name;
- if a_open_in(read_file[n]) then read_open[n]:=just_open;
- end;
-end;
-
-@ The user can issue messages to the terminal, regardless of the
-current mode.
-
-@<Cases of |main_control| that don't...@>=
-any_mode(message):issue_message;
-
-@ @<Put each...@>=
-primitive("message",message,0);
-@!@:message_}{\.{\\message} primitive@>
-primitive("errmessage",message,1);
-@!@:err_message_}{\.{\\errmessage} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-message: if chr_code=0 then print_esc("message")
- else print_esc("errmessage");
-
-@ @<Declare act...@>=
-procedure issue_message;
-var old_setting:0..max_selector; {holds |selector| setting}
-@!c:0..1; {identifies \.{\\message} and \.{\\errmessage}}
-@!s:str_number; {the message}
-begin c:=cur_chr; link(garbage):=scan_toks(false,true);
-old_setting:=selector; selector:=new_string;
-token_show(def_ref); selector:=old_setting;
-flush_list(def_ref);
-str_room(1); s:=make_string;
-if c=0 then @<Print string |s| on the terminal@>
-else @<Print string |s| as an error message@>;
-flush_string;
-end;
-
-@ @<Print string |s| on the terminal@>=
-begin if term_offset+length(s)>max_print_line-2 then print_ln
-else if (term_offset>0)or(file_offset>0) then print_char(" ");
-slow_print(s); update_terminal;
-end
-
-@ If \.{\\errmessage} occurs often in |scroll_mode|, without user-defined
-\.{\\errhelp}, we don't want to give a long help message each time. So we
-give a verbose explanation only once.
-
-@<Glob...@>=
-@!long_help_seen:boolean; {has the long \.{\\errmessage} help been used?}
-
-@ @<Set init...@>=long_help_seen:=false;
-
-@ @<Print string |s| as an error message@>=
-begin print_err(""); slow_print(s);
-if err_help<>null then use_err_help:=true
-else if long_help_seen then help1("(That was another \errmessage.)")
-else begin if interaction<error_stop_mode then long_help_seen:=true;
- help4("This error message was generated by an \errmessage")@/
- ("command, so I can't give any explicit help.")@/
- ("Pretend that you're Hercule Poirot: Examine all clues,")@/
-@^Poirot, Hercule@>
- ("and deduce the truth by order and method.");
- end;
-error; use_err_help:=false;
-end
-
-@ The |error| routine calls on |give_err_help| if help is requested from
-the |err_help| parameter.
-
-@p procedure give_err_help;
-begin token_show(err_help);
-end;
-
-@ The \.{\\uppercase} and \.{\\lowercase} commands are implemented by
-building a token list and then changing the cases of the letters in it.
-
-@<Cases of |main_control| that don't...@>=
-any_mode(case_shift):shift_case;
-
-@ @<Put each...@>=
-primitive("lowercase",case_shift,lc_code_base);
-@!@:lowercase_}{\.{\\lowercase} primitive@>
-primitive("uppercase",case_shift,uc_code_base);
-@!@:uppercase_}{\.{\\uppercase} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-case_shift:if chr_code=lc_code_base then print_esc("lowercase")
- else print_esc("uppercase");
-
-@ @<Declare act...@>=
-procedure shift_case;
-var b:pointer; {|lc_code_base| or |uc_code_base|}
-@!p:pointer; {runs through the token list}
-@!t:halfword; {token}
-@!c:eight_bits; {character code}
-begin b:=cur_chr; p:=scan_toks(false,false); p:=link(def_ref);
-while p<>null do
- begin @<Change the case of the token in |p|, if a change is appropriate@>;
- p:=link(p);
- end;
-back_list(link(def_ref)); free_avail(def_ref); {omit reference count}
-end;
-
-@ When the case of a |chr_code| changes, we don't change the |cmd|.
-We also change active characters, using the fact that
-|cs_token_flag+active_base| is a multiple of~256.
-@^data structure assumptions@>
-
-@<Change the case of the token in |p|, if a change is appropriate@>=
-t:=info(p);
-if t<cs_token_flag+single_base then
- begin c:=t mod 256;
- if equiv(b+c)<>0 then info(p):=t-c+equiv(b+c);
- end
-
-@ We come finally to the last pieces missing from |main_control|, namely the
-`\.{\\show}' commands that are useful when debugging.
-
-@<Cases of |main_control| that don't...@>=
-any_mode(xray): show_whatever;
-
-@ @d show_code=0 { \.{\\show} }
-@d show_box_code=1 { \.{\\showbox} }
-@d show_the_code=2 { \.{\\showthe} }
-@d show_lists_code=3 { \.{\\showlists} }
-
-@<Put each...@>=
-primitive("show",xray,show_code);
-@!@:show_}{\.{\\show} primitive@>
-primitive("showbox",xray,show_box_code);
-@!@:show_box_}{\.{\\showbox} primitive@>
-primitive("showthe",xray,show_the_code);
-@!@:show_the_}{\.{\\showthe} primitive@>
-primitive("showlists",xray,show_lists_code);
-@!@:show_lists_code_}{\.{\\showlists} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-xray: case chr_code of
- show_box_code:print_esc("showbox");
- show_the_code:print_esc("showthe");
- show_lists_code:print_esc("showlists");
- @<Cases of |xray| for |print_cmd_chr|@>@;@/
- othercases print_esc("show")
- endcases;
-
-@ @<Declare act...@>=
-procedure show_whatever;
-label common_ending;
-var p:pointer; {tail of a token list to show}
-@!t:small_number; {type of conditional being shown}
-@!m:normal..or_code; {upper bound on |fi_or_else| codes}
-@!l:integer; {line where that conditional began}
-@!n:integer; {level of \.{\\if...\\fi} nesting}
-begin case cur_chr of
-show_lists_code: begin begin_diagnostic; show_activities;
- end;
-show_box_code: @<Show the current contents of a box@>;
-show_code: @<Show the current meaning of a token, then |goto common_ending|@>;
-@<Cases for |show_whatever|@>@;@/
-othercases @<Show the current value of some parameter or register,
- then |goto common_ending|@>
-endcases;@/
-@<Complete a potentially long \.{\\show} command@>;
-common_ending: if interaction<error_stop_mode then
- begin help0; decr(error_count);
- end
-else if tracing_online>0 then
- begin@t@>@;@/
- help3("This isn't an error message; I'm just \showing something.")@/
- ("Type `I\show...' to show more (e.g., \show\cs,")@/
- ("\showthe\count10, \showbox255, \showlists).");
- end
-else begin@t@>@;@/
- help5("This isn't an error message; I'm just \showing something.")@/
- ("Type `I\show...' to show more (e.g., \show\cs,")@/
- ("\showthe\count10, \showbox255, \showlists).")@/
- ("And type `I\tracingonline=1\show...' to show boxes and")@/
- ("lists on your terminal as well as in the transcript file.");
- end;
-error;
-end;
-
-@ @<Show the current meaning of a token...@>=
-begin get_token;
-if interaction=error_stop_mode then wake_up_terminal;
-print_nl("> ");
-if cur_cs<>0 then
- begin sprint_cs(cur_cs); print_char("=");
- end;
-print_meaning; goto common_ending;
-end
-
-@ @<Cases of |print_cmd_chr|...@>=
-undefined_cs: print("undefined");
-call,long_call,outer_call,long_outer_call: begin n:=cmd-call;
- if info(link(chr_code))=protected_token then n:=n+4;
- if odd(n div 4) then print_esc("protected");
- if odd(n) then print_esc("long");
- if odd(n div 2) then print_esc("outer");
- if n>0 then print_char(" ");
- print("macro");
- end;
-end_template: print_esc("outer endtemplate");
-
-@ @<Show the current contents of a box@>=
-begin scan_register_num; fetch_box(p); begin_diagnostic;
-print_nl("> \box"); print_int(cur_val); print_char("=");
-if p=null then print("void")@+else show_box(p);
-end
-
-@ @<Show the current value of some parameter...@>=
-begin p:=the_toks;
-if interaction=error_stop_mode then wake_up_terminal;
-print_nl("> "); token_show(temp_head);
-flush_list(link(temp_head)); goto common_ending;
-end
-
-@ @<Complete a potentially long \.{\\show} command@>=
-end_diagnostic(true); print_err("OK");
-@.OK@>
-if selector=term_and_log then if tracing_online<=0 then
- begin selector:=term_only; print(" (see the transcript file)");
- selector:=term_and_log;
- end
-
-@* \[50] Dumping and undumping the tables.
-After \.{INITEX} has seen a collection of fonts and macros, it
-can write all the necessary information on an auxiliary file so
-that production versions of \TeX\ are able to initialize their
-memory at high speed. The present section of the program takes
-care of such output and input. We shall consider simultaneously
-the processes of storing and restoring,
-so that the inverse relation between them is clear.
-@.INITEX@>
-
-The global variable |format_ident| is a string that is printed right
-after the |banner| line when \TeX\ is ready to start. For \.{INITEX} this
-string says simply `\.{ (INITEX)}'; for other versions of \TeX\ it says,
-for example, `\.{ (preloaded format=plain 1982.11.19)}', showing the year,
-month, and day that the format file was created. We have |format_ident=0|
-before \TeX's tables are loaded.
-
-@<Glob...@>=
-@!format_ident:str_number;
-
-@ @<Set init...@>=
-format_ident:=0;
-
-@ @<Initialize table entries...@>=
-format_ident:=" (INITEX)";
-
-@ @<Declare act...@>=
-@!init procedure store_fmt_file;
-label found1,found2,done1,done2;
-var j,@!k,@!l:integer; {all-purpose indices}
-@!p,@!q: pointer; {all-purpose pointers}
-@!x: integer; {something to dump}
-@!w: four_quarters; {four ASCII codes}
-begin @<If dumping is not allowed, abort@>;
-@<Create the |format_ident|, open the format file,
- and inform the user that dumping has begun@>;
-@<Dump constants for consistency check@>;
-@<Dump the string pool@>;
-@<Dump the dynamic memory@>;
-@<Dump the table of equivalents@>;
-@<Dump the font information@>;
-@<Dump the hyphenation tables@>;
-@<Dump pdftex data@>;
-@<Dump a couple more things and the closing check word@>;
-@<Close the format file@>;
-end;
-tini
-
-@ Corresponding to the procedure that dumps a format file, we have a function
-that reads one in. The function returns |false| if the dumped format is
-incompatible with the present \TeX\ table sizes, etc.
-
-@d bad_fmt=6666 {go here if the format file is unacceptable}
-@d too_small(#)==begin wake_up_terminal;
- wterm_ln('---! Must increase the ',#);
-@.Must increase the x@>
- goto bad_fmt;
- end
-
-@p @t\4@>@<Declare the function called |open_fmt_file|@>@;
-function load_fmt_file:boolean;
-label bad_fmt,exit;
-var j,@!k:integer; {all-purpose indices}
-@!p,@!q: pointer; {all-purpose pointers}
-@!x: integer; {something undumped}
-@!w: four_quarters; {four ASCII codes}
-begin @<Undump constants for consistency check@>;
-@<Undump the string pool@>;
-@<Undump the dynamic memory@>;
-@<Undump the table of equivalents@>;
-@<Undump the font information@>;
-@<Undump the hyphenation tables@>;
-@<Undump pdftex data@>;
-@<Undump a couple more things and the closing check word@>;
-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|.
-System error messages should be suppressed when undumping.
-@^system dependencies@>
-
-@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
-@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
-@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
-@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
-@d undump_end_end(#)==#:=x;@+end
-@d undump_end(#)==(x>#) then goto bad_fmt@+else undump_end_end
-@d undump(#)==begin undump_int(x); if (x<#) or undump_end
-@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
-@d undump_size_end(#)==if x># then undump_size_end_end
-@d undump_size(#)==begin undump_int(x);
- if x<# then goto bad_fmt; undump_size_end
-
-@ The next few sections of the program should make it clear how we use the
-dump/undump macros.
-
-@<Dump constants for consistency check@>=
-dump_int(@$);@/
-@<Dump the \eTeX\ state@>@/
-dump_int(mem_bot);@/
-dump_int(mem_top);@/
-dump_int(eqtb_size);@/
-dump_int(hash_prime);@/
-dump_int(hyph_size)
-
-@ Sections of a \.{WEB} program that are ``commented out'' still contribute
-strings to the string pool; therefore \.{INITEX} and \TeX\ will have
-the same strings. (And it is, of course, a good thing that they do.)
-@.WEB@>
-@^string pool@>
-
-@<Undump constants for consistency check@>=
-x:=fmt_file^.int;
-if x<>@$ then goto bad_fmt; {check that strings are the same}
-@/@<Undump the \eTeX\ state@>@/
-undump_int(x);
-if x<>mem_bot then goto bad_fmt;
-undump_int(x);
-if x<>mem_top then goto bad_fmt;
-undump_int(x);
-if x<>eqtb_size then goto bad_fmt;
-undump_int(x);
-if x<>hash_prime then goto bad_fmt;
-undump_int(x);
-if x<>hyph_size then goto bad_fmt
-
-@ @d dump_four_ASCII==
- w.b0:=qi(so(str_pool[k])); w.b1:=qi(so(str_pool[k+1]));
- w.b2:=qi(so(str_pool[k+2])); w.b3:=qi(so(str_pool[k+3]));
- dump_qqqq(w)
-
-@<Dump the string pool@>=
-dump_int(pool_ptr);
-dump_int(str_ptr);
-for k:=0 to str_ptr do dump_int(str_start[k]);
-k:=0;
-while k+4<pool_ptr do
- begin dump_four_ASCII; k:=k+4;
- end;
-k:=pool_ptr-4; dump_four_ASCII;
-print_ln; print_int(str_ptr); print(" strings of total length ");
-print_int(pool_ptr)
-
-@ @d undump_four_ASCII==
- undump_qqqq(w);
- str_pool[k]:=si(qo(w.b0)); str_pool[k+1]:=si(qo(w.b1));
- str_pool[k+2]:=si(qo(w.b2)); str_pool[k+3]:=si(qo(w.b3))
-
-@<Undump the string pool@>=
-undump_size(0)(pool_size)('string pool size')(pool_ptr);
-undump_size(0)(max_strings)('max strings')(str_ptr);
-for k:=0 to str_ptr do undump(0)(pool_ptr)(str_start[k]);
-k:=0;
-while k+4<pool_ptr do
- begin undump_four_ASCII; k:=k+4;
- end;
-k:=pool_ptr-4; undump_four_ASCII;
-init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr
-
-@ By sorting the list of available spaces in the variable-size portion of
-|mem|, we are usually able to get by without having to dump very much
-of the dynamic memory.
-
-We recompute |var_used| and |dyn_used|, so that \.{INITEX} dumps valid
-information even when it has not been gathering statistics.
-
-@<Dump the dynamic memory@>=
-sort_avail; var_used:=0;
-dump_int(lo_mem_max); dump_int(rover);
-if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
-p:=mem_bot; q:=rover; x:=0;
-repeat for k:=p to q+1 do dump_wd(mem[k]);
-x:=x+q+2-p; var_used:=var_used+q-p;
-p:=q+node_size(q); q:=rlink(q);
-until q=rover;
-var_used:=var_used+lo_mem_max-p; dyn_used:=mem_end+1-hi_mem_min;@/
-for k:=p to lo_mem_max do dump_wd(mem[k]);
-x:=x+lo_mem_max+1-p;
-dump_int(hi_mem_min); dump_int(avail);
-for k:=hi_mem_min to mem_end do dump_wd(mem[k]);
-x:=x+mem_end+1-hi_mem_min;
-p:=avail;
-while p<>null do
- begin decr(dyn_used); p:=link(p);
- end;
-dump_int(var_used); dump_int(dyn_used);
-print_ln; print_int(x);
-print(" memory locations dumped; current usage is ");
-print_int(var_used); print_char("&"); print_int(dyn_used)
-
-@ @<Undump the dynamic memory@>=
-undump(lo_mem_stat_max+1000)(hi_mem_stat_min-1)(lo_mem_max);
-undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
-if eTeX_ex then for k:=int_val to tok_val do
- undump(null)(lo_mem_max)(sa_root[k]);
-p:=mem_bot; q:=rover;
-repeat for k:=p to q+1 do undump_wd(mem[k]);
-p:=q+node_size(q);
-if (p>lo_mem_max)or((q>=rlink(q))and(rlink(q)<>rover)) then goto bad_fmt;
-q:=rlink(q);
-until q=rover;
-for k:=p to lo_mem_max do undump_wd(mem[k]);
-if mem_min<mem_bot-2 then {make more low memory available}
- begin p:=llink(rover); q:=mem_min+1;
- link(mem_min):=null; info(mem_min):=null; {we don't use the bottom word}
- rlink(p):=q; llink(rover):=q;@/
- rlink(q):=rover; llink(q):=p; link(q):=empty_flag;
- node_size(q):=mem_bot-q;
- end;
-undump(lo_mem_max+1)(hi_mem_stat_min)(hi_mem_min);
-undump(null)(mem_top)(avail); mem_end:=mem_top;
-for k:=hi_mem_min to mem_end do undump_wd(mem[k]);
-undump_int(var_used); undump_int(dyn_used)
-
-@ @<Dump the table of equivalents@>=
-@<Dump regions 1 to 4 of |eqtb|@>;
-@<Dump regions 5 and 6 of |eqtb|@>;
-dump_int(par_loc); dump_int(write_loc);@/
-@<Dump the hash table@>
-
-@ @<Undump the table of equivalents@>=
-@<Undump regions 1 to 6 of |eqtb|@>;
-undump(hash_base)(frozen_control_sequence)(par_loc);
-par_token:=cs_token_flag+par_loc;@/
-undump(hash_base)(frozen_control_sequence)(write_loc);@/
-@<Undump the hash table@>
-
-@ The table of equivalents usually contains repeated information, so we dump it
-in compressed form: The sequence of $n+2$ values $(n,x_1,\ldots,x_n,m)$ in the
-format file represents $n+m$ consecutive entries of |eqtb|, with |m| extra
-copies of $x_n$, namely $(x_1,\ldots,x_n,x_n,\ldots,x_n)$.
-
-@<Dump regions 1 to 4 of |eqtb|@>=
-k:=active_base;
-repeat j:=k;
-while j<int_base-1 do
- begin if (equiv(j)=equiv(j+1))and(eq_type(j)=eq_type(j+1))and@|
- (eq_level(j)=eq_level(j+1)) then goto found1;
- incr(j);
- end;
-l:=int_base; goto done1; {|j=int_base-1|}
-found1: incr(j); l:=j;
-while j<int_base-1 do
- begin if (equiv(j)<>equiv(j+1))or(eq_type(j)<>eq_type(j+1))or@|
- (eq_level(j)<>eq_level(j+1)) then goto done1;
- incr(j);
- end;
-done1:dump_int(l-k);
-while k<l do
- begin dump_wd(eqtb[k]); incr(k);
- end;
-k:=j+1; dump_int(k-l);
-until k=int_base
-
-@ @<Dump regions 5 and 6 of |eqtb|@>=
-repeat j:=k;
-while j<eqtb_size do
- begin if eqtb[j].int=eqtb[j+1].int then goto found2;
- incr(j);
- end;
-l:=eqtb_size+1; goto done2; {|j=eqtb_size|}
-found2: incr(j); l:=j;
-while j<eqtb_size do
- begin if eqtb[j].int<>eqtb[j+1].int then goto done2;
- incr(j);
- end;
-done2:dump_int(l-k);
-while k<l do
- begin dump_wd(eqtb[k]); incr(k);
- end;
-k:=j+1; dump_int(k-l);
-until k>eqtb_size
-
-@ @<Undump regions 1 to 6 of |eqtb|@>=
-k:=active_base;
-repeat undump_int(x);
-if (x<1)or(k+x>eqtb_size+1) then goto bad_fmt;
-for j:=k to k+x-1 do undump_wd(eqtb[j]);
-k:=k+x;
-undump_int(x);
-if (x<0)or(k+x>eqtb_size+1) then goto bad_fmt;
-for j:=k to k+x-1 do eqtb[j]:=eqtb[k-1];
-k:=k+x;
-until k>eqtb_size
-
-@ A different scheme is used to compress the hash table, since its lower
-region is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output
-two words, |p| and |hash[p]|. The hash table is, of course, densely packed
-for |p>=hash_used|, so the remaining entries are output in a~block.
-
-@<Dump the hash table@>=
-for p:=0 to prim_size do dump_hh(prim[p]);
-dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used;
-for p:=hash_base to hash_used do if text(p)<>0 then
- begin dump_int(p); dump_hh(hash[p]); incr(cs_count);
- end;
-for p:=hash_used+1 to undefined_control_sequence-1 do dump_hh(hash[p]);
-dump_int(cs_count);@/
-print_ln; print_int(cs_count); print(" multiletter control sequences")
-
-@ @<Undump the hash table@>=
-for p:=0 to prim_size do undump_hh(prim[p]);
-undump(hash_base)(frozen_control_sequence)(hash_used); p:=hash_base-1;
-repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]);
-until p=hash_used;
-for p:=hash_used+1 to undefined_control_sequence-1 do undump_hh(hash[p]);
-undump_int(cs_count)
-
-@ @<Dump the font information@>=
-dump_int(fmem_ptr);
-for k:=0 to fmem_ptr-1 do dump_wd(font_info[k]);
-dump_int(font_ptr);
-for k:=null_font to font_ptr do
- @<Dump the array info for internal font number |k|@>;
-print_ln; print_int(fmem_ptr-7); print(" words of font info for ");
-print_int(font_ptr-font_base); print(" preloaded font");
-if font_ptr<>font_base+1 then print_char("s")
-
-@ @<Undump the font information@>=
-undump_size(7)(font_mem_size)('font mem size')(fmem_ptr);
-for k:=0 to fmem_ptr-1 do undump_wd(font_info[k]);
-undump_size(font_base)(font_max)('font max')(font_ptr);
-for k:=null_font to font_ptr do
- @<Undump the array info for internal font number |k|@>
-
-@ @<Dump the array info for internal font number |k|@>=
-begin dump_qqqq(font_check[k]);
-dump_int(font_size[k]);
-dump_int(font_dsize[k]);
-dump_int(font_params[k]);@/
-dump_int(hyphen_char[k]);
-dump_int(skew_char[k]);@/
-dump_int(font_name[k]);
-dump_int(font_area[k]);@/
-dump_int(font_bc[k]);
-dump_int(font_ec[k]);@/
-dump_int(char_base[k]);
-dump_int(width_base[k]);
-dump_int(height_base[k]);@/
-dump_int(depth_base[k]);
-dump_int(italic_base[k]);
-dump_int(lig_kern_base[k]);@/
-dump_int(kern_base[k]);
-dump_int(exten_base[k]);
-dump_int(param_base[k]);@/
-dump_int(font_glue[k]);@/
-dump_int(bchar_label[k]);
-dump_int(font_bchar[k]);
-dump_int(font_false_bchar[k]);@/
-print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
-print_file_name(font_name[k],font_area[k],"");
-if font_size[k]<>font_dsize[k] then
- begin print(" at "); print_scaled(font_size[k]); print("pt");
- end;
-end
-
-@ @<Undump the array info for internal font number |k|@>=
-begin undump_qqqq(font_check[k]);@/
-undump_int(font_size[k]);
-undump_int(font_dsize[k]);
-undump(min_halfword)(max_halfword)(font_params[k]);@/
-undump_int(hyphen_char[k]);
-undump_int(skew_char[k]);@/
-undump(0)(str_ptr)(font_name[k]);
-undump(0)(str_ptr)(font_area[k]);@/
-undump(0)(255)(font_bc[k]);
-undump(0)(255)(font_ec[k]);@/
-undump_int(char_base[k]);
-undump_int(width_base[k]);
-undump_int(height_base[k]);@/
-undump_int(depth_base[k]);
-undump_int(italic_base[k]);
-undump_int(lig_kern_base[k]);@/
-undump_int(kern_base[k]);
-undump_int(exten_base[k]);
-undump_int(param_base[k]);@/
-undump(min_halfword)(lo_mem_max)(font_glue[k]);@/
-undump(0)(fmem_ptr-1)(bchar_label[k]);
-undump(min_quarterword)(non_char)(font_bchar[k]);
-undump(min_quarterword)(non_char)(font_false_bchar[k]);
-end
-
-@ @<Dump the hyphenation tables@>=
-dump_int(hyph_count);
-for k:=0 to hyph_size do if hyph_word[k]<>0 then
- begin dump_int(k); dump_int(hyph_word[k]); dump_int(hyph_list[k]);
- end;
-print_ln; print_int(hyph_count); print(" hyphenation exception");
-if hyph_count<>1 then print_char("s");
-if trie_not_ready then init_trie;
-dump_int(trie_max);
-dump_int(hyph_start);
-for k:=0 to trie_max do dump_hh(trie[k]);
-dump_int(trie_op_ptr);
-for k:=1 to trie_op_ptr do
- begin dump_int(hyf_distance[k]);
- dump_int(hyf_num[k]);
- dump_int(hyf_next[k]);
- end;
-print_nl("Hyphenation trie of length "); print_int(trie_max);
-@.Hyphenation trie...@>
-print(" has "); print_int(trie_op_ptr); print(" op");
-if trie_op_ptr<>1 then print_char("s");
-print(" out of "); print_int(trie_op_size);
-for k:=255 downto 0 do if trie_used[k]>min_quarterword then
- begin print_nl(" "); print_int(qo(trie_used[k]));
- print(" for language "); print_int(k);
- dump_int(k); dump_int(qo(trie_used[k]));
- end
-
-@ Only ``nonempty'' parts of |op_start| need to be restored.
-
-@<Undump the hyphenation tables@>=
-undump(0)(hyph_size)(hyph_count);
-for k:=1 to hyph_count do
- begin undump(0)(hyph_size)(j);
- undump(0)(str_ptr)(hyph_word[j]);
- undump(min_halfword)(max_halfword)(hyph_list[j]);
- end;
-undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
-undump(0)(j)(hyph_start);
-for k:=0 to j do undump_hh(trie[k]);
-undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
-for k:=1 to j do
- begin undump(0)(63)(hyf_distance[k]); {a |small_number|}
- undump(0)(63)(hyf_num[k]);
- undump(min_quarterword)(max_quarterword)(hyf_next[k]);
- end;
-init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/
-k:=256;
-while j>0 do
- begin undump(0)(k-1)(k); undump(1)(j)(x);@+init trie_used[k]:=qi(x);@+tini@;@/
- j:=j-x; op_start[k]:=qo(j);
- end;
-@!init trie_not_ready:=false @+tini
-
-@ 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 pdfTeX 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);
-dumptounicode;
-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_major_version,pdf_minor_version,pdf_inclusion_errorlevel); {the image information array }
-undump_int(pdf_mem_size);
-pdf_mem := xrealloc_array(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);
-undumptounicode;
-end
-
-@ We have already printed a lot of statistics, so we set |tracing_stats:=0|
-to prevent them from appearing again.
-
-@<Dump a couple more things and the closing check word@>=
-dump_int(interaction); dump_int(format_ident); dump_int(69069);
-tracing_stats:=0
-
-@ @<Undump a couple more things and the closing check word@>=
-undump(batch_mode)(error_stop_mode)(interaction);
-undump(0)(str_ptr)(format_ident);
-undump_int(x);
-if (x<>69069)or eof(fmt_file) then goto bad_fmt
-
-@ @<Create the |format_ident|...@>=
-selector:=new_string;
-print(" (preloaded format="); print(job_name); print_char(" ");
-print_int(year); print_char(".");
-print_int(month); print_char("."); print_int(day); print_char(")");
-if interaction=batch_mode then selector:=log_only
-else selector:=term_and_log;
-str_room(1);
-format_ident:=make_string;
-pack_job_name(format_extension);
-while not w_open_out(fmt_file) do
- prompt_file_name("format file name",format_extension);
-print_nl("Beginning to dump on file ");
-@.Beginning to dump...@>
-slow_print(w_make_name_string(fmt_file)); flush_string;
-print_nl(""); slow_print(format_ident)
-
-@ @<Close the format file@>=
-w_close(fmt_file)
-
-@* \[51] The main program.
-This is it: the part of \TeX\ that executes all those procedures we have
-written.
-
-Well---almost. Let's leave space for a few more routines that we may
-have forgotten.
-
-@p @<Last-minute procedures@>
-
-@ We have noted that there are two versions of \TeX82. One, called \.{INITEX},
-@.INITEX@>
-has to be run first; it initializes everything from scratch, without
-reading a format file, and it has the capability of dumping a format file.
-The other one is called `\.{VIRTEX}'; it is a ``virgin'' program that needs
-@.VIRTEX@>
-to input a format file in order to get started. \.{VIRTEX} typically has
-more memory capacity than \.{INITEX}, because it does not need the space
-consumed by the auxiliary hyphenation tables and the numerous calls on
-|primitive|, etc.
-
-The \.{VIRTEX} program cannot read a format file instantaneously, of course;
-the best implementations therefore allow for production versions of \TeX\ that
-not only avoid the loading routine for \PASCAL\ object code, they also have
-a format file pre-loaded. This is impossible to do if we stick to standard
-\PASCAL; but there is a simple way to fool many systems into avoiding the
-initialization, as follows:\quad(1)~We declare a global integer variable
-called |ready_already|. The probability is negligible that this
-variable holds any particular value like 314159 when \.{VIRTEX} is first
-loaded.\quad(2)~After we have read in a format file and initialized
-everything, we set |ready_already:=314159|.\quad(3)~Soon \.{VIRTEX}
-will print `\.*', waiting for more input; and at this point we
-interrupt the program and save its core image in some form that the
-operating system can reload speedily.\quad(4)~When that core image is
-activated, the program starts again at the beginning; but now
-|ready_already=314159| and all the other global variables have
-their initial values too. The former chastity has vanished!
-
-In other words, if we allow ourselves to test the condition
-|ready_already=314159|, before |ready_already| has been
-assigned a value, we can avoid the lengthy initialization. Dirty tricks
-rarely pay off so handsomely.
-@^dirty \PASCAL@>
-@^system dependencies@>
-
-On systems that allow such preloading, the standard program called \.{TeX}
-should be the one that has \.{plain} format preloaded, since that agrees
-with {\sl The \TeX book}. Other versions, e.g., \.{AmSTeX}, should also
-@:TeXbook}{\sl The \TeX book@>
-@.AmSTeX@>
-@.plain@>
-be provided for commonly used formats.
-
-@<Glob...@>=
-@!ready_already:integer; {a sacrifice of purity for economy}
-
-@ Now this is really it: \TeX\ starts and ends here.
-
-The initial test involving |ready_already| should be deleted if the
-\PASCAL\ runtime system is smart enough to detect such a ``mistake.''
-@^system dependencies@>
-
-@p begin @!{|start_here|}
-history:=fatal_error_stop; {in case we quit during initialization}
-t_open_out; {open the terminal for output}
-if ready_already=314159 then goto start_of_TEX;
-@<Check the ``constant'' values...@>@;
-if bad>0 then
- begin wterm_ln('Ouch---my internal constants have been clobbered!',
- '---case ',bad:1);
-@.Ouch...clobbered@>
- goto final_end;
- end;
-initialize; {set global variables to their starting values}
-@!init if not get_strings_started then goto final_end;
-init_prim; {call |primitive| for each primitive}
-init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
-tini@/
-ready_already:=314159;
-start_of_TEX: @<Initialize the output routines@>;
-@<Get the first line of input and prepare to start@>;
-history:=spotless; {ready to go!}
-main_control; {come to life}
-final_cleanup; {prepare for death}
-end_of_TEX: close_files_and_terminate;
-final_end: ready_already:=0;
-end.
-
-@ Here we do whatever is needed to complete \TeX's job gracefully on the
-local operating system. The code here might come into play after a fatal
-error; it must therefore consist entirely of ``safe'' operations that
-cannot produce error messages. For example, it would be a mistake to call
-|str_room| or |make_string| at this time, because a call on |overflow|
-might lead to an infinite loop.
-@^system dependencies@>
-(Actually there's one way to get error messages, via |prepare_mag|;
-but that can't cause infinite recursion.)
-@^recursion@>
-
-If |final_cleanup| is bypassed, this program doesn't bother to close
-the input files that may still be open.
-
-@<Last-minute...@>=
-procedure close_files_and_terminate;
-label done, done1;
-var a, b, c, i, j, k, l: integer; {all-purpose index}
- is_root: boolean; {|pdf_last_pages| is root of Pages tree?}
- is_names: boolean; {flag for name tree output: is it Names or Kids?}
- root, outlines, threads, names_tree, dests: integer;
- xref_offset_width, names_head, names_tail: integer;
-begin @<Finish the extensions@>; new_line_char:=-1;
-@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
-wake_up_terminal;
-if not fixed_pdfoutput_set then
- fix_pdfoutput;
-if fixed_pdfoutput > 0 then begin
- if history = fatal_error_stop then begin
- remove_pdffile;
- print_err(" ==> Fatal error occurred, no output PDF file produced!")
- end
- else begin
- @<Finish the PDF file@>;
- if 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
-else begin
- @<Finish the \.{DVI} file@>;
-end;
-if log_opened then
- begin wlog_cr; a_close(log_file); selector:=selector-2;
- if selector=term_only then
- begin print_nl("Transcript written on ");
-@.Transcript written...@>
- slow_print(log_name); print_char(".");
- end;
- end;
-end;
-
-@ The present section goes directly to the log file instead of using
-|print| commands, because there's no need for these strings to take
-up |str_pool| memory when a non-{\bf stat} version of \TeX\ is being used.
-
-@<Output statistics...@>=
-if log_opened then
- begin wlog_ln(' ');
- wlog_ln('Here is how much of TeX''s memory',' you used:');
-@.Here is how much...@>
- wlog(' ',str_ptr-init_str_ptr:1,' string');
- if str_ptr<>init_str_ptr+1 then wlog('s');
- wlog_ln(' out of ', max_strings-init_str_ptr:1);@/
- wlog_ln(' ',pool_ptr-init_pool_ptr:1,' string characters out of ',
- pool_size-init_pool_ptr:1);@/
- wlog_ln(' ',lo_mem_max-mem_min+mem_end-hi_mem_min+2:1,@|
- ' words of memory out of ',mem_end+1-mem_min:1);@/
- wlog_ln(' ',cs_count:1,' multiletter control sequences out of ',
- hash_size:1);@/
- wlog(' ',fmem_ptr:1,' words of font info for ',
- font_ptr-font_base:1,' font');
- if font_ptr<>font_base+1 then wlog('s');
- wlog_ln(', out of ',font_mem_size:1,' for ',font_max-font_base:1);@/
- wlog(' ',hyph_count:1,' hyphenation exception');
- if hyph_count<>1 then wlog('s');
- wlog_ln(' out of ',hyph_size:1);@/
- wlog_ln(' ',max_in_stack:1,'i,',max_nest_stack:1,'n,',@|
- max_param_stack:1,'p,',@|
- max_buf_stack+1:1,'b,',@|
- max_save_stack+6:1,'s stack positions out of ',@|
- stack_size:1,'i,',
- nest_size:1,'n,',
- param_size:1,'p,',
- buf_size:1,'b,',
- save_size:1,'s');
- end
-
-@ We get to the |final_cleanup| routine when \.{\\end} or \.{\\dump} has
-been scanned and |its_all_over|\kern-2pt.
-
-@<Last-minute...@>=
-procedure final_cleanup;
-label exit;
-var c:small_number; {0 for \.{\\end}, 1 for \.{\\dump}}
-begin c:=cur_chr; if c<>1 then new_line_char:=-1;
-if job_name=0 then open_log_file;
-while input_ptr>0 do
- if state=token_list then end_token_list@+else end_file_reading;
-while open_parens>0 do
- begin print(" )"); decr(open_parens);
- end;
-if cur_level>level_one then
- begin print_nl("("); print_esc("end occurred ");
- print("inside a group at level ");
-@:end_}{\.{(\\end occurred...)}@>
- print_int(cur_level-level_one); print_char(")");
- if eTeX_ex then show_save_groups;
- end;
-while cond_ptr<>null do
- begin print_nl("("); print_esc("end occurred ");
- print("when "); print_cmd_chr(if_test,cur_if);
- if if_line<>0 then
- begin print(" on line "); print_int(if_line);
- end;
- print(" was incomplete)");
- if_line:=if_line_field(cond_ptr);
- cur_if:=subtype(cond_ptr); temp_ptr:=cond_ptr;
- cond_ptr:=link(cond_ptr); free_node(temp_ptr,if_node_size);
- end;
-if history<>spotless then
- if ((history=warning_issued)or(interaction<error_stop_mode)) then
- if selector=term_and_log then
- begin selector:=term_only;
- print_nl("(see the transcript file for additional information)");
-@.see the transcript file...@>
- selector:=term_and_log;
- end;
-if c=1 then
- begin @!init for c:=top_mark_code to split_bot_mark_code do
- if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
- if sa_mark<>null then
- if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
- for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
- if last_glue<>max_halfword then delete_glue_ref(last_glue);
- store_fmt_file; return;@+tini@/
- print_nl("(\dump is performed only by INITEX)"); return;
-@:dump_}{\.{\\dump...only by INITEX}@>
- end;
-exit:end;
-
-@ @<Last-minute...@>=
-@!init procedure init_prim; {initialize all the primitives}
-begin no_new_control_sequence:=false;
-first:=0;
-@<Put each...@>;
-no_new_control_sequence:=true;
-end;
-tini
-
-@ When we begin the following code, \TeX's tables may still contain garbage;
-the strings might not even be present. Thus we must proceed cautiously to get
-bootstrapped in.
-
-But when we finish this part of the program, \TeX\ is ready to call on the
-|main_control| routine to do its work.
-
-@<Get the first line...@>=
-begin @<Initialize the input routines@>;
-@<Enable \eTeX, if requested@>@;@/
-if (format_ident=0)or(buffer[loc]="&") then
- begin if format_ident<>0 then initialize; {erase preloaded format}
- if not open_fmt_file then goto final_end;
- if not load_fmt_file then
- begin w_close(fmt_file); goto final_end;
- end;
- w_close(fmt_file);
- while (loc<limit)and(buffer[loc]=" ") do incr(loc);
- end;
-if (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 eTeX_ex then wterm_ln('entering extended mode');
-if end_line_char_inactive then decr(limit)
-else buffer[limit]:=end_line_char;
-fix_date_and_time;@/
-random_seed :=(microseconds*1000)+(epochseconds mod 1000000);@/
-init_randoms(random_seed);@/
-@<Compute the magic offset@>;
-@<Initialize the print |selector|...@>;
-if (loc<limit)and(cat_code(buffer[loc])<>escape) then start_input;
- {\.{\\input} assumed}
-end
-
-@* \[52] Debugging.
-Once \TeX\ is working, you should be able to diagnose most errors with
-the \.{\\show} commands and other diagnostic features. But for the initial
-stages of debugging, and for the revelation of really deep mysteries, you
-can compile \TeX\ with a few more aids, including the \PASCAL\ runtime
-checks and its debugger. An additional routine called |debug_help|
-will also come into play when you type `\.D' after an error message;
-|debug_help| also occurs just before a fatal error causes \TeX\ to succumb.
-@^debugging@>
-@^system dependencies@>
-
-The interface to |debug_help| is primitive, but it is good enough when used
-with a \PASCAL\ debugger that allows you to set breakpoints and to read
-variables and change their values. After getting the prompt `\.{debug \#}', you
-type either a negative number (this exits |debug_help|), or zero (this
-goes to a location where you can set a breakpoint, thereby entering into
-dialog with the \PASCAL\ debugger), or a positive number |m| followed by
-an argument |n|. The meaning of |m| and |n| will be clear from the
-program below. (If |m=13|, there is an additional argument, |l|.)
-@.debug \#@>
-
-@d breakpoint=888 {place where a breakpoint is desirable}
-
-@<Last-minute...@>=
-@!debug procedure debug_help; {routine to display various things}
-label breakpoint,exit;
-var k,@!l,@!m,@!n:integer;
-begin clear_terminal;
- loop begin wake_up_terminal;
- print_nl("debug # (-1 to exit):"); update_terminal;
-@.debug \#@>
- read(term_in,m);
- if m<0 then return
- else if m=0 then
- begin goto breakpoint;@/ {go to every declared label at least once}
- breakpoint: m:=0; @{'BREAKPOINT'@}@/
- end
- else begin read(term_in,n);
- case m of
- @t\4@>@<Numbered cases for |debug_help|@>@;
- othercases print("?")
- endcases;
- end;
- end;
-exit:end;
-gubed
-
-@ @<Numbered cases...@>=
-1: print_word(mem[n]); {display |mem[n]| in all forms}
-2: print_int(info(n));
-3: print_int(link(n));
-4: print_word(eqtb[n]);
-5: print_word(font_info[n]);
-6: print_word(save_stack[n]);
-7: show_box(n);
- {show a box, abbreviated by |show_box_depth| and |show_box_breadth|}
-8: begin breadth_max:=10000; depth_threshold:=pool_size-pool_ptr-10;
- show_node_list(n); {show a box in its entirety}
- end;
-9: show_token_list(n,null,1000);
-10: slow_print(n);
-11: check_mem(n>0); {check wellformedness; print new busy locations if |n>0|}
-12: search_mem(n); {look for pointers to |n|}
-13: begin read(term_in,l); print_cmd_chr(n,l);
- end;
-14: for k:=0 to n do print(buffer[k]);
-15: begin font_in_short_display:=null_font; short_display(n);
- end;
-16: panicking:=not panicking;
-
-@* \[53] Extensions.
-The program above includes a bunch of ``hooks'' that allow further
-capabilities to be added without upsetting \TeX's basic structure.
-Most of these hooks are concerned with ``whatsit'' nodes, which are
-intended to be used for special purposes; whenever a new extension to
-\TeX\ involves a new kind of whatsit node, a corresponding change needs
-to be made to the routines below that deal with such nodes,
-but it will usually be unnecessary to make many changes to the
-other parts of this program.
-
-In order to demonstrate how extensions can be made, we shall treat
-`\.{\\write}', `\.{\\openout}', `\.{\\closeout}', `\.{\\immediate}',
-`\.{\\special}', and `\.{\\setlanguage}' as if they were extensions.
-These commands are actually primitives of \TeX, and they should
-appear in all implementations of the system; but let's try to imagine
-that they aren't. Then the program below illustrates how a person
-could add them.
-
-Sometimes, of course, an extension will require changes to \TeX\ itself;
-no system of hooks could be complete enough for all conceivable extensions.
-The features associated with `\.{\\write}' are almost all confined to the
-following paragraphs, but there are small parts of the |print_ln| and
-|print_char| procedures that were introduced specifically to \.{\\write}
-characters. Furthermore one of the token lists recognized by the scanner
-is a |write_text|; and there are a few other miscellaneous places where we
-have already provided for some aspect of \.{\\write}. The goal of a \TeX\
-extender should be to minimize alterations to the standard parts of the
-program, and to avoid them completely if possible. He or she should also
-be quite sure that there's no easy way to accomplish the desired goals
-with the standard features that \TeX\ already has. ``Think thrice before
-extending,'' because that may save a lot of work, and it will also keep
-incompatible extensions of \TeX\ from proliferating.
-@^system dependencies@>
-@^extensions to \TeX@>
-
-@ First let's consider the format of whatsit nodes that are used to represent
-the data associated with \.{\\write} and its relatives. Recall that a whatsit
-has |type=whatsit_node|, and the |subtype| is supposed to distinguish
-different kinds of whatsits. Each node occupies two or more words; the
-exact number is immaterial, as long as it is readily determined from the
-|subtype| or other data.
-
-We shall introduce five |subtype| values here, corresponding to the
-control sequences \.{\\openout}, \.{\\write}, \.{\\closeout}, \.{\\special}, and
-\.{\\setlanguage}. The second word of I/O whatsits has a |write_stream| field
-that identifies the write-stream number (0 to 15, or 16 for out-of-range and
-positive, or 17 for out-of-range and negative).
-In the case of \.{\\write} and \.{\\special}, there is also a field that
-points to the reference count of a token list that should be sent. In the
-case of \.{\\openout}, we need three words and three auxiliary subfields
-to hold the string numbers for name, area, and extension.
-
-@d write_node_size=2 {number of words in a write/whatsit node}
-@d open_node_size=3 {number of words in an open/whatsit node}
-@d open_node=0 {|subtype| in whatsits that represent files to \.{\\openout}}
-@d write_node=1 {|subtype| in whatsits that represent things to \.{\\write}}
-@d close_node=2 {|subtype| in whatsits that represent streams to \.{\\closeout}}
-@d special_node=3 {|subtype| in whatsits that represent \.{\\special} things}
-@d language_node=4 {|subtype| in whatsits that change the current language}
-@d what_lang(#)==link(#+1) {language number, in the range |0..255|}
-@d what_lhm(#)==type(#+1) {minimum left fragment, in the range |1..63|}
-@d what_rhm(#)==subtype(#+1) {minimum right fragment, in the range |1..63|}
-@d write_tokens(#) == link(#+1) {reference count of token list to write}
-@d write_stream(#) == info(#+1) {stream number (0 to 17)}
-@d open_name(#) == link(#+1) {string number of file name to open}
-@d open_area(#) == info(#+2) {string number of file area for |open_name|}
-@d open_ext(#) == link(#+2) {string number of file extension for |open_name|}
-
-@ The sixteen possible \.{\\write} streams are represented by the |write_file|
-array. The |j|th file is open if and only if |write_open[j]=true|. The last
-two streams are special; |write_open[16]| represents a stream number
-greater than 15, while |write_open[17]| represents a negative stream number,
-and both of these variables are always |false|.
-
-@<Glob...@>=
-@!write_file:array[0..15] of alpha_file;
-@!write_open:array[0..17] of boolean;
-
-@ @<Set init...@>=
-for k:=0 to 17 do write_open[k]:=false;
-
-@ Extensions might introduce new command codes; but it's best to use
-|extension| with a modifier, whenever possible, so that |main_control|
-stays the same.
-
-@d immediate_code=4 {command modifier for \.{\\immediate}}
-@d set_language_code=5 {command modifier for \.{\\setlanguage}}
-@d pdftex_first_extension_code = 6
-@d pdf_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_catalog_code == 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_trailer_id_code == pdftex_first_extension_code + 24
-@d reset_timer_code == pdftex_first_extension_code + 25
-@d pdf_font_expand_code == pdftex_first_extension_code + 26
-@d set_random_seed_code == pdftex_first_extension_code + 27
-@d pdf_snap_ref_point_node == pdftex_first_extension_code + 28
-@d pdf_snapy_node == pdftex_first_extension_code + 29
-@d pdf_snapy_comp_node == pdftex_first_extension_code + 30
-@d pdf_glyph_to_unicode_code == pdftex_first_extension_code + 31
-@d pdf_colorstack_node == pdftex_first_extension_code + 32
-@d pdf_setmatrix_node == pdftex_first_extension_code + 33
-@d pdf_save_node == pdftex_first_extension_code + 34
-@d pdf_restore_node == pdftex_first_extension_code + 35
-@d pdf_nobuiltin_tounicode_code== pdftex_first_extension_code + 36
-@d pdf_interword_space_on_node == pdftex_first_extension_code + 37
-@d pdf_interword_space_off_node== pdftex_first_extension_code + 38
-@d pdf_fake_space_node == pdftex_first_extension_code + 39
-@d pdf_running_link_off_node == pdftex_first_extension_code + 40
-@d pdf_running_link_on_node == pdftex_first_extension_code + 41
-@d pdftex_last_extension_code == pdftex_first_extension_code + 41
-
-@<Put each...@>=
-primitive("openout",extension,open_node);@/
-@!@:open_out_}{\.{\\openout} primitive@>
-primitive("write",extension,write_node); write_loc:=cur_val;@/
-@!@:write_}{\.{\\write} primitive@>
-primitive("closeout",extension,close_node);@/
-@!@:close_out_}{\.{\\closeout} primitive@>
-primitive("special",extension,special_node);@/
-@!@:special_}{\.{\\special} primitive@>
-primitive("immediate",extension,immediate_code);@/
-@!@:immediate_}{\.{\\immediate} primitive@>
-primitive("setlanguage",extension,set_language_code);@/
-@!@:set_language_}{\.{\\setlanguage} primitive@>
-primitive("pdfliteral",extension,pdf_literal_node);@/
-@!@:pdf_literal_}{\.{\\pdfliteral} primitive@>
-primitive("pdfcolorstack",extension,pdf_colorstack_node);@/
-@!@:pdf_colorstack_}{\.{\\pdfcolorstack} primitive@>
-primitive("pdfsetmatrix",extension,pdf_setmatrix_node);@/
-@!@:pdf_setmatrix_}{\.{\\pdfsetmatrix} primitive@>
-primitive("pdfsave",extension,pdf_save_node);@/
-@!@:pdf_save_}{\.{\\pdfsave} primitive@>
-primitive("pdfrestore",extension,pdf_restore_node);@/
-@!@:pdf_restore_}{\.{\\pdfrestore} primitive@>
-primitive("pdfobj",extension,pdf_obj_code);@/
-@!@:pdf_obj_}{\.{\\pdfobj} primitive@>
-primitive("pdfrefobj",extension,pdf_refobj_node);@/
-@!@:pdf_refobj_}{\.{\\pdfrefobj} primitive@>
-primitive("pdfxform",extension,pdf_xform_code);@/
-@!@:pdf_xform_}{\.{\\pdfxform} primitive@>
-primitive("pdfrefxform",extension,pdf_refxform_node);@/
-@!@:pdf_refxform_}{\.{\\pdfrefxform} primitive@>
-primitive("pdfximage",extension,pdf_ximage_code);@/
-@!@:pdf_ximage_}{\.{\\pdfximage} primitive@>
-primitive("pdfrefximage",extension,pdf_refximage_node);@/
-@!@:pdf_refximage_}{\.{\\pdfrefximage} primitive@>
-primitive("pdfannot",extension,pdf_annot_node);@/
-@!@:pdf_annot_}{\.{\\pdfannot} primitive@>
-primitive("pdfstartlink",extension,pdf_start_link_node);@/
-@!@:pdf_start_link_}{\.{\\pdfstartlink} primitive@>
-primitive("pdfendlink",extension,pdf_end_link_node);@/
-@!@:pdf_end_link_}{\.{\\pdfendlink} primitive@>
-primitive("pdfoutline",extension,pdf_outline_code);@/
-@!@:pdf_outline_}{\.{\\pdfoutline} primitive@>
-primitive("pdfdest",extension,pdf_dest_node);@/
-@!@:pdf_dest_}{\.{\\pdfdest} primitive@>
-primitive("pdfthread",extension,pdf_thread_node);@/
-@!@:pdf_thread_}{\.{\\pdfthread} primitive@>
-primitive("pdfstartthread",extension,pdf_start_thread_node);@/
-@!@:pdf_start_thread_}{\.{\\pdfstartthread} primitive@>
-primitive("pdfendthread",extension,pdf_end_thread_node);@/
-@!@:pdf_end_thread_}{\.{\\pdfendthread} primitive@>
-primitive("pdfsavepos",extension,pdf_save_pos_node);@/
-@!@:pdf_save_pos_}{\.{\\pdfsavepos} primitive@>
-primitive("pdfsnaprefpoint",extension,pdf_snap_ref_point_node);@/
-@!@:pdf_snap_ref_point_}{\.{\\pdfsnaprefpoint} primitive@>
-primitive("pdfsnapy",extension,pdf_snapy_node);@/
-@!@:pdf_snapy_}{\.{\\pdfsnapy} primitive@>
-primitive("pdfsnapycomp",extension,pdf_snapy_comp_node);@/
-@!@:pdf_snapy_comp_}{\.{\\pdfsnapycomp} primitive@>
-primitive("pdfinfo",extension,pdf_info_code);@/
-@!@:pdf_info_}{\.{\\pdfinfo} primitive@>
-primitive("pdfcatalog",extension,pdf_catalog_code);@/
-@!@:pdf_catalog_}{\.{\\pdfcatalog} primitive@>
-primitive("pdfnames",extension,pdf_names_code);@/
-@!@:pdf_names_}{\.{\\pdfnames} primitive@>
-primitive("pdfincludechars",extension,pdf_include_chars_code);@/
-@!@:pdf_include_chars_}{\.{\\pdfincludechars} primitive@>
-primitive("pdffontattr",extension,pdf_font_attr_code);@/
-@!@:pdf_font_attr_}{\.{\\pdffontattr} primitive@>
-primitive("pdfmapfile",extension,pdf_map_file_code);@/
-@!@:pdf_map_file_}{\.{\\pdfmapfile} primitive@>
-primitive("pdfmapline",extension,pdf_map_line_code);@/
-@!@:pdf_map_line_}{\.{\\pdfmapline} primitive@>
-primitive("pdftrailer",extension,pdf_trailer_code);@/
-@!@:pdf_trailer_}{\.{\\pdftrailer} primitive@>
-primitive("pdftrailerid",extension,pdf_trailer_id_code);@/
-@!@:pdf_trailer_id_}{\.{\\pdftrailerid} primitive@>
-primitive("pdfresettimer",extension,reset_timer_code);@/
-@!@:reset_timer_}{\.{\\pdfresettimer} primitive@>
-primitive("pdfsetrandomseed",extension,set_random_seed_code);@/
-@!@:set_random_seed_code}{\.{\\pdfsetrandomseed} primitive@>
-primitive("pdffontexpand",extension,pdf_font_expand_code);@/
-@!@:pdf_font_expand_}{\.{\\pdffontexpand} primitive@>
-primitive("pdfglyphtounicode",extension,pdf_glyph_to_unicode_code);@/
-@!@:pdf_glyph_to_unicode_}{\.{\\pdfglyphtounicode} primitive@>
-primitive("pdfnobuiltintounicode",extension,pdf_nobuiltin_tounicode_code);@/
-@!@:pdf_nobuiltin_tounicode_}{\.{\\pdfnobuiltintounicode} primitive@>
-primitive("pdfinterwordspaceon",extension,pdf_interword_space_on_node);@/
-@!@:pdf_interword_space_on_}{\.{\\pdfinterwordspaceon} primitive@>
-primitive("pdfinterwordspaceoff",extension,pdf_interword_space_off_node);@/
-@!@:pdf_interword_space_off_}{\.{\\pdfinterwordspaceoff} primitive@>
-primitive("pdffakespace",extension,pdf_fake_space_node);@/
-@!@:pdf_fake_space_}{\.{\\pdffakespace} primitive@>
-primitive("pdfrunninglinkoff",extension,pdf_running_link_off_node);@/
-@!@:pdf_running_link_off_}{\.{\\pdfrunninglinkoff} primitive@>
-primitive("pdfrunninglinkon",extension,pdf_running_link_on_node);@/
-@!@:pdf_running_link_on_}{\.{\\pdfrunninglinkon} primitive@>
-
-@ The variable |write_loc| just introduced is used to provide an
-appropriate error message in case of ``runaway'' write texts.
-
-@<Glob...@>=
-@!write_loc:pointer; {|eqtb| address of \.{\\write}}
-
-@ @<Cases of |print_cmd_chr|...@>=
-extension: case chr_code of
- open_node:print_esc("openout");
- write_node:print_esc("write");
- close_node:print_esc("closeout");
- special_node:print_esc("special");
- immediate_code:print_esc("immediate");
- set_language_code:print_esc("setlanguage");
- pdf_annot_node: print_esc("pdfannot");
- pdf_catalog_code: print_esc("pdfcatalog");
- pdf_dest_node: print_esc("pdfdest");
- pdf_end_link_node: print_esc("pdfendlink");
- pdf_end_thread_node: print_esc("pdfendthread");
- pdf_font_attr_code: print_esc("pdffontattr");
- pdf_font_expand_code: print_esc("pdffontexpand");
- pdf_include_chars_code: print_esc("pdfincludechars");
- pdf_info_code: print_esc("pdfinfo");
- pdf_literal_node: print_esc("pdfliteral");
- pdf_colorstack_node: print_esc("pdfcolorstack");
- pdf_setmatrix_node: print_esc("pdfsetmatrix");
- pdf_save_node: print_esc("pdfsave");
- pdf_restore_node: print_esc("pdfrestore");
- pdf_map_file_code: print_esc("pdfmapfile");
- pdf_map_line_code: print_esc("pdfmapline");
- pdf_names_code: print_esc("pdfnames");
- pdf_obj_code: print_esc("pdfobj");
- pdf_outline_code: print_esc("pdfoutline");
- pdf_refobj_node: print_esc("pdfrefobj");
- pdf_refxform_node: print_esc("pdfrefxform");
- pdf_refximage_node: print_esc("pdfrefximage");
- pdf_save_pos_node: print_esc("pdfsavepos");
- pdf_snap_ref_point_node: print_esc("pdfsnaprefpoint");
- pdf_snapy_comp_node: print_esc("pdfsnapycomp");
- pdf_snapy_node: print_esc("pdfsnapy");
- pdf_start_link_node: print_esc("pdfstartlink");
- pdf_start_thread_node: print_esc("pdfstartthread");
- pdf_thread_node: print_esc("pdfthread");
- pdf_trailer_code: print_esc("pdftrailer");
- pdf_trailer_id_code: print_esc("pdftrailerid");
- pdf_xform_code: print_esc("pdfxform");
- pdf_ximage_code: print_esc("pdfximage");
- reset_timer_code: print_esc("pdfresettimer");
- set_random_seed_code: print_esc("pdfsetrandomseed");
- pdf_nobuiltin_tounicode_code: print_esc("pdfnobuiltintounicode");
- pdf_glyph_to_unicode_code: print_esc("pdfglyphtounicode");
- pdf_interword_space_on_node: print_esc("pdfinterwordspaceon");
- pdf_interword_space_off_node: print_esc("pdfinterwordspaceoff");
- pdf_fake_space_node: print_esc("pdffakespace");
- pdf_running_link_off_node: print_esc("pdfrunninglinkoff");
- pdf_running_link_on_node: print_esc("pdfrunninglinkon");
- othercases print("[unknown extension!]")
- endcases;
-
-@ When an |extension| command occurs in |main_control|, in any mode,
-the |do_extension| routine is called.
-
-@<Cases of |main_control| that are for extensions...@>=
-any_mode(extension):do_extension;
-
-@ @<Declare act...@>=
-@t\4@>@<Declare procedures needed in |do_extension|@>@;
-procedure do_extension;
-var i,@!j,@!k:integer; {all-purpose integers}
-@!p,@!q,@!r:pointer; {all-purpose pointers}
-begin case cur_chr of
- open_node:@<Implement \.{\\openout}@>;
- write_node:@<Implement \.{\\write}@>;
- close_node:@<Implement \.{\\closeout}@>;
- special_node:@<Implement \.{\\special}@>;
- immediate_code:@<Implement \.{\\immediate}@>;
- set_language_code:@<Implement \.{\\setlanguage}@>;
- pdf_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_snap_ref_point_node: @<Implement \.{\\pdfsnaprefpoint}@>;
- pdf_snapy_comp_node: @<Implement \.{\\pdfsnapycomp}@>;
- pdf_snapy_node: @<Implement \.{\\pdfsnapy}@>;
- pdf_start_link_node: @<Implement \.{\\pdfstartlink}@>;
- pdf_start_thread_node: @<Implement \.{\\pdfstartthread}@>;
- pdf_thread_node: @<Implement \.{\\pdfthread}@>;
- pdf_trailer_code: @<Implement \.{\\pdftrailer}@>;
- pdf_trailer_id_code: @<Implement \.{\\pdftrailerid}@>;
- pdf_xform_code: @<Implement \.{\\pdfxform}@>;
- pdf_ximage_code: @<Implement \.{\\pdfximage}@>;
- reset_timer_code: @<Implement \.{\\pdfresettimer}@>;
- set_random_seed_code: @<Implement \.{\\pdfsetrandomseed}@>;
- pdf_glyph_to_unicode_code: @<Implement \.{\\pdfglyphtounicode}@>;
- pdf_nobuiltin_tounicode_code: @<Implement \.{\\pdfnobuiltintounicode}@>;
- pdf_interword_space_on_node: @<Implement \.{\\pdfinterwordspaceon}@>;
- pdf_interword_space_off_node: @<Implement \.{\\pdfinterwordspaceoff}@>;
- pdf_fake_space_node: @<Implement \.{\\pdffakespace}@>;
- pdf_running_link_off_node: @<Implement \.{\\pdfrunninglinkoff}@>;
- pdf_running_link_on_node: @<Implement \.{\\pdfrunninglinkon}@>;
-othercases confusion("ext1")
-@:this can't happen ext1}{\quad ext1@>
-endcases;
-end;
-
-@ Here is a subroutine that creates a whatsit node having a given |subtype|
-and a given number of words. It initializes only the first word of the whatsit,
-and appends it to the current list.
-
-@<Declare procedures needed in |do_extension|@>=
-procedure new_whatsit(@!s:small_number;@!w:small_number);
-var p:pointer; {the new node}
-begin p:=get_node(w); type(p):=whatsit_node; subtype(p):=s;
-link(tail):=p; tail:=p;
-end;
-
-@ The next subroutine uses |cur_chr| to decide what sort of whatsit is
-involved, and also inserts a |write_stream| number.
-
-@<Declare procedures needed in |do_ext...@>=
-procedure new_write_whatsit(@!w:small_number);
-begin new_whatsit(cur_chr,w);
-if w<>write_node_size then scan_four_bit_int
-else begin scan_int;
- if cur_val<0 then cur_val:=17
- else if cur_val>15 then cur_val:=16;
- end;
-write_stream(tail):=cur_val;
-end;
-
-@ @<Implement \.{\\openout}@>=
-begin new_write_whatsit(open_node_size);
-scan_optional_equals; scan_file_name;@/
-open_name(tail):=cur_name; open_area(tail):=cur_area; open_ext(tail):=cur_ext;
-end
-
-@ When `\.{\\write 12\{...\}}' appears, we scan the token list `\.{\{...\}}'
-without expanding its macros; the macros will be expanded later when this
-token list is rescanned.
-
-@<Implement \.{\\write}@>=
-begin k:=cur_cs; new_write_whatsit(write_node_size);@/
-cur_cs:=k; p:=scan_toks(false,false); write_tokens(tail):=def_ref;
-end
-
-@ @<Implement \.{\\closeout}@>=
-begin new_write_whatsit(write_node_size); write_tokens(tail):=null;
-end
-
-@ When `\.{\\special\{...\}}' appears, we expand the macros in the token
-list as in \.{\\xdef} and \.{\\mark}.
-
-@<Implement \.{\\special}@>=
-begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
-p:=scan_toks(false,true); write_tokens(tail):=def_ref;
-end
-
-@ @<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_user_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_page_tokens(#))
- else if pdf_action_named_id(#) > 0 then
- delete_token_ref(pdf_action_id(#));
- end;
- free_node(#, pdf_action_size);
- 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;
-
-procedure compare_strings; {to implement \.{\\pdfstrcmp}}
-label done;
-var s1, s2: str_number;
- i1, i2, j1, j2: pool_pointer;
- save_cur_cs: pointer;
-begin
- save_cur_cs:=cur_cs; call_func(scan_toks(false, true));
- s1 := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- cur_cs:=save_cur_cs; call_func(scan_toks(false, true));
- s2 := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- i1 := str_start[s1];
- j1 := str_start[s1 + 1];
- i2 := str_start[s2];
- j2 := str_start[s2 + 1];
- while (i1 < j1) and (i2 < j2) do begin
- if str_pool[i1] < str_pool[i2] then begin
- cur_val := -1;
- goto done;
- end;
- if str_pool[i1] > str_pool[i2] then begin
- cur_val := 1;
- goto done;
- end;
- incr(i1);
- incr(i2);
- end;
- if (i1 = j1) and (i2 = j2) then
- cur_val := 0
- else if i1 < j1 then
- cur_val := 1
- else
- cur_val := -1;
-done:
- flush_str(s2);
- flush_str(s1);
- cur_val_level := int_val;
-end;
-
-@ @<Implement \.{\\pdfliteral}@>=
-begin
- check_pdfoutput("\pdfliteral", true);
- new_whatsit(pdf_literal_node, write_node_size);
- if scan_keyword("direct") then
- pdf_literal_mode(tail) := direct_always
- else if scan_keyword("page") then
- pdf_literal_mode(tail) := direct_page
- else
- pdf_literal_mode(tail) := set_origin;
- scan_pdf_ext_toks;
- pdf_literal_data(tail) := def_ref;
-end
-
-@ @<Implement \.{\\pdfcolorstack}@>=
-begin
- check_pdfoutput("\pdfcolorstack", true);
- {Scan and check the stack number and store in |cur_val|}
- scan_int;
- if cur_val >= colorstackused then begin
- print_err("Unknown color stack number ");
- print_int(cur_val);
-@.Unknown color stack@>
- help3("Allocate and initialize a color stack with \\pdfcolorstackinit.")@/
- ("I'll use default color stack 0 here.")@/
- ("Proceed, with fingers crossed.");
- error;
- cur_val := 0;
- end;
- if cur_val < 0 then begin
- print_err("Invalid negative color stack number");
-@.Invalid negative color stack number@>
- help2("I'll use default color stack 0 here.")@/
- ("Proceed, with fingers crossed.");
- error;
- cur_val := 0;
- end;
- {Scan the command and store in i, j holds the node size}
- if scan_keyword("set") then begin
- i := colorstack_set;
- j := pdf_colorstack_setter_node_size;
- end
- else if scan_keyword("push") then begin
- i := colorstack_push;
- j := pdf_colorstack_setter_node_size;
- end
- else if scan_keyword("pop") then begin
- i := colorstack_pop;
- j := pdf_colorstack_getter_node_size;
- end
- else if scan_keyword("current") then begin
- i := colorstack_current;
- j := pdf_colorstack_getter_node_size;
- end
- else begin
- i := -1; {error}
- end;
- if i >= 0 then begin
- new_whatsit(pdf_colorstack_node, j);
- pdf_colorstack_stack(tail) := cur_val;
- pdf_colorstack_cmd(tail) := i;
- 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, pdf_setmatrix_node_size);
- scan_pdf_ext_toks;
- pdf_setmatrix_data(tail) := def_ref;
-end
-
-@ @<Implement \.{\\pdfsave}@>=
-begin
- check_pdfoutput("\pdfsave", true);
- new_whatsit(pdf_save_node, pdf_save_node_size);
-end
-
-@ @<Implement \.{\\pdfrestore}@>=
-begin
- check_pdfoutput("\pdfrestore", true);
- new_whatsit(pdf_restore_node, pdf_restore_node_size);
-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 link(p) <> e do begin
- p := link(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_refobj_node_size);
- pdf_obj_objnum(tail) := cur_val;
-end
-
-@ \.{\\pdfxform} and \.{\\pdfrefxform} are similar 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_register_num;
- fetch_box(p);
- 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}
- change_box(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_refxform_node_size);
- 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 similar 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...@>=
-procedure scale_image(n: integer);
-var x, y, xr, yr: integer; {size and resolution of image}
- w, h: scaled; {indeed size corresponds to image resolution}
- default_res: integer;
- image: integer;
-begin
- image := obj_ximage_data(n);
- if (image_rotate(image) = 90) or (image_rotate(image) = 270) then begin
- y := image_width(image);
- x := image_height(image);
- yr := image_x_res(image);
- xr := image_y_res(image);
- end else begin
- x := image_width(image);
- y := image_height(image);
- xr := image_x_res(image);
- yr := image_y_res(image);
- end;
-
- if (xr > 65535) or (yr > 65535) then begin
- xr := 0;
- yr := 0;
- pdf_warning("ext1", "too large image resolution ignored", true, true);
- end;
- if (x <= 0) or (y <= 0) or (xr < 0) or (yr < 0) then
- pdf_error("ext1", "invalid image dimensions");
- if is_pdf_image(image) then begin
- w := x;
- h := y;
- end
- else begin
- default_res := fix_int(pdf_image_resolution, 0, 65535);
- if (default_res > 0) and ((xr = 0) or (yr = 0)) then begin
- xr := default_res;
- yr := default_res;
- end;
- if is_running(obj_ximage_width(n)) and
- is_running(obj_ximage_height(n)) then
- begin
- if (xr > 0) and (yr > 0) then begin
- w := ext_xn_over_d(one_hundred_inch, x, 100*xr);
- h := ext_xn_over_d(one_hundred_inch, y, 100*yr);
- end
- else begin
- w := ext_xn_over_d(one_hundred_inch, x, 7200);
- h := ext_xn_over_d(one_hundred_inch, y, 7200);
- end;
- end;
- end;
- if is_running(obj_ximage_width(n)) and is_running(obj_ximage_height(n)) and
- is_running(obj_ximage_depth(n)) then begin
- obj_ximage_width(n) := w;
- obj_ximage_height(n) := h;
- obj_ximage_depth(n) := 0;
- end
- else if is_running(obj_ximage_width(n)) then begin
- {image depth or height is explicitly specified}
- if is_running(obj_ximage_height(n)) then begin
- {image depth is explicitly specified}
- obj_ximage_width(n) := ext_xn_over_d(h, x, y);
- obj_ximage_height(n) := h - obj_ximage_depth(n);
- end
- else if is_running(obj_ximage_depth(n)) then begin
- {image height is explicitly specified}
- obj_ximage_width(n) := ext_xn_over_d(obj_ximage_height(n), x, y);
- obj_ximage_depth(n) := 0;
- end
- else begin
- {both image depth and height are explicitly specified}
- obj_ximage_width(n) := ext_xn_over_d(obj_ximage_height(n) +
- obj_ximage_depth(n), x, y);
- end;
- end
- else begin
- {image width is explicitly specified}
- if is_running(obj_ximage_height(n)) and
- is_running(obj_ximage_depth(n)) then begin
- {both image depth and height are not specified}
- obj_ximage_height(n) := ext_xn_over_d(obj_ximage_width(n), y, x);
- obj_ximage_depth(n) := 0;
- end
- {image depth is explicitly specified}
- else if is_running(obj_ximage_height(n)) then begin
- obj_ximage_height(n) :=
- ext_xn_over_d(obj_ximage_width(n), y, x) - obj_ximage_depth(n);
- end
- {image height is explicitly specified}
- else if is_running(obj_ximage_depth(n)) then begin
- obj_ximage_depth(n) := 0;
- end
- {both image depth and height are explicitly specified}
- else
- do_nothing;
- end;
-end;
-
-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: integer;
- named: 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;
- obj_data_ptr(k) := pdf_get_mem(pdfmem_ximage_size);
- scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
- obj_ximage_width(k) := width(alt_rule);
- obj_ximage_height(k) := height(alt_rule);
- obj_ximage_depth(k) := depth(alt_rule);
- if scan_keyword("attr") then begin
- scan_pdf_ext_toks;
- obj_ximage_attr(k) := def_ref;
- end
- else
- obj_ximage_attr(k) := null;
- named := 0;
- if scan_keyword("named") then begin
- scan_pdf_ext_toks;
- named := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- end
- else if scan_keyword("page") then begin
- scan_int;
- page := cur_val;
- end
- else
- page := 1;
- if scan_keyword("colorspace") then begin
- scan_int;
- colorspace := cur_val;
- end
- else
- colorspace := 0;
- 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;
- obj_ximage_data(k) := read_image(s, page, named, colorspace, pagebox,
- pdf_major_version, pdf_minor_version,
- pdf_inclusion_errorlevel);
- if named <> 0 then flush_str(named);
- flush_str(s);
- scale_image(k);
- pdf_last_ximage := k;
- pdf_last_ximage_pages := image_pages(obj_ximage_data(k));
- pdf_last_ximage_colordepth := image_colordepth(obj_ximage_data(k));
-end;
-
-@ @<Implement \.{\\pdfximage}@>=
-begin
- check_pdfoutput("\pdfximage", true);
- check_pdfversion;
- 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, pdf_refximage_node_size);
- pdf_ximage_objnum(tail) := cur_val;
- pdf_width(tail) := obj_ximage_width(cur_val);
- pdf_height(tail) := obj_ximage_height(cur_val);
- pdf_depth(tail) := obj_ximage_depth(cur_val);
-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 := get_node(pdf_action_size);
- scan_action := p;
- pdf_action_file(p) := null;
- pdf_action_refcount(p) := null;
- 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_user_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_page_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, s: small_number); {create a new whatsit node for
-annotation}
-begin
- new_whatsit(w, s);
- 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_start_link_node) then begin
- if scan_keyword("attr") then begin
- scan_pdf_ext_toks;
- pdf_link_attr(tail) := def_ref;
- end
- else
- pdf_link_attr(tail) := null;
- end;
- 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_node_size);
- 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_annot_node_size);
- pdf_link_action(tail) := scan_action;
- 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, small_node_size);
-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
- if pdf_suppress_warning_dup_dest > 0 then
- return;
- 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, pdf_dest_node_size);
- 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;
- link(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, pdf_thread_node_size);
- scan_thread_id;
-end
-
-@ @<Implement \.{\\pdfstartthread}@>=
-begin
- check_pdfoutput("\pdfstartthread", true);
- new_annot_whatsit(pdf_start_thread_node, pdf_thread_node_size);
- scan_thread_id;
-end
-
-@ @<Implement \.{\\pdfendthread}@>=
-begin
- check_pdfoutput("\pdfendthread", true);
- new_whatsit(pdf_end_thread_node, small_node_size);
-end
-
-@ @<Glob...@>=
-@!pdf_last_x_pos: integer;
-@!pdf_last_y_pos: integer;
-@!pdf_snapx_refpos: integer;
-@!pdf_snapy_refpos: integer;
-@!count_do_snapy: integer;
-
-@ @<Set init...@>=
-count_do_snapy := 0;
-
-@ @<Implement \.{\\pdfsnaprefpoint}@>=
-begin
- check_pdfoutput("\pdfsnaprefpoint", true);
- new_whatsit(pdf_snap_ref_point_node, small_node_size);
-end
-
-@ @<Declare procedures needed in |do_ext...@>=
-function new_snap_node(s: small_number): pointer;
-var p: pointer;
-begin
- scan_glue(glue_val);
- if width(cur_val) < 0 then
- pdf_error("ext1", "negative snap glue");
- p := get_node(snap_node_size);
- type(p) := whatsit_node;
- subtype(p) := s;
- link(p) := null;
- snap_glue_ptr(p) := cur_val;
- final_skip(p) := 0;
- new_snap_node := p;
-end;
-
-@ @<Implement \.{\\pdfsnapy}@>=
-begin
- check_pdfoutput("\pdfsnapy", true);
- tail_append(new_snap_node(pdf_snapy_node));
-end
-
-@ @<Implement \.{\\pdfsnapycomp}@>=
-begin
- check_pdfoutput("\pdfsnapycomp", true);
- new_whatsit(pdf_snapy_comp_node, small_node_size);
- scan_int;
- snapy_comp_ratio(tail) := fix_int(cur_val, 0, 1000);
-end
-
-@ @<Implement \.{\\pdfsavepos}@>=
-begin
- new_whatsit(pdf_save_pos_node, small_node_size);
-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
-
-@ @<Implement \.{\\pdftrailerid}@>=
-begin
- check_pdfoutput("\pdftrailerid", false);
- scan_pdf_ext_toks;
- if pdf_output > 0 then
- pdf_trailer_id_toks := concat_tokens(pdf_trailer_id_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 \.{\\pdfresettimer}@>=
-begin
- seconds_and_micros(epochseconds,microseconds);
-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[s];
- while k < str_start[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 \.{\\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;
- pdf_font_attr[k] := tokens_to_string(def_ref);
-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
-
-@ @<Implement \.{\\pdfglyphtounicode}@>=
-begin
- glyph_to_unicode;
-end
-
-@ @<Implement \.{\\pdfnobuiltintounicode}@>=
-begin
- check_pdfoutput("\pdfnobuiltintounicode", true);
- scan_font_ident;
- k := cur_val;
- if k = null_font then
- pdf_error("font", "invalid font identifier");
- pdf_font_nobuiltin_tounicode[k] := true;
-end
-
-@ @<Implement \.{\\pdfinterwordspaceon}@>=
-begin
- check_pdfoutput("\pdfinterwordspaceon", true);
- new_whatsit(pdf_interword_space_on_node, small_node_size);
-end
-
-@ @<Implement \.{\\pdfinterwordspaceoff}@>=
-begin
- check_pdfoutput("\pdfinterwordspaceoff", true);
- new_whatsit(pdf_interword_space_off_node, small_node_size);
-end
-
-@ @<Implement \.{\\pdffakespace}@>=
-begin
- check_pdfoutput("\pdffakespace", true);
- new_whatsit(pdf_fake_space_node, small_node_size);
-end
-
-@ @<Implement \.{\\pdfrunninglinkoff}@>=
-begin
- check_pdfoutput("\pdfrunninglinkoff", true);
- new_whatsit(pdf_running_link_off_node, small_node_size);
-end
-
-@ @<Implement \.{\\pdfrunninglinkon}@>=
-begin
- check_pdfoutput("\pdfrunninglinkon", true);
- new_whatsit(pdf_running_link_on_node, small_node_size);
-end
-
-@ The following function are needed for outputting 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(pdf_page_width); pdf_out(" ");
- pdf_print_bp(pdf_page_height);
- pdf_print_ln("]");
- pdf_end_dict;
- pdf_begin_dict(thread, 1);
- pdf_print_ln("/I << ");
- thread_title(thread);
- pdf_print_ln(">>");
- pdf_indirect_ln("F", a);
- pdf_end_dict;
-end;
-
-procedure out_thread(thread: integer);
-var a, b: pointer;
- last_attr: integer;
-begin
- if obj_thread_first(thread) = 0 then begin
- pdf_fix_thread(thread);
- return;
- end;
- pdf_begin_dict(thread, 1);
- a := obj_thread_first(thread);
- b := a;
- last_attr := 0;
- repeat
- if obj_bead_attr(a) <> 0 then
- last_attr := obj_bead_attr(a);
- a := obj_bead_next(a);
- until a = b;
- if last_attr <> 0 then
- pdf_print_ln(last_attr)
- else begin
- pdf_print_ln("/I << ");
- thread_title(thread);
- pdf_print_ln(">>");
- end;
- pdf_indirect_ln("F", a);
- pdf_end_dict;
- repeat
- pdf_begin_dict(a, 1);
- if a = b then
- pdf_indirect_ln("T", thread);
- pdf_indirect_ln("V", obj_bead_prev(a));
- pdf_indirect_ln("N", obj_bead_next(a));
- pdf_indirect_ln("P", obj_bead_page(a));
- pdf_indirect_ln("R", obj_bead_rect(a));
- pdf_end_dict;
- a := obj_bead_next(a);
- until a = b;
-end;
-
-@ @<Display <rule spec> for whatsit node created by \pdfTeX@>=
-print("(");
-print_rule_dimen(pdf_height(p));
-print_char("+");
-print_rule_dimen(pdf_depth(p));
-print(")x");
-print_rule_dimen(pdf_width(p))
-
-@ Each new type of node that appears in our data structure must be capable
-of being displayed, copied, destroyed, and so on. The routines that we
-need for write-oriented whatsits are somewhat like those for mark nodes;
-other extensions might, of course, involve more subtlety here.
-
-@<Basic printing...@>=
-procedure print_write_whatsit(@!s:str_number;@!p:pointer);
-begin print_esc(s);
-if write_stream(p)<16 then print_int(write_stream(p))
-else if write_stream(p)=16 then print_char("*")
-@.*\relax@>
-else print_char("-");
-end;
-
-@ @<Display the whatsit...@>=
-case subtype(p) of
-open_node:begin print_write_whatsit("openout",p);
- print_char("="); print_file_name(open_name(p),open_area(p),open_ext(p));
- end;
-write_node:begin print_write_whatsit("write",p);
- print_mark(write_tokens(p));
- end;
-close_node:print_write_whatsit("closeout",p);
-special_node:begin print_esc("special");
- print_mark(write_tokens(p));
- end;
-language_node:begin print_esc("setlanguage");
- print_int(what_lang(p)); print(" (hyphenmin ");
- print_int(what_lhm(p)); print_char(",");
- print_int(what_rhm(p)); print_char(")");
- end;
-pdf_literal_node: begin
- print_esc("pdfliteral");
- case pdf_literal_mode(p) of
- set_origin:
- do_nothing;
- direct_page:
- print(" page");
- direct_always:
- print(" direct");
- othercases confusion("literal2")
- endcases;
- print_mark(pdf_literal_data(p));
-end;
-pdf_colorstack_node: begin
- print_esc("pdfcolorstack ");
- print_int(pdf_colorstack_stack(p));
- case pdf_colorstack_cmd(p) of
- colorstack_set:
- print(" set ");
- colorstack_push:
- print(" push ");
- colorstack_pop:
- print(" pop");
- colorstack_current:
- print(" current");
- othercases confusion("pdfcolorstack")
- endcases;
- if pdf_colorstack_cmd(p) <= colorstack_data then
- print_mark(pdf_colorstack_data(p));
-end;
-pdf_setmatrix_node: begin
- print_esc("pdfsetmatrix");
- print_mark(pdf_setmatrix_data(p));
-end;
-pdf_save_node: begin
- print_esc("pdfsave");
-end;
-pdf_restore_node: begin
- print_esc("pdfrestore");
-end;
-pdf_refobj_node: begin
- print_esc("pdfrefobj");
- if obj_obj_is_stream(pdf_obj_objnum(p)) > 0 then begin
- if obj_obj_stream_attr(pdf_obj_objnum(p)) <> null then begin
- print(" attr");
- print_mark(obj_obj_stream_attr(pdf_obj_objnum(p)));
- end;
- print(" stream");
- end;
- if obj_obj_is_file(pdf_obj_objnum(p)) > 0 then
- print(" file");
- print_mark(obj_obj_data(pdf_obj_objnum(p)));
-end;
-pdf_refxform_node: begin
- print_esc("pdfrefxform");
- print("(");
- print_scaled(obj_xform_height(pdf_xform_objnum(p)));
- print_char("+");
- print_scaled(obj_xform_depth(pdf_xform_objnum(p)));
- print(")x");
- print_scaled(obj_xform_width(pdf_xform_objnum(p)));
-end;
-pdf_refximage_node: begin
- print_esc("pdfrefximage");
- print("(");
- print_scaled(obj_ximage_height(pdf_ximage_objnum(p)));
- print_char("+");
- print_scaled(obj_ximage_depth(pdf_ximage_objnum(p)));
- print(")x");
- print_scaled(obj_ximage_width(pdf_ximage_objnum(p)));
-end;
-pdf_annot_node: begin
- print_esc("pdfannot");
- @<Display <rule spec> for whatsit node created by \pdfTeX@>;
- print_mark(pdf_annot_data(p));
-end;
-pdf_start_link_node: begin
- print_esc("pdfstartlink");
- @<Display <rule spec> for whatsit node created by \pdfTeX@>;
- if pdf_link_attr(p) <> null then begin
- print(" attr");
- print_mark(pdf_link_attr(p));
- end;
- print(" action");
- if pdf_action_type(pdf_link_action(p)) = pdf_action_user then begin
- print(" user");
- print_mark(pdf_action_user_tokens(pdf_link_action(p)));
- end
- else begin
- if pdf_action_file(pdf_link_action(p)) <> null then begin
- print(" file");
- print_mark(pdf_action_file(pdf_link_action(p)));
- end;
- case pdf_action_type(pdf_link_action(p)) of
- pdf_action_goto: begin
- if pdf_action_named_id(pdf_link_action(p)) > 0 then begin
- print(" goto name");
- print_mark(pdf_action_id(pdf_link_action(p)));
- end
- else begin
- print(" goto num");
- print_int(pdf_action_id(pdf_link_action(p)))
- end;
- end;
- pdf_action_page: begin
- print(" page");
- print_int(pdf_action_id(pdf_link_action(p)));
- print_mark(pdf_action_page_tokens(pdf_link_action(p)));
- end;
- pdf_action_thread: begin
- if pdf_action_named_id(pdf_link_action(p)) > 0 then begin
- print(" thread name");
- print_mark(pdf_action_id(pdf_link_action(p)));
- end
- else begin
- print(" thread num");
- print_int(pdf_action_id(pdf_link_action(p)));
- end;
- end;
- othercases pdf_error("displaying", "unknown action type");
- endcases;
- end
-end;
-pdf_end_link_node: print_esc("pdfendlink");
-pdf_dest_node: begin
- print_esc("pdfdest");
- if pdf_dest_named_id(p) > 0 then begin
- print(" name");
- print_mark(pdf_dest_id(p));
- end
- else begin
- print(" num");
- print_int(pdf_dest_id(p));
- end;
- print(" ");
- case pdf_dest_type(p) of
- pdf_dest_xyz: begin
- print("xyz");
- if pdf_dest_xyz_zoom(p) <> null then begin
- print(" zoom");
- print_int(pdf_dest_xyz_zoom(p));
- end;
- end;
- pdf_dest_fitbh: print("fitbh");
- pdf_dest_fitbv: print("fitbv");
- pdf_dest_fitb: print("fitb");
- pdf_dest_fith: print("fith");
- pdf_dest_fitv: print("fitv");
- pdf_dest_fitr: begin
- print("fitr");
- @<Display <rule spec> for whatsit node created by \pdfTeX@>;
- end;
- pdf_dest_fit: print("fit");
- othercases print("unknown!");
- endcases;
-end;
-pdf_thread_node,
-pdf_start_thread_node: begin
- if subtype(p) = pdf_thread_node then
- print_esc("pdfthread")
- else
- print_esc("pdfstartthread");
- print("("); print_rule_dimen(pdf_height(p)); print_char("+");
- print_rule_dimen(pdf_depth(p)); print(")x");
- print_rule_dimen(pdf_width(p));
- if pdf_thread_attr(p) <> null then begin
- print(" attr");
- print_mark(pdf_thread_attr(p));
- end;
- if pdf_thread_named_id(p) > 0 then begin
- print(" name");
- print_mark(pdf_thread_id(p));
- end
- else begin
- print(" num");
- print_int(pdf_thread_id(p));
- end;
-end;
-pdf_end_thread_node: print_esc("pdfendthread");
-pdf_save_pos_node: print_esc("pdfsavepos");
-pdf_snap_ref_point_node: print_esc("pdfsnaprefpoint");
-pdf_snapy_node: begin
- print_esc("pdfsnapy");
- print_char(" ");
- print_spec(snap_glue_ptr(p), 0);
- print_char(" ");
- print_spec(final_skip(p), 0);
-end;
-pdf_snapy_comp_node: begin
- print_esc("pdfsnapycomp");
- print_char(" ");
- print_int(snapy_comp_ratio(p));
-end;
-pdf_interword_space_on_node: print_esc("pdfinterwordspaceon");
-pdf_interword_space_off_node: print_esc("pdfinterwordspaceoff");
-pdf_fake_space_node: print_esc("pdffakespace");
-pdf_running_link_off_node: print_esc("pdfrunninglinkoff");
-pdf_running_link_on_node: print_esc("pdfrunninglinkon");
-othercases print("whatsit?")
-endcases
-
-@ @<Make a partial copy of the whatsit...@>=
-case subtype(p) of
-open_node: begin r:=get_node(open_node_size); words:=open_node_size;
- end;
-write_node,special_node: begin r:=get_node(write_node_size);
- add_token_ref(write_tokens(p)); words:=write_node_size;
- end;
-close_node,language_node: begin r:=get_node(small_node_size);
- words:=small_node_size;
- end;
-pdf_literal_node: begin
- r := get_node(write_node_size);
- add_token_ref(pdf_literal_data(p));
- words := write_node_size;
-end;
-pdf_colorstack_node: begin
- if pdf_colorstack_cmd(p) <= colorstack_data then begin
- r := get_node(pdf_colorstack_setter_node_size);
- add_token_ref(pdf_colorstack_data(p));
- words := pdf_colorstack_setter_node_size;
- end
- else begin
- r := get_node(pdf_colorstack_getter_node_size);
- words := pdf_colorstack_getter_node_size;
- end;
-end;
-pdf_setmatrix_node: begin
- r := get_node(pdf_setmatrix_node_size);
- add_token_ref(pdf_setmatrix_data(p));
- words := pdf_setmatrix_node_size;
-end;
-pdf_save_node: begin
- r := get_node(pdf_save_node_size);
- words := pdf_save_node_size;
-end;
-pdf_restore_node: begin
- r := get_node(pdf_restore_node_size);
- words := pdf_restore_node_size;
-end;
-pdf_refobj_node: begin
- r := get_node(pdf_refobj_node_size);
- words := pdf_refobj_node_size;
-end;
-pdf_refxform_node: begin
- r := get_node(pdf_refxform_node_size);
- words := pdf_refxform_node_size;
-end;
-pdf_refximage_node: begin
- r := get_node(pdf_refximage_node_size);
- words := pdf_refximage_node_size;
-end;
-pdf_annot_node: begin
- r := get_node(pdf_annot_node_size);
- add_token_ref(pdf_annot_data(p));
- words := pdf_annot_node_size;
-end;
-pdf_start_link_node: begin
- r := get_node(pdf_annot_node_size);
- pdf_height(r) := pdf_height(p);
- pdf_depth(r) := pdf_depth(p);
- pdf_width(r) := pdf_width(p);
- pdf_link_attr(r) := pdf_link_attr(p);
- if pdf_link_attr(r) <> null then
- add_token_ref(pdf_link_attr(r));
- pdf_link_action(r) := pdf_link_action(p);
- add_action_ref(pdf_link_action(r));
- pdf_link_objnum(r) := pdf_link_objnum(p);
-end;
-pdf_end_link_node:
- r := get_node(small_node_size);
-pdf_dest_node: begin
- r := get_node(pdf_dest_node_size);
- if pdf_dest_named_id(p) > 0 then
- add_token_ref(pdf_dest_id(p));
- words := pdf_dest_node_size;
-end;
-pdf_thread_node,
-pdf_start_thread_node: begin
- r := get_node(pdf_thread_node_size);
- if pdf_thread_named_id(p) > 0 then
- add_token_ref(pdf_thread_id(p));
- if pdf_thread_attr(p) <> null then
- add_token_ref(pdf_thread_attr(p));
- words := pdf_thread_node_size;
-end;
-pdf_end_thread_node:
- r := get_node(small_node_size);
-pdf_save_pos_node:
- r := get_node(small_node_size);
-pdf_snap_ref_point_node:
- r := get_node(small_node_size);
-pdf_snapy_node: begin
- add_glue_ref(snap_glue_ptr(p));
- r := get_node(snap_node_size);
- words := snap_node_size;
-end;
-pdf_snapy_comp_node:
- r := get_node(small_node_size);
-pdf_interword_space_on_node:
- r := get_node(small_node_size);
-pdf_interword_space_off_node:
- r := get_node(small_node_size);
-pdf_fake_space_node:
- r := get_node(small_node_size);
-pdf_running_link_off_node:
- r := get_node(small_node_size);
-pdf_running_link_on_node:
- r := get_node(small_node_size);
-othercases confusion("ext2")
-@:this can't happen ext2}{\quad ext2@>
-endcases
-
-@ @<Wipe out the whatsit...@>=
-begin case subtype(p) of
-open_node: free_node(p,open_node_size);
-write_node,special_node: begin delete_token_ref(write_tokens(p));
- free_node(p,write_node_size); goto done;
- end;
-close_node,language_node: free_node(p,small_node_size);
-pdf_literal_node: begin
- delete_token_ref(pdf_literal_data(p));
- free_node(p, write_node_size);
-end;
-pdf_colorstack_node: begin
- if pdf_colorstack_cmd(p) <= colorstack_data then begin
- delete_token_ref(pdf_colorstack_data(p));
- free_node(p, pdf_colorstack_setter_node_size);
- end
- else
- free_node(p, pdf_colorstack_getter_node_size);
-end;
-pdf_setmatrix_node: begin
- delete_token_ref(pdf_setmatrix_data(p));
- free_node(p, pdf_setmatrix_node_size);
-end;
-pdf_save_node: begin
- free_node(p, pdf_save_node_size);
-end;
-pdf_restore_node: begin
- free_node(p, pdf_restore_node_size);
-end;
-pdf_refobj_node:
- free_node(p, pdf_refobj_node_size);
-pdf_refxform_node:
- free_node(p, pdf_refxform_node_size);
-pdf_refximage_node:
- free_node(p, pdf_refximage_node_size);
-pdf_annot_node: begin
- delete_token_ref(pdf_annot_data(p));
- free_node(p, pdf_annot_node_size);
-end;
-pdf_start_link_node: begin
- if pdf_link_attr(p) <> null then
- delete_token_ref(pdf_link_attr(p));
- delete_action_ref(pdf_link_action(p));
- free_node(p, pdf_annot_node_size);
-end;
-pdf_end_link_node:
- free_node(p, small_node_size);
-pdf_dest_node: begin
- if pdf_dest_named_id(p) > 0 then
- delete_token_ref(pdf_dest_id(p));
- free_node(p, pdf_dest_node_size);
-end;
-pdf_thread_node,
-pdf_start_thread_node: begin
- if pdf_thread_named_id(p) > 0 then
- delete_token_ref(pdf_thread_id(p));
- if pdf_thread_attr(p) <> null then
- delete_token_ref(pdf_thread_attr(p));
- free_node(p, pdf_thread_node_size);
-end;
-pdf_end_thread_node:
- free_node(p, small_node_size);
-pdf_save_pos_node:
- free_node(p, small_node_size);
-pdf_snap_ref_point_node:
- free_node(p, small_node_size);
-pdf_snapy_node: begin
- delete_glue_ref(snap_glue_ptr(p));
- free_node(p, snap_node_size);
-end;
-pdf_snapy_comp_node:
- free_node(p, small_node_size);
-pdf_interword_space_on_node:
- free_node(p, small_node_size);
-pdf_interword_space_off_node:
- free_node(p, small_node_size);
-pdf_fake_space_node:
- free_node(p, small_node_size);
-pdf_running_link_off_node:
- free_node(p, small_node_size);
-pdf_running_link_on_node:
- free_node(p, small_node_size);
-othercases confusion("ext3")
-@:this can't happen ext3}{\quad ext3@>
-endcases;@/
-goto done;
-end
-
-@ @<Incorporate a whatsit node into a vbox@>=
-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@>=
-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
-
-@ @<Let |d| be the width of the whatsit |p|@>=
-if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
- d := pdf_width(p)
-else
- d := 0
-
-@ @d adv_past(#)==@+if subtype(#)=language_node then
- begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);@+end
-
-@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
-begin
-adv_past(cur_p);
-if (subtype(cur_p) = pdf_refxform_node) or (subtype(cur_p) = pdf_refximage_node) then
- act_width:=act_width+pdf_width(cur_p);
-end
-
-@ @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>=@+
-if subtype(s)=language_node then
- begin cur_lang:=what_lang(s); l_hyf:=what_lhm(s); r_hyf:=what_rhm(s);
- set_hyph_index;
- 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@>=
-out_what(p)
-
-@ After all this preliminary shuffling, we come finally to the routines
-that actually send out the requested data. Let's do \.{\\special} first
-(it's easier).
-
-@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
-procedure special_out(@!p:pointer);
-var old_setting:0..max_selector; {holds print |selector|}
-@!k:pool_pointer; {index into |str_pool|}
-begin synch_h; synch_v;@/
-old_setting:=selector; selector:=new_string;
-show_token_list(link(write_tokens(p)),null,pool_size-pool_ptr);
-selector:=old_setting;
-str_room(1);
-if cur_length<256 then
- begin dvi_out(xxx1); dvi_out(cur_length);
- end
-else begin dvi_out(xxx4); dvi_four(cur_length);
- end;
-for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k]));
-pool_ptr:=str_start[str_ptr]; {erase the string}
-end;
-
-@ To write a token list, we must run it through \TeX's scanner, expanding
-macros and \.{\\the} and \.{\\number}, etc. This might cause runaways,
-if a delimited macro parameter isn't matched, and runaways would be
-extremely confusing since we are calling on \TeX's scanner in the middle
-of a \.{\\shipout} command. Therefore we will put a dummy control sequence as
-a ``stopper,'' right after the token list. This control sequence is
-artificially defined to be \.{\\outer}.
-@:end_write_}{\.{\\endwrite}@>
-
-@<Initialize table...@>=
-text(end_write):="endwrite"; eq_level(end_write):=level_one;
-eq_type(end_write):=outer_call; equiv(end_write):=null;
-
-@ @<Declare procedures needed in |hlist_out|, |vlist_out|@>=
-procedure write_out(@!p:pointer);
-var old_setting:0..max_selector; {holds print |selector|}
-@!old_mode:integer; {saved |mode|}
-@!j:small_number; {write stream number}
-@!q,@!r:pointer; {temporary variables for list manipulation}
-begin @<Expand macros in the token list
- and make |link(def_ref)| point to the result@>;
-old_setting:=selector; j:=write_stream(p);
-if write_open[j] then selector:=j
-else begin {write to the terminal if file isn't open}
- if (j=17)and(selector=term_and_log) then selector:=log_only;
- print_nl("");
- end;
-token_show(def_ref); print_ln;
-flush_list(def_ref); selector:=old_setting;
-end;
-
-@ The final line of this routine is slightly subtle; at least, the author
-didn't think about it until getting burnt! There is a used-up token list
-@^Knuth, Donald Ervin@>
-on the stack, namely the one that contained |end_write_token|. (We
-insert this artificial `\.{\\endwrite}' to prevent runaways, as explained
-above.) If it were not removed, and if there were numerous writes on a
-single page, the stack would overflow.
-
-@d end_write_token==cs_token_flag+end_write
-
-@<Expand macros in the token list and...@>=
-q:=get_avail; info(q):=right_brace_token+"}";@/
-r:=get_avail; link(q):=r; info(r):=end_write_token; ins_list(q);@/
-begin_token_list(write_tokens(p),write_text);@/
-q:=get_avail; info(q):=left_brace_token+"{"; ins_list(q);
-{now we're ready to scan
- `\.\{$\langle\,$token list$\,\rangle$\.{\} \\endwrite}'}
-old_mode:=mode; mode:=0;
- {disable \.{\\prevdepth}, \.{\\spacefactor}, \.{\\lastskip}, \.{\\prevgraf}}
-cur_cs:=write_loc; q:=scan_toks(false,true); {expand macros, etc.}
-get_token;@+if cur_tok<>end_write_token then
- @<Recover from an unbalanced write command@>;
-mode:=old_mode;
-end_token_list {conserve stack space}
-
-@ @<Recover from an unbalanced write command@>=
-begin print_err("Unbalanced write command");
-@.Unbalanced write...@>
-help2("On this page there's a \write with fewer real {'s than }'s.")@/
-("I can't handle that very well; good luck."); error;
-repeat get_token;
-until cur_tok=end_write_token;
-end
-
-@ The |out_what| procedure takes care of outputting whatsit nodes for
-|vlist_out| and |hlist_out|\kern-.3pt.
-
-@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
-procedure out_what(@!p:pointer);
-var j:small_number; {write stream number}
-begin case subtype(p) of
-open_node,write_node,close_node:@<Do some work that has been queued up
- for \.{\\write}@>;
-special_node:special_out(p);
-language_node:do_nothing;
-pdf_save_pos_node:
- @<Save current position in DVI mode@>;
-others: begin
- if (pdftex_first_extension_code <= subtype(p)) and (subtype(p) <= pdftex_last_extension_code) then
- pdf_error("ext4", "pdf node ended up in DVI mode")
- else
- confusion("ext4")
- @:this can't happen ext4}{\quad ext4@>
-end;
-endcases;
-end;
-
-@ @<Save current position in DVI mode@>=
-begin
- {4736286 = 1in, the funny DVI origin offset}
- pdf_last_x_pos := cur_h + 4736286;
- pdf_last_y_pos := cur_page_height - cur_v - 4736286;
-end
-
-@ We don't implement \.{\\write} inside of leaders. (The reason is that
-the number of times a leader box appears might be different in different
-implementations, due to machine-dependent rounding in the glue calculations.)
-@^leaders@>
-
-@<Do some work that has been queued up...@>=
-if not doing_leaders then
- begin j:=write_stream(p);
- if subtype(p)=write_node then write_out(p)
- else begin if write_open[j] then a_close(write_file[j]);
- if subtype(p)=close_node then write_open[j]:=false
- else if j<16 then
- begin cur_name:=open_name(p); cur_area:=open_area(p);
- cur_ext:=open_ext(p);
- if cur_ext="" then cur_ext:=".tex";
- pack_cur_name;
- while not a_open_out(write_file[j]) do
- prompt_file_name("output file name",".tex");
- write_open[j]:=true;
- end;
- end;
- end
-
-@ The presence of `\.{\\immediate}' causes the |do_extension| procedure
-to descend to one level of recursion. Nothing happens unless \.{\\immediate}
-is followed by `\.{\\openout}', `\.{\\write}', or `\.{\\closeout}'.
-@^recursion@>
-
-@<Implement \.{\\immediate}@>=
-begin get_x_token;
-if cur_cmd=extension 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; link(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
-
-@ The \.{\\language} extension is somewhat different.
-We need a subroutine that comes into play when a character of
-a non-|clang| language is being appended to the current paragraph.
-
-@<Declare action...@>=
-procedure fix_language;
-var @!l:ASCII_code; {the new current language}
-begin if language<=0 then l:=0
-else if language>255 then l:=0
-else l:=language;
-if l<>clang then
- begin new_whatsit(language_node,small_node_size);
- what_lang(tail):=l; clang:=l;@/
- what_lhm(tail):=norm_min(left_hyphen_min);
- what_rhm(tail):=norm_min(right_hyphen_min);
- end;
-end;
-
-@ @<Implement \.{\\setlanguage}@>=
-if abs(mode)<>hmode then report_illegal_case
-else begin new_whatsit(language_node,small_node_size);
- scan_int;
- if cur_val<=0 then clang:=0
- else if cur_val>255 then clang:=0
- else clang:=cur_val;
- what_lang(tail):=clang;
- what_lhm(tail):=norm_min(left_hyphen_min);
- what_rhm(tail):=norm_min(right_hyphen_min);
- end
-
-@ @<Finish the extensions@>=
-for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
-
-@ Shipping out PDF marks.
-
-@<Types...@>=
-dest_name_entry = record
- objname: str_number; {destination name}
- objnum: integer; {destination object number}
-end;
-
-@ @<Glob...@>=
-@!cur_page_width: scaled; {width of page being shipped}
-@!cur_page_height: scaled; {height of page being shipped}
-@!cur_h_offset: scaled; {horizontal offset of page being shipped}
-@!cur_v_offset: scaled; {vertical offset of page being shipped}
-@!pdf_obj_list: pointer; {list of objects in the current page}
-@!pdf_xform_list: pointer; {list of forms in the current page}
-@!pdf_ximage_list: pointer; {list of images in the current page}
-@!last_thread: pointer; {pointer to the last thread}
-@!pdf_thread_ht, pdf_thread_dp, pdf_thread_wd: scaled; {dimensions of the last
-thread}
-@!pdf_last_thread_id: halfword; {identifier of the last thread}
-@!pdf_last_thread_named_id: boolean; {is identifier of the last thread named}
-@!pdf_thread_level: integer; {depth of nesting of box containing the last thread}
-@!pdf_annot_list: pointer; {list of annotations in the current page}
-@!pdf_link_list: pointer; {list of link annotations in the current page}
-@!pdf_dest_list: pointer; {list of destinations in the current page}
-@!pdf_bead_list: pointer; {list of thread beads in the current page}
-@!pdf_obj_count: integer; {counter of objects}
-@!pdf_xform_count: integer; {counter of forms}
-@!pdf_ximage_count: integer; {counter of images}
-@!pdf_cur_form: integer; {the form being output}
-@!pdf_first_outline, pdf_last_outline, pdf_parent_outline: integer;
-@!pdf_xform_width,
-@!pdf_xform_height,
-@!pdf_xform_depth: scaled; {dimension of the current form}
-@!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}
-@!pdf_trailer_id_toks: pointer; {custom Trailer ID}
-@!gen_faked_interword_space: boolean; {flag to turn on/off faked interword spaces}
-@!gen_running_link: boolean; {flag to turn on/off running link}
-
-@ @<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;
-pdf_trailer_id_toks := null;
-gen_faked_interword_space := false;
-gen_running_link := true;
-
-@ The following procedures are needed for outputting 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
- if pdf_action_type(p) = pdf_action_user then begin
- pdf_print_toks_ln(pdf_action_user_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[s]] = 40) and
- (str_pool[str_start[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_page_tokens(p)));
- flush_str(last_tokens_string);
- pdf_out("]");
- end;
- pdf_action_goto: begin
- if pdf_action_file(p) = null then begin
- pdf_print("/S /GoTo ");
- d := get_obj(obj_type_dest, pdf_action_id(p),
- pdf_action_named_id(p));
- end
- else
- pdf_print("/S /GoToR ");
- if pdf_action_named_id(p) > 0 then begin
- pdf_str_entry("D", tokens_to_string(pdf_action_id(p)));
- flush_str(last_tokens_string);
- end
- else if pdf_action_file(p) = null then
- pdf_indirect("D", d)
- else
- pdf_error("ext4", "`goto' option cannot be used with both `file' and `num'");
- end;
- pdf_action_thread: begin
- pdf_print("/S /Thread ");
- if pdf_action_file(p) = null then
- d := get_obj(obj_type_thread, pdf_action_id(p),
- pdf_action_named_id(p));
- if pdf_action_named_id(p) > 0 then begin
- pdf_str_entry("D", tokens_to_string(pdf_action_id(p)));
- flush_str(last_tokens_string);
- end
- else if pdf_action_file(p) = null then
- pdf_indirect("D", d)
- else
- pdf_int_entry("D", pdf_action_id(p));
- end;
- endcases;
- pdf_print_ln(" >>");
-end;
-
-procedure set_rect_dimens(p, parent_box: pointer; x, y, w, h, d, margin: scaled);
-begin
- pdf_left(p) := cur_h;
- if is_running(w) then
- pdf_right(p) := x + width(parent_box)
- else
- pdf_right(p) := cur_h + w;
- if is_running(h) then
- pdf_top(p) := y - height(parent_box)
- else
- pdf_top(p) := cur_v - h;
- if is_running(d) then
- pdf_bottom(p) := y + depth(parent_box)
- else
- pdf_bottom(p) := cur_v + d;
- if is_shipping_page and matrixused then begin
- matrixtransformrect(pdf_left(p), cur_page_height - pdf_bottom(p),
- pdf_right(p), cur_page_height - pdf_top(p));
- pdf_left(p) := getllx;
- pdf_bottom(p) := cur_page_height - getlly;
- pdf_right(p) := geturx;
- pdf_top(p) := cur_page_height - getury;
- end;
- pdf_left(p) := pdf_left(p) - margin;
- pdf_top(p) := pdf_top(p) - margin;
- pdf_right(p) := pdf_right(p) + margin;
- pdf_bottom(p) := pdf_bottom(p) + margin;
-end;
-
-procedure do_annot(p, parent_box: pointer; x, y: scaled);
-begin
- if not is_shipping_page then
- pdf_error("ext4", "annotations cannot be inside an XForm");
- if doing_leaders then
- return;
- 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;
-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_warning(0, "\pdfendlink ended up in different nesting level than \pdfstartlink", true, true);
-
- {N.B.: test for running link must be done on |link_node| and not |ref_link_node|,
- as |ref_link_node| can be set by |do_link| or |append_link| already}
-
- if is_running(pdf_width(pdf_link_stack_top.link_node)) then begin
- p := pdf_link_stack_top.ref_link_node;
- if is_shipping_page and matrixused then begin
- matrixrecalculate(cur_h + pdf_link_margin);
- pdf_left(p) := getllx - pdf_link_margin;
- pdf_top(p) := cur_page_height - getury - pdf_link_margin;
- pdf_right(p) := geturx + pdf_link_margin;
- pdf_bottom(p) := cur_page_height - getlly + pdf_link_margin;
- end
- else
- pdf_right(p) := cur_h + pdf_link_margin;
- end;
- pop_link_level;
-end;
-
-@ For ``running'' annotations we must append a new node when the end of
-annotation is in other box than its start. The new created node is identical to
-corresponding whatsit node representing the start of annotation, but its
-|info| field is |max_halfword|. We set |info| field just before destroying the
-node, in order to use |flush_node_list| to do the job.
-
-@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
-procedure append_link(parent_box: pointer; x, y: scaled; i: small_number); {append a new
-pdf annot to |pdf_link_list|}
-var p: pointer;
-begin
- pdfassert(type(parent_box) = hlist_node);
- p := copy_node_list(pdf_link_stack[i].link_node);
- pdf_link_stack[i].ref_link_node := p;
- info(p) := max_halfword; {mark that this node is not a whatsit node}
- link(p) := null; {this node is not linked in any list}
- 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 := get_node(pdf_thread_node_size);
- info(p) := max_halfword; {this is not a whatsit node}
- link(p) := null; {this node will be destroyed separately}
- pdf_width(p) := pdf_thread_wd;
- pdf_height(p) := pdf_thread_ht;
- pdf_depth(p) := pdf_thread_dp;
- pdf_thread_attr(p) := null;
- pdf_thread_id(p) := pdf_last_thread_id;
- if pdf_last_thread_named_id then begin
- add_token_ref(pdf_thread_id(p));
- pdf_thread_named_id(p) := 1;
- end
- else
- pdf_thread_named_id(p) := 0;
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_thread_margin);
- append_bead(p);
- last_thread := p;
-end;
-
-procedure end_thread;
-begin
- if pdf_thread_level <> cur_s then
- pdf_error("ext4", "\pdfendthread ended up in different nesting level than \pdfstartthread");
- if is_running(pdf_thread_dp) and (last_thread <> null) then
- pdf_bottom(last_thread) := cur_v + pdf_thread_margin;
- if pdf_last_thread_named_id then
- delete_token_ref(pdf_last_thread_id);
- last_thread := null;
-end;
-
-function open_subentries(p: pointer): integer;
-var k, c: integer;
- l, r: integer;
-begin
- k := 0;
- if obj_outline_first(p) <> 0 then begin
- l := obj_outline_first(p);
- repeat
- incr(k);
- c := open_subentries(l);
- if obj_outline_count(l) > 0 then
- k := k + c;
- obj_outline_parent(l) := p;
- r := obj_outline_next(l);
- if r = 0 then
- obj_outline_last(p) := l;
- l := r;
- until l = 0;
- end;
- if obj_outline_count(p) > 0 then
- obj_outline_count(p) := k
- else
- obj_outline_count(p) := -k;
- open_subentries := k;
-end;
-
-procedure do_dest(p, parent_box: pointer; x, y: scaled);
-var k: integer;
-begin
- if not is_shipping_page then
- pdf_error("ext4", "destinations cannot be inside an XForm");
- if doing_leaders then
- return;
- k := get_obj(obj_type_dest, pdf_dest_id(p), pdf_dest_named_id(p));
- if obj_dest_ptr(k) <> null then begin
- warn_dest_dup(pdf_dest_id(p), pdf_dest_named_id(p),
- "ext4", "has been already used, duplicate ignored");
- return;
- end;
- obj_dest_ptr(k) := p;
- pdf_append_list(k)(pdf_dest_list);
- case pdf_dest_type(p) of
- pdf_dest_xyz:
- if matrixused then
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_dest_margin)
- else begin
- pdf_left(p) := cur_h;
- pdf_top(p) := cur_v;
- end;
- pdf_dest_fith,
- pdf_dest_fitbh:
- if matrixused then
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_dest_margin)
- else
- pdf_top(p) := cur_v;
- pdf_dest_fitv,
- pdf_dest_fitbv:
- if matrixused then
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_dest_margin)
- else
- pdf_left(p) := cur_h;
- pdf_dest_fit,
- pdf_dest_fitb:
- do_nothing;
- pdf_dest_fitr:
- set_rect_dimens(p, parent_box, x, y,
- pdf_width(p), pdf_height(p), pdf_depth(p),
- pdf_dest_margin);
- endcases;
-end;
-
-procedure out_form(p: pointer);
-begin
- pdf_end_text;
- pdf_print_ln("q");
- if pdf_lookup_list(pdf_xform_list, pdf_xform_objnum(p)) = null then
- pdf_append_list(pdf_xform_objnum(p))(pdf_xform_list);
- cur_v := cur_v + obj_xform_depth(pdf_xform_objnum(p));
- pdf_print("1 0 0 1 ");
- pdf_print_bp(pdf_x(cur_h)); pdf_out(" ");
- pdf_print_bp(pdf_y(cur_v));
- pdf_print_ln(" cm");
- pdf_print("/Fm");
- pdf_print_int(obj_info(pdf_xform_objnum(p)));
- pdf_print_resname_prefix;
- pdf_print_ln(" Do");
- pdf_print_ln("Q");
-end;
-
-procedure out_image(p: pointer);
-var image, groupref: integer;
- img_w, img_h: integer;
-begin
- image := obj_ximage_data(pdf_ximage_objnum(p));
- if (image_rotate(image) = 90) or (image_rotate(image) = 270) then begin
- img_h := image_width(image);
- img_w := image_height(image);
- end else begin
- img_w := image_width(image);
- img_h := image_height(image);
- end;
-
- pdf_end_text;
- pdf_print_ln("q");
- if pdf_lookup_list(pdf_ximage_list, pdf_ximage_objnum(p)) = null then
- pdf_append_list(pdf_ximage_objnum(p))(pdf_ximage_list);
- if not is_pdf_image(image) then begin
- if is_png_image(image) then begin
- groupref := get_image_group_ref(image);
- if (groupref > 0) and (pdf_page_group_val = 0) then
- pdf_page_group_val := groupref;
- end;
- pdf_print_real(ext_xn_over_d(pdf_width(p),
- ten_pow[6], one_hundred_bp), 4);
- pdf_print(" 0 0 ");
- pdf_print_real(ext_xn_over_d(pdf_height(p) + pdf_depth(p),
- ten_pow[6], one_hundred_bp), 4);
- pdf_out(" ");
- pdf_print_bp(pdf_x(cur_h)); pdf_out(" ");
- pdf_print_bp(pdf_y(cur_v));
- end
- else begin
- {for pdf images we generate the page group object number here}
- groupref := get_image_group_ref(image); {0: no group, -1: to be generated; >0: already written}
- if (groupref <> 0) and (pdf_page_group_val = 0) then begin
- if groupref = -1 then begin
- pdf_page_group_val := pdf_new_objnum;
- set_image_group_ref(image, pdf_page_group_val);
- end
- else { groupref > 0 }
- pdf_page_group_val := groupref;
- end;
- pdf_print_real(ext_xn_over_d(pdf_width(p),
- ten_pow[6], img_w), 6);
- pdf_print(" 0 0 ");
- pdf_print_real(ext_xn_over_d(pdf_height(p) + pdf_depth(p),
- ten_pow[6], img_h), 6);
- pdf_out(" ");
- pdf_print_bp(pdf_x(cur_h) -
- ext_xn_over_d(pdf_width(p), epdf_orig_x(image),
- img_w));
- pdf_out(" ");
- pdf_print_bp(pdf_y(cur_v) -
- ext_xn_over_d(pdf_height(p) + pdf_depth(p), epdf_orig_y(image),
- img_h));
- end;
- pdf_print_ln(" cm");
- pdf_print("/Im");
- pdf_print_int(obj_info(pdf_ximage_objnum(p)));
- pdf_print_resname_prefix;
- pdf_print_ln(" Do");
- pdf_print_ln("Q");
-end;
-
-function gap_amount(p: pointer; cur_pos: scaled): scaled; {find the gap between
-the position of the current snap node |p| and the nearest point on the grid}
-var snap_unit, stretch_amount, shrink_amount: scaled;
- last_pos, next_pos, g, g2: scaled;
-begin
- snap_unit := width(snap_glue_ptr(p));
- if stretch_order(snap_glue_ptr(p)) > normal then
- stretch_amount := max_dimen
- else
- stretch_amount := stretch(snap_glue_ptr(p));
- if shrink_order(snap_glue_ptr(p)) > normal then
- shrink_amount := max_dimen
- else
- shrink_amount := shrink(snap_glue_ptr(p));
- if subtype(p) = pdf_snapy_node then
- last_pos := pdf_snapy_refpos +
- snap_unit * ((cur_pos - pdf_snapy_refpos) div snap_unit)
- else
- pdf_error("snapping", "invalid parameter value for gap_amount");
- next_pos := last_pos + snap_unit;
- @{
- print_nl("snap ref pos = "); print_scaled(pdf_snapy_refpos);
- print_nl("snap glue = "); print_spec(snap_glue_ptr(p), 0);
- print_nl("gap amount = "); print_scaled(snap_unit);
- print_nl("stretch amount = "); print_scaled(stretch_amount);
- print_nl("shrink amount = "); print_scaled(shrink_amount);
- print_nl("last point = "); print_scaled(last_pos);
- print_nl("cur point = "); print_scaled(cur_pos);
- print_nl("next point = "); print_scaled(next_pos);
- @}
- g := max_dimen;
- g2 := max_dimen;
- gap_amount := 0;
- if cur_pos - last_pos < shrink_amount then
- g := cur_pos - last_pos;
- if (next_pos - cur_pos < stretch_amount) then
- g2 := next_pos - cur_pos;
- if (g = max_dimen) and (g2 = max_dimen) then
- return; {unable to snap}
- if g2 <= g then
- gap_amount := g2 {skip forward}
- else
- gap_amount := -g; {skip backward}
-end;
-
-function get_vpos(p, q, b: pointer): pointer; {find the vertical position of
-node |q| in the output PDF page; this functions is called when the current node
-is |p| and current position is |cur_v| (global variable); |b| is the parent
-box;}
-var tmp_v: scaled;
- g_order: glue_ord; {applicable order of infinity for glue}
- g_sign: normal..shrinking; {selects type of glue}
- glue_temp: real; {glue value before rounding}
- cur_glue: real; {glue seen so far}
- cur_g: scaled; {rounded equivalent of |cur_glue| times the glue ratio}
- this_box: pointer; {pointer to containing box}
-begin
- tmp_v := cur_v;
- this_box := b;
- cur_g := 0;
- cur_glue := float_constant(0);
- g_order := glue_order(this_box);
- g_sign := glue_sign(this_box);
- while (p <> q) and (p <> null) do begin
- if is_char_node(p) then
- confusion("get_vpos")
- else begin
- case type(p) of
- hlist_node,
- vlist_node,
- rule_node:
- tmp_v := tmp_v + height(p) + depth(p);
- whatsit_node:
- if (subtype(p) = pdf_refxform_node) or
- (subtype(p) = pdf_refximage_node) then
- tmp_v := tmp_v + pdf_height(p) + pdf_depth(p);
- glue_node: begin
- @<Move down without outputting leaders@>;
- tmp_v := tmp_v + rule_ht;
- end;
- kern_node:
- tmp_v := tmp_v + width(p);
- othercases do_nothing;
- endcases;
- end;
- p := link(p);
- end;
- get_vpos := tmp_v;
-end;
-
-procedure do_snapy_comp(p, b: pointer); {do snapping compensation in vertical
-direction; search for the next snap node and do the compensation if found}
-var q: pointer;
- tmp_v, g, g2: scaled;
-begin
- if not (not is_char_node(p) and
- (type(p) = whatsit_node) and
- (subtype(p) = pdf_snapy_comp_node))
- then
- pdf_error("snapping", "invalid parameter value for do_snapy_comp");
- q := p;
- while (q <> null) do begin
- if not is_char_node(q) and
- (type(q) = whatsit_node) and
- (subtype(q) = pdf_snapy_node)
- then begin
- tmp_v := get_vpos(p, q, b); {get the position of |q|}
- g := gap_amount(q, tmp_v); {get the gap to the grid}
- g2 := round_xn_over_d(g, snapy_comp_ratio(p), 1000); {adjustment for |p|}
- @{
- print_nl("do_snapy_comp: tmp_v = "); print_scaled(tmp_v);
- print_nl("do_snapy_comp: cur_v = "); print_scaled(cur_v);
- print_nl("do_snapy_comp: g = "); print_scaled(g);
- print_nl("do_snapy_comp: g2 = "); print_scaled(g2);
- @}
- cur_v := cur_v + g2;
- final_skip(q) := g - g2; {adjustment for |q|}
- if final_skip(q) = 0 then
- final_skip(q) := 1; {use |1sp| as the magic value to record
- that |final_skip| has been set here}
- return;
- end;
- q := link(q);
- end;
-end;
-
-procedure do_snapy(p: pointer);
-begin
- incr(count_do_snapy);
- @{
- print_nl("do_snapy: count = "); print_int(count_do_snapy);
- print_nl("do_snapy: cur_v = "); print_scaled(cur_v);
- print_nl("do_snapy: final skip = "); print_scaled(final_skip(p));
- @}
- if final_skip(p) <> 0 then
- cur_v := cur_v + final_skip(p)
- else
- cur_v := cur_v + gap_amount(p, cur_v);
- @{
- print_nl("do_snapy: cur_v after snap = "); print_scaled(cur_v);
- @}
-end;
-
-@ @<Move down without outputting 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;
-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(p);
-pdf_restore_node:
- pdf_out_restore(p);
-pdf_refobj_node:
- pdf_append_list(pdf_obj_objnum(p))(pdf_obj_list);
-pdf_refxform_node:
- @<Output a Form node in a vlist@>;
-pdf_refximage_node:
- @<Output a Image node in a vlist@>;
-pdf_annot_node:
- do_annot(p, this_box, left_edge, top_edge + height(this_box));
-pdf_start_link_node:
- pdf_error("ext4", "\pdfstartlink ended up in vlist");
-pdf_end_link_node:
- pdf_error("ext4", "\pdfendlink ended up in vlist");
-pdf_dest_node:
- do_dest(p, this_box, left_edge, top_edge + height(this_box));
-pdf_thread_node,
-pdf_start_thread_node:
- do_thread(p, this_box, left_edge, top_edge + height(this_box));
-pdf_end_thread_node:
- end_thread;
-pdf_save_pos_node:
- @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
-special_node:
- pdf_special(p);
-pdf_snap_ref_point_node:
- @<Save current position to |pdf_snapx_refpos|, |pdf_snapy_refpos|@>;
-pdf_snapy_comp_node:
- do_snapy_comp(p, this_box);
-pdf_snapy_node:
- do_snapy(p);
-pdf_interword_space_on_node:
- gen_faked_interword_space := true;
-pdf_interword_space_off_node:
- gen_faked_interword_space := false;
-pdf_fake_space_node:
- pdf_insert_fake_space;
-pdf_running_link_off_node:
- gen_running_link := false;
-pdf_running_link_on_node:
- gen_running_link := true;
-othercases out_what(p);
-endcases
-
-@ @<Glob...@>=
-@!is_shipping_page: boolean; {set to |shipping_page| when |pdf_ship_out| starts}
-
-@ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>=
-begin
- pdf_last_x_pos := cur_h;
- if is_shipping_page then
- pdf_last_y_pos := cur_page_height - cur_v
- else
- pdf_last_y_pos := pdf_xform_height + pdf_xform_depth - cur_v;
-end
-
-@ @<Save current position to |pdf_snapx_refpos|, |pdf_snapy_refpos|@>=
-begin
- pdf_snapx_refpos := cur_h;
- pdf_snapy_refpos := cur_v;
-end
-
-@ @<Output a Image node in a vlist@>=
-begin cur_v:=cur_v+pdf_height(p)+pdf_depth(p); save_v:=cur_v;
- cur_h:=left_edge;
- out_image(p);
- cur_v:=save_v; cur_h:=left_edge;
- end
-
-@ @<Output a Form node in a vlist@>=
-begin cur_v:=cur_v+pdf_height(p); save_v:=cur_v;
- cur_h:=left_edge;
- out_form(p);
- cur_v:=save_v+pdf_depth(p); cur_h:=left_edge;
- 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(p);
-pdf_restore_node:
- pdf_out_restore(p);
-pdf_refobj_node:
- pdf_append_list(pdf_obj_objnum(p))(pdf_obj_list);
-pdf_refxform_node:
- @<Output a Form node in a hlist@>;
-pdf_refximage_node:
- @<Output a Image node in a hlist@>;
-pdf_annot_node:
- do_annot(p, this_box, left_edge, base_line);
-pdf_start_link_node:
- do_link(p, this_box, left_edge, base_line);
-pdf_end_link_node:
- end_link;
-pdf_dest_node:
- do_dest(p, this_box, left_edge, base_line);
-pdf_thread_node:
- do_thread(p, this_box, left_edge, base_line);
-pdf_start_thread_node:
- pdf_error("ext4", "\pdfstartthread ended up in hlist");
-pdf_end_thread_node:
- pdf_error("ext4", "\pdfendthread ended up in hlist");
-pdf_save_pos_node:
- @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
-special_node:
- pdf_special(p);
-pdf_snap_ref_point_node:
- @<Save current position to |pdf_snapx_refpos|, |pdf_snapy_refpos|@>;
-pdf_snapy_comp_node,
-pdf_snapy_node: do_nothing; {snapy nodes do nothing in hlist}
-pdf_interword_space_on_node:
- gen_faked_interword_space := true;
-pdf_interword_space_off_node:
- gen_faked_interword_space := false;
-pdf_fake_space_node:
- pdf_insert_fake_space;
-pdf_running_link_off_node:
- gen_running_link := false;
-pdf_running_link_on_node:
- gen_running_link := true;
-othercases out_what(p);
-endcases
-
-@ @<Output a Image node in a hlist@>=
-begin
- cur_v:=base_line+pdf_depth(p);
- edge:=cur_h;
- out_image(p);
- cur_h:=edge+pdf_width(p); cur_v:=base_line;
- end
-
-@ @<Output a Form node in a hlist@>=
-begin
- cur_v:=base_line;
- edge:=cur_h;
- out_form(p);
- cur_h:=edge+pdf_width(p); cur_v:=base_line;
- end
-
-@* \[53a] The extended features of \eTeX.
-The program has two modes of operation: (1)~In \TeX\ compatibility mode
-it fully deserves the name \TeX\ and there are neither extended features
-nor additional primitive commands. There are, however, a few
-modifications that would be legitimate in any implementation of \TeX\
-such as, e.g., preventing inadequate results of the glue to \.{DVI}
-unit conversion during |ship_out|. (2)~In extended mode there are
-additional primitive commands and the extended features of \eTeX\ are
-available.
-
-The distinction between these two modes of operation initially takes
-place when a `virgin' \.{eINITEX} starts without reading a format file.
-Later on the values of all \eTeX\ state variables are inherited when
-\.{eVIRTEX} (or \.{eINITEX}) reads a format file.
-
-The code below is designed to work for cases where `$|init|\ldots|tini|$'
-is a run-time switch.
-
-@<Enable \eTeX, if requested@>=
-@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
- begin no_new_control_sequence:=false;
- @<Generate all \eTeX\ primitives@>@;
- incr(loc); eTeX_mode:=1; {enter extended mode}
- @<Initialize variables for \eTeX\ extended mode@>@;
- end;
-tini@;@/
-if not no_new_control_sequence then {just entered extended mode ?}
- no_new_control_sequence:=true@+else
-
-@ The \eTeX\ features available in extended mode are grouped into two
-categories: (1)~Some of them are permanently enabled and have no
-semantic effect as long as none of the additional primitives are
-executed. (2)~The remaining \eTeX\ features are optional and can be
-individually enabled and disabled. For each optional feature there is
-an \eTeX\ state variable named \.{\\...state}; the feature is enabled,
-resp.\ disabled by assigning a positive, resp.\ non-positive value to
-that integer.
-
-@d eTeX_state_base=int_base+eTeX_state_code
-@d eTeX_state(#)==eqtb[eTeX_state_base+#].int {an \eTeX\ state variable}
-@#
-@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
-
-@<Generate all \eTeX...@>=
-primitive("lastnodetype",last_item,last_node_type_code);
-@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
-primitive("eTeXversion",last_item,eTeX_version_code);
-@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
-primitive("eTeXrevision",convert,eTeX_revision_code);@/
-@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
-
-@ @<Cases of |last_item| for |print_cmd_chr|@>=
-last_node_type_code: print_esc("lastnodetype");
-eTeX_version_code: print_esc("eTeXversion");
-
-@ @<Cases for fetching an integer value@>=
-eTeX_version_code: cur_val:=eTeX_version;
-
-@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?}
-
-@<Glob...@>=
-@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
-
-@ @<Initialize table entries...@>=
-eTeX_mode:=0; {initially we are in compatibility mode}
-@<Initialize variables for \eTeX\ compatibility mode@>@;
-
-@ @<Dump the \eTeX\ state@>=
-dump_int(eTeX_mode);
-for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
-
-@ @<Undump the \eTeX\ state@>=
-undump(0)(1)(eTeX_mode);
-if eTeX_ex then
- begin @<Initialize variables for \eTeX\ extended mode@>@;
- end
-else begin @<Initialize variables for \eTeX\ compatibility mode@>@;
- end;
-
-@ The |eTeX_enabled| function simply returns its first argument as
-result. This argument is |true| if an optional \eTeX\ feature is
-currently enabled; otherwise, if the argument is |false|, the function
-gives an error message.
-
-@<Declare \eTeX\ procedures for use...@>=
-function eTeX_enabled(@!b:boolean;@!j:quarterword;@!k:halfword):boolean;
-begin if not b then
- begin print_err("Improper "); print_cmd_chr(j,k);
- help1("Sorry, this optional e-TeX feature has been disabled."); error;
- end;
-eTeX_enabled:=b;
-end;
-
-@ First we implement the additional \eTeX\ parameters in the table of
-equivalents.
-
-@<Generate all \eTeX...@>=
-primitive("everyeof",assign_toks,every_eof_loc);
-@!@:every_eof_}{\.{\\everyeof} primitive@>
-primitive("tracingassigns",assign_int,int_base+tracing_assigns_code);@/
-@!@:tracing_assigns_}{\.{\\tracingassigns} primitive@>
-primitive("tracinggroups",assign_int,int_base+tracing_groups_code);@/
-@!@:tracing_groups_}{\.{\\tracinggroups} primitive@>
-primitive("tracingifs",assign_int,int_base+tracing_ifs_code);@/
-@!@:tracing_ifs_}{\.{\\tracingifs} primitive@>
-primitive("tracingscantokens",assign_int,int_base+tracing_scan_tokens_code);@/
-@!@:tracing_scan_tokens_}{\.{\\tracingscantokens} primitive@>
-primitive("tracingnesting",assign_int,int_base+tracing_nesting_code);@/
-@!@:tracing_nesting_}{\.{\\tracingnesting} primitive@>
-primitive("predisplaydirection",
- assign_int,int_base+pre_display_direction_code);@/
-@!@:pre_display_direction_}{\.{\\predisplaydirection} primitive@>
-primitive("lastlinefit",assign_int,int_base+last_line_fit_code);@/
-@!@:last_line_fit_}{\.{\\lastlinefit} primitive@>
-primitive("savingvdiscards",assign_int,int_base+saving_vdiscards_code);@/
-@!@:saving_vdiscards_}{\.{\\savingvdiscards} primitive@>
-primitive("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code);@/
-@!@:saving_hyph_codes_}{\.{\\savinghyphcodes} primitive@>
-
-@ @d every_eof==equiv(every_eof_loc)
-
-@<Cases of |assign_toks| for |print_cmd_chr|@>=
-every_eof_loc: print_esc("everyeof");
-
-@ @<Cases for |print_param|@>=
-tracing_assigns_code:print_esc("tracingassigns");
-tracing_groups_code:print_esc("tracinggroups");
-tracing_ifs_code:print_esc("tracingifs");
-tracing_scan_tokens_code:print_esc("tracingscantokens");
-tracing_nesting_code:print_esc("tracingnesting");
-pre_display_direction_code:print_esc("predisplaydirection");
-last_line_fit_code:print_esc("lastlinefit");
-saving_vdiscards_code:print_esc("savingvdiscards");
-saving_hyph_codes_code:print_esc("savinghyphcodes");
-
-@ In order to handle \.{\\everyeof} we need an array |eof_seen| of
-boolean variables.
-
-@<Glob...@>=
-@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
-
-@ The |print_group| procedure prints the current level of grouping and
-the name corresponding to |cur_group|.
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure print_group(@!e:boolean);
-label exit;
-begin case cur_group of
- bottom_level: begin print("bottom level"); return;
- end;
- simple_group,semi_simple_group:
- begin if cur_group=semi_simple_group then print("semi ");
- print("simple");
- end;
- hbox_group,adjusted_hbox_group:
- begin if cur_group=adjusted_hbox_group then print("adjusted ");
- print("hbox");
- end;
- vbox_group: print("vbox");
- vtop_group: print("vtop");
- align_group,no_align_group:
- begin if cur_group=no_align_group then print("no ");
- print("align");
- end;
- output_group: print("output");
- disc_group: print("disc");
- insert_group: print("insert");
- vcenter_group: print("vcenter");
- math_group,math_choice_group,math_shift_group,math_left_group:
- begin print("math");
- if cur_group=math_choice_group then print(" choice")
- else if cur_group=math_shift_group then print(" shift")
- else if cur_group=math_left_group then print(" left");
- end;
- end; {there are no other cases}
-print(" group (level "); print_int(qo(cur_level)); print_char(")");
-if saved(-1)<>0 then
- begin if e then print(" entered at line ") else print(" at line ");
- print_int(saved(-1));
- end;
-exit:end;
-
-@ The |group_trace| procedure is called when a new level of grouping
-begins (|e=false|) or ends (|e=true|) with |saved(-1)| containing the
-line number.
-
-@<Declare \eTeX\ procedures for tr...@>=
-@!stat procedure group_trace(@!e:boolean);
-begin begin_diagnostic; print_char("{");
-if e then print("leaving ") else print("entering ");
-print_group(e); print_char("}"); end_diagnostic(false);
-end;
-tats
-
-@ The \.{\\currentgrouplevel} and \.{\\currentgrouptype} commands return
-the current level of grouping and the type of the current group
-respectively.
-
-@d current_group_level_code=eTeX_int+1 {code for \.{\\currentgrouplevel}}
-@d current_group_type_code=eTeX_int+2 {code for \.{\\currentgrouptype}}
-
-@<Generate all \eTeX...@>=
-primitive("currentgrouplevel",last_item,current_group_level_code);
-@!@:current_group_level_}{\.{\\currentgrouplevel} primitive@>
-primitive("currentgrouptype",last_item,current_group_type_code);
-@!@:current_group_type_}{\.{\\currentgrouptype} primitive@>
-
-@ @<Cases of |last_item| for |print_cmd_chr|@>=
-current_group_level_code: print_esc("currentgrouplevel");
-current_group_type_code: print_esc("currentgrouptype");
-
-@ @<Cases for fetching an integer value@>=
-current_group_level_code: cur_val:=cur_level-level_one;
-current_group_type_code: cur_val:=cur_group;
-
-@ The \.{\\currentiflevel}, \.{\\currentiftype}, and
-\.{\\currentifbranch} commands return the current level of conditionals
-and the type and branch of the current conditional.
-
-@d current_if_level_code=eTeX_int+3 {code for \.{\\currentiflevel}}
-@d current_if_type_code=eTeX_int+4 {code for \.{\\currentiftype}}
-@d current_if_branch_code=eTeX_int+5 {code for \.{\\currentifbranch}}
-
-@<Generate all \eTeX...@>=
-primitive("currentiflevel",last_item,current_if_level_code);
-@!@:current_if_level_}{\.{\\currentiflevel} primitive@>
-primitive("currentiftype",last_item,current_if_type_code);
-@!@:current_if_type_}{\.{\\currentiftype} primitive@>
-primitive("currentifbranch",last_item,current_if_branch_code);
-@!@:current_if_branch_}{\.{\\currentifbranch} primitive@>
-
-@ @<Cases of |last_item| for |print_cmd_chr|@>=
-current_if_level_code: print_esc("currentiflevel");
-current_if_type_code: print_esc("currentiftype");
-current_if_branch_code: print_esc("currentifbranch");
-
-@ @<Cases for fetching an integer value@>=
-current_if_level_code: begin q:=cond_ptr; cur_val:=0;
- while q<>null do
- begin incr(cur_val); q:=link(q);
- end;
- end;
-current_if_type_code: if cond_ptr=null then cur_val:=0
- else if cur_if<unless_code then cur_val:=cur_if+1
- else cur_val:=-(cur_if-unless_code+1);
-current_if_branch_code:
- if (if_limit=or_code)or(if_limit=else_code) then cur_val:=1
- else if if_limit=fi_code then cur_val:=-1
- else cur_val:=0;
-
-@ The \.{\\fontcharwd}, \.{\\fontcharht}, \.{\\fontchardp}, and
-\.{\\fontcharic} commands return information about a character in a
-font.
-
-@d font_char_wd_code=eTeX_dim {code for \.{\\fontcharwd}}
-@d font_char_ht_code=eTeX_dim+1 {code for \.{\\fontcharht}}
-@d font_char_dp_code=eTeX_dim+2 {code for \.{\\fontchardp}}
-@d font_char_ic_code=eTeX_dim+3 {code for \.{\\fontcharic}}
-
-@<Generate all \eTeX...@>=
-primitive("fontcharwd",last_item,font_char_wd_code);
-@!@:font_char_wd_}{\.{\\fontcharwd} primitive@>
-primitive("fontcharht",last_item,font_char_ht_code);
-@!@:font_char_ht_}{\.{\\fontcharht} primitive@>
-primitive("fontchardp",last_item,font_char_dp_code);
-@!@:font_char_dp_}{\.{\\fontchardp} primitive@>
-primitive("fontcharic",last_item,font_char_ic_code);
-@!@:font_char_ic_}{\.{\\fontcharic} primitive@>
-
-@ @<Cases of |last_item| for |print_cmd_chr|@>=
-font_char_wd_code: print_esc("fontcharwd");
-font_char_ht_code: print_esc("fontcharht");
-font_char_dp_code: print_esc("fontchardp");
-font_char_ic_code: print_esc("fontcharic");
-
-@ @<Cases for fetching a dimension value@>=
-font_char_wd_code,
-font_char_ht_code,
-font_char_dp_code,
-font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num;
- if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
- begin i:=char_info(q)(qi(cur_val));
- case m of
- font_char_wd_code: cur_val:=char_width(q)(i);
- font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
- font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
- font_char_ic_code: cur_val:=char_italic(q)(i);
- end; {there are no other cases}
- end
- else cur_val:=0;
- end;
-
-@ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength}
-commands return the indent and length parameters of the current
-\.{\\parshape} specification.
-
-@d par_shape_length_code=eTeX_dim+4 {code for \.{\\parshapelength}}
-@d par_shape_indent_code=eTeX_dim+5 {code for \.{\\parshapeindent}}
-@d par_shape_dimen_code=eTeX_dim+6 {code for \.{\\parshapedimen}}
-
-@<Generate all \eTeX...@>=
-primitive("parshapelength",last_item,par_shape_length_code);
-@!@:par_shape_length_}{\.{\\parshapelength} primitive@>
-primitive("parshapeindent",last_item,par_shape_indent_code);
-@!@:par_shape_indent_}{\.{\\parshapeindent} primitive@>
-primitive("parshapedimen",last_item,par_shape_dimen_code);
-@!@:par_shape_dimen_}{\.{\\parshapedimen} primitive@>
-
-@ @<Cases of |last_item| for |print_cmd_chr|@>=
-par_shape_length_code: print_esc("parshapelength");
-par_shape_indent_code: print_esc("parshapeindent");
-par_shape_dimen_code: print_esc("parshapedimen");
-
-@ @<Cases for fetching a dimension value@>=
-par_shape_length_code,
-par_shape_indent_code,
-par_shape_dimen_code: begin q:=cur_chr-par_shape_length_code; scan_int;
- if (par_shape_ptr=null)or(cur_val<=0) then cur_val:=0
- else begin if q=2 then
- begin q:=cur_val mod 2; cur_val:=(cur_val+q)div 2;
- end;
- if cur_val>info(par_shape_ptr) then cur_val:=info(par_shape_ptr);
- cur_val:=mem[par_shape_ptr+2*cur_val-q].sc;
- end;
- cur_val_level:=dimen_val;
- end;
-
-@ The \.{\\showgroups} command displays all currently active grouping
-levels.
-
-@d show_groups=4 { \.{\\showgroups} }
-
-@<Generate all \eTeX...@>=
-primitive("showgroups",xray,show_groups);
-@!@:show_groups_}{\.{\\showgroups} primitive@>
-
-@ @<Cases of |xray| for |print_cmd_chr|@>=
-show_groups:print_esc("showgroups");
-
-@ @<Cases for |show_whatever|@>=
-show_groups: begin begin_diagnostic; show_save_groups;
- end;
-
-@ @<Types...@>=
-@!save_pointer=0..save_size; {index into |save_stack|}
-
-@ The modifications of \TeX\ required for the display produced by the
-|show_save_groups| procedure were first discussed by Donald~E. Knuth in
-{\sl TUGboat\/} {\bf 11}, 165--170 and 499--511, 1990.
-@^Knuth, Donald Ervin@>
-
-In order to understand a group type we also have to know its mode.
-Since unrestricted horizontal modes are not associated with grouping,
-they are skipped when traversing the semantic nest.
-
-@<Declare \eTeX\ procedures for use...@>=
-procedure show_save_groups;
-label found1,found2,found,done;
-var p:0..nest_size; {index into |nest|}
-@!m:-mmode..mmode; {mode}
-@!v:save_pointer; {saved value of |save_ptr|}
-@!l:quarterword; {saved value of |cur_level|}
-@!c:group_code; {saved value of |cur_group|}
-@!a:-1..1; {to keep track of alignments}
-@!i:integer;
-@!j:quarterword;
-@!s:str_number;
-begin p:=nest_ptr; nest[p]:=cur_list; {put the top level into the array}
-v:=save_ptr; l:=cur_level; c:=cur_group;
-save_ptr:=cur_boundary; decr(cur_level);@/
-a:=1;
-print_nl(""); print_ln;
-loop@+begin print_nl("### "); print_group(true);
- if cur_group=bottom_level then goto done;
- repeat m:=nest[p].mode_field;
- if p>0 then decr(p) else m:=vmode;
- until m<>hmode;
- print(" (");
- case cur_group of
- simple_group: begin incr(p); goto found2;
- end;
- hbox_group,adjusted_hbox_group: s:="hbox";
- vbox_group: s:="vbox";
- vtop_group: s:="vtop";
- align_group: if a=0 then
- begin if m=-vmode then s:="halign" else s:="valign";
- a:=1; goto found1;
- end
- else begin if a=1 then print("align entry") else print_esc("cr");
- if p>=a then p:=p-a;
- a:=0; goto found;
- end;
- no_align_group:
- begin incr(p); a:=-1; print_esc("noalign"); goto found2;
- end;
- output_group:
- begin print_esc("output"); goto found;
- end;
- math_group: goto found2;
- disc_group,math_choice_group:
- begin if cur_group=disc_group then print_esc("discretionary")
- else print_esc("mathchoice");
- for i:=1 to 3 do if i<=saved(-2) then print("{}");
- goto found2;
- end;
- insert_group:
- begin if saved(-2)=255 then print_esc("vadjust")
- else begin print_esc("insert"); print_int(saved(-2));
- end;
- goto found2;
- end;
- vcenter_group: begin s:="vcenter"; goto found1;
- end;
- semi_simple_group: begin incr(p); print_esc("begingroup"); goto found;
- end;
- math_shift_group:
- begin if m=mmode then print_char("$")
- else if nest[p].mode_field=mmode then
- begin print_cmd_chr(eq_no,saved(-2)); goto found;
- end;
- print_char("$"); goto found;
- end;
- math_left_group:
- begin if type(nest[p+1].eTeX_aux_field)=left_noad then print_esc("left")
- else print_esc("middle");
- goto found;
- end;
- end; {there are no other cases}
- @<Show the box context@>;
- found1: print_esc(s); @<Show the box packaging info@>;
- found2: print_char("{");
- found: print_char(")"); decr(cur_level);
- cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
- end;
-done: save_ptr:=v; cur_level:=l; cur_group:=c;
-end;
-
-@ @<Show the box packaging info@>=
-if saved(-2)<>0 then
- begin print_char(" ");
- if saved(-3)=exactly then print("to") else print("spread");
- print_scaled(saved(-2)); print("pt");
- end
-
-@ @<Show the box context@>=
-i:=saved(-4);
-if i<>0 then
- if i<box_flag then
- begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove;
- if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1);
- print_scaled(abs(i)); print("pt");
- end
- else if i<ship_out_flag then
- begin if i>=global_box_flag then
- begin print_esc("global"); i:=i-(global_box_flag-box_flag);
- end;
- print_esc("setbox"); print_int(i-box_flag); print_char("=");
- end
- else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders))
-
-@ The |scan_general_text| procedure is much like |scan_toks(false,false)|,
-but will be invoked via |expand|, i.e., recursively.
-@^recursion@>
-
-@<Declare \eTeX\ procedures for sc...@>=
-procedure@?scan_general_text; forward;@t\2@>
-
-@ The token list (balanced text) created by |scan_general_text| begins
-at |link(temp_head)| and ends at |cur_val|. (If |cur_val=temp_head|,
-the list is empty.)
-
-@<Declare \eTeX\ procedures for tok...@>=
-procedure scan_general_text;
-label found;
-var s:normal..absorbing; {to save |scanner_status|}
-@!w:pointer; {to save |warning_index|}
-@!d:pointer; {to save |def_ref|}
-@!p:pointer; {tail of the token list being built}
-@!q:pointer; {new node being added to the token list via |store_new_token|}
-@!unbalance:halfword; {number of unmatched left braces}
-begin s:=scanner_status; w:=warning_index; d:=def_ref;
-scanner_status:=absorbing; warning_index:=cur_cs;
-def_ref:=get_avail; token_ref_count(def_ref):=null; p:=def_ref;
-scan_left_brace; {remove the compulsory left brace}
-unbalance:=1;
-loop@+ begin get_token;
- if cur_tok<right_brace_limit then
- if cur_cmd<right_brace then incr(unbalance)
- else begin decr(unbalance);
- if unbalance=0 then goto found;
- end;
- store_new_token(cur_tok);
- end;
-found: q:=link(def_ref); free_avail(def_ref); {discard reference count}
-if q=null then cur_val:=temp_head @+ else cur_val:=p;
-link(temp_head):=q;
-scanner_status:=s; warning_index:=w; def_ref:=d;
-end;
-
-@ The \.{\\showtokens} command displays a token list.
-
-@d show_tokens=5 { \.{\\showtokens} , must be odd! }
-
-@<Generate all \eTeX...@>=
-primitive("showtokens",xray,show_tokens);
-@!@:show_tokens_}{\.{\\showtokens} primitive@>
-
-@ @<Cases of |xray| for |print_cmd_chr|@>=
-show_tokens:print_esc("showtokens");
-
-@ The \.{\\unexpanded} primitive prevents expansion of tokens much as
-the result from \.{\\the} applied to a token variable. The
-\.{\\detokenize} primitive converts a token list into a list of
-character tokens much as if the token list were written to a file. We
-use the fact that the command modifiers for \.{\\unexpanded} and
-\.{\\detokenize} are odd whereas those for \.{\\the} and \.{\\showthe}
-are even.
-
-@<Generate all \eTeX...@>=
-primitive("unexpanded",the,1);@/
-@!@:unexpanded_}{\.{\\unexpanded} primitive@>
-primitive("detokenize",the,show_tokens);@/
-@!@:detokenize_}{\.{\\detokenize} primitive@>
-
-@ @<Cases of |the| for |print_cmd_chr|@>=
-else if chr_code=1 then print_esc("unexpanded")
-else print_esc("detokenize")
-
-@ @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>=
-if odd(cur_chr) then
- begin c:=cur_chr; scan_general_text;
- if c=1 then the_toks:=cur_val
- else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
- p:=get_avail; link(p):=link(temp_head);
- token_show(p); flush_list(p);
- selector:=old_setting; the_toks:=str_toks(b);
- end;
- return;
- end
-
-@ The \.{\\showifs} command displays all currently active conditionals.
-
-@d show_ifs=6 { \.{\\showifs} }
-
-@<Generate all \eTeX...@>=
-primitive("showifs",xray,show_ifs);
-@!@:show_ifs_}{\.{\\showifs} primitive@>
-
-@ @<Cases of |xray| for |print_cmd_chr|@>=
-show_ifs:print_esc("showifs");
-
-@
-@d print_if_line(#)==if #<>0 then
- begin print(" entered on line "); print_int(#);
- end
-
-@<Cases for |show_whatever|@>=
-show_ifs: begin begin_diagnostic; print_nl(""); print_ln;
- if cond_ptr=null then
- begin print_nl("### "); print("no active conditionals");
- end
- else begin p:=cond_ptr; n:=0;
- repeat incr(n); p:=link(p);@+until p=null;
- p:=cond_ptr; t:=cur_if; l:=if_line; m:=if_limit;
- repeat print_nl("### level "); print_int(n); print(": ");
- print_cmd_chr(if_test,t);
- if m=fi_code then print_esc("else");
- print_if_line(l);
- decr(n); t:=subtype(p); l:=if_line_field(p); m:=type(p); p:=link(p);
- until p=null;
- end;
- end;
-
-@ The \.{\\interactionmode} primitive allows to query and set the
-interaction mode.
-
-@<Generate all \eTeX...@>=
-primitive("interactionmode",set_page_int,2);
-@!@:interaction_mode_}{\.{\\interactionmode} primitive@>
-
-@ @<Cases of |set_page_int| for |print_cmd_chr|@>=
-else if chr_code=2 then print_esc("interactionmode")
-
-@ @<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>=
-else if m=2 then cur_val:=interaction
-
-@ @<Declare \eTeX\ procedures for use...@>=
-procedure@?new_interaction; forward;@t\2@>
-
-@ @<Cases for |alter_integer|@>=
-else if c=2 then
- begin if (cur_val<batch_mode)or(cur_val>error_stop_mode) then
- begin print_err("Bad interaction mode");
-@.Bad interaction mode@>
- help2("Modes are 0=batch, 1=nonstop, 2=scroll, and")@/
- ("3=errorstop. Proceed, and I'll ignore this case.");
- int_error(cur_val);
- end
- else begin cur_chr:=cur_val; new_interaction;
- end;
- end
-
-@ The |middle| feature of \eTeX\ allows one ore several \.{\\middle}
-delimiters to appear between \.{\\left} and \.{\\right}.
-
-@<Generate all \eTeX...@>=
-primitive("middle",left_right,middle_noad);
-@!@:middle_}{\.{\\middle} primitive@>
-
-@ @<Cases of |left_right| for |print_cmd_chr|@>=
-else if chr_code=middle_noad then print_esc("middle")
-
-@ In constructions such as
-$$\vbox{\halign{\.{#}\hfil\cr
-{}\\hbox to \\hsize\{\cr
-\hskip 25pt \\hskip 0pt plus 0.0001fil\cr
-\hskip 25pt ...\cr
-\hskip 25pt \\hfil\\penalty-200\\hfilneg\cr
-\hskip 25pt ...\}\cr}}$$
-the stretch components of \.{\\hfil} and \.{\\hfilneg} compensate; they may,
-however, get modified in order to prevent arithmetic overflow during
-|hlist_out| when each of them is multiplied by a large |glue_set| value.
-
-Since this ``glue rounding'' depends on state variables |cur_g| and
-|cur_glue| and \TeXXeT\ is supposed to emulate the behavior of \TeXeT\
-(plus a suitable postprocessor) as close as possible the glue rounding
-cannot be postponed until (segments of) an hlist has been reversed.
-
-The code below is invoked after the effective width, |rule_wd|, of a glue
-node has been computed. The glue node is either converted into a kern node
-or, for leaders, the glue specification is replaced by an equivalent rigid
-one; the subtype of the glue node remains unchanged.
-
-@<Handle a glue node for mixed...@>=
-if (((g_sign=stretching) and (stretch_order(g)=g_order)) or
- ((g_sign=shrinking) and (shrink_order(g)=g_order))) then
- begin fast_delete_glue_ref(g);
- if subtype(p)<a_leaders then
- begin type(p):=kern_node; width(p):=rule_wd;
- end
- else begin g:=get_node(glue_spec_size);@/
- stretch_order(g):=filll+1; shrink_order(g):=filll+1; {will never match}
- width(g):=rule_wd; stretch(g):=0; shrink(g):=0; glue_ptr(p):=g;
- end;
- end
-
-@ The optional |TeXXeT| feature of \eTeX\ contains the code for mixed
-left-to-right and right-to-left typesetting. This code is inspired by
-but different from \TeXeT\ as presented by Donald~E. Knuth and Pierre
-MacKay in {\sl TUGboat\/} {\bf 8}, 14--25, 1987.
-@^Knuth, Donald Ervin@>
-@^MacKay, Pierre@>
-
-In order to avoid confusion with \TeXeT\ the present implementation of
-mixed direction typesetting is called \TeXXeT. It differs from \TeXeT\
-in several important aspects: (1)~Right-to-left text is reversed
-explicitly by the |ship_out| routine and is written to a normal \.{DVI}
-file without any |begin_reflect| or |end_reflect| commands; (2)~a
-|math_node| is (ab)used instead of a |whatsit_node| to record the
-\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} text direction
-primitives in order to keep the influence on the line breaking algorithm
-for pure left-to-right text as small as possible; (3)~right-to-left text
-interrupted by a displayed equation is automatically resumed after that
-equation; and (4)~the |valign| command code with a non-zero command
-modifier is (ab)used for the text direction primitives.
-
-Nevertheless there is a subtle difference between \TeX\ and \TeXXeT\
-that may influence the line breaking algorithm for pure left-to-right
-text. When a paragraph containing math mode material is broken into
-lines \TeX\ may generate lines where math mode material is not enclosed
-by properly nested \.{\\mathon} and \.{\\mathoff} nodes. Unboxing such
-lines as part of a new paragraph may have the effect that hyphenation is
-attempted for `words' originating from math mode or that hyphenation is
-inhibited for words originating from horizontal mode.
-
-In \TeXXeT\ additional \.{\\beginM}, resp.\ \.{\\endM} math nodes are
-supplied at the start, resp.\ end of lines such that math mode material
-inside a horizontal list always starts with either \.{\\mathon} or
-\.{\\beginM} and ends with \.{\\mathoff} or \.{\\endM}. These
-additional nodes are transparent to operations such as \.{\\unskip},
-\.{\\lastpenalty}, or \.{\\lastbox} but they do have the effect that
-hyphenation is never attempted for `words' originating from math mode
-and is never inhibited for words originating from horizontal mode.
-
-@d TeXXeT_state==eTeX_state(TeXXeT_code)
-@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?}
-
-@<Cases for |print_param|@>=
-eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate");
-
-@ @<Generate all \eTeX...@>=
-primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code);
-@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@>
-primitive("beginL",valign,begin_L_code);
-@!@:beginL_}{\.{\\beginL} primitive@>
-primitive("endL",valign,end_L_code);
-@!@:endL_}{\.{\\endL} primitive@>
-primitive("beginR",valign,begin_R_code);
-@!@:beginR_}{\.{\\beginR} primitive@>
-primitive("endR",valign,end_R_code);
-@!@:endR_}{\.{\\endR} primitive@>
-
-@ @<Cases of |valign| for |print_cmd_chr|@>=
-else case chr_code of
- begin_L_code: print_esc("beginL");
- end_L_code: print_esc("endL");
- begin_R_code: print_esc("beginR");
- othercases print_esc("endR")
- endcases
-
-@ @<Cases of |main_control| for |hmode+valign|@>=
-if cur_chr>0 then
- begin if eTeX_enabled(TeXXeT_en,cur_cmd,cur_chr) then
-@.Improper \\beginL@>
-@.Improper \\endL@>
-@.Improper \\beginR@>
-@.Improper \\endR@>
- tail_append(new_math(0,cur_chr));
- end
-else
-
-@ An hbox with subtype dlist will never be reversed, even when embedded
-in right-to-left text.
-
-@<Display if this box is never to be reversed@>=
-if (type(p)=hlist_node)and(box_lr(p)=dlist) then print(", display")
-
-@ A number of routines are based on a stack of one-word nodes whose
-|info| fields contain |end_M_code|, |end_L_code|, or |end_R_code|. The
-top of the stack is pointed to by |LR_ptr|.
-
-When the stack manipulation macros of this section are used below,
-variable |LR_ptr| might be the global variable declared here for |hpack|
-and |ship_out|, or might be local to |post_line_break|.
-
-@d put_LR(#)==begin temp_ptr:=get_avail; info(temp_ptr):=#;
- link(temp_ptr):=LR_ptr; LR_ptr:=temp_ptr;
- end
-@#
-@d push_LR(#)==put_LR(end_LR_type(#))
-@#
-@d pop_LR==begin temp_ptr:=LR_ptr; LR_ptr:=link(temp_ptr);
- free_avail(temp_ptr);
- end
-
-@<Glob...@>=
-@!LR_ptr:pointer; {stack of LR codes for |hpack|, |ship_out|, and |init_math|}
-@!LR_problems:integer; {counts missing begins and ends}
-@!cur_dir:small_number; {current text direction}
-
-@ @<Set init...@>=
-LR_ptr:=null; LR_problems:=0; cur_dir:=left_to_right;
-
-@ @<Insert LR nodes at the beg...@>=
-begin q:=link(temp_head);
-if LR_ptr<>null then
- begin temp_ptr:=LR_ptr; r:=q;
- repeat s:=new_math(0,begin_LR_type(info(temp_ptr))); link(s):=r; r:=s;
- temp_ptr:=link(temp_ptr);
- until temp_ptr=null;
- link(temp_head):=r;
- end;
-while q<>cur_break(cur_p) do
- begin if not is_char_node(q) then
- if type(q)=math_node then @<Adjust \(t)the LR stack for the |p...@>;
- q:=link(q);
- end;
-end
-
-@ @<Adjust \(t)the LR stack for the |p...@>=
-if end_LR(q) then
- begin if LR_ptr<>null then if info(LR_ptr)=end_LR_type(q) then pop_LR;
- end
-else push_LR(q)
-
-@ We use the fact that |q| now points to the node with \.{\\rightskip} glue.
-
-@<Insert LR nodes at the end...@>=
-if LR_ptr<>null then
- begin s:=temp_head; r:=link(s);
- while r<>q do
- begin s:=r; r:=link(s);
- end;
- r:=LR_ptr;
- while r<>null do
- begin temp_ptr:=new_math(0,info(r));
- link(s):=temp_ptr; s:=temp_ptr; r:=link(r);
- end;
- link(s):=q;
- end
-
-@ @<Initialize the LR stack@>=
-put_LR(before) {this will never match}
-
-@ @<Adjust \(t)the LR stack for the |hp...@>=
-if end_LR(p) then
- if info(LR_ptr)=end_LR_type(p) then pop_LR
- else begin incr(LR_problems); type(p):=kern_node; subtype(p):=explicit;
- end
-else push_LR(p)
-
-@ @<Check for LR anomalies at the end of |hp...@>=
-begin if info(LR_ptr)<>before then
- begin while link(q)<>null do q:=link(q);
- repeat temp_ptr:=q; q:=new_math(0,info(LR_ptr)); link(temp_ptr):=q;
- LR_problems:=LR_problems+10000; pop_LR;
- until info(LR_ptr)=before;
- end;
-if LR_problems>0 then
- begin @<Report LR problems@>; goto common_ending;
- end;
-pop_LR;
-if LR_ptr<>null then confusion("LR1");
-@:this can't happen LR1}{\quad LR1@>
-end
-
-@ @<Report LR problems@>=
-begin print_ln; print_nl("\endL or \endR problem (");@/
-print_int(LR_problems div 10000); print(" missing, ");@/
-print_int(LR_problems mod 10000); print(" extra");@/
-LR_problems:=0;
-end
-
-@ @<Initialize |hlist_out| for mixed...@>=
-if eTeX_ex then
- begin @<Initialize the LR stack@>;
- if box_lr(this_box)=dlist then
- if cur_dir=right_to_left then
- begin cur_dir:=left_to_right; cur_h:=cur_h-width(this_box);
- end
- else set_box_lr(this_box)(0);
- if (cur_dir=right_to_left)and(box_lr(this_box)<>reversed) then
- @<Reverse the complete hlist and set the subtype to |reversed|@>;
- end
-
-@ @<Finish |hlist_out| for mixed...@>=
-if eTeX_ex then
- begin @<Check for LR anomalies at the end of |hlist_out|@>;
- if box_lr(this_box)=dlist then cur_dir:=right_to_left;
- end
-
-@ @<Handle a math node in |hlist_out|@>=
-begin if eTeX_ex then
- @<Adjust \(t)the LR stack for the |hlist_out| routine; if necessary
- reverse an hlist segment and |goto reswitch|@>;
- cur_h:=cur_h+width(p);
- end
-
-@ Breaking a paragraph into lines while \TeXXeT\ is disabled may result
-in lines with unpaired math nodes. Such hlists are silently accepted
-in the absence of text direction directives.
-
-@d LR_dir(#)==(subtype(#) div R_code) {text direction of a `math node'}
-
-@<Adjust \(t)the LR stack for the |hl...@>=
-begin if end_LR(p) then
- if info(LR_ptr)=end_LR_type(p) then pop_LR
- else begin if subtype(p)>L_code then incr(LR_problems);
- end
-else begin push_LR(p);
- if LR_dir(p)<>cur_dir then
- @<Reverse an hlist segment and |goto reswitch|@>;
- end;
-type(p):=kern_node;
-end
-
-@ @<Check for LR anomalies at the end of |hl...@>=
-begin while info(LR_ptr)<>before do
- begin if info(LR_ptr)>L_code then LR_problems:=LR_problems+10000;
- pop_LR;
- end;
-pop_LR;
-end
-
-@ @d edge_node=style_node {a |style_node| does not occur in hlists}
-@d edge_node_size=style_node_size {number of words in an edge node}
-@d edge_dist(#)==depth(#) {new |left_edge| position relative to |cur_h|
- (after |width| has been taken into account)}
-
-@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
-function new_edge(@!s:small_number;@!w:scaled):pointer;
- {create an edge node}
-var p:pointer; {the new node}
-begin p:=get_node(edge_node_size); type(p):=edge_node; subtype(p):=s;
-width(p):=w; edge_dist(p):=0; {the |edge_dist| field will be set later}
-new_edge:=p;
-end;
-
-@ @<Cases of |hlist_out| that arise...@>=
-edge_node: begin cur_h:=cur_h+width(p);
- left_edge:=cur_h+edge_dist(p); cur_dir:=subtype(p);
- end;
-
-@ We detach the hlist, start a new one consisting of just one kern node,
-append the reversed list, and set the width of the kern node.
-
-@<Reverse the complete hlist...@>=
-begin save_h:=cur_h; temp_ptr:=p; p:=new_kern(0); link(prev_p):=p;
-cur_h:=0; link(p):=reverse(this_box,null,cur_g,cur_glue); width(p):=-cur_h;
-cur_h:=save_h; set_box_lr(this_box)(reversed);
-end
-
-@ We detach the remainder of the hlist, replace the math node by
-an edge node, and append the reversed hlist segment to it; the tail of
-the reversed segment is another edge node and the remainder of the
-original list is attached to it.
-
-@<Reverse an hlist segment...@>=
-begin save_h:=cur_h; temp_ptr:=link(p); rule_wd:=width(p);
-free_node(p,small_node_size);
-cur_dir:=reflected; p:=new_edge(cur_dir,rule_wd); link(prev_p):=p;
-cur_h:=cur_h-left_edge+rule_wd;
-link(p):=reverse(this_box,new_edge(reflected,0),cur_g,cur_glue);
-edge_dist(p):=cur_h; cur_dir:=reflected; cur_h:=save_h;
-goto reswitch;
-end
-
-@ The |reverse| function defined here is responsible to reverse the
-nodes of an hlist (segment). The first parameter |this_box| is the enclosing
-hlist node, the second parameter |t| is to become the tail of the reversed
-list, and the global variable |temp_ptr| is the head of the list to be
-reversed. Finally |cur_g| and |cur_glue| are the current glue rounding state
-variables, to be updated by this function. We remove nodes from the original
-list and add them to the head of the new one.
-
-@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
-function reverse(@!this_box,@!t:pointer; var cur_g:scaled;
- var cur_glue:real):pointer;
-label reswitch,next_p,done;
-var l:pointer; {the new list}
-@!p:pointer; {the current node}
-@!q:pointer; {the next node}
-@!g_order: glue_ord; {applicable order of infinity for glue}
-@!g_sign: normal..shrinking; {selects type of glue}
-@!glue_temp:real; {glue value before rounding}
-@!m,@!n:halfword; {count of unmatched math nodes}
-begin g_order:=glue_order(this_box); g_sign:=glue_sign(this_box);
-l:=t; p:=temp_ptr; m:=min_halfword; n:=min_halfword;
-loop@+ begin while p<>null do
- @<Move node |p| to the new list and go to the next node;
- or |goto done| if the end of the reflected segment has been reached@>;
- if (t=null)and(m=min_halfword)and(n=min_halfword) then goto done;
- p:=new_math(0,info(LR_ptr)); LR_problems:=LR_problems+10000;
- {manufacture one missing math node}
- end;
-done:reverse:=l;
-end;
-
-@ @<Move node |p| to the new list...@>=
-reswitch: if is_char_node(p) then
- repeat f:=font(p); c:=character(p);
- cur_h:=cur_h+char_width(f)(char_info(f)(c));
- q:=link(p); link(p):=l; l:=p; p:=q;
- until not is_char_node(p)
-else @<Move the non-|char_node| |p| to the new list@>
-
-@ @<Move the non-|char_node| |p| to the new list@>=
-begin q:=link(p);
-case type(p) of
-hlist_node,vlist_node,rule_node,kern_node: rule_wd:=width(p);
-@t\4@>@<Cases of |reverse| that need special treatment@>@;
-edge_node: confusion("LR2");
-@:this can't happen LR2}{\quad LR2@>
-othercases goto next_p
-endcases;@/
-cur_h:=cur_h+rule_wd;
-next_p: link(p):=l;
-if type(p)=kern_node then if (rule_wd=0)or(l=null) then
- begin free_node(p,small_node_size); p:=l;
- end;
-l:=p; p:=q;
-end
-
-@ Here we compute the effective width of a glue node as in |hlist_out|.
-
-@<Cases of |reverse|...@>=
-glue_node: begin round_glue;
- @<Handle a glue node for mixed...@>;
- end;
-
-@ A ligature node is replaced by a char node.
-
-@<Cases of |reverse|...@>=
-ligature_node: begin flush_node_list(lig_ptr(p));
- temp_ptr:=p; p:=get_avail; mem[p]:=mem[lig_char(temp_ptr)]; link(p):=q;
- free_node(temp_ptr,small_node_size); goto reswitch;
- end;
-
-@ Math nodes in an inner reflected segment are modified, those at the
-outer level are changed into kern nodes.
-
-@<Cases of |reverse|...@>=
-math_node: begin rule_wd:=width(p);
-if end_LR(p) then
- if info(LR_ptr)<>end_LR_type(p) then
- begin type(p):=kern_node; incr(LR_problems);
- end
- else begin pop_LR;
- if n>min_halfword then
- begin decr(n); decr(subtype(p)); {change |after| into |before|}
- end
- else begin type(p):=kern_node;
- if m>min_halfword then decr(m)
- else @<Finish the reversed hlist segment and |goto done|@>;
- end;
- end
-else begin push_LR(p);
- if (n>min_halfword)or(LR_dir(p)<>cur_dir) then
- begin incr(n); incr(subtype(p)); {change |before| into |after|}
- end
- else begin type(p):=kern_node; incr(m);
- end;
- end;
-end;
-
-@ Finally we have found the end of the hlist segment to be reversed; the
-final math node is released and the remaining list attached to the
-edge node terminating the reversed segment.
-
-@<Finish the reversed...@>=
-begin free_node(p,small_node_size);
-link(t):=q; width(t):=rule_wd; edge_dist(t):=-cur_h-rule_wd; goto done;
-end
-
-@ @<Check for LR anomalies at the end of |s...@>=
-begin if LR_problems>0 then
- begin @<Report LR problems@>; print_char(")"); print_ln;
- end;
-if (LR_ptr<>null)or(cur_dir<>left_to_right) then confusion("LR3");
-@:this can't happen LR3}{\quad LR3@>
-end
-
-@ Some special actions are required for displayed equation in paragraphs
-with mixed direction texts. First of all we have to set the text
-direction preceding the display.
-
-@<Set the value of |x| to the text direction before the display@>=
-if LR_save=null then x:=0
-else if info(LR_save)>=R_code then x:=-1@+else x:=1
-
-@ @<Prepare for display after an empty...@>=
-begin pop_nest; @<Set the value of |x|...@>;
-end
-
-@ When calculating the natural width, |w|, of the final line preceding
-the display, we may have to copy all or part of its hlist. We copy,
-however, only those parts of the original list that are relevant for the
-computation of |pre_display_size|.
-@^data structure assumptions@>
-
-@<Declare subprocedures for |init_math|@>=
-procedure just_copy(@!p,@!h,@!t:pointer);
-label found,not_found;
-var @!r:pointer; {current node being fabricated for new list}
-@!words:0..5; {number of words remaining to be copied}
-begin while p<>null do
- begin words:=1; {this setting occurs in more branches than any other}
- if is_char_node(p) then r:=get_avail
- else case type(p) of
- hlist_node,vlist_node: begin r:=get_node(box_node_size);
- mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
- words:=5; list_ptr(r):=null; {this affects |mem[r+5]|}
- end;
- rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size;
- end;
- ligature_node: begin r:=get_avail; {only |font| and |character| are needed}
- mem[r]:=mem[lig_char(p)]; goto found;
- end;
- kern_node,math_node: begin r:=get_node(small_node_size);
- words:=small_node_size;
- end;
- glue_node: begin r:=get_node(small_node_size); add_glue_ref(glue_ptr(p));
- glue_ptr(r):=glue_ptr(p); leader_ptr(r):=null;
- end;
- whatsit_node:@<Make a partial copy of the whatsit...@>;
- othercases goto not_found
- endcases;
- while words>0 do
- begin decr(words); mem[r+words]:=mem[p+words];
- end;
- found: link(h):=r; h:=r;
- not_found: p:=link(p);
- end;
-link(h):=t;
-end;
-
-@ When the final line ends with R-text, the value |w| refers to the line
-reflected with respect to the left edge of the enclosing vertical list.
-
-@<Prepare for display after a non-empty...@>=
-if eTeX_ex then @<Let |j| be the prototype box for the display@>;
-v:=shift_amount(just_box);
-@<Set the value of |x|...@>;
-if x>=0 then
- begin p:=list_ptr(just_box); link(temp_head):=null;
- end
-else begin v:=-v-width(just_box);
- p:=new_math(0,begin_L_code); link(temp_head):=p;
- just_copy(list_ptr(just_box),p,new_math(0,end_L_code));
- cur_dir:=right_to_left;
- end;
-v:=v+2*quad(cur_font);
-if TeXXeT_en then @<Initialize the LR stack@>
-
-@ @<Finish the natural width computation@>=
-if TeXXeT_en then
- begin while LR_ptr<>null do pop_LR;
- if LR_problems<>0 then
- begin w:=max_dimen; LR_problems:=0;
- end;
- end;
-cur_dir:=left_to_right; flush_node_list(link(temp_head))
-
-@ In the presence of text direction directives we assume that any LR
-problems have been fixed by the |hpack| routine. If the final line
-contains, however, text direction directives while \TeXXeT\ is disabled,
-then we set |w:=max_dimen|.
-
-@<Cases of `Let |d| be the natural...@>=
-math_node: begin d:=width(p);
- if TeXXeT_en then @<Adjust \(t)the LR stack for the |init_math| routine@>
- else if subtype(p)>=L_code then
- begin w:=max_dimen; goto done;
- end;
- end;
-edge_node: begin d:=width(p); cur_dir:=subtype(p);
- end;
-
-@ @<Adjust \(t)the LR stack for the |i...@>=
-if end_LR(p) then
- begin if info(LR_ptr)=end_LR_type(p) then pop_LR
- else if subtype(p)>L_code then
- begin w:=max_dimen; goto done;
- end
- end
-else begin push_LR(p);
- if LR_dir(p)<>cur_dir then
- begin just_reverse(p); p:=temp_head;
- end;
- end
-
-@ @<Declare subprocedures for |init_math|@>=
-procedure just_reverse(@!p:pointer);
-label found,done;
-var l:pointer; {the new list}
-@!t:pointer; {tail of reversed segment}
-@!q:pointer; {the next node}
-@!m,@!n:halfword; {count of unmatched math nodes}
-begin m:=min_halfword; n:=min_halfword;
-if link(temp_head)=null then
- begin just_copy(link(p),temp_head,null); q:=link(temp_head);
- end
-else begin q:=link(p); link(p):=null; flush_node_list(link(temp_head));
- end;
-t:=new_edge(cur_dir,0); l:=t; cur_dir:=reflected;
-while q<>null do
- if is_char_node(q) then
- repeat p:=q; q:=link(p); link(p):=l; l:=p;
- until not is_char_node(q)
- else begin p:=q; q:=link(p);
- if type(p)=math_node then
- @<Adjust \(t)the LR stack for the |just_reverse| routine@>;
- link(p):=l; l:=p;
- end;
-goto done;
-found:width(t):=width(p); link(t):=q; free_node(p,small_node_size);
-done:link(temp_head):=l;
-end;
-
-@ @<Adjust \(t)the LR stack for the |j...@>=
-if end_LR(p) then
- if info(LR_ptr)<>end_LR_type(p) then
- begin type(p):=kern_node; incr(LR_problems);
- end
- else begin pop_LR;
- if n>min_halfword then
- begin decr(n); decr(subtype(p)); {change |after| into |before|}
- end
- else begin if m>min_halfword then decr(m)@+else goto found;
- type(p):=kern_node;
- end;
- end
-else begin push_LR(p);
- if (n>min_halfword)or(LR_dir(p)<>cur_dir) then
- begin incr(n); incr(subtype(p)); {change |before| into |after|}
- end
- else begin type(p):=kern_node; incr(m);
- end;
- end
-
-@ The prototype box is an hlist node with the width, glue set, and shift
-amount of |just_box|, i.e., the last line preceding the display. Its
-hlist reflects the current \.{\\leftskip} and \.{\\rightskip}.
-
-@<Let |j| be the prototype box for the display@>=
-begin if right_skip=zero_glue then j:=new_kern(0)
-else j:=new_param_glue(right_skip_code);
-if left_skip=zero_glue then p:=new_kern(0)
-else p:=new_param_glue(left_skip_code);
-link(p):=j; j:=new_null_box; width(j):=width(just_box);
-shift_amount(j):=shift_amount(just_box); list_ptr(j):=p;
-glue_order(j):=glue_order(just_box); glue_sign(j):=glue_sign(just_box);
-glue_set(j):=glue_set(just_box);
-end
-
-@ At the end of a displayed equation we retrieve the prototype box.
-
-@<Local variables for finishing...@>=
-@!j:pointer; {prototype box}
-
-@ @<Retrieve the prototype box@>=
-if mode=mmode then j:=LR_box
-
-@ @<Flush the prototype box@>=
-flush_node_list(j)
-
-@ The |app_display| procedure used to append the displayed equation
-and\slash or equation number to the current vertical list has three
-parameters: the prototype box, the hbox to be appended, and the
-displacement of the hbox in the display line.
-
-@<Declare subprocedures for |after_math|@>=
-procedure app_display(@!j,@!b:pointer;@!d:scaled);
-var z:scaled; {width of the line}
-@!s:scaled; {move the line right this much}
-@!e:scaled; {distance from right edge of box to end of line}
-@!x:integer; {|pre_display_direction|}
-@!p,@!q,@!r,@!t,@!u:pointer; {for list manipulation}
-begin s:=display_indent; x:=pre_display_direction;
-if x=0 then shift_amount(b):=s+d
-else begin z:=display_width; p:=b;
- @<Set up the hlist for the display line@>;
- @<Package the display line@>;
- end;
-append_to_vlist(b);
-end;
-
-@ Here we construct the hlist for the display, starting with node |p|
-and ending with node |q|. We also set |d| and |e| to the amount of
-kerning to be added before and after the hlist (adjusted for the
-prototype box).
-
-@<Set up the hlist for the display line@>=
-if x>0 then e:=z-d-width(p)
-else begin e:=d; d:=z-e-width(p);
- end;
-if j<>null then
- begin b:=copy_node_list(j); height(b):=height(p); depth(b):=depth(p);
- s:=s-shift_amount(b); d:=d+s; e:=e+width(b)-z-s;
- end;
-if box_lr(p)=dlist then q:=p {display or equation number}
-else begin {display and equation number}
- r:=list_ptr(p); free_node(p,box_node_size);
- if r=null then confusion("LR4");
- if x>0 then
- begin p:=r;
- repeat q:=r; r:=link(r); {find tail of list}
- until r=null;
- end
- else begin p:=null; q:=r;
- repeat t:=link(r); link(r):=p; p:=r; r:=t; {reverse list}
- until r=null;
- end;
- end
-
-@ In the presence of a prototype box we use its shift amount and width
-to adjust the values of kerning and add these values to the glue nodes
-inserted to cancel the \.{\\leftskip} and \.{\\rightskip}. If there is
-no prototype box (because the display is preceded by an empty
-paragraph), or if the skip parameters are zero, we just add kerns.
-
-The |cancel_glue| macro creates and links a glue node that is, together
-with another glue node, equivalent to a given amount of kerning. We can
-use |j| as temporary pointer, since all we need is |j<>null|.
-
-@d cancel_glue(#)==j:=new_skip_param(#); cancel_glue_cont
-@d cancel_glue_cont(#)==link(#):=j; cancel_glue_cont_cont
-@d cancel_glue_cont_cont(#)==link(j):=#; cancel_glue_end
-@d cancel_glue_end(#)==j:=glue_ptr(#); cancel_glue_end_end
-@d cancel_glue_end_end(#)==
-stretch_order(temp_ptr):=stretch_order(j);
-shrink_order(temp_ptr):=shrink_order(j); width(temp_ptr):=#-width(j);
-stretch(temp_ptr):=-stretch(j); shrink(temp_ptr):=-shrink(j)
-
-@<Package the display line@>=
-if j=null then
- begin r:=new_kern(0); t:=new_kern(0); {the widths will be set later}
- end
-else begin r:=list_ptr(b); t:=link(r);
- end;
-u:=new_math(0,end_M_code);
-if type(t)=glue_node then {|t| is \.{\\rightskip} glue}
- begin cancel_glue(right_skip_code)(q)(u)(t)(e); link(u):=t;
- end
-else begin width(t):=e; link(t):=u; link(q):=t;
- end;
-u:=new_math(0,begin_M_code);
-if type(r)=glue_node then {|r| is \.{\\leftskip} glue}
- begin cancel_glue(left_skip_code)(u)(p)(r)(d); link(r):=u;
- end
-else begin width(r):=d; link(r):=p; link(u):=r;
- if j=null then
- begin b:=hpack(u,natural); shift_amount(b):=s;
- end
- else list_ptr(b):=u;
- end
-
-@ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens}
-primitive.
-
-@<Generate all \eTeX...@>=
-primitive("scantokens",input,2);
-@!@:scan_tokens_}{\.{\\scantokens} primitive@>
-
-@ @<Cases of |input| for |print_cmd_chr|@>=
-else if chr_code=2 then print_esc("scantokens")
-
-@ @<Cases for |input|@>=
-else if cur_chr=2 then pseudo_start
-
-@ The global variable |pseudo_files| is used to maintain a stack of
-pseudo files. The |info| field of each pseudo file points to a linked
-list of variable size nodes representing lines not yet processed: the
-|info| field of the first word contains the size of this node, all the
-following words contain ASCII codes.
-
-@<Glob...@>=
-@!pseudo_files:pointer; {stack of pseudo files}
-
-@ @<Set init...@>=
-pseudo_files:=null;
-
-@ The |pseudo_start| procedure initiates reading from a pseudo file.
-
-@<Declare \eTeX\ procedures for ex...@>=
-procedure@?pseudo_start; forward;@t\2@>
-
-@ @<Declare \eTeX\ procedures for tok...@>=
-procedure pseudo_start;
-var old_setting:0..max_selector; {holds |selector| setting}
-@!s:str_number; {string to be converted into a pseudo file}
-@!l,@!m:pool_pointer; {indices into |str_pool|}
-@!p,@!q,@!r:pointer; {for list construction}
-@!w: four_quarters; {four ASCII codes}
-@!nl,@!sz:integer;
-begin scan_general_text;
-old_setting:=selector; selector:=new_string;
-token_show(temp_head); selector:=old_setting;
-flush_list(link(temp_head));
-str_room(1); s:=make_string;
-@<Convert string |s| into a new pseudo file@>;
-flush_string;
-@<Initiate input from new pseudo file@>;
-end;
-
-@ @<Convert string |s| into a new pseudo file@>=
-str_pool[pool_ptr]:=si(" "); l:=str_start[s];
-nl:=si(new_line_char);
-p:=get_avail; q:=p;
-while l<pool_ptr do
- begin m:=l;
- while (l<pool_ptr)and(str_pool[l]<>nl) do incr(l);
- sz:=(l-m+7)div 4;
- if sz=1 then sz:=2;
- r:=get_node(sz); link(q):=r; q:=r; info(q):=hi(sz);
- while sz>2 do
- begin decr(sz); incr(r);
- w.b0:=qi(so(str_pool[m])); w.b1:=qi(so(str_pool[m+1]));
- w.b2:=qi(so(str_pool[m+2])); w.b3:=qi(so(str_pool[m+3]));
- mem[r].qqqq:=w; m:=m+4;
- end;
- w.b0:=qi(" "); w.b1:=qi(" "); w.b2:=qi(" "); w.b3:=qi(" ");
- if l>m then
- begin w.b0:=qi(so(str_pool[m]));
- if l>m+1 then
- begin w.b1:=qi(so(str_pool[m+1]));
- if l>m+2 then
- begin w.b2:=qi(so(str_pool[m+2]));
- if l>m+3 then w.b3:=qi(so(str_pool[m+3]));
- end;
- end;
- end;
- mem[r+1].qqqq:=w;
- if str_pool[l]=nl then incr(l);
- end;
-info(p):=link(p); link(p):=pseudo_files; pseudo_files:=p
-
-@ @<Initiate input from new pseudo file@>=
-begin_file_reading; {set up |cur_file| and new level of input}
-line:=0; limit:=start; loc:=limit+1; {force line read}
-if tracing_scan_tokens>0 then
- begin if term_offset>max_print_line-3 then print_ln
- else if (term_offset>0)or(file_offset>0) then print_char(" ");
- name:=19; print("( "); incr(open_parens); update_terminal;
- end
-else name:=18
-
-@ Here we read a line from the current pseudo file into |buffer|.
-
-@<Declare \eTeX\ procedures for tr...@>=
-function pseudo_input: boolean; {inputs the next line or returns |false|}
-var p:pointer; {current line from pseudo file}
-@!sz:integer; {size of node |p|}
-@!w:four_quarters; {four ASCII codes}
-@!r:pointer; {loop index}
-begin last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
-p:=info(pseudo_files);
-if p=null then pseudo_input:=false
-else begin info(pseudo_files):=link(p); sz:=ho(info(p));
- if 4*sz-3>=buf_size-last then
- @<Report overflow of the input buffer, and abort@>;
- last:=first;
- for r:=p+1 to p+sz-1 do
- begin w:=mem[r].qqqq;
- buffer[last]:=w.b0; buffer[last+1]:=w.b1;
- buffer[last+2]:=w.b2; buffer[last+3]:=w.b3;
- last:=last+4;
- end;
- if last>=max_buf_stack then max_buf_stack:=last+1;
- while (last>first)and(buffer[last-1]=" ") do decr(last);
- free_node(p,sz);
- pseudo_input:=true;
- end;
-end;
-
-@ When we are done with a pseudo file we `close' it.
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure pseudo_close; {close the top level pseudo file}
-var p,@!q: pointer;
-begin p:=link(pseudo_files); q:=info(pseudo_files);
-free_avail(pseudo_files); pseudo_files:=p;
-while q<>null do
- begin p:=q; q:=link(p); free_node(p,ho(info(p)));
- end;
-end;
-
-@ @<Dump the \eTeX\ state@>=
-while pseudo_files<>null do pseudo_close; {flush pseudo files}
-
-@ @<Generate all \eTeX...@>=
-primitive("readline",read_to_cs,1);@/
-@!@:read_line_}{\.{\\readline} primitive@>
-
-@ @<Cases of |read| for |print_cmd_chr|@>=
-else print_esc("readline")
-
-@ @<Handle \.{\\readline} and |goto done|@>=
-if j=1 then
- begin while loc<=limit do {current line not yet finished}
- begin cur_chr:=buffer[loc]; incr(loc);
- if cur_chr=" " then cur_tok:=space_token
- @+else cur_tok:=cur_chr+other_token;
- store_new_token(cur_tok);
- end;
- goto done;
- end
-
-@ Here we define the additional conditionals of \eTeX\ as well as the
-\.{\\unless} prefix.
-
-@d if_def_code=17 { `\.{\\ifdefined}' }
-@d if_cs_code=18 { `\.{\\ifcsname}' }
-@d if_font_char_code=19 { `\.{\\iffontchar}' }
-@d if_in_csname_code=20 { `\.{\\ifincsname}' }
-@d if_pdfabs_num_code=22 { `\.{\\ifpdfabsnum}' } { 21 = |if_pdfprimitive|}
-@d if_pdfabs_dim_code=23 { `\.{\\ifpdfabsdim}' }
-
-@<Generate all \eTeX...@>=
-primitive("unless",expand_after,1);@/
-@!@:unless_}{\.{\\unless} primitive@>
-primitive("ifdefined",if_test,if_def_code);
-@!@:if_defined_}{\.{\\ifdefined} primitive@>
-primitive("ifcsname",if_test,if_cs_code);
-@!@:if_cs_name_}{\.{\\ifcsname} primitive@>
-primitive("iffontchar",if_test,if_font_char_code);
-@!@:if_font_char_}{\.{\\iffontchar} primitive@>
-primitive("ifincsname",if_test,if_in_csname_code);
-@!@:if_in_csname_}{\.{\\ifincsname} primitive@>
-primitive("ifpdfabsnum",if_test,if_pdfabs_num_code);
-@!@:if_pdfabs_num_}{\.{\\ifpdfabsnum} primitive@>
-primitive("ifpdfabsdim",if_test,if_pdfabs_dim_code);
-@!@:if_pdfabs_dim_}{\.{\\ifpdfabsdim} primitive@>
-
-@ @<Cases of |expandafter| for |print_cmd_chr|@>=
-else print_esc("unless")
-
-@ @<Cases of |if_test| for |print_cmd_chr|@>=
-if_def_code:print_esc("ifdefined");
-if_cs_code:print_esc("ifcsname");
-if_font_char_code:print_esc("iffontchar");
-if_in_csname_code:print_esc("ifincsname");
-if_pdfabs_num_code:print_esc("ifpdfabsnum");
-if_pdfabs_dim_code:print_esc("ifpdfabsdim");
-
-@ The result of a boolean condition is reversed when the conditional is
-preceded by \.{\\unless}.
-
-@<Negate a boolean conditional and |goto reswitch|@>=
-begin get_token;
-if (cur_cmd=if_test)and(cur_chr<>if_case_code) then
- begin cur_chr:=cur_chr+unless_code; goto reswitch;
- end;
-print_err("You can't use `"); print_esc("unless"); print("' before `");
-@.You can't use \\unless...@>
-print_cmd_chr(cur_cmd,cur_chr); print_char("'");
-help1("Continue, and I'll forget that it ever happened.");
-back_error;
-end
-
-@ The conditional \.{\\ifdefined} tests if a control sequence is
-defined.
-
-We need to reset |scanner_status|, since \.{\\outer} control sequences
-are allowed, but we might be scanning a macro definition or preamble.
-
-@<Cases for |conditional|@>=
-if_def_code:begin save_scanner_status:=scanner_status;
- scanner_status:=normal;
- get_next; b:=(cur_cmd<>undefined_cs);
- scanner_status:=save_scanner_status;
- end;
-
-@ The conditional \.{\\ifcsname} is equivalent to \.{\{\\expandafter}
-\.{\}\\expandafter} \.{\\ifdefined} \.{\\csname}, except that no new
-control sequence will be entered into the hash table (once all tokens
-preceding the mandatory \.{\\endcsname} have been expanded).
-
-@<Cases for |conditional|@>=
-if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
- e := is_in_csname; is_in_csname := true;
- repeat get_x_token;
- if cur_cs=0 then store_new_token(cur_tok);
- until cur_cs<>0;
- if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
- @<Look up the characters of list |n| in the hash table, and set |cur_cs|@>;
- flush_list(n);
- b:=(eq_type(cur_cs)<>undefined_cs);
- is_in_csname := e;
- end;
-
-@ @<Look up the characters of list |n| in the hash table...@>=
-m:=first; p:=link(n);
-while p<>null do
- begin if m>=max_buf_stack then
- begin max_buf_stack:=m+1;
- if max_buf_stack=buf_size then
- overflow("buffer size",buf_size);
-@:TeX capacity exceeded buffer size}{\quad buffer size@>
- end;
- buffer[m]:=info(p) mod @'400; incr(m); p:=link(p);
- end;
-if m>first+1 then
- cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|}
-else if m=first then cur_cs:=null_cs {the list is empty}
-else cur_cs:=single_base+buffer[first] {the list has length one}
-
-@ The conditional \.{\\iffontchar} tests the existence of a character in
-a font.
-
-@<Cases for |conditional|@>=
-if_in_csname_code: b := is_in_csname;
-if_pdfabs_dim_code, if_pdfabs_num_code: begin
- if this_if=if_pdfabs_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_pdfabs_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;
- if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then
- b:=char_exists(char_info(n)(qi(cur_val)))
- else b:=false;
- end;
-
-@ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix
-command for macro definitions. Such macros are protected against
-expansions when lists of expanded tokens are built, e.g., for \.{\\edef}
-or during \.{\\write}.
-
-@<Generate all \eTeX...@>=
-primitive("protected",prefix,8);
-@!@:protected_}{\.{\\protected} primitive@>
-
-@ @<Cases of |prefix| for |print_cmd_chr|@>=
-else if chr_code=8 then print_esc("protected")
-
-@ The |get_x_or_protected| procedure is like |get_x_token| except that
-protected macros are not expanded.
-
-@<Declare \eTeX\ procedures for sc...@>=
-procedure get_x_or_protected; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
- and expands non-protected macros}
-label exit;
-begin loop@+begin get_token;
- if cur_cmd<=max_command then return;
- if (cur_cmd>=call)and(cur_cmd<end_template) then
- if info(link(cur_chr))=protected_token then return;
- expand;
- end;
-exit:end;
-
-@ A group entered (or a conditional started) in one file may end in a
-different file. Such slight anomalies, although perfectly legitimate,
-may cause errors that are difficult to locate. In order to be able to
-give a warning message when such anomalies occur, \eTeX\ uses the
-|grp_stack| and |if_stack| arrays to record the initial |cur_boundary|
-and |cond_ptr| values for each input file.
-
-@<Glob...@>=
-@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
-@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
-
-@ When a group ends that was apparently entered in a different input
-file, the |group_warning| procedure is invoked in order to update the
-|grp_stack|. If moreover \.{\\tracingnesting} is positive we want to
-give a warning message. The situation is, however, somewhat complicated
-by two facts: (1)~There may be |grp_stack| elements without a
-corresponding \.{\\input} file or \.{\\scantokens} pseudo file (e.g.,
-error insertions from the terminal); and (2)~the relevant information is
-recorded in the |name_field| of the |input_stack| only loosely
-synchronized with the |in_open| variable indexing |grp_stack|.
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure group_warning;
-var i:0..max_in_open; {index into |grp_stack|}
-@!w:boolean; {do we need a warning?}
-begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
- {store current state}
-i:=in_open; w:=false;
-while (grp_stack[i]=cur_boundary)and(i>0) do
- begin @<Set variable |w| to indicate if this case should be reported@>;
- grp_stack[i]:=save_index(save_ptr); decr(i);
- end;
-if w then
- begin print_nl("Warning: end of "); print_group(true);
-@.Warning: end of...@>
- print(" of a different file"); print_ln;
- if tracing_nesting>1 then show_context;
- if history=spotless then history:=warning_issued;
- end;
-end;
-
-@ This code scans the input stack in order to determine the type of the
-current input file.
-
-@<Set variable |w| to...@>=
-if tracing_nesting>0 then
- begin while (input_stack[base_ptr].state_field=token_list)or@|
- (input_stack[base_ptr].index_field>i) do decr(base_ptr);
- if input_stack[base_ptr].name_field>17 then w:=true;
- end
-
-@ When a conditional ends that was apparently started in a different
-input file, the |if_warning| procedure is invoked in order to update the
-|if_stack|. If moreover \.{\\tracingnesting} is positive we want to
-give a warning message (with the same complications as above).
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure if_warning;
-var i:0..max_in_open; {index into |if_stack|}
-@!w:boolean; {do we need a warning?}
-begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
- {store current state}
-i:=in_open; w:=false;
-while if_stack[i]=cond_ptr do
- begin @<Set variable |w| to...@>;
- if_stack[i]:=link(cond_ptr); decr(i);
- end;
-if w then
- begin print_nl("Warning: end of "); print_cmd_chr(if_test,cur_if);
-@.Warning: end of...@>
- print_if_line(if_line); print(" of a different file"); print_ln;
- if tracing_nesting>1 then show_context;
- if history=spotless then history:=warning_issued;
- end;
-end;
-
-@ Conversely, the |file_warning| procedure is invoked when a file ends
-and some groups entered or conditionals started while reading from that
-file are still incomplete.
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure file_warning;
-var p:pointer; {saved value of |save_ptr| or |cond_ptr|}
-@!l:quarterword; {saved value of |cur_level| or |if_limit|}
-@!c:quarterword; {saved value of |cur_group| or |cur_if|}
-@!i:integer; {saved value of |if_line|}
-begin p:=save_ptr; l:=cur_level; c:=cur_group; save_ptr:=cur_boundary;
-while grp_stack[in_open]<>save_ptr do
- begin decr(cur_level);
- print_nl("Warning: end of file when ");
-@.Warning: end of file when...@>
- print_group(true); print(" is incomplete");@/
- cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
- end;
-save_ptr:=p; cur_level:=l; cur_group:=c; {restore old values}
-p:=cond_ptr; l:=if_limit; c:=cur_if; i:=if_line;
-while if_stack[in_open]<>cond_ptr do
- begin print_nl("Warning: end of file when ");
-@.Warning: end of file when...@>
- print_cmd_chr(if_test,cur_if);
- if if_limit=fi_code then print_esc("else");
- print_if_line(if_line); print(" is incomplete");@/
- if_line:=if_line_field(cond_ptr); cur_if:=subtype(cond_ptr);
- if_limit:=type(cond_ptr); cond_ptr:=link(cond_ptr);
- end;
-cond_ptr:=p; if_limit:=l; cur_if:=c; if_line:=i; {restore old values}
-print_ln;
-if tracing_nesting>1 then show_context;
-if history=spotless then history:=warning_issued;
-end;
-
-@ Here are the additional \eTeX\ primitives for expressions.
-
-@<Generate all \eTeX...@>=
-primitive("numexpr",last_item,eTeX_expr-int_val+int_val);
-@!@:num_expr_}{\.{\\numexpr} primitive@>
-primitive("dimexpr",last_item,eTeX_expr-int_val+dimen_val);
-@!@:dim_expr_}{\.{\\dimexpr} primitive@>
-primitive("glueexpr",last_item,eTeX_expr-int_val+glue_val);
-@!@:glue_expr_}{\.{\\glueexpr} primitive@>
-primitive("muexpr",last_item,eTeX_expr-int_val+mu_val);
-@!@:mu_expr_}{\.{\\muexpr} primitive@>
-
-@ @<Cases of |last_item| for |print_cmd_chr|@>=
-eTeX_expr-int_val+int_val: print_esc("numexpr");
-eTeX_expr-int_val+dimen_val: print_esc("dimexpr");
-eTeX_expr-int_val+glue_val: print_esc("glueexpr");
-eTeX_expr-int_val+mu_val: print_esc("muexpr");
-
-@ This code for reducing |cur_val_level| and\slash or negating the
-result is similar to the one for all the other cases of
-|scan_something_internal|, with the difference that |scan_expr| has
-already increased the reference count of a glue specification.
-
-@<Process an expression and |return|@>=
-begin if m<eTeX_mu then
- begin case m of
- @/@<Cases for fetching a glue value@>@/
- end; {there are no other cases}
- cur_val_level:=glue_val;
- end
-else if m<eTeX_expr then
- begin case m of
- @/@<Cases for fetching a mu value@>@/
- end; {there are no other cases}
- cur_val_level:=mu_val;
- end
-else begin cur_val_level:=m-eTeX_expr+int_val; scan_expr;
- end;
-while cur_val_level>level do
- begin if cur_val_level=glue_val then
- begin m:=cur_val; cur_val:=width(m); delete_glue_ref(m);
- end
- else if cur_val_level=mu_val then mu_error;
- decr(cur_val_level);
- end;
-if negative then
- if cur_val_level>=glue_val then
- begin m:=cur_val; cur_val:=new_spec(m); delete_glue_ref(m);
- @<Negate all three glue components of |cur_val|@>;
- end
- else negate(cur_val);
-return;
-end
-
-@ @<Declare \eTeX\ procedures for sc...@>=
-procedure@?scan_expr; forward;@t\2@>
-
-@ The |scan_expr| procedure scans and evaluates an expression.
-
-@<Declare procedures needed for expressions@>=
-@t\4@>@<Declare subprocedures for |scan_expr|@>
-procedure scan_expr; {scans and evaluates an expression}
-label restart, continue, found;
-var a,@!b:boolean; {saved values of |arith_error|}
-@!l:small_number; {type of expression}
-@!r:small_number; {state of expression so far}
-@!s:small_number; {state of term so far}
-@!o:small_number; {next operation or type of next factor}
-@!e:integer; {expression so far}
-@!t:integer; {term so far}
-@!f:integer; {current factor}
-@!n:integer; {numerator of combined multiplication and division}
-@!p:pointer; {top of expression stack}
-@!q:pointer; {for stack manipulations}
-begin l:=cur_val_level; a:=arith_error; b:=false; p:=null;
-incr(expand_depth_count);
-if expand_depth_count>=expand_depth then overflow("expansion depth",expand_depth);
-@<Scan and evaluate an expression |e| of type |l|@>;
-decr(expand_depth_count);
-if b then
- begin print_err("Arithmetic overflow");
-@.Arithmetic overflow@>
- help2("I can't evaluate this expression,")@/
- ("since the result is out of range.");
- error;
- if l>=glue_val then
- begin delete_glue_ref(e); e:=zero_glue; add_glue_ref(e);
- end
- else e:=0;
- end;
-arith_error:=a; cur_val:=e; cur_val_level:=l;
-end;
-
-@ Evaluating an expression is a recursive process: When the left
-parenthesis of a subexpression is scanned we descend to the next level
-of recursion; the previous level is resumed with the matching right
-parenthesis.
-
-@d expr_none=0 {\.( seen, or \.( $\langle\it expr\rangle$ \.) seen}
-@d expr_add=1 {\.( $\langle\it expr\rangle$ \.+ seen}
-@d expr_sub=2 {\.( $\langle\it expr\rangle$ \.- seen}
-@d expr_mult=3 {$\langle\it term\rangle$ \.* seen}
-@d expr_div=4 {$\langle\it term\rangle$ \./ seen}
-@d expr_scale=5 {$\langle\it term\rangle$ \.*
- $\langle\it factor\rangle$ \./ seen}
-
-@<Scan and eval...@>=
-restart: r:=expr_none; e:=0; s:=expr_none; t:=0; n:=0;
-continue: if s=expr_none then o:=l@+else o:=int_val;
-@<Scan a factor |f| of type |o| or start a subexpression@>;
-found: @<Scan the next operator and set |o|@>;
-arith_error:=b;
-@<Make sure that |f| is in the proper range@>;
-case s of @<Cases for evaluation of the current term@>@;
-end; {there are no other cases}
-if o>expr_sub then s:=o@+else @<Evaluate the current expression@>;
-b:=arith_error;
-if o<>expr_none then goto continue;
-if p<>null then @<Pop the expression stack and |goto found|@>
-
-@ @<Scan the next op...@>=
-@<Get the next non-blank non-call token@>;
-if cur_tok=other_token+"+" then o:=expr_add
-else if cur_tok=other_token+"-" then o:=expr_sub
-else if cur_tok=other_token+"*" then o:=expr_mult
-else if cur_tok=other_token+"/" then o:=expr_div
-else begin o:=expr_none;
- if p=null then
- begin if cur_cmd<>relax then back_input;
- end
- else if cur_tok<>other_token+")" then
- begin print_err("Missing ) inserted for expression");
-@.Missing ) inserted@>
- help1("I was expecting to see `+', `-', `*', `/', or `)'. Didn't.");
- back_error;
- end;
- end
-
-@ @<Scan a factor...@>=
-@<Get the next non-blank non-call token@>;
-if cur_tok=other_token+"(" then
- @<Push the expression stack and |goto restart|@>;
-back_input;
-if o=int_val then scan_int
-else if o=dimen_val then scan_normal_dimen
-else if o=glue_val then scan_normal_glue
-else scan_mu_glue;
-f:=cur_val
-
-@ @<Declare \eTeX\ procedures for sc...@>=
-procedure@?scan_normal_glue; forward;@t\2@>@/
-procedure@?scan_mu_glue; forward;@t\2@>
-
-@ Here we declare two trivial procedures in order to avoid mutually
-recursive procedures with parameters.
-
-@<Declare procedures needed for expressions@>=
-procedure scan_normal_glue;
-begin scan_glue(glue_val);
-end;
-@#
-procedure scan_mu_glue;
-begin scan_glue(mu_val);
-end;
-
-@ Parenthesized subexpressions can be inside expressions, and this
-nesting has a stack. Seven local variables represent the top of the
-expression stack: |p| points to pushed-down entries, if any; |l|
-specifies the type of expression currently being evaluated; |e| is the
-expression so far and |r| is the state of its evaluation; |t| is the
-term so far and |s| is the state of its evaluation; finally |n| is the
-numerator for a combined multiplication and division, if any.
-
-@d expr_node_size=4 {number of words in stack entry for subexpressions}
-@d expr_e_field(#)==mem[#+1].int {saved expression so far}
-@d expr_t_field(#)==mem[#+2].int {saved term so far}
-@d expr_n_field(#)==mem[#+3].int {saved numerator}
-
-@<Push the expression...@>=
-begin q:=get_node(expr_node_size); link(q):=p; type(q):=l;
-subtype(q):=4*s+r;
-expr_e_field(q):=e; expr_t_field(q):=t; expr_n_field(q):=n;
-p:=q; l:=o; goto restart;
-end
-
-@ @<Pop the expression...@>=
-begin f:=e; q:=p;
-e:=expr_e_field(q); t:=expr_t_field(q); n:=expr_n_field(q);
-s:=subtype(q) div 4; r:=subtype(q) mod 4;
-l:=type(q); p:=link(q); free_node(q,expr_node_size);
-goto found;
-end
-
-@ We want to make sure that each term and (intermediate) result is in
-the proper range. Integer values must not exceed |infinity|
-($2^{31}-1$) in absolute value, dimensions must not exceed |max_dimen|
-($2^{30}-1$). We avoid the absolute value of an integer, because this
-might fail for the value $-2^{31}$ using 32-bit arithmetic.
-
-@d num_error(#)== {clear a number or dimension and set |arith_error|}
- begin arith_error:=true; #:=0;
- end
-@d glue_error(#)== {clear a glue spec and set |arith_error|}
- begin arith_error:=true; delete_glue_ref(#); #:=new_spec(zero_glue);
- end
-
-@<Make sure that |f|...@>=
-if (l=int_val)or(s>expr_sub) then
- begin if (f>infinity)or(f<-infinity) then num_error(f);
- end
-else if l=dimen_val then
- begin if abs(f)>max_dimen then num_error(f);
- end
-else begin if (abs(width(f))>max_dimen)or@|
- (abs(stretch(f))>max_dimen)or@|
- (abs(shrink(f))>max_dimen) then glue_error(f);
- end
-
-@ Applying the factor |f| to the partial term |t| (with the operator
-|s|) is delayed until the next operator |o| has been scanned. Here we
-handle the first factor of a partial term. A glue spec has to be copied
-unless the next operator is a right parenthesis; this allows us later on
-to simply modify the glue components.
-
-@d normalize_glue(#)==
- if stretch(#)=0 then stretch_order(#):=normal;
- if shrink(#)=0 then shrink_order(#):=normal
-
-@<Cases for evaluation of the current term@>=
-expr_none: if (l>=glue_val)and(o<>expr_none) then
- begin t:=new_spec(f); delete_glue_ref(f); normalize_glue(t);
- end
- else t:=f;
-
-@ When a term |t| has been completed it is copied to, added to, or
-subtracted from the expression |e|.
-
-@d expr_add_sub(#)==add_or_sub(#,r=expr_sub)
-@d expr_a(#)==expr_add_sub(#,max_dimen)
-
-@<Evaluate the current expression@>=
-begin s:=expr_none;
-if r=expr_none then e:=t
-else if l=int_val then e:=expr_add_sub(e,t,infinity)
-else if l=dimen_val then e:=expr_a(e,t)
-else @<Compute the sum or difference of two glue specs@>;
-r:=o;
-end
-
-@ The function |add_or_sub(x,y,max_answer,negative)| computes the sum
-(for |negative=false|) or difference (for |negative=true|) of |x| and
-|y|, provided the absolute value of the result does not exceed
-|max_answer|.
-
-@<Declare subprocedures for |scan_expr|@>=
-function add_or_sub(@!x,@!y,@!max_answer:integer;@!negative:boolean):integer;
-var a:integer; {the answer}
-begin if negative then negate(y);
-if x>=0 then
- if y<=max_answer-x then a:=x+y@+else num_error(a)
-else if y>=-max_answer-x then a:=x+y@+else num_error(a);
-add_or_sub:=a;
-end;
-
-@ We know that |stretch_order(e)>normal| implies |stretch(e)<>0| and
-|shrink_order(e)>normal| implies |shrink(e)<>0|.
-
-@<Compute the sum or diff...@>=
-begin width(e):=expr_a(width(e),width(t));
-if stretch_order(e)=stretch_order(t) then
- stretch(e):=expr_a(stretch(e),stretch(t))
-else if (stretch_order(e)<stretch_order(t))and(stretch(t)<>0) then
- begin stretch(e):=stretch(t); stretch_order(e):=stretch_order(t);
- end;
-if shrink_order(e)=shrink_order(t) then
- shrink(e):=expr_a(shrink(e),shrink(t))
-else if (shrink_order(e)<shrink_order(t))and(shrink(t)<>0) then
- begin shrink(e):=shrink(t); shrink_order(e):=shrink_order(t);
- end;
-delete_glue_ref(t); normalize_glue(e);
-end
-
-@ If a multiplication is followed by a division, the two operations are
-combined into a `scaling' operation. Otherwise the term |t| is
-multiplied by the factor |f|.
-
-@d expr_m(#)==#:=nx_plus_y(#,f,0)
-
-@<Cases for evaluation of the current term@>=
-expr_mult: if o=expr_div then
- begin n:=f; o:=expr_scale;
- end
- else if l=int_val then t:=mult_integers(t,f)
- else if l=dimen_val then expr_m(t)
- else begin expr_m(width(t)); expr_m(stretch(t)); expr_m(shrink(t));
- end;
-
-@ Here we divide the term |t| by the factor |f|.
-
-@d expr_d(#)==#:=quotient(#,f)
-
-@<Cases for evaluation of the current term@>=
-expr_div: if l<glue_val then expr_d(t)
- else begin expr_d(width(t)); expr_d(stretch(t)); expr_d(shrink(t));
- end;
-
-@ The function |quotient(n,d)| computes the rounded quotient
-$q=\lfloor n/d+{1\over2}\rfloor$, when $n$ and $d$ are positive.
-
-@<Declare subprocedures for |scan_expr|@>=
-function quotient(@!n,@!d:integer):integer;
-var negative:boolean; {should the answer be negated?}
-@!a:integer; {the answer}
-begin if d=0 then num_error(a)
-else begin if d>0 then negative:=false
- else begin negate(d); negative:=true;
- end;
- if n<0 then
- begin negate(n); negative:=not negative;
- end;
- a:=n div d; n:=n-a*d; d:=n-d; {avoid certain compiler optimizations!}
- if d+n>=0 then incr(a);
- if negative then negate(a);
- end;
-quotient:=a;
-end;
-
-@ Here the term |t| is multiplied by the quotient $n/f$.
-
-@d expr_s(#)==#:=fract(#,n,f,max_dimen)
-
-@<Cases for evaluation of the current term@>=
-expr_scale: if l=int_val then t:=fract(t,n,f,infinity)
- else if l=dimen_val then expr_s(t)
- else begin expr_s(width(t)); expr_s(stretch(t)); expr_s(shrink(t));
- end;
-
-@ Finally, the function |fract(x,n,d,max_answer)| computes the integer
-$q=\lfloor xn/d+{1\over2}\rfloor$, when $x$, $n$, and $d$ are positive
-and the result does not exceed |max_answer|. We can't use floating
-point arithmetic since the routine must produce identical results in all
-cases; and it would be too dangerous to multiply by~|n| and then divide
-by~|d|, in separate operations, since overflow might well occur. Hence
-this subroutine simulates double precision arithmetic, somewhat
-analogous to \MF's |make_fraction| and |take_fraction| routines.
-
-@d too_big=88 {go here when the result is too big}
-
-@<Declare subprocedures for |scan_expr|@>=
-function fract(@!x,@!n,@!d,@!max_answer:integer):integer;
-label found, found1, too_big, done;
-var negative:boolean; {should the answer be negated?}
-@!a:integer; {the answer}
-@!f:integer; {a proper fraction}
-@!h:integer; {smallest integer such that |2*h>=d|}
-@!r:integer; {intermediate remainder}
-@!t:integer; {temp variable}
-begin if d=0 then goto too_big;
-a:=0;
-if d>0 then negative:=false
-else begin negate(d); negative:=true;
- end;
-if x<0 then
- begin negate(x); negative:=not negative;
- end
-else if x=0 then goto done;
-if n<0 then
- begin negate(n); negative:=not negative;
- end;
-t:=n div d;
-if t>max_answer div x then goto too_big;
-a:=t*x; n:=n-t*d;
-if n=0 then goto found;
-t:=x div d;
-if t>(max_answer-a) div n then goto too_big;
-a:=a+t*n; x:=x-t*d;
-if x=0 then goto found;
-if x<n then
- begin t:=x; x:=n; n:=t;
- end; {now |0<n<=x<d|}
-@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>@;
-if f>(max_answer-a) then goto too_big;
-a:=a+f;
-found: if negative then negate(a);
-goto done;
-too_big: num_error(a);
-done: fract:=a;
-end;
-
-@ The loop here preserves the following invariant relations
-between |f|, |x|, |n|, and~|r|:
-(i)~$f+\lfloor(xn+(r+d))/d\rfloor=\lfloor x_0n_0/d+{1\over2}\rfloor$;
-(ii)~|-d<=r<0<n<=x<d|, where $x_0$, $n_0$ are the original values of~$x$
-and $n$.
-
-Notice that the computation specifies |(x-d)+x| instead of |(x+x)-d|,
-because the latter could overflow.
-
-@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>=
-f:=0; r:=(d div 2)-d; h:=-r;
-loop@+begin if odd(n) then
- begin r:=r+x;
- if r>=0 then
- begin r:=r-d; incr(f);
- end;
- end;
- n:=n div 2;
- if n=0 then goto found1;
- if x<h then x:=x+x
- else begin t:=x-d; x:=t+x; f:=f+n;
- if x<n then
- begin if x=0 then goto found1;
- t:=x; x:=n; n:=t;
- end;
- end;
- end;
-found1:
-
-@ The \.{\\gluestretch}, \.{\\glueshrink}, \.{\\gluestretchorder}, and
-\.{\\glueshrinkorder} commands return the stretch and shrink components
-and their orders of ``infinity'' of a glue specification.
-
-@d glue_stretch_order_code=eTeX_int+6 {code for \.{\\gluestretchorder}}
-@d glue_shrink_order_code=eTeX_int+7 {code for \.{\\glueshrinkorder}}
-@d glue_stretch_code=eTeX_dim+7 {code for \.{\\gluestretch}}
-@d glue_shrink_code=eTeX_dim+8 {code for \.{\\glueshrink}}
-
-@<Generate all \eTeX...@>=
-primitive("gluestretchorder",last_item,glue_stretch_order_code);
-@!@:glue_stretch_order_}{\.{\\gluestretchorder} primitive@>
-primitive("glueshrinkorder",last_item,glue_shrink_order_code);
-@!@:glue_shrink_order_}{\.{\\glueshrinkorder} primitive@>
-primitive("gluestretch",last_item,glue_stretch_code);
-@!@:glue_stretch_}{\.{\\gluestretch} primitive@>
-primitive("glueshrink",last_item,glue_shrink_code);
-@!@:glue_shrink_}{\.{\\glueshrink} primitive@>
-
-@ @<Cases of |last_item| for |print_cmd_chr|@>=
-glue_stretch_order_code: print_esc("gluestretchorder");
-glue_shrink_order_code: print_esc("glueshrinkorder");
-glue_stretch_code: print_esc("gluestretch");
-glue_shrink_code: print_esc("glueshrink");
-
-@ @<Cases for fetching an integer value@>=
-glue_stretch_order_code, glue_shrink_order_code:
- begin scan_normal_glue; q:=cur_val;
- if m=glue_stretch_order_code then cur_val:=stretch_order(q)
- else cur_val:=shrink_order(q);
- delete_glue_ref(q);
- end;
-
-@ @<Cases for fetching a dimension value@>=
-glue_stretch_code, glue_shrink_code:
- begin scan_normal_glue; q:=cur_val;
- if m=glue_stretch_code then cur_val:=stretch(q)
- else cur_val:=shrink(q);
- delete_glue_ref(q);
- end;
-
-@ The \.{\\mutoglue} and \.{\\gluetomu} commands convert ``math'' glue
-into normal glue and vice versa; they allow to manipulate math glue with
-\.{\\gluestretch} etc.
-
-@d mu_to_glue_code=eTeX_glue {code for \.{\\mutoglue}}
-@d glue_to_mu_code=eTeX_mu {code for \.{\\gluetomu}}
-
-@<Generate all \eTeX...@>=
-primitive("mutoglue",last_item,mu_to_glue_code);
-@!@:mu_to_glue_}{\.{\\mutoglue} primitive@>
-primitive("gluetomu",last_item,glue_to_mu_code);
-@!@:glue_to_mu_}{\.{\\gluetomu} primitive@>
-
-@ @<Cases of |last_item| for |print_cmd_chr|@>=
-mu_to_glue_code: print_esc("mutoglue");
-glue_to_mu_code: print_esc("gluetomu");
-
-@ @<Cases for fetching a glue value@>=
-mu_to_glue_code: scan_mu_glue;
-
-@ @<Cases for fetching a mu value@>=
-glue_to_mu_code: scan_normal_glue;
-
-@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count,
-dimen, skip, muskip, box, and token registers. As in \TeX\ the first
-256 registers of each kind are realized as arrays in the table of
-equivalents; the additional registers are realized as tree structures
-built from variable-size nodes with individual registers existing only
-when needed. Default values are used for nonexistent registers: zero
-for count and dimen values, |zero_glue| for glue (skip and muskip)
-values, void for boxes, and |null| for token lists (and current marks
-discussed below).
-
-Similarly there are 32768 mark classes; the command \.{\\marks}|n|
-creates a mark node for a given mark class |0<=n<=32767| (where
-\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
-the |fire_up| routine) and the |vsplit| routine maintain the current
-values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
-|split_bot_mark| for each mark class. They are accessed as
-\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
-\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
-are realized as |cur_mark| array. The additional current marks are
-again realized as tree structure with individual mark classes existing
-only when needed.
-
-@<Generate all \eTeX...@>=
-primitive("marks",mark,marks_code);
-@!@:marks_}{\.{\\marks} primitive@>
-primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
-@!@:top_marks_}{\.{\\topmarks} primitive@>
-primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
-@!@:first_marks_}{\.{\\firstmarks} primitive@>
-primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
-@!@:bot_marks_}{\.{\\botmarks} primitive@>
-primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
-@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
-primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
-@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
-
-@ The |scan_register_num| procedure scans a register number that must
-not exceed 255 in compatibility mode resp.\ 32767 in extended mode.
-
-@<Declare \eTeX\ procedures for ex...@>=
-procedure@?scan_register_num; forward;@t\2@>
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-procedure scan_register_num;
-begin scan_int;
-if (cur_val<0)or(cur_val>max_reg_num) then
- begin print_err("Bad register code");
-@.Bad register code@>
- help2(max_reg_help_line)("I changed this one to zero.");
- int_error(cur_val); cur_val:=0;
- end;
-end;
-
-@ @<Initialize variables for \eTeX\ comp...@>=
-max_reg_num:=255;
-max_reg_help_line:="A register number must be between 0 and 255.";
-
-@ @<Initialize variables for \eTeX\ ext...@>=
-max_reg_num:=32767;
-max_reg_help_line:="A register number must be between 0 and 32767.";
-
-@ @<Glob...@>=
-@!max_reg_num: halfword; {largest allowed register number}
-@!max_reg_help_line: str_number; {first line of help message}
-
-@ There are seven almost identical doubly linked trees, one for the
-sparse array of the up to 32512 additional registers of each kind and
-one for the sparse array of the up to 32767 additional mark classes.
-The root of each such tree, if it exists, is an index node containing 16
-pointers to subtrees for 4096 consecutive array elements. Similar index
-nodes are the starting points for all nonempty subtrees for 4096, 256,
-and 16 consecutive array elements. These four levels of index nodes are
-followed by a fifth level with nodes for the individual array elements.
-
-Each index node is nine words long. The pointers to the 16 possible
-subtrees or are kept in the |info| and |link| fields of the last eight
-words. (It would be both elegant and efficient to declare them as
-array, unfortunately \PASCAL\ doesn't allow this.)
-
-The fields in the first word of each index node and in the nodes for the
-array elements are closely related. The |link| field points to the next
-lower index node and the |sa_index| field contains four bits (one
-hexadecimal digit) of the register number or mark class. For the lowest
-index node the |link| field is |null| and the |sa_index| field indicates
-the type of quantity (|int_val|, |dimen_val|, |glue_val|, |mu_val|,
-|box_val|, |tok_val|, or |mark_val|). The |sa_used| field in the index
-nodes counts how many of the 16 pointers are non-null.
-
-The |sa_index| field in the nodes for array elements contains the four
-bits plus 16 times the type. Therefore such a node represents a count
-or dimen register if and only if |sa_index<dimen_val_limit|; it
-represents a skip or muskip register if and only if
-|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
-if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
-token list register if and only if
-|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
-class if and only if |tok_val_limit<=sa_index|.
-
-The |new_index| procedure creates an index node (returned in |cur_ptr|)
-having given contents of the |sa_index| and |link| fields.
-
-@d box_val==4 {the additional box registers}
-@d mark_val=6 {the additional mark classes}
-@#
-@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
-@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
-@d box_val_limit=@"50 {$2^4\cdot(|box_val|+1)$}
-@d tok_val_limit=@"60 {$2^4\cdot(|tok_val|+1)$}
-@#
-@d index_node_size=9 {size of an index node}
-@d sa_index==type {a four-bit address or a type or both}
-@d sa_used==subtype {count of non-null pointers}
-
-@<Declare \eTeX\ procedures for ex...@>=
-procedure new_index(@!i:quarterword; @!q:pointer);
-var k:small_number; {loop index}
-begin cur_ptr:=get_node(index_node_size); sa_index(cur_ptr):=i;
-sa_used(cur_ptr):=0; link(cur_ptr):=q;
-for k:=1 to index_node_size-1 do {clear all 16 pointers}
- mem[cur_ptr+k]:=sa_null;
-end;
-
-@ The roots of the seven trees for the additional registers and mark
-classes are kept in the |sa_root| array. The first six locations must
-be dumped and undumped; the last one is also known as |sa_mark|.
-
-@d sa_mark==sa_root[mark_val] {root for mark classes}
-
-@<Glob...@>=
-@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
-@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
-@!sa_null:memory_word; {two |null| pointers}
-
-@ @<Set init...@>=
-sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
-
-@ @<Initialize table...@>=
-for i:=int_val to tok_val do sa_root[i]:=null;
-
-@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
-procedure returns (in |cur_ptr|) a pointer to the node for the
-corresponding array element, or |null| when no such element exists. The
-third parameter |w| is set |true| if the element must exist, e.g.,
-because it is about to be modified. The procedure has two main
-branches: one follows the existing tree structure, the other (only used
-when |w| is |true|) creates the missing nodes.
-
-We use macros to extract the four-bit pieces from a sixteen-bit register
-number or mark class and to fetch or store one of the 16 pointers from
-an index node.
-
-@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
- begin if cur_ptr=null then
- if w then goto #@+else return;
- end
-@#
-@d hex_dig1(#)==# div 4096 {the fourth lowest hexadecimal digit}
-@d hex_dig2(#)==(# div 256) mod 16 {the third lowest hexadecimal digit}
-@d hex_dig3(#)==(# div 16) mod 16 {the second lowest hexadecimal digit}
-@d hex_dig4(#)==# mod 16 {the lowest hexadecimal digit}
-@#
-@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
- else cur_ptr:=info(q+(i div 2)+1)
- {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
-@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
- else info(q+(i div 2)+1):=#
- {store the pointer indexed by |i| in index node |q|}
-@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
- end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
-@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
- end {delete the pointer indexed by |i| in index node |q|}
-
-@<Declare \eTeX\ procedures for ex...@>=
-procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
- {sets |cur_val| to sparse array element location or |null|}
-label not_found,not_found1,not_found2,not_found3,not_found4,exit;
-var q:pointer; {for list manipulations}
-@!i:small_number; {a four bit index}
-begin cur_ptr:=sa_root[t];
-if_cur_ptr_is_null_then_return_or_goto(not_found);@/
-q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
-if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
-q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
-if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
-q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
-if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
-q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
-if (cur_ptr=null)and w then goto not_found4;
-return;
-not_found: new_index(t,null); {create first level index node}
-sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
-not_found1: new_index(i,q); {create second level index node}
-add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
-not_found2: new_index(i,q); {create third level index node}
-add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
-not_found3: new_index(i,q); {create fourth level index node}
-add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
-not_found4: @<Create a new array element of type |t| with index |i|@>;
-link(cur_ptr):=q; add_sa_ptr;
-exit:end;
-
-@ The array elements for registers are subject to grouping and have an
-|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
-Since saved values as well as shorthand definitions (created by e.g.,
-\.{\\countdef}) refer to the location of the respective array element,
-we need a reference count that is kept in the |sa_ref| field. An array
-element can be deleted (together with all references to it) when its
-|sa_ref| value is |null| and its value is the default value.
-@^reference counts@>
-
-Skip, muskip, box, and token registers use two word nodes, their values
-are stored in the |sa_ptr| field.
-Count and dimen registers use three word nodes, their
-values are stored in the |sa_int| resp.\ |sa_dim| field in the third
-word; the |sa_ptr| field is used under the name |sa_num| to store
-the register number. Mark classes use four word nodes. The last three
-words contain the five types of current marks
-
-@d sa_lev==sa_used {grouping level for the current value}
-@d pointer_node_size=2 {size of an element with a pointer value}
-@d sa_type(#)==(sa_index(#) div 16) {type part of combined type/index}
-@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
-@d sa_ptr(#)==link(#+1) {a pointer value}
-@#
-@d word_node_size=3 {size of an element with a word value}
-@d sa_num==sa_ptr {the register number}
-@d sa_int(#)==mem[#+2].int {an integer}
-@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esoteric distinction)}
-@#
-@d mark_class_node_size=4 {size of an element for a mark class}
-@#
-@d fetch_box(#)== {fetch |box(cur_val)|}
- if cur_val<256 then #:=box(cur_val)
- else begin find_sa_element(box_val,cur_val,false);
- if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
- end
-
-@<Create a new array element...@>=
-if t=mark_val then {a mark class}
- begin cur_ptr:=get_node(mark_class_node_size);
- mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
- end
-else begin if t<=dimen_val then {a count or dimen register}
- begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
- sa_num(cur_ptr):=n;
- end
- else begin cur_ptr:=get_node(pointer_node_size);
- if t<=mu_val then {a skip or muskip register}
- begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
- end
- else sa_ptr(cur_ptr):=null; {a box or token list register}
- end;
- sa_ref(cur_ptr):=null; {all registers have a reference count}
- end;
-sa_index(cur_ptr):=16*t+i; sa_lev(cur_ptr):=level_one
-
-@ The |delete_sa_ref| procedure is called when a pointer to an array
-element representing a register is being removed; this means that the
-reference count should be decreased by one. If the reduced reference
-count is |null| and the register has been (globally) assigned its
-default value the array element should disappear, possibly together with
-some index nodes. This procedure will never be used for mark class
-nodes.
-@^reference counts@>
-
-@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
-@#
-@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
- if cur_val<256 then box(cur_val):=#@+else set_sa_box(#)
-@#
-@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
- if cur_ptr<>null then
- begin sa_ptr(cur_ptr):=#; add_sa_ref(cur_ptr); delete_sa_ref(cur_ptr);
- end;
- end
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure delete_sa_ref(@!q:pointer); {reduce reference count}
-label exit;
-var p:pointer; {for list manipulations}
-@!i:small_number; {a four bit index}
-@!s:small_number; {size of a node}
-begin decr(sa_ref(q));
-if sa_ref(q)<>null then return;
-if sa_index(q)<dimen_val_limit then
- if sa_int(q)=0 then s:=word_node_size
- else return
-else begin if sa_index(q)<mu_val_limit then
- if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
- else return
- else if sa_ptr(q)<>null then return;
- s:=pointer_node_size;
- end;
-repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
-if q=null then {the whole tree has been freed}
- begin sa_root[i]:=null; return;
- end;
-delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
-until sa_used(q)>0;
-exit:end;
-
-@ The |print_sa_num| procedure prints the register number corresponding
-to an array element.
-
-@<Basic print...@>=
-procedure print_sa_num(@!q:pointer); {print register number}
-var @!n:halfword; {the register number}
-begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
-else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+16*sa_index(q);
- q:=link(q); n:=n+256*(sa_index(q)+16*sa_index(link(q)));
- end;
-print_int(n);
-end;
-
-@ Here is a procedure that displays the contents of an array element
-symbolically. It is used under similar circumstances as is
-|restore_trace| (together with |show_eqtb|) for the quantities kept in
-the |eqtb| array.
-
-@<Declare \eTeX\ procedures for tr...@>=
-@!stat procedure show_sa(@!p:pointer;@!s:str_number);
-var t:small_number; {the type of element}
-begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
-if p=null then print_char("?") {this can't happen}
-else begin t:=sa_type(p);
- if t<box_val then print_cmd_chr(register,p)
- else if t=box_val then
- begin print_esc("box"); print_sa_num(p);
- end
- else if t=tok_val then print_cmd_chr(toks_register,p)
- else print_char("?"); {this can't happen either}
- print_char("=");
- if t=int_val then print_int(sa_int(p))
- else if t=dimen_val then
- begin print_scaled(sa_dim(p)); print("pt");
- end
- else begin p:=sa_ptr(p);
- if t=glue_val then print_spec(p,"pt")
- else if t=mu_val then print_spec(p,"mu")
- else if t=box_val then
- if p=null then print("void")
- else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
- end
- else if t=tok_val then
- begin if p<>null then show_token_list(link(p),null,32);
- end
- else print_char("?"); {this can't happen either}
- end;
- end;
-print_char("}"); end_diagnostic(false);
-end;
-tats
-
-@ Here we compute the pointer to the current mark of type |t| and mark
-class |cur_val|.
-
-@<Compute the mark pointer...@>=
-begin find_sa_element(mark_val,cur_val,false);
-if cur_ptr<>null then
- if odd(t) then cur_ptr:=link(cur_ptr+(t div 2)+1)
- else cur_ptr:=info(cur_ptr+(t div 2)+1);
-end
-
-@ The current marks for all mark classes are maintained by the |vsplit|
-and |fire_up| routines and are finally destroyed (for \.{INITEX} only)
-@.INITEX@>
-by the |final_cleanup| routine. Apart from updating the current marks
-when mark nodes are encountered, these routines perform certain actions
-on all existing mark classes. The recursive |do_marks| procedure walks
-through the whole tree or a subtree of existing mark class nodes and
-preforms certain actions indicted by its first parameter |a|, the action
-code. The second parameter |l| indicates the level of recursion (at
-most four); the third parameter points to a nonempty tree or subtree.
-The result is |true| if the complete tree or subtree has been deleted.
-
-@d vsplit_init==0 {action code for |vsplit| initialization}
-@d fire_up_init==1 {action code for |fire_up| initialization}
-@d fire_up_done==2 {action code for |fire_up| completion}
-@d destroy_marks==3 {action code for |final_cleanup|}
-@#
-@d sa_top_mark(#)==info(#+1) {\.{\\topmarks}|n|}
-@d sa_first_mark(#)==link(#+1) {\.{\\firstmarks}|n|}
-@d sa_bot_mark(#)==info(#+2) {\.{\\botmarks}|n|}
-@d sa_split_first_mark(#)==link(#+2) {\.{\\splitfirstmarks}|n|}
-@d sa_split_bot_mark(#)==info(#+3) {\.{\\splitbotmarks}|n|}
-
-@<Declare the function called |do_marks|@>=
-function do_marks(@!a,@!l:small_number;@!q:pointer):boolean;
-var i:small_number; {a four bit index}
-begin if l<4 then {|q| is an index node}
- begin for i:=0 to 15 do
- begin get_sa_ptr;
- if cur_ptr<>null then if do_marks(a,l+1,cur_ptr) then delete_sa_ptr;
- end;
- if sa_used(q)=0 then
- begin free_node(q,index_node_size); q:=null;
- end;
- end
-else {|q| is the node for a mark class}
- begin case a of
- @<Cases for |do_marks|@>@;
- end; {there are no other cases}
- if sa_bot_mark(q)=null then if sa_split_bot_mark(q)=null then
- begin free_node(q,mark_class_node_size); q:=null;
- end;
- end;
-do_marks:=(q=null);
-end;
-
-@ At the start of the |vsplit| routine the existing |split_fist_mark|
-and |split_bot_mark| are discarded.
-
-@<Cases for |do_marks|@>=
-vsplit_init: if sa_split_first_mark(q)<>null then
- begin delete_token_ref(sa_split_first_mark(q)); sa_split_first_mark(q):=null;
- delete_token_ref(sa_split_bot_mark(q)); sa_split_bot_mark(q):=null;
- end;
-
-@ We use again the fact that |split_first_mark=null| if and only if
-|split_bot_mark=null|.
-
-@<Update the current marks for |vsplit|@>=
-begin find_sa_element(mark_val,mark_class(p),true);
-if sa_split_first_mark(cur_ptr)=null then
- begin sa_split_first_mark(cur_ptr):=mark_ptr(p);
- add_token_ref(mark_ptr(p));
- end
-else delete_token_ref(sa_split_bot_mark(cur_ptr));
-sa_split_bot_mark(cur_ptr):=mark_ptr(p);
-add_token_ref(mark_ptr(p));
-end
-
-@ At the start of the |fire_up| routine the old |top_mark| and
-|first_mark| are discarded, whereas the old |bot_mark| becomes the new
-|top_mark|. An empty new |top_mark| token list is, however, discarded
-as well in order that mark class nodes can eventually be released. We
-use again the fact that |bot_mark<>null| implies |first_mark<>null|; it
-also knows that |bot_mark=null| implies |top_mark=first_mark=null|.
-
-@<Cases for |do_marks|@>=
-fire_up_init: if sa_bot_mark(q)<>null then
- begin if sa_top_mark(q)<>null then delete_token_ref(sa_top_mark(q));
- delete_token_ref(sa_first_mark(q)); sa_first_mark(q):=null;
- if link(sa_bot_mark(q))=null then {an empty token list}
- begin delete_token_ref(sa_bot_mark(q)); sa_bot_mark(q):=null;
- end
- else add_token_ref(sa_bot_mark(q));
- sa_top_mark(q):=sa_bot_mark(q);
- end;
-
-@ @<Cases for |do_marks|@>=
-fire_up_done: if (sa_top_mark(q)<>null)and(sa_first_mark(q)=null) then
- begin sa_first_mark(q):=sa_top_mark(q); add_token_ref(sa_top_mark(q));
- end;
-
-@ @<Update the current marks for |fire_up|@>=
-begin find_sa_element(mark_val,mark_class(p),true);
-if sa_first_mark(cur_ptr)=null then
- begin sa_first_mark(cur_ptr):=mark_ptr(p);
- add_token_ref(mark_ptr(p));
- end;
-if sa_bot_mark(cur_ptr)<>null then delete_token_ref(sa_bot_mark(cur_ptr));
-sa_bot_mark(cur_ptr):=mark_ptr(p); add_token_ref(mark_ptr(p));
-end
-
-@ Here we use the fact that the five current mark pointers in a mark
-class node occupy the same locations as the the first five pointers of
-an index node. For systems using a run-time switch to distinguish
-between \.{VIRTEX} and \.{INITEX}, the codewords `$|init|\ldots|tini|$'
-surrounding the following piece of code should be removed.
-@.INITEX@>
-@^system dependencies@>
-
-@<Cases for |do_marks|@>=
-@!init destroy_marks: for i:=top_mark_code to split_bot_mark_code do
- begin get_sa_ptr;
- if cur_ptr<>null then
- begin delete_token_ref(cur_ptr); put_sa_ptr(null);
- end;
- end;
-tini
-
-@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}',
-etc., as well as for references to sparse array elements defined by
-`\.{\\countdef}', etc.
-
-@<Cases of |register| for |print_cmd_chr|@>=
-begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then
- cmd:=sa_type(chr_code)
-else begin cmd:=chr_code-mem_bot; chr_code:=null;
- end;
-if cmd=int_val then print_esc("count")
-else if cmd=dimen_val then print_esc("dimen")
-else if cmd=glue_val then print_esc("skip")
-else print_esc("muskip");
-if chr_code<>null then print_sa_num(chr_code);
-end
-
-@ Similarly the command code |toks_register| is used for `\.{\\toks}' as
-well as for references to sparse array elements defined by
-`\.{\\toksdef}'.
-
-@<Cases of |toks_register| for |print_cmd_chr|@>=
-begin print_esc("toks");
-if chr_code<>mem_bot then print_sa_num(chr_code);
-end
-
-@ When a shorthand definition for an element of one of the sparse arrays
-is destroyed, we must reduce the reference count.
-
-@<Cases for |eq_destroy|@>=
-toks_register,register:
- if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then
- delete_sa_ref(equiv_field(w));
-
-@ The task to maintain (change, save, and restore) register values is
-essentially the same when the register is realized as sparse array
-element or entry in |eqtb|. The global variable |sa_chain| is the head
-of a linked list of entries saved at the topmost level |sa_level|; the
-lists for lower levels are kept in special save stack entries.
-
-@<Glob...@>=
-@!sa_chain: pointer; {chain of saved sparse array entries}
-@!sa_level: quarterword; {group level for |sa_chain|}
-
-@ @<Set init...@>=
-sa_chain:=null; sa_level:=level_zero;
-
-@ The individual saved items are kept in pointer or word nodes similar
-to those used for the array elements: a word node with value zero is,
-however, saved as pointer node with the otherwise impossible |sa_index|
-value |tok_val_limit|.
-
-@d sa_loc==sa_ref {location of saved item}
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure sa_save(@!p:pointer); {saves value of |p|}
-var q:pointer; {the new save node}
-@!i:quarterword; {index field of node}
-begin if cur_level<>sa_level then
- begin check_full_save_stack; save_type(save_ptr):=restore_sa;
- save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
- incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
- end;
-i:=sa_index(p);
-if i<dimen_val_limit then
- begin if sa_int(p)=0 then
- begin q:=get_node(pointer_node_size); i:=tok_val_limit;
- end
- else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
- end;
- sa_ptr(q):=null;
- end
-else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
- end;
-sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
-link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
-end;
-
-@ @<Declare \eTeX\ procedures for tr...@>=
-procedure sa_destroy(@!p:pointer); {destroy value of |p|}
-begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
-else if sa_ptr(p)<>null then
- if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
- else delete_token_ref(sa_ptr(p));
-end;
-
-@ The procedure |sa_def| assigns a new value to sparse array elements,
-and saves the former value if appropriate. This procedure is used only
-for skip, muskip, box, and token list registers. The counterpart of
-|sa_def| for count and dimen registers is called |sa_w_def|.
-
-@d sa_define(#)==if e then
- if global then gsa_def(#)@+else sa_def(#)
- else define
-@#
-@d sa_def_box== {assign |cur_box| to |box(cur_val)|}
- begin find_sa_element(box_val,cur_val,true);
- if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box);
- end
-@#
-@d sa_word_define(#)==if e then
- if global then gsa_w_def(#)@+else sa_w_def(#)
- else word_define(#)
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure sa_def(@!p:pointer;@!e:halfword);
- {new data for sparse array elements}
-begin add_sa_ref(p);
-if sa_ptr(p)=e then
- begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
- sa_destroy(p);
- end
-else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
- if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p);
- sa_lev(p):=cur_level; sa_ptr(p):=e;
- @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
- end;
-delete_sa_ref(p);
-end;
-@#
-procedure sa_w_def(@!p:pointer;@!w:integer);
-begin add_sa_ref(p);
-if sa_int(p)=w then
- begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
- end
-else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
- if sa_lev(p)<>cur_level then sa_save(p);
- sa_lev(p):=cur_level; sa_int(p):=w;
- @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
- end;
-delete_sa_ref(p);
-end;
-
-@ The |sa_def| and |sa_w_def| routines take care of local definitions.
-@^global definitions@>
-Global definitions are done in almost the same way, but there is no need
-to save old values, and the new value is associated with |level_one|.
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|}
-begin add_sa_ref(p);
-@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
-sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e;
-@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
-delete_sa_ref(p);
-end;
-@#
-procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|}
-begin add_sa_ref(p);
-@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
-sa_lev(p):=level_one; sa_int(p):=w;
-@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
-delete_sa_ref(p);
-end;
-
-@ The |sa_restore| procedure restores the sparse array entries pointed
-at by |sa_chain|.
-
-@<Declare \eTeX\ procedures for tr...@>=
-procedure sa_restore;
-var p:pointer; {sparse array element}
-begin repeat p:=sa_loc(sa_chain);
-if sa_lev(p)=level_one then
- begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
- @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
- end
-else begin if sa_index(p)<dimen_val_limit then
- if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
- else sa_int(p):=0
- else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
- end;
- sa_lev(p):=sa_lev(sa_chain);
- @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
- end;
-delete_sa_ref(p);
-p:=sa_chain; sa_chain:=link(p);
-if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
-else free_node(p,pointer_node_size);
-until sa_chain=null;
-end;
-
-@ When the value of |last_line_fit| is positive, the last line of a
-(partial) paragraph is treated in a special way and we need additional
-fields in the active nodes.
-
-@d active_node_size_extended=5 {number of words in extended active nodes}
-@d active_short(#)==mem[#+3].sc {|shortfall| of this line}
-@d active_glue(#)==mem[#+4].sc {corresponding glue stretch or shrink}
-
-@<Glob...@>=
-@!last_line_fill:pointer; {the |par_fill_skip| glue node of the new paragraph}
-@!do_last_line_fit:boolean; {special algorithm for last line of paragraph?}
-@!active_node_size:small_number; {number of words in active nodes}
-@!fill_width:array[0..2] of scaled; {infinite stretch components of
- |par_fill_skip|}
-@!best_pl_short:array[very_loose_fit..tight_fit] of scaled; {|shortfall|
- corresponding to |minimal_demerits|}
-@!best_pl_glue:array[very_loose_fit..tight_fit] of scaled; {corresponding
- glue stretch or shrink}
-
-@ The new algorithm for the last line requires that the stretchability of
-|par_fill_skip| is infinite and the stretchability of |left_skip| plus
-|right_skip| is finite.
-
-@<Check for special...@>=
-do_last_line_fit:=false; active_node_size:=active_node_size_normal;
- {just in case}
-if last_line_fit>0 then
- begin q:=glue_ptr(last_line_fill);
- if (stretch(q)>0)and(stretch_order(q)>normal) then
- if (background[3]=0)and(background[4]=0)and(background[5]=0) then
- begin do_last_line_fit:=true;
- active_node_size:=active_node_size_extended;
- fill_width[0]:=0; fill_width[1]:=0; fill_width[2]:=0;
- fill_width[stretch_order(q)-1]:=stretch(q);
- end;
- end
-
-@ @<Other local variables for |try_break|@>=
-@!g:scaled; {glue stretch or shrink of test line, adjustment for last line}
-
-@ Here we initialize the additional fields of the first active node
-representing the beginning of the paragraph.
-
-@<Initialize additional fields of the first active node@>=
-begin active_short(q):=0; active_glue(q):=0;
-end
-
-@ Here we compute the adjustment |g| and badness |b| for a line from |r|
-to the end of the paragraph. When any of the criteria for adjustment is
-violated we fall through to the normal algorithm.
-
-The last line must be too short, and have infinite stretch entirely due
-to |par_fill_skip|.
-
-@<Perform computations for last line and |goto found|@>=
-begin if (active_short(r)=0)or(active_glue(r)<=0) then goto not_found;
- {previous line was neither stretched nor shrunk, or was infinitely bad}
-if (cur_active_width[3]<>fill_width[0])or@|
- (cur_active_width[4]<>fill_width[1])or@|
- (cur_active_width[5]<>fill_width[2]) then goto not_found;
- {infinite stretch of this line not entirely due to |par_fill_skip|}
-if active_short(r)>0 then g:=cur_active_width[2]
-else g:=cur_active_width[6];
-if g<=0 then goto not_found; {no finite stretch resp.\ no shrink}
-arith_error:=false; g:=fract(g,active_short(r),active_glue(r),max_dimen);
-if last_line_fit<1000 then g:=fract(g,last_line_fit,1000,max_dimen);
-if arith_error then
- if active_short(r)>0 then g:=max_dimen@+else g:=-max_dimen;
-if g>0 then
- @<Set the value of |b| to the badness of the last line for stretching,
- compute the corresponding |fit_class|, and |goto found|@>
-else if g<0 then
- @<Set the value of |b| to the badness of the last line for shrinking,
- compute the corresponding |fit_class|, and |goto found|@>;
-not_found:end
-
-@ These badness computations are rather similar to those of the standard
-algorithm, with the adjustment amount |g| replacing the |shortfall|.
-
-@<Set the value of |b| to the badness of the last line for str...@>=
-begin if g>shortfall then g:=shortfall;
-if g>7230584 then if cur_active_width[2]<1663497 then
- begin b:=inf_bad; fit_class:=very_loose_fit; goto found;
- end;
-b:=badness(g,cur_active_width[2]);
-if b>12 then
- if b>99 then fit_class:=very_loose_fit
- else fit_class:=loose_fit
-else fit_class:=decent_fit;
-goto found;
-end
-
-@ @<Set the value of |b| to the badness of the last line for shr...@>=
-begin if -g>cur_active_width[6] then g:=-cur_active_width[6];
-b:=badness(-g,cur_active_width[6]);
-if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit;
-goto found;
-end
-
-@ Vanishing values of |shortfall| and |g| indicate that the last line is
-not adjusted.
-
-@<Adjust \(t)the additional data for last line@>=
-begin if cur_p=null then shortfall:=0;
-if shortfall>0 then g:=cur_active_width[2]
-else if shortfall<0 then g:=cur_active_width[6]
-else g:=0;
-end
-
-@ For each feasible break we record the shortfall and glue stretch or
-shrink (or adjustment).
-
-@<Store \(a)additional data for this feasible break@>=
-begin best_pl_short[fit_class]:=shortfall; best_pl_glue[fit_class]:=g;
-end
-
-@ Here we save these data in the active node representing a potential
-line break.
-
-@<Store \(a)additional data in the new active node@>=
-begin active_short(q):=best_pl_short[fit_class];
-active_glue(q):=best_pl_glue[fit_class];
-end
-
-@ @<Print additional data in the new active node@>=
-begin print(" s="); print_scaled(active_short(q));
-if cur_p=null then print(" a=")@+else print(" g=");
-print_scaled(active_glue(q));
-end
-
-@ Here we either reset |do_last_line_fit| or adjust the |par_fill_skip|
-glue.
-
-@<Adjust \(t)the final line of the paragraph@>=
-if active_short(best_bet)=0 then do_last_line_fit:=false
-else begin q:=new_spec(glue_ptr(last_line_fill));
- delete_glue_ref(glue_ptr(last_line_fill));
- width(q):=width(q)+active_short(best_bet)-active_glue(best_bet);
- stretch(q):=0; glue_ptr(last_line_fill):=q;
- end
-
-@ When reading \.{\\patterns} while \.{\\savinghyphcodes} is positive
-the current |lc_code| values are stored together with the hyphenation
-patterns for the current language. They will later be used instead of
-the |lc_code| values for hyphenation purposes.
-
-The |lc_code| values are stored in the linked trie analogous to patterns
-$p_1$ of length~1, with |hyph_root=trie_r[0]| replacing |trie_root| and
-|lc_code(p_1)| replacing the |trie_op| code. This allows to compress
-and pack them together with the patterns with minimal changes to the
-existing code.
-
-@d hyph_root==trie_r[0] {root of the linked trie for |hyph_codes|}
-
-@<Initialize table entries...@>=
-hyph_root:=0; hyph_start:=0;
-
-@ @<Store hyphenation codes for current language@>=
-begin c:=cur_lang; first_child:=false; p:=0;
-repeat q:=p; p:=trie_r[q];
-until (p=0)or(c<=so(trie_c[p]));
-if (p=0)or(c<so(trie_c[p])) then
- @<Insert a new trie node between |q| and |p|, and
- make |p| point to it@>;
-q:=p; {now node |q| represents |cur_lang|}
-@<Store all current |lc_code| values@>;
-end
-
-@ We store all nonzero |lc_code| values, overwriting any previously
-stored values (and possibly wasting a few trie nodes that were used
-previously and are not needed now). We always store at least one
-|lc_code| value such that |hyph_index| (defined below) will not be zero.
-
-@<Store all current |lc_code| values@>=
-p:=trie_l[q]; first_child:=true;
-for c:=0 to 255 do
- if (lc_code(c)>0)or((c=255)and first_child) then
- begin if p=0 then
- @<Insert a new trie node between |q| and |p|, and
- make |p| point to it@>
- else trie_c[p]:=si(c);
- trie_o[p]:=qi(lc_code(c));
- q:=p; p:=trie_r[q]; first_child:=false;
- end;
-if first_child then trie_l[q]:=0@+else trie_r[q]:=0
-
-@ We must avoid to ``take'' location~1, in order to distinguish between
-|lc_code| values and patterns.
-
-@<Pack all stored |hyph_codes|@>=
-begin if trie_root=0 then for p:=0 to 255 do trie_min[p]:=p+2;
-first_fit(hyph_root); trie_pack(hyph_root);
-hyph_start:=trie_ref[hyph_root];
-end
-
-@ The global variable |hyph_index| will point to the hyphenation codes
-for the current language.
-
-@d set_hyph_index== {set |hyph_index| for current language}
- if trie_char(hyph_start+cur_lang)<>qi(cur_lang)
- then hyph_index:=0 {no hyphenation codes for |cur_lang|}
- else hyph_index:=trie_link(hyph_start+cur_lang)
-@#
-@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|}
- if hyph_index=0 then hc[0]:=lc_code(#)
- else if trie_char(hyph_index+#)<>qi(#) then hc[0]:=0
- else hc[0]:=qo(trie_op(hyph_index+#))
-
-@<Glob...@>=
-@!hyph_start:trie_pointer; {root of the packed trie for |hyph_codes|}
-@!hyph_index:trie_pointer; {pointer to hyphenation codes for |cur_lang|}
-
-@ When |saving_vdiscards| is positive then the glue, kern, and penalty
-nodes removed by the page builder or by \.{\\vsplit} from the top of a
-vertical list are saved in special lists instead of being discarded.
-
-@d tail_page_disc==disc_ptr[copy_code] {last item removed by page builder}
-@d page_disc==disc_ptr[last_box_code] {first item removed by page builder}
-@d split_disc==disc_ptr[vsplit_code] {first item removed by \.{\\vsplit}}
-
-@<Glob...@>=
-@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers}
-
-@ @<Set init...@>=
-page_disc:=null; split_disc:=null;
-
-@ The \.{\\pagediscards} and \.{\\splitdiscards} commands share the
-command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are
-distinguished by their |chr_code| values |last_box_code| and
-|vsplit_code|. These |chr_code| values are larger than |box_code| and
-|copy_code|.
-
-@<Generate all \eTeX...@>=
-primitive("pagediscards",un_vbox,last_box_code);@/
-@!@:page_discards_}{\.{\\pagediscards} primitive@>
-primitive("splitdiscards",un_vbox,vsplit_code);@/
-@!@:split_discards_}{\.{\\splitdiscards} primitive@>
-
-@ @<Cases of |un_vbox| for |print_cmd_chr|@>=
-else if chr_code=last_box_code then print_esc("pagediscards")
-else if chr_code=vsplit_code then print_esc("splitdiscards")
-
-@ @<Handle saved items and |goto done|@>=
-begin link(tail):=disc_ptr[cur_chr]; disc_ptr[cur_chr]:=null;
-goto done;
-end
-
-@ The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties},
-and \.{\\displaywidowpenalties} commands allow to define arrays of
-penalty values to be used instead of the corresponding single values.
-
-@d inter_line_penalties_ptr==equiv(inter_line_penalties_loc)
-@d club_penalties_ptr==equiv(club_penalties_loc)
-@d widow_penalties_ptr==equiv(widow_penalties_loc)
-@d display_widow_penalties_ptr==equiv(display_widow_penalties_loc)
-
-@<Generate all \eTeX...@>=
-primitive("interlinepenalties",set_shape,inter_line_penalties_loc);@/
-@!@:inter_line_penalties_}{\.{\\interlinepenalties} primitive@>
-primitive("clubpenalties",set_shape,club_penalties_loc);@/
-@!@:club_penalties_}{\.{\\clubpenalties} primitive@>
-primitive("widowpenalties",set_shape,widow_penalties_loc);@/
-@!@:widow_penalties_}{\.{\\widowpenalties} primitive@>
-primitive("displaywidowpenalties",set_shape,display_widow_penalties_loc);@/
-@!@:display_widow_penalties_}{\.{\\displaywidowpenalties} primitive@>
-
-@ @<Cases of |set_shape| for |print_cmd_chr|@>=
-inter_line_penalties_loc: print_esc("interlinepenalties");
-club_penalties_loc: print_esc("clubpenalties");
-widow_penalties_loc: print_esc("widowpenalties");
-display_widow_penalties_loc: print_esc("displaywidowpenalties");
-
-@ @<Fetch a penalties array element@>=
-begin scan_int;
-if (equiv(m)=null)or(cur_val<0) then cur_val:=0
-else begin if cur_val>penalty(equiv(m)) then cur_val:=penalty(equiv(m));
- cur_val:=penalty(equiv(m)+cur_val);
- end;
-end
-
-@* \[54] System-dependent changes.
-This section should be replaced, if necessary, by any special
-modifications of the program
-that are necessary to make \TeX\ work at a particular installation.
-It is usually best to design your change file so that all changes to
-previous sections preserve the section numbering; then everybody's version
-will be consistent with the published program. More extensive changes,
-which introduce new sections, can be inserted here; then only the index
-itself will get a new section number.
-@^system dependencies@>
-
-@* \[55] Index.
-Here is where you can find all uses of each identifier in the program,
-with underlined entries pointing to where the identifier was defined.
-If the identifier is only one letter long, however, you get to see only
-the underlined entries. {\sl All references are to section numbers instead of
-page numbers.}
-
-This index also lists error messages and other aspects of the program
-that you might want to look up some day. For example, the entry
-for ``system dependencies'' lists all sections that should receive
-special attention from people who are installing \TeX\ in a new
-operating environment. A list of various things that can't happen appears
-under ``this can't happen''. Approximately 40 sections are listed under
-``inner loop''; these account for about 60\pct! of \TeX's running time,
-exclusive of input and output.
diff --git a/Build/source/texk/web2c/pdftexdir/pdftex_version.h b/Build/source/texk/web2c/pdftexdir/pdftex_version.h
deleted file mode 100644
index 026f967d163..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftex_version.h
+++ /dev/null
@@ -1 +0,0 @@
-#define PDFTEX_VERSION "1.40.22"
diff --git a/Build/source/texk/web2c/pdftexdir/pdftexextra.c b/Build/source/texk/web2c/pdftexdir/pdftexextra.c
deleted file mode 100644
index 86a7939ade2..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftexextra.c
+++ /dev/null
@@ -1,12 +0,0 @@
-/* pdftexextra.c: Hand-coded routines for pdfTeX.
-
- This file is public domain. */
-
-#define EXTERN /* Instantiate data from pdftexd.h here. */
-#define DLLPROC dllpdftexmain
-
-/* This file defines TeX and pdfTeX. */
-#include <pdftexd.h>
-
-/* Hand-coded routines for TeX or Metafont in C. */
-#include <lib/texmfmp.c>
diff --git a/Build/source/texk/web2c/pdftexdir/pdftexextra.h b/Build/source/texk/web2c/pdftexdir/pdftexextra.h
deleted file mode 100644
index 264448f2a5a..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftexextra.h
+++ /dev/null
@@ -1,40 +0,0 @@
-/*
-Copyright 1996-2021 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-/* pdftexextra.h: banner etc. for pdfTeX.
-
- This is included by pdfTeX, from pdftexextra.c.
-*/
-
-#include <pdftexdir/pdftex_version.h> /* for PDFTEX_VERSION */
-#include <pdftexdir/etex_version.h> /* for ETEX_VERSION */
-
-#define BANNER "This is pdfTeX, Version 3.141592653-" ETEX_VERSION "-" PDFTEX_VERSION
-#define COPYRIGHT_HOLDER "Han The Thanh (pdfTeX) et al"
-#define AUTHOR NULL
-#define PROGRAM_HELP PDFTEXHELP
-#define BUG_ADDRESS "pdftex@tug.org"
-#define DUMP_VAR TEXformatdefault
-#define DUMP_LENGTH_VAR formatdefaultlength
-#define DUMP_OPTION "fmt"
-#define DUMP_EXT ".fmt"
-#define INPUT_FORMAT kpse_tex_format
-#define INI_PROGRAM "pdfinitex"
-#define VIR_PROGRAM "pdfvirtex"
-
diff --git a/Build/source/texk/web2c/pdftexdir/pdftoepdf.cc b/Build/source/texk/web2c/pdftexdir/pdftoepdf.cc
deleted file mode 100644
index e0ce148834f..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftoepdf.cc
+++ /dev/null
@@ -1,1076 +0,0 @@
-/*
-Copyright 1996-2016 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-/* Do this early in order to avoid a conflict between
- MINGW32 <rpcndr.h> defining 'boolean' as 'unsigned char' and
- <kpathsea/types.h> defining Pascal's boolean as 'int'.
-*/
-#include <w2c/config.h>
-#include <kpathsea/lib.h>
-
-#include <stdlib.h>
-#include <math.h>
-#include <stddef.h>
-#include <stdio.h>
-#include <string.h>
-#include <ctype.h>
-
-#include <aconf.h>
-#include <GString.h>
-#include <gmem.h>
-#include <gfile.h>
-#include <assert.h>
-
-#include "Object.h"
-#include "Stream.h"
-#include "Array.h"
-#include "Dict.h"
-#include "XRef.h"
-#include "Catalog.h"
-#include "Link.h"
-#include "Page.h"
-#include "GfxFont.h"
-#include "PDFDoc.h"
-#include "GlobalParams.h"
-#include "Error.h"
-
-// This file is mostly C and not very much C++; it's just used to interface
-// the functions of xpdf, which are written in C++.
-
-extern "C" {
-#include <pdftexdir/ptexmac.h>
-#include <pdftexdir/pdftex-common.h>
-
-// These functions from pdftex.web gets declared in pdftexcoerce.h in the
-// usual web2c way, but we cannot include that file here because C++
-// does not allow it.
-extern int getpdfsuppresswarningpagegroup(void);
-extern integer getpdfsuppressptexinfo(void);
-extern integer zround(double);
-}
-
-// The prefix "PTEX" for the PDF keys is special to pdfTeX;
-// this has been registered with Adobe by Hans Hagen.
-
-#define pdfkeyprefix "PTEX"
-
-#define MASK_SUPPRESS_PTEX_FULLBANNER 0x01
-#define MASK_SUPPRESS_PTEX_FILENAME 0x02
-#define MASK_SUPPRESS_PTEX_PAGENUMBER 0x04
-#define MASK_SUPPRESS_PTEX_INFODICT 0x08
-
-// PdfObject encapsulates the xpdf Object type,
-// and properly frees its resources on destruction.
-// Use obj-> to access members of the Object,
-// and &obj to get a pointer to the object.
-// It is no longer necessary to call Object::free explicitely.
-
-class PdfObject {
- public:
- PdfObject() { // nothing
- } ~PdfObject() {
- iObject.free();
- }
- Object *operator->() {
- return &iObject;
- }
- Object *operator&() {
- return &iObject;
- }
- private: // no copying or assigning
- PdfObject(const PdfObject &);
- void operator=(const PdfObject &);
- public:
- Object iObject;
-};
-
-// When copying the Resources of the selected page, all objects are copied
-// recusively top-down. Indirect objects however are not fetched during
-// copying, but get a new object number from pdfTeX and then will be
-// appended into a linked list. Duplicates are checked and removed from the
-// list of indirect objects during appending.
-
-enum InObjType {
- objFont,
- objFontDesc,
- objOther
-};
-
-struct InObj {
- Ref ref; // ref in original PDF
- InObjType type; // object type
- InObj *next; // next entry in list of indirect objects
- int num; // new object number in output PDF
- fd_entry *fd; // pointer to /FontDescriptor object structure
- int enc_objnum; // Encoding for objFont
- int written; // has it been written to output PDF?
-};
-
-struct UsedEncoding {
- int enc_objnum;
- GfxFont *font;
- UsedEncoding *next;
-};
-
-static InObj *inObjList;
-static UsedEncoding *encodingList;
-static GBool isInit = gFalse;
-
-// --------------------------------------------------------------------
-// Maintain list of open embedded PDF files
-// --------------------------------------------------------------------
-
-struct PdfDocument {
- char *file_name;
- PDFDoc *doc;
- XRef *xref;
- InObj *inObjList;
- int occurences; // number of references to the document; the doc can be
- // deleted when this is negative
- PdfDocument *next;
-};
-
-static PdfDocument *pdfDocuments = 0;
-
-static XRef *xref = 0;
-
-// Returns pointer to PdfDocument record for PDF file.
-// Creates a new record if it doesn't exist yet.
-// xref is made current for the document.
-
-static PdfDocument *find_add_document(char *file_name)
-{
- PdfDocument *p = pdfDocuments;
- while (p && strcmp(p->file_name, file_name) != 0)
- p = p->next;
- if (p) {
- xref = p->xref;
- (p->occurences)++;
- return p;
- }
- p = new PdfDocument;
- p->file_name = xstrdup(file_name);
- p->xref = xref = 0;
- p->occurences = 0;
- GString *docName = new GString(p->file_name);
- p->doc = new PDFDoc(docName); // takes ownership of docName
- if (!p->doc->isOk() || !p->doc->okToPrint()) {
- pdftex_fail("xpdf: reading PDF image failed");
- }
- p->inObjList = 0;
- p->next = pdfDocuments;
- pdfDocuments = p;
- return p;
-}
-
-// Deallocate a PdfDocument with all its resources
-
-static void delete_document(PdfDocument * pdf_doc)
-{
- PdfDocument **p = &pdfDocuments;
- while (*p && *p != pdf_doc)
- p = &((*p)->next);
- // should not happen:
- if (!*p)
- return;
- // unlink from list
- *p = pdf_doc->next;
- // free pdf_doc's resources
- InObj *r, *n;
- for (r = pdf_doc->inObjList; r != 0; r = n) {
- n = r->next;
- delete r;
- }
- xref = pdf_doc->xref;
- delete pdf_doc->doc;
- xfree(pdf_doc->file_name);
- delete pdf_doc;
-}
-
-// Replacement for
-// Object *initDict(Dict *dict1){ initObj(objDict); dict = dict1; return this; }
-
-static void initDictFromDict(PdfObject & obj, Dict * dict)
-{
- obj->initDict(xref);
- for (int i = 0, l = dict->getLength(); i < l; i++) {
- Object obj1;
- obj->dictAdd(copyString(dict->getKey(i)), dict->getValNF(i, &obj1));
- }
-}
-
-// --------------------------------------------------------------------
-
-static int addEncoding(GfxFont * gfont)
-{
- UsedEncoding *n;
- n = new UsedEncoding;
- n->next = encodingList;
- encodingList = n;
- n->font = gfont;
- n->enc_objnum = pdfnewobjnum();
- return n->enc_objnum;
-}
-
-#define addFont(ref, fd, enc_objnum) \
- addInObj(objFont, ref, fd, enc_objnum)
-
-// addFontDesc is only used to avoid writing the original FontDescriptor
-// from the PDF file.
-
-#define addFontDesc(ref, fd) \
- addInObj(objFontDesc, ref, fd, 0)
-
-#define addOther(ref) \
- addInObj(objOther, ref, 0, 0)
-
-static int addInObj(InObjType type, Ref ref, fd_entry * fd, int e)
-{
- InObj *p, *q, *n = new InObj;
- if (ref.num == 0)
- pdftex_fail("PDF inclusion: invalid reference");
- n->ref = ref;
- n->type = type;
- n->next = 0;
- n->fd = fd;
- n->enc_objnum = e;
- n->written = 0;
- if (inObjList == 0)
- inObjList = n;
- else {
- for (p = inObjList; p != 0; p = p->next) {
- if (p->ref.num == ref.num && p->ref.gen == ref.gen) {
- delete n;
- return p->num;
- }
- q = p;
- }
- // it is important to add new objects at the end of the list,
- // because new objects are being added while the list is being
- // written out.
- q->next = n;
- }
- if (type == objFontDesc)
- n->num = get_fd_objnum(fd);
- else
- n->num = pdfnewobjnum();
- return n->num;
-}
-
-#if 0 /* unusewd */
-static int getNewObjectNumber(Ref ref)
-{
- InObj *p;
- if (inObjList == 0) {
- pdftex_fail("No objects copied yet");
- } else {
- for (p = inObjList; p != 0; p = p->next) {
- if (p->ref.num == ref.num && p->ref.gen == ref.gen) {
- return p->num;
- }
- }
- pdftex_fail("Object not yet copied: %i %i", ref.num, ref.gen);
- }
-#ifdef _MSC_VER
- /* Never reached, but without __attribute__((noreturn)) for pdftex_fail()
- MSVC 5.0 requires an int return value. */
- return -60000;
-#endif
-}
-#endif
-
-static void copyObject(Object *);
-
-static void copyName(char *s)
-{
- pdf_puts("/");
- for (; *s != 0; s++) {
- if (isdigit(*s) || isupper(*s) || islower(*s) || *s == '_' ||
- *s == '.' || *s == '-' || *s == '+')
- pdfout(*s);
- else
- pdf_printf("#%.2X", *s & 0xFF);
- }
-}
-
-static void copyDictEntry(Object * obj, int i)
-{
- PdfObject obj1;
- copyName(obj->dictGetKey(i));
- pdf_puts(" ");
- obj->dictGetValNF(i, &obj1);
- copyObject(&obj1);
- pdf_puts("\n");
-}
-
-static void copyDict(Object * obj)
-{
- int i, l;
- if (!obj->isDict())
- pdftex_fail("PDF inclusion: invalid dict type <%s>",
- obj->getTypeName());
- for (i = 0, l = obj->dictGetLength(); i < l; ++i)
- copyDictEntry(obj, i);
-}
-
-static void copyFontDict(Object * obj, InObj * r)
-{
- int i, l;
- char *key;
- if (!obj->isDict())
- pdftex_fail("PDF inclusion: invalid dict type <%s>",
- obj->getTypeName());
- pdf_puts("<<\n");
- assert(r->type == objFont); // FontDescriptor is in fd_tree
- for (i = 0, l = obj->dictGetLength(); i < l; ++i) {
- key = obj->dictGetKey(i);
- if (strncmp("FontDescriptor", key, strlen("FontDescriptor")) == 0
- || strncmp("BaseFont", key, strlen("BaseFont")) == 0
- || strncmp("Encoding", key, strlen("Encoding")) == 0)
- continue; // skip original values
- copyDictEntry(obj, i);
- }
- // write new FontDescriptor, BaseFont, and Encoding
- pdf_printf("/FontDescriptor %d 0 R\n", get_fd_objnum(r->fd));
- pdf_printf("/BaseFont %d 0 R\n", get_fn_objnum(r->fd));
- pdf_printf("/Encoding %d 0 R\n", r->enc_objnum);
- pdf_puts(">>");
-}
-
-static void copyStream(Stream * str)
-{
- int c, c2 = 0;
- str->reset();
- while ((c = str->getChar()) != EOF) {
- pdfout(c);
- c2 = c;
- }
- pdflastbyte = c2;
-}
-
-static void copyProcSet(Object * obj)
-{
- int i, l;
- PdfObject procset;
- if (!obj->isArray())
- pdftex_fail("PDF inclusion: invalid ProcSet array type <%s>",
- obj->getTypeName());
- pdf_puts("/ProcSet [ ");
- for (i = 0, l = obj->arrayGetLength(); i < l; ++i) {
- obj->arrayGetNF(i, &procset);
- if (!procset->isName())
- pdftex_fail("PDF inclusion: invalid ProcSet entry type <%s>",
- procset->getTypeName());
- copyName(procset->getName());
- pdf_puts(" ");
- }
- pdf_puts("]\n");
-}
-
-#define REPLACE_TYPE1C true
-
-static void copyFont(char *tag, Object * fontRef)
-{
- PdfObject fontdict, subtype, basefont, fontdescRef, fontdesc, charset,
- fontfile, ffsubtype, stemV;
- GfxFont *gfont;
- fd_entry *fd;
- fm_entry *fontmap;
- // Check whether the font has already been embedded before analysing it.
- InObj *p;
- Ref ref = fontRef->getRef();
- for (p = inObjList; p; p = p->next) {
- if (p->ref.num == ref.num && p->ref.gen == ref.gen) {
- copyName(tag);
- pdf_printf(" %d 0 R ", p->num);
- return;
- }
- }
- // Only handle included Type1 (and Type1C) fonts; anything else will be copied.
- // Type1C fonts are replaced by Type1 fonts, if REPLACE_TYPE1C is true.
- if (!fixedinclusioncopyfont && fontRef->fetch(xref, &fontdict)->isDict()
- && fontdict->dictLookup("Subtype", &subtype)->isName()
- && !strcmp(subtype->getName(), "Type1")
- && fontdict->dictLookup("BaseFont", &basefont)->isName()
- && fontdict->dictLookupNF("FontDescriptor", &fontdescRef)->isRef()
- && fontdescRef->fetch(xref, &fontdesc)->isDict()
- && (fontdesc->dictLookup("FontFile", &fontfile)->isStream()
- || (REPLACE_TYPE1C
- && fontdesc->dictLookup("FontFile3", &fontfile)->isStream()
- && fontfile->streamGetDict()->lookup("Subtype",
- &ffsubtype)->isName()
- && !strcmp(ffsubtype->getName(), "Type1C")))
- && (fontmap = lookup_fontmap(basefont->getName())) != NULL) {
- // round /StemV value, since the PDF input is a float
- // (see Font Descriptors in PDF reference), but we only store an
- // integer, since we don't want to change the struct.
- fontdesc->dictLookup("StemV", &stemV);
- fd = epdf_create_fontdescriptor(fontmap, zround(stemV->getNum()));
- if (fontdesc->dictLookup("CharSet", &charset) &&
- charset->isString() && is_subsetable(fontmap))
- epdf_mark_glyphs(fd, charset->getString()->getCString());
- else
- embed_whole_font(fd);
- addFontDesc(fontdescRef->getRef(), fd);
- copyName(tag);
- gfont = GfxFont::makeFont(xref, tag, fontRef->getRef(),
- fontdict->getDict());
- pdf_printf(" %d 0 R ", addFont(fontRef->getRef(), fd,
- addEncoding(gfont)));
- } else {
- copyName(tag);
- pdf_puts(" ");
- copyObject(fontRef);
- }
-}
-
-static void copyFontResources(Object * obj)
-{
- PdfObject fontRef;
- int i, l;
- if (!obj->isDict())
- pdftex_fail("PDF inclusion: invalid font resources dict type <%s>",
- obj->getTypeName());
- pdf_puts("/Font << ");
- for (i = 0, l = obj->dictGetLength(); i < l; ++i) {
- obj->dictGetValNF(i, &fontRef);
- if (fontRef->isRef())
- copyFont(obj->dictGetKey(i), &fontRef);
- else if (fontRef->isDict()) { // some programs generate pdf with embedded font object
- copyName(obj->dictGetKey(i));
- pdf_puts(" ");
- copyObject(&fontRef);
- }
- else
- pdftex_fail("PDF inclusion: invalid font in reference type <%s>",
- fontRef->getTypeName());
- }
- pdf_puts(">>\n");
-}
-
-static void copyOtherResources(Object * obj, char *key)
-{
- // copies all other resources (write_epdf handles Fonts and ProcSets),
-
- // if Subtype is present, it must be a name
- if (strcmp("Subtype", key) == 0) {
- if (!obj->isName()) {
- pdftex_warn("PDF inclusion: Subtype in Resources dict is not a name"
- " (key '%s', type <%s>); ignored.",
- key, obj->getTypeName());
- return;
- }
- } else if (!obj->isDict()) {
- //FIXME: Write the message only to the log file
- pdftex_warn("PDF inclusion: invalid other resource which is no dict"
- " (key '%s', type <%s>); ignored.",
- key, obj->getTypeName());
- return;
- }
- copyName(key);
- pdf_puts(" ");
- copyObject(obj);
-}
-
-// Function onverts double to string; very small and very large numbers
-// are NOT converted to scientific notation.
-// n must be a number or real conforming to the implementation limits
-// of PDF as specified in appendix C.1 of the PDF Ref.
-// These are:
-// maximum value of ints is +2^32
-// maximum value of reals is +2^15
-// smalles values of reals is 1/(2^16)
-
-static char *convertNumToPDF(double n)
-{
- static const int precision = 6;
- static const int fact = (int) 1E6; // must be 10^precision
- static const double epsilon = 0.5E-6; // 2epsilon must be 10^-precision
- static char buf[64];
- // handle very small values: return 0
- if (fabs(n) < epsilon) {
- buf[0] = '0';
- buf[1] = '\0';
- } else {
- char ints[64];
- int bindex = 0, sindex = 0;
- int ival, fval;
- // handle the sign part if n is negative
- if (n < 0) {
- buf[bindex++] = '-';
- n = -n;
- }
- n += epsilon; // for rounding
- // handle the integer part, simply with sprintf
- ival = (int) floor(n);
- n -= ival;
- sprintf(ints, "%d", ival);
- while (ints[sindex] != 0)
- buf[bindex++] = ints[sindex++];
- // handle the fractional part up to 'precision' digits
- fval = (int) floor(n * fact);
- if (fval) {
- // set a dot
- buf[bindex++] = '.';
- sindex = bindex + precision;
- buf[sindex--] = '\0';
- // fill up trailing zeros with the string terminator NULL
- while (((fval % 10) == 0) && (sindex >= bindex)) {
- buf[sindex--] = '\0';
- fval /= 10;
- }
- // fill up the fractional part back to front
- while (sindex >= bindex) {
- buf[sindex--] = (fval % 10) + '0';
- fval /= 10;
- }
- } else
- buf[bindex++] = 0;
- }
- return (char *) buf;
-}
-
-static void copyObject(Object * obj)
-{
- PdfObject obj1;
- int i, l, c;
- Ref ref;
- char *p;
- GString *s;
- if (obj->isBool()) {
- pdf_printf("%s", obj->getBool()? "true" : "false");
- } else if (obj->isInt()) {
- pdf_printf("%i", obj->getInt());
- } else if (obj->isReal()) {
- pdf_printf("%s", convertNumToPDF(obj->getReal()));
- } else if (obj->isNum()) {
- pdf_printf("%s", convertNumToPDF(obj->getNum()));
- } else if (obj->isString()) {
- s = obj->getString();
- p = s->getCString();
- l = s->getLength();
- if (strlen(p) == (unsigned int) l) {
- pdf_puts("(");
- for (; *p != 0; p++) {
- c = (unsigned char) *p;
- if (c == '(' || c == ')' || c == '\\')
- pdf_printf("\\%c", c);
- else if (c < 0x20 || c > 0x7F)
- pdf_printf("\\%03o", c);
- else
- pdfout(c);
- }
- pdf_puts(")");
- } else {
- pdf_puts("<");
- for (i = 0; i < l; i++) {
- c = s->getChar(i) & 0xFF;
- pdf_printf("%.2x", c);
- }
- pdf_puts(">");
- }
- } else if (obj->isName()) {
- copyName(obj->getName());
- } else if (obj->isNull()) {
- pdf_puts("null");
- } else if (obj->isArray()) {
- pdf_puts("[");
- for (i = 0, l = obj->arrayGetLength(); i < l; ++i) {
- obj->arrayGetNF(i, &obj1);
- if (!obj1->isName())
- pdf_puts(" ");
- copyObject(&obj1);
- }
- pdf_puts("]");
- } else if (obj->isDict()) {
- pdf_puts("<<\n");
- copyDict(obj);
- pdf_puts(">>");
- } else if (obj->isStream()) {
- initDictFromDict(obj1, obj->streamGetDict());
- pdf_puts("<<\n");
- copyDict(&obj1);
- pdf_puts(">>\n");
- pdf_puts("stream\n");
- copyStream(obj->getStream()->getUndecodedStream());
- pdf_puts("\nendstream");
- } else if (obj->isRef()) {
- ref = obj->getRef();
- if (ref.num == 0) {
- pdftex_fail
- ("PDF inclusion: reference to invalid object"
- " (is the included pdf broken?)");
- } else
- pdf_printf("%d 0 R", addOther(ref));
- } else {
- pdftex_fail("PDF inclusion: type <%s> cannot be copied",
- obj->getTypeName());
- }
-}
-
-static void writeRefs()
-{
- InObj *r;
- for (r = inObjList; r != 0; r = r->next) {
- if (!r->written) {
- Object obj1;
- r->written = 1;
- xref->fetch(r->ref.num, r->ref.gen, &obj1);
- if (r->type == objFont) {
- assert(!obj1.isStream());
- pdfbeginobj(r->num, 2); // \pdfobjcompresslevel = 2 is for this
- copyFontDict(&obj1, r);
- pdf_puts("\n");
- pdfendobj();
- } else if (r->type != objFontDesc) { // /FontDescriptor is written via write_fontdescriptor()
- if (obj1.isStream())
- pdfbeginobj(r->num, 0);
- else
- pdfbeginobj(r->num, 2); // \pdfobjcompresslevel = 2 is for this
- copyObject(&obj1);
- pdf_puts("\n");
- pdfendobj();
- }
- obj1.free();
- }
- }
-}
-
-static void writeEncodings()
-{
- UsedEncoding *r, *n;
- char *glyphNames[256], *s;
- int i;
- for (r = encodingList; r != 0; r = r->next) {
- for (i = 0; i < 256; i++) {
- if (r->font->isCIDFont()) {
- pdftex_fail
- ("PDF inclusion: CID fonts are not supported"
- " (try to disable font replacement to fix this)");
- }
- if ((s = ((Gfx8BitFont *) r->font)->getCharName(i)) != 0)
- glyphNames[i] = s;
- else
- glyphNames[i] = notdef;
- }
- epdf_write_enc(glyphNames, r->enc_objnum);
- }
- for (r = encodingList; r != 0; r = n) {
- n = r->next;
- delete r->font;
- delete r;
- }
-}
-
-// get the pagebox according to the pagebox_spec
-static PDFRectangle *get_pagebox(Page * page, int pagebox_spec)
-{
- if (pagebox_spec == pdfboxspecmedia)
- return page->getMediaBox();
- else if (pagebox_spec == pdfboxspeccrop)
- return page->getCropBox();
- else if (pagebox_spec == pdfboxspecbleed)
- return page->getBleedBox();
- else if (pagebox_spec == pdfboxspectrim)
- return page->getTrimBox();
- else if (pagebox_spec == pdfboxspecart)
- return page->getArtBox();
- else
- pdftex_fail("PDF inclusion: unknown value of pagebox spec (%i)",
- (int) pagebox_spec);
- return page->getMediaBox(); // to make the compiler happy
-}
-
-
-// Reads various information about the PDF and sets it up for later inclusion.
-// This will fail if the PDF version of the PDF is higher than
-// minor_pdf_version_wanted or page_name is given and can not be found.
-// It makes no sense to give page_name _and_ page_num.
-// Returns the page number.
-
-int
-read_pdf_info(char *image_name, char *page_name, int page_num,
- int pagebox_spec, int major_pdf_version_wanted, int minor_pdf_version_wanted,
- int pdf_inclusion_errorlevel)
-{
- PdfDocument *pdf_doc;
- Page *page;
- PDFRectangle *pagebox;
- float pdf_version_found, pdf_version_wanted;
- // initialize
- if (!isInit) {
- globalParams = new GlobalParams();
- globalParams->setErrQuiet(gFalse);
- isInit = gTrue;
- }
- // open PDF file
- pdf_doc = find_add_document(image_name);
- epdf_doc = (void *) pdf_doc;
-
- // check PDF version
- // this works only for PDF 1.x -- but since any versions of PDF newer
- // than 1.x will not be backwards compatible to PDF 1.x, pdfTeX will
- // then have to changed drastically anyway.
- pdf_version_found = pdf_doc->doc->getPDFVersion();
- pdf_version_wanted = major_pdf_version_wanted + (minor_pdf_version_wanted * 0.1);
- if (pdf_version_found > pdf_version_wanted + 0.01) {
- char msg[] =
- "PDF inclusion: found PDF version <%.1f>, but at most version <%.1f> allowed";
- if (pdf_inclusion_errorlevel > 0) {
- pdftex_fail(msg, pdf_version_found, pdf_version_wanted);
- } else if (pdf_inclusion_errorlevel < 0) {
- ; /* do nothing */
- } else { /* = 0, give warning */
- pdftex_warn(msg, pdf_version_found, pdf_version_wanted);
- }
- }
- epdf_num_pages = pdf_doc->doc->getCatalog()->getNumPages();
- if (page_name) {
- // get page by name
- GString name(page_name);
- LinkDest *link = pdf_doc->doc->findDest(&name);
- if (link == 0 || !link->isOk())
- pdftex_fail("PDF inclusion: invalid destination <%s>", page_name);
- Ref ref = link->getPageRef();
- page_num = pdf_doc->doc->getCatalog()->findPage(ref.num, ref.gen);
- if (page_num == 0)
- pdftex_fail("PDF inclusion: destination is not a page <%s>",
- page_name);
- delete link;
- } else {
- // get page by number
- if (page_num <= 0 || page_num > epdf_num_pages)
- pdftex_fail("PDF inclusion: required page does not exist <%i>",
- epdf_num_pages);
- }
- // get the required page
- page = pdf_doc->doc->getCatalog()->getPage(page_num);
-
- // get the pagebox (media, crop...) to use.
- pagebox = get_pagebox(page, pagebox_spec);
- if (pagebox->x2 > pagebox->x1) {
- epdf_orig_x = pagebox->x1;
- epdf_width = pagebox->x2 - pagebox->x1;
- } else {
- epdf_orig_x = pagebox->x2;
- epdf_width = pagebox->x1 - pagebox->x2;
- }
- if (pagebox->y2 > pagebox->y1) {
- epdf_orig_y = pagebox->y1;
- epdf_height = pagebox->y2 - pagebox->y1;
- } else {
- epdf_orig_y = pagebox->y2;
- epdf_height = pagebox->y1 - pagebox->y2;
- }
-
- // get page rotation
- epdf_rotate = page->getRotate() % 360;
- if (epdf_rotate < 0)
- epdf_rotate += 360;
-
- // page group
- if (page->getGroup() != NULL)
- epdf_has_page_group = 1; // only flag that page group is present;
- // the actual object number will be
- // generated in pdftex.web
- else
- epdf_has_page_group = 0; // no page group present
-
- pdf_doc->xref = pdf_doc->doc->getXRef();
- return page_num;
-}
-
-// writes the current epf_doc.
-// Here the included PDF is copied, so most errors that can happen during PDF
-// inclusion will arise here.
-
-void write_epdf(void)
-{
- Page *page;
- Ref *pageRef;
- Dict *pageDict;
- PdfObject contents, obj1, obj2, pageObj, dictObj;
- PdfObject groupDict;
- bool writeSepGroup = false;
- Object info;
- char *key;
- char s[256];
- int i, l;
- int rotate;
- double scale[6] = { 0, 0, 0, 0, 0, 0 };
- bool writematrix = false;
- int suppress_ptex_info = getpdfsuppressptexinfo();
- static const char *pageDictKeys[] = {
- "LastModified",
- "Metadata",
- "PieceInfo",
- "SeparationInfo",
-// "Group",
-// "Resources",
- NULL
- };
-
- PdfDocument *pdf_doc = (PdfDocument *) epdf_doc;
- (pdf_doc->occurences)--;
- xref = pdf_doc->xref;
- inObjList = pdf_doc->inObjList;
- encodingList = 0;
- page = pdf_doc->doc->getCatalog()->getPage(epdf_selected_page);
- pageRef = pdf_doc->doc->getCatalog()->getPageRef(epdf_selected_page);
- xref->fetch(pageRef->num, pageRef->gen, &pageObj);
- pageDict = pageObj->getDict();
- rotate = page->getRotate();
- PDFRectangle *pagebox;
- // write the Page header
- pdf_puts("/Type /XObject\n");
- pdf_puts("/Subtype /Form\n");
- pdf_puts("/FormType 1\n");
-
- // write additional information
- if ((suppress_ptex_info & MASK_SUPPRESS_PTEX_FILENAME) == 0) {
- pdf_printf("/%s.FileName (%s)\n", pdfkeyprefix,
- convertStringToPDFString(pdf_doc->file_name,
- strlen(pdf_doc->file_name)));
- }
- if ((suppress_ptex_info & MASK_SUPPRESS_PTEX_PAGENUMBER) == 0) {
- pdf_printf("/%s.PageNumber %i\n", pdfkeyprefix, (int) epdf_selected_page);
- }
- if ((suppress_ptex_info & MASK_SUPPRESS_PTEX_INFODICT) == 0) {
- pdf_doc->doc->getDocInfoNF(&info);
- if (info.isRef()) {
- // the info dict must be indirect (PDF Ref p. 61)
- pdf_printf("/%s.InfoDict ", pdfkeyprefix);
- pdf_printf("%d 0 R\n", addOther(info.getRef()));
- }
- }
- // get the pagebox (media, crop...) to use.
- pagebox = get_pagebox(page, epdf_page_box);
-
- // handle page rotation
- if (rotate != 0) {
- if (rotate % 90 == 0) {
- // this handles only the simple case: multiple of 90s but these
- // are the only values allowed according to the reference
- // (v1.3, p. 78).
- // the image is rotated around its center.
- // the /Rotate key is clockwise while the matrix is
- // counterclockwise :-%
- tex_printf(", page is rotated %d degrees", rotate);
- switch (rotate) {
- case 90:
- scale[1] = -1;
- scale[2] = 1;
- scale[4] = pagebox->x1 - pagebox->y1;
- scale[5] = pagebox->y1 + pagebox->x2;
- writematrix = true;
- break;
- case 180:
- scale[0] = scale[3] = -1;
- scale[4] = pagebox->x1 + pagebox->x2;
- scale[5] = pagebox->y1 + pagebox->y2;
- writematrix = true;
- break; // width and height are exchanged
- case 270:
- scale[1] = 1;
- scale[2] = -1;
- scale[4] = pagebox->x1 + pagebox->y2;
- scale[5] = pagebox->y1 - pagebox->x1;
- writematrix = true;
- break;
- }
- if (writematrix) { // The matrix is only written if the image is rotated.
- sprintf(s, "/Matrix [%.8f %.8f %.8f %.8f %.8f %.8f]\n",
- scale[0],
- scale[1], scale[2], scale[3], scale[4], scale[5]);
- pdf_puts(stripzeros(s));
- }
- }
- }
-
- sprintf(s, "/BBox [%.8f %.8f %.8f %.8f]\n",
- pagebox->x1, pagebox->y1, pagebox->x2, pagebox->y2);
- pdf_puts(stripzeros(s));
-
- // Metadata validity check (as a stream it must be indirect)
- pageDict->lookupNF("Metadata", &dictObj);
- if (!dictObj->isNull() && !dictObj->isRef())
- pdftex_warn("PDF inclusion: /Metadata must be indirect object");
-
- // copy selected items in Page dictionary except Resources & Group
- for (i = 0; pageDictKeys[i] != NULL; i++) {
- pageDict->lookupNF(pageDictKeys[i], &dictObj);
- if (!dictObj->isNull()) {
- pdf_newline();
- pdf_printf("/%s ", pageDictKeys[i]);
- copyObject(&dictObj); // preserves indirection
- }
- }
-
- // handle page group
- pageDict->lookupNF("Group", &dictObj);
- if (!dictObj->isNull()) {
- if (pdfpagegroupval == 0) {
- // another pdf with page group was included earlier on the
- // same page; copy the Group entry as is. See manual for
- // info on why this is a warning.
- if (getpdfsuppresswarningpagegroup() == 0) {
- pdftex_warn
- ("PDF inclusion: multiple pdfs with page group included in a single page");
- }
- pdf_newline();
- pdf_puts("/Group ");
- copyObject(&dictObj);
- } else {
- // write Group dict as a separate object, since the Page dict also refers to it
- pageDict->lookup("Group", &dictObj);
- if (!dictObj->isDict())
- pdftex_fail("PDF inclusion: /Group dict missing");
- writeSepGroup = true;
- initDictFromDict(groupDict, page->getGroup());
- pdf_printf("/Group %ld 0 R\n", (long)pdfpagegroupval);
- }
- }
-
- // write the Resources dictionary
- if (page->getResourceDict() == NULL) {
- // Resources can be missing (files without them have been spotted
- // in the wild); in which case the /Resouces of the /Page will be used.
- // "This practice is not recommended".
- pdftex_warn
- ("PDF inclusion: /Resources missing. 'This practice is not recommended' (PDF Ref)");
- } else {
- initDictFromDict(obj1, page->getResourceDict());
- if (!obj1->isDict())
- pdftex_fail("PDF inclusion: invalid resources dict type <%s>",
- obj1->getTypeName());
- pdf_newline();
- pdf_puts("/Resources <<\n");
- for (i = 0, l = obj1->dictGetLength(); i < l; ++i) {
- obj1->dictGetVal(i, &obj2);
- key = obj1->dictGetKey(i);
- if (strcmp("Font", key) == 0)
- copyFontResources(&obj2);
- else if (strcmp("ProcSet", key) == 0)
- copyProcSet(&obj2);
- else
- copyOtherResources(&obj2, key);
- }
- pdf_puts(">>\n");
- }
-
- // write the page contents
- page->getContents(&contents);
- if (contents->isStream()) {
-
- // Variant A: get stream and recompress under control
- // of \pdfcompresslevel
- //
- // pdfbeginstream();
- // copyStream(contents->getStream());
- // pdfendstream();
-
- // Variant B: copy stream without recompressing
- //
- contents->streamGetDict()->lookup("F", &obj1);
- if (!obj1->isNull()) {
- pdftex_fail("PDF inclusion: Unsupported external stream");
- }
- contents->streamGetDict()->lookup("Length", &obj1);
- assert(!obj1->isNull());
- pdf_puts("/Length ");
- copyObject(&obj1);
- pdf_puts("\n");
- contents->streamGetDict()->lookup("Filter", &obj1);
- if (!obj1->isNull()) {
- pdf_puts("/Filter ");
- copyObject(&obj1);
- pdf_puts("\n");
- contents->streamGetDict()->lookup("DecodeParms", &obj1);
- if (!obj1->isNull()) {
- pdf_puts("/DecodeParms ");
- copyObject(&obj1);
- pdf_puts("\n");
- }
- }
- pdf_puts(">>\nstream\n");
- copyStream(contents->getStream()->getUndecodedStream());
- pdfendstream();
- } else if (contents->isArray()) {
- pdfbeginstream();
- for (i = 0, l = contents->arrayGetLength(); i < l; ++i) {
- Object contentsobj;
- copyStream((contents->arrayGet(i, &contentsobj))->getStream());
- contentsobj.free();
- if (i < l - 1)
- pdf_newline(); // add a newline after each stream except the last
- }
- pdfendstream();
- } else { // the contents are optional, but we need to include an empty stream
- pdfbeginstream();
- pdfendstream();
- }
-
- // write out all indirect objects
- writeRefs();
-
- // write out all used encodings (and delete list)
- writeEncodings();
-
- // write the Group dict if needed
- if (writeSepGroup) {
- pdfbeginobj(pdfpagegroupval, 2);
- copyObject(&groupDict);
- pdf_puts("\n");
- pdfendobj();
- pdfpagegroupval = 0; // only the 1st included pdf on a page gets its
- // Group included in the Page dict
- }
-
- // save object list, xref
- pdf_doc->inObjList = inObjList;
- pdf_doc->xref = xref;
-}
-
-// Called when an image has been written and it's resources in image_tab are
-// freed and it's not referenced anymore.
-
-void epdf_delete()
-{
- PdfDocument *pdf_doc = (PdfDocument *) epdf_doc;
- xref = pdf_doc->xref;
- if (pdf_doc->occurences < 0) {
- delete_document(pdf_doc);
- }
-}
-
-// Called when PDF embedding system is finalized.
-// Now deallocate all remaining PdfDocuments.
-
-void epdf_check_mem()
-{
- if (isInit) {
- PdfDocument *p, *n;
- for (p = pdfDocuments; p; p = n) {
- n = p->next;
- delete_document(p);
- }
- // see above for globalParams
- delete globalParams;
- }
-}
diff --git a/Build/source/texk/web2c/pdftexdir/pdftosrc.cc b/Build/source/texk/web2c/pdftexdir/pdftosrc.cc
deleted file mode 100644
index 2fd9d5f9283..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftosrc.cc
+++ /dev/null
@@ -1,204 +0,0 @@
-/*
-Copyright 1996-2017 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-#include <w2c/config.h>
-
-#include <stdlib.h>
-#include <stddef.h>
-#include <stdio.h>
-#include <string.h>
-#include <ctype.h>
-
-#include <aconf.h>
-#include <GString.h>
-#include <gmem.h>
-#include <gfile.h>
-#include <assert.h>
-
-#include "Object.h"
-#include "Stream.h"
-#include "Lexer.h"
-#include "Parser.h"
-#include "Array.h"
-#include "Dict.h"
-#include "XRef.h"
-#include "Catalog.h"
-#include "Page.h"
-#include "GfxFont.h"
-#include "PDFDoc.h"
-#include "GlobalParams.h"
-#include "Error.h"
-
-static XRef *xref = 0;
-
-int main(int argc, char *argv[])
-{
- char *p, buf[1024];
- PDFDoc *doc;
- GString *fileName;
- Stream *s;
- Object srcStream, srcName, catalogDict;
- FILE *outfile;
- char *outname;
- int objnum = 0, objgen = 0;
- bool extract_xref_table = false;
- int c;
- fprintf(stderr, "pdftosrc version %s\n", xpdfVersion);
- if (argc < 2) {
- fprintf(stderr,
- "Usage: pdftosrc <PDF-file> [<stream-object-number>]\n");
- exit(1);
- }
- fileName = new GString(argv[1]);
- globalParams = new GlobalParams();
- doc = new PDFDoc(fileName);
- if (!doc->isOk()) {
- fprintf(stderr, "Invalid PDF file\n");
- exit(1);
- }
- if (argc >= 3) {
- objnum = atoi(argv[2]);
- if (argc >= 4)
- objgen = atoi(argv[3]);
- }
- xref = doc->getXRef();
- catalogDict.initNull();
- xref->getCatalog(&catalogDict);
- if (!catalogDict.isDict("Catalog")) {
- fprintf(stderr, "No Catalog found\n");
- exit(1);
- }
- srcStream.initNull();
- if (objnum == 0) {
- catalogDict.dictLookup("SourceObject", &srcStream);
- static char const_SourceFile[] = "SourceFile";
- if (!srcStream.isStream(const_SourceFile)) {
- fprintf(stderr, "No SourceObject found\n");
- exit(1);
- }
- srcName.initNull();
- srcStream.getStream()->getDict()->lookup("SourceName", &srcName);
- if (!srcName.isString()) {
- fprintf(stderr, "No SourceName found\n");
- exit(1);
- }
- outname = srcName.getString()->getCString();
- // We cannot free srcName, as objname shares its string.
- // srcName.free();
- } else if (objnum > 0) {
- xref->fetch(objnum, objgen, &srcStream);
- if (!srcStream.isStream()) {
- fprintf(stderr, "Not a Stream object\n");
- exit(1);
- }
- sprintf(buf, "%s", fileName->getCString());
- if ((p = strrchr(buf, '.')) == 0)
- p = strchr(buf, 0);
- if (objgen == 0)
- sprintf(p, ".%i", objnum);
- else
- sprintf(p, ".%i+%i", objnum, objgen);
- outname = buf;
- } else { // objnum < 0 means we are extracting the XRef table
- extract_xref_table = true;
- sprintf(buf, "%s", fileName->getCString());
- if ((p = strrchr(buf, '.')) == 0)
- p = strchr(buf, 0);
- sprintf(p, ".xref");
- outname = buf;
- }
- if (!(outfile = fopen(outname, "wb"))) {
- fprintf(stderr, "Cannot open file \"%s\" for writing\n", outname);
- exit(1);
- }
- if (extract_xref_table) {
- int size = xref->getNumObjects();
- int i;
- for (i = 0; i < size; i++) {
- if (xref->getEntry(i)->offset == 0xffffffff)
- break;
- }
- size = i;
- fprintf(outfile, "xref\n");
- fprintf(outfile, "0 %i\n", size);
- for (i = 0; i < size; i++) {
- XRefEntry *e = xref->getEntry(i);
- if (e->type != xrefEntryCompressed)
- fprintf(outfile, "%.10lu %.5i %s\n",
- (long unsigned) e->offset, e->gen,
- (e->type == xrefEntryFree ? "f" : "n"));
- else { // e->offset is the object number of the object stream
- Stream *str;
- Lexer *lexer;
- Parser *parser;
- Object objStr, obj1, obj2;
- int nObjects, first, n;
- int localOffset = 0;
- Guint firstOffset;
-
- assert(xref->fetch(e->offset, 0, &objStr)->isStream());
- nObjects = objStr.streamGetDict()->lookup("N", &obj1)->getInt();
- obj1.free();
- first = objStr.streamGetDict()->lookup("First", &obj1)->getInt();
- obj1.free();
- firstOffset = objStr.getStream()->getBaseStream()->getStart() + first;
-
- // parse the header: object numbers and offsets
- objStr.streamReset();
- obj1.initNull();
- str = new EmbedStream(objStr.getStream(), &obj1, gTrue, first);
- lexer = new Lexer(xref, str);
- parser = new Parser(xref, lexer, gFalse);
- for (n = 0; n < nObjects; ++n) {
- parser->getObj(&obj1);
- parser->getObj(&obj2);
- if (n == e->gen)
- localOffset = obj2.getInt();
- obj1.free();
- obj2.free();
- }
-#if defined(XPDF304)
- while (str->getChar() != EOF) ;
-#else /* xpdf 4.00 */
- lexer->skipToEOF();
-#endif
- delete parser;
- objStr.free();
-
- fprintf(outfile, "%.10lu 00000 n\n",
- (long unsigned)(firstOffset + localOffset));
- }
- }
- } else {
- s = srcStream.getStream();
- s->reset();
- while ((c = s->getChar()) != EOF)
- fputc(c, outfile);
- srcStream.free();
- }
- if (objnum == 0)
- fprintf(stderr, "Source file extracted to %s\n", outname);
- else if (objnum > 0)
- fprintf(stderr, "Stream object extracted to %s\n", outname);
- else
- fprintf(stderr, "Cross-reference table extracted to %s\n", outname);
- fclose(outfile);
- catalogDict.free();
- delete doc;
- delete globalParams;
-}
diff --git a/Build/source/texk/web2c/pdftexdir/pdftosrc.test b/Build/source/texk/web2c/pdftexdir/pdftosrc.test
deleted file mode 100755
index e93c3e83eab..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pdftosrc.test
+++ /dev/null
@@ -1,20 +0,0 @@
-#! /bin/sh -vx
-# $Id: pdftosrc.test 804 2018-05-17 22:29:15Z karl $
-# Copyright 2017 Karl Berry <tex-live@tug.org>
-# Copyright 2011 Peter Breitenlohner <tex-live@tug.org>
-# You may freely use, modify and/or distribute this file.
-
-src=$srcdir/pdftexdir/tests
-
-rm -rf test-13.* test-15.*
-
-cp $src/test-13.pdf .
-./pdftosrc test-13.pdf -1 \
- && diff test-13.xref $src/test-13.xref \
- || exit 1
-
-cp $src/test-15.pdf .
-./pdftosrc test-15.pdf -1 \
- && diff test-15.xref $src/test-15.xref \
- || exit 1
-
diff --git a/Build/source/texk/web2c/pdftexdir/pkin.c b/Build/source/texk/web2c/pdftexdir/pkin.c
deleted file mode 100644
index e698a5625ee..00000000000
--- a/Build/source/texk/web2c/pdftexdir/pkin.c
+++ /dev/null
@@ -1,425 +0,0 @@
-/*
-Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-/*
- * NAME
- * pkin.c - implementation of readchar()
- * DESCRIPTION
- * This implementation of readchar() uses parts of the program dvips
- * written by Tomas Rokicki--the inventor of the pkformat--(loadfont.c,
- * download.c and unpack.c). Dvips in turn is derived from pktype.
- * Pktype(TeX) is described in debt in ``The PKtype processor'',
- * which is available as pktype.weave as part of the METAFONTware.
- * What was needed to implement readchar() is rearranged in pkfile.c to
- * get more modularity in the style of MODULA2.
- * BUGFIXES
- * May 1997: Eric Delaunay <delaunay@lix.polytechnique.fr> reports a
- * problem with huge fonts (greater than 1008 DPI). The code for
- * handling PK characters in `extended format' was wrongly derived
- * from dvips. Made some minor improvements regarding error handling.
- * REDESIGN
- * Piet Tutelaers
- * rcpt@urc.tue.nl
- *
- * Modified for use with pdftex by Han The Thanh <thanh@fi.muni.cz>.
- */
-
-#include "ptexlib.h"
-
-/*
- * Now we have some routines to get stuff from the pk file. pkbyte returns
- * the next byte from the pk file.
- */
-
-
-/*
-static FILE *pkfile ;
-*/
-#define pkfile t3_file
-
-static shalfword pkbyte(void)
-{
- register shalfword i;
-
- if ((i = xgetc(pkfile)) == EOF)
- pdftex_fail("unexpected eof in pk file");
- return (i);
-}
-
-static integer pkduo(void)
-{
- register integer i;
-
- i = pkbyte();
- if (i > 127)
- i -= 256;
- i = i * 256 + pkbyte();
- return (i);
-}
-
-static integer pktrio(void)
-{
- register integer i;
-
- i = pkbyte();
- if (i > 127)
- i -= 256;
- i = i * 256 + pkbyte();
- i = i * 256 + pkbyte();
- return (i);
-}
-
-static integer pkquad(void)
-{
- register integer i;
-
- i = pkbyte();
- if (i > 127)
- i -= 256;
- i = i * 256 + pkbyte();
- i = i * 256 + pkbyte();
- i = i * 256 + pkbyte();
- return (i);
-}
-
-/*
- * The next part is devoted to unpacking the character data.
- */
-
-/*
- * We need procedures to get a nybble, bit, and packed word from the
- * packed data structure.
- */
-
-static halfword inputbyte, flagbyte;
-static halfword bitweight;
-static halfword dynf;
-static halfword repeatcount;
-
-static shalfword getnyb(void)
-{
- halfword temp;
- if (bitweight == 0) {
- bitweight = 16;
- inputbyte = pkbyte();
- temp = inputbyte >> 4;
- } else {
- bitweight = 0;
- temp = inputbyte & 15;
- }
- return (temp);
-}
-
-static boolean getbit(void)
-{
- bitweight >>= 1;
- if (bitweight == 0) {
- inputbyte = pkbyte();
- bitweight = 128;
- }
- return (inputbyte & bitweight);
-}
-
-static halfword(*realfunc) (void);
-long pk_remainder;
-static halfword handlehuge(halfword i, halfword k);
-
-static halfword pkpackednum(void)
-{
- register halfword i, j;
- i = getnyb();
- if (i == 0) {
- do {
- j = getnyb();
- i++;
- } while (!(j != 0));
- if (i > 3) {
-/*
- * Damn, we got a huge count! We *fake* it by giving an artificially
- * large repeat count.
- */
- return (handlehuge(i, j));
- } else {
- while (i > 0) {
- j = j * 16 + getnyb();
- i--;
- }
- return (j - 15 + (13 - dynf) * 16 + dynf);
- }
- } else if (i <= dynf)
- return (i);
- else if (i < 14)
- return ((i - dynf - 1) * 16 + getnyb() + dynf + 1);
- else {
- if (i == 14)
- repeatcount = pkpackednum();
- else
- repeatcount = 1;
- return ((*realfunc) ());
- }
-}
-
-static halfword rest(void)
-{
- halfword i;
-
- if (pk_remainder < 0) {
- pk_remainder = -pk_remainder;
- return (0);
- } else if (pk_remainder > 0) {
- if (pk_remainder > 4000) {
- pk_remainder = 4000 - pk_remainder;
- return (4000);
- } else {
- i = pk_remainder;
- pk_remainder = 0;
- realfunc = pkpackednum;
- return (i);
- }
- } else {
- pdftex_fail("shouldn't happen");
- return 0;
- /*NOTREACHED*/}
-}
-
-static halfword handlehuge(halfword i, halfword k)
-{
- register long j = k;
-
- while (i) {
- j = (j << 4L) + getnyb();
- i--;
- }
- pk_remainder = j - 15 + (13 - dynf) * 16 + dynf;
- realfunc = rest;
- return (rest());
-}
-
-/*
- * And now we have our unpacking routine.
- */
-
-static halfword gpower[17] = { 0, 1, 3, 7, 15, 31, 63, 127,
- 255, 511, 1023, 2047, 4095, 8191, 16383, 32767, 65535
-};
-
-static void unpack(chardesc * cd)
-{
- register integer i, j;
- register halfword word, wordweight;
- halfword *raster;
- shalfword rowsleft;
- boolean turnon;
- shalfword hbit;
- halfword count;
- shalfword wordwidth;
-
- wordwidth = (cd->cwidth + 15) / 16;
- i = 2 * cd->cheight * (long) wordwidth;
- if (i <= 0)
- i = 2;
- if (i > cd->rastersize) {
- xfree(cd->raster);
- cd->rastersize = i;
- cd->raster = xtalloc(cd->rastersize, halfword);
- }
- raster = cd->raster;
- realfunc = pkpackednum;
- dynf = flagbyte / 16;
- turnon = flagbyte & 8;
- if (dynf == 14) {
- bitweight = 0;
- for (i = 1; i <= cd->cheight; i++) {
- word = 0;
- wordweight = 32768;
- for (j = 1; j <= cd->cwidth; j++) {
- if (getbit())
- word += wordweight;
- wordweight >>= 1;
- if (wordweight == 0) {
- *raster++ = word;
- word = 0;
- wordweight = 32768;
- }
- }
- if (wordweight != 32768)
- *raster++ = word;
- }
- } else {
- rowsleft = cd->cheight;
- hbit = cd->cwidth;
- repeatcount = 0;
- wordweight = 16;
- word = 0;
- bitweight = 0;
- while (rowsleft > 0) {
- count = (*realfunc) ();
- while (count != 0) {
- if ((count < wordweight) && (count < hbit)) {
- if (turnon)
- word += gpower[wordweight] - gpower[wordweight - count];
- hbit -= count;
- wordweight -= count;
- count = 0;
- } else if ((count >= hbit) && (hbit <= wordweight)) {
- if (turnon)
- word += gpower[wordweight] - gpower[wordweight - hbit];
- *raster++ = word;
- for (i = 1; i <= repeatcount; i++) {
- for (j = 1; j <= wordwidth; j++) {
- *raster = *(raster - wordwidth);
- raster++;
- }
- }
- rowsleft -= repeatcount + 1;
- repeatcount = 0;
- word = 0;
- wordweight = 16;
- count -= hbit;
- hbit = cd->cwidth;
- } else {
- if (turnon)
- word += gpower[wordweight];
- *raster++ = word;
- word = 0;
- count -= wordweight;
- hbit -= wordweight;
- wordweight = 16;
- }
- }
- turnon = !turnon;
- }
- if ((rowsleft != 0) || ((integer) hbit != cd->cwidth))
- pdftex_fail("error while unpacking; more bits than required");
- }
-}
-
-/*
- * readchar(): the main routine
- * Reads the character definition of character `c' into `cd' if available,
- * return FALSE (0) otherwise.
- */
-
-/*
- * readchar(): the main routine
- * check pk preamble if necessary,
- * read the next character definition into `cd',
- * return EOF if no character definition is available
- */
-
-int readchar(boolean check_preamble, chardesc * cd)
-{
- register shalfword i;
- register integer k;
- register integer length = 0;
-
-/*
- * Check the preamble of the pkfile
- */
- if (check_preamble) {
- if (pkbyte() != 247)
- pdftex_fail("bad pk file, expected pre");
- if (pkbyte() != 89)
- pdftex_fail("bad version of pk file");
- for (i = pkbyte(); i > 0; i--) /* creator of pkfile */
- (void) pkbyte();
- (void) pkquad(); /* design size */
- k = pkquad(); /* checksum */
- k = pkquad(); /* hppp */
- k = pkquad(); /* vppp */
- }
-/*
- * Now we skip to the desired character definition
- */
- while ((flagbyte = pkbyte()) != 245) {
- if (flagbyte < 240) {
- switch (flagbyte & 7) {
- case 0:
- case 1:
- case 2:
- case 3:
- length = (flagbyte & 7) * 256 + pkbyte() - 3;
- cd->charcode = pkbyte();
- (void) pktrio(); /* TFMwidth */
- cd->xescape = pkbyte(); /* pixel width */
- cd->cwidth = pkbyte();
- cd->cheight = pkbyte();
- cd->xoff = pkbyte();
- cd->yoff = pkbyte();
- if (cd->xoff > 127)
- cd->xoff -= 256;
- if (cd->yoff > 127)
- cd->yoff -= 256;
- break;
- case 4:
- case 5:
- case 6:
- length = (flagbyte & 3) * 65536L + pkbyte() * 256L;
- length = length + pkbyte() - 4L;
- cd->charcode = pkbyte();
- (void) pktrio(); /* TFMwidth */
- cd->xescape = pkduo(); /* pixelwidth */
- cd->cwidth = pkduo();
- cd->cheight = pkduo();
- cd->xoff = pkduo();
- cd->yoff = pkduo();
- break;
- case 7:
- length = pkquad() - 9L;
- cd->charcode = pkquad();
- (void) pkquad(); /* TFMwidth */
- cd->xescape = pkquad(); /* pixelwidth */
- k = pkquad();
- cd->cwidth = pkquad();
- cd->cheight = pkquad();
- cd->xoff = pkquad();
- cd->yoff = pkquad();
- }
- if (length <= 0)
- pdftex_fail("packet length (%i) too small", (int) length);
- unpack(cd);
- return 1;
- } else {
- k = 0;
- switch (flagbyte) {
- case 243:
- k = pkbyte();
- if (k > 127)
- k -= 256;
- case 242:
- k = k * 256 + pkbyte();
- case 241:
- k = k * 256 + pkbyte();
- case 240:
- k = k * 256 + pkbyte();
- while (k-- > 0)
- i = pkbyte();
- break;
- case 244:
- k = pkquad();
- break;
- case 246:
- break;
- default:
- pdftex_fail("unexpected command (%i)", (int) flagbyte);
- }
- }
- }
- return 0; /* character not found */
-}
diff --git a/Build/source/texk/web2c/pdftexdir/ptexlib.h b/Build/source/texk/web2c/pdftexdir/ptexlib.h
deleted file mode 100644
index b10d289b38b..00000000000
--- a/Build/source/texk/web2c/pdftexdir/ptexlib.h
+++ /dev/null
@@ -1,359 +0,0 @@
-/* ptexlib.h: macros for pdfTeX library code.
-Copyright 1996-2021 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#ifndef PDFTEXLIB
-# define PDFTEXLIB
-
-#ifdef _WIN32
-#undef fopen
-#undef xfopen
-#undef fputs
-#undef putc
-#define fopen fsyscp_fopen
-#define xfopen fsyscp_xfopen
-#define fputs win32_fputs
-#define putc win32_putc
-#endif
-
-/* WEB2C macros and prototypes */
-# if !defined(PDFTEXCOERCE) && !defined(PDFETEXCOERCE)
-# ifdef pdfTeX
-# undef pdfTeX /* to avoid warning about redefining pdfTeX in pdftexd.h */
-# endif /* pdfTeX */
-# define EXTERN extern
-# include "pdftexd.h"
-# endif
-
-/* pdftexlib macros */
-# include "ptexmac.h"
-
-/* avl */
-# include "avlstuff.h"
-
-/* pdftexlib type declarations */
-typedef struct {
- const char *pdfname;
- const char *t1name;
- float value;
- boolean valid;
-} key_entry;
-
-struct _subfont_entry;
-typedef struct _subfont_entry subfont_entry;
-
-struct _subfont_entry {
- char *infix; /* infix for this subfont, eg "01" */
- long charcodes[256]; /* the mapping for this subfont as read from sfd */
- subfont_entry *next;
-};
-
-typedef struct {
- char *name; /* sfd name, eg "Unicode" */
- subfont_entry *subfont; /* linked list of subfonts */
-} sfd_entry;
-
-typedef struct {
- integer fe_objnum; /* object number */
- char *name; /* encoding file name */
- char **glyph_names; /* array of glyph names */
- struct avl_table *tx_tree; /* tree of encoding positions marked as used by TeX */
-} fe_entry;
-
-typedef struct {
- char *name; /* glyph name */
- long code; /* -1 = undefined; -2 = multiple codes, stored
- as string in unicode_seq; otherwise unicode value */
- char *unicode_seq; /* multiple unicode sequence */
-} glyph_unicode_entry;
-
-# define FD_FLAGS_NOT_SET_IN_MAPLINE -1
-# define FD_FLAGS_DEFAULT_EMBED 4 /* a symbol font */
-# define FD_FLAGS_DEFAULT_NON_EMBED 0x22
- /* a nonsymbolic serif font */
-
-typedef struct {
- /* parameters scanned from the map file: */
- char *tfm_name; /* TFM file name (1st field in map line) */
- char *sfd_name; /* subfont directory name, like @sfd_name@ */
- char *ps_name; /* PostScript name (optional 2nd field in map line) */
- integer fd_flags; /* font descriptor /Flags (PDF Ref. section 5.7.1) */
- integer slant; /* SlantFont */
- integer extend; /* ExtendFont */
- char *encname; /* encoding file name */
- char *ff_name; /* font file name */
- unsigned short type; /* various flags */
- short pid; /* Pid for truetype fonts */
- short eid; /* Eid for truetype fonts */
- /* parameters NOT scanned from the map file: */
- subfont_entry *subfont; /* subfont mapping */
- unsigned short links; /* link flags from tfm_tree and ps_tree */
- boolean in_use; /* true if this structure has been referenced already */
-} fm_entry;
-
-/**********************************************************************/
-
-typedef struct {
- int val; /* value */
- boolean set; /* true if parameter has been set */
-} intparm;
-
-typedef struct fd_entry_ {
- integer fd_objnum; /* object number of the font descriptor object */
- char *fontname; /* /FontName (without subset tag) */
- char *subset_tag; /* 6-character subset tag */
- boolean ff_found;
- integer ff_objnum; /* object number of the font program stream */
- integer fn_objnum; /* font name object number (embedded PDF) */
- boolean all_glyphs; /* embed all glyphs? */
- boolean write_ttf_glyph_names;
- intparm font_dim[FONT_KEYS_NUM];
- fe_entry *fe; /* pointer to encoding structure */
- char **builtin_glyph_names; /* builtin encoding as read from the Type1 font file */
- fm_entry *fm; /* pointer to font map structure */
- struct avl_table *tx_tree; /* tree of non-reencoded TeX characters marked as used */
- struct avl_table *gl_tree; /* tree of all marked glyphs */
-} fd_entry;
-
-typedef struct cw_entry_ {
- integer cw_objnum; /* object number of the font program object */
- integer *width; /* array [0...255] of character width values */
-} cw_entry;
-
-typedef struct fo_entry_ {
- integer fo_objnum; /* object number of the font dictionary */
- internalfontnumber tex_font; /* needed only for \pdffontattr{} */
- fm_entry *fm; /* pointer to font map structure for this font dictionary */
- fd_entry *fd; /* pointer to /FontDescriptor object structure */
- fe_entry *fe; /* pointer to encoding structure */
- cw_entry *cw; /* pointer to character /Widths array object structure */
- integer first_char; /* first character used in this font */
- integer last_char; /* last character used in this font */
- integer tounicode_objnum; /* object number of ToUnicode */
-} fo_entry;
-
-/**********************************************************************/
-
-typedef struct {
- char *ff_name; /* base name of font file */
- char *ff_path; /* full path to font file */
-} ff_entry;
-
-typedef short shalfword;
-typedef struct {
- integer charcode, cwidth, cheight, xoff, yoff, xescape, rastersize;
- halfword *raster;
-} chardesc;
-
-/* pdftexlib variable declarations */
-extern boolean true_dimen;
-extern char **t1_glyph_names, *t1_builtin_glyph_names[];
-extern char *cur_file_name;
-extern integer t1_length1, t1_length2, t1_length3;
-extern integer ttf_length;
-extern strnumber last_tex_string;
-extern size_t last_ptr_index;
-extern char *fb_array;
-extern FILE *t3_file;
-extern const char *ptexbanner;
-
-/* pdftexlib function prototypes */
-
-/* prototypes used in C code as well as pdftoepdf.cc */
-#include <pdftexdir/pdftex-common.h>
-
-/* mapfile.c */
-extern boolean hasfmentry(internalfontnumber);
-extern boolean isscalable(internalfontnumber);
-extern void fm_free(void);
-extern void fm_read_info(void);
-extern ff_entry *check_ff_exist(char *, boolean);
-extern void pdfmapfile(integer);
-extern void pdfmapline(integer);
-extern void pdfinitmapfile(const_string map_name);
-extern fm_entry *new_fm_entry(void);
-extern void delete_fm_entry(fm_entry *);
-extern int avl_do_entry(fm_entry *, int);
-extern int check_std_t1font(char *s);
-
-/* papersiz.c */
-extern integer myatodim(char **);
-extern integer myatol(char **);
-
-/* pkin.c */
-extern int readchar(boolean, chardesc *);
-
-/* subfont.c */
-extern void sfd_free(void);
-extern boolean handle_subfont_fm(fm_entry *, int);
-
-/* tounicode.c */
-extern void glyph_unicode_free(void);
-extern void deftounicode(strnumber, strnumber);
-extern integer write_tounicode(char **, const char *, const char *);
-extern void dumptounicode(void);
-extern void undumptounicode(void);
-
-/* utils.c */
-extern boolean str_eq_cstr(strnumber, char *);
-extern int xfflush(FILE *);
-extern int xgetc(FILE *);
-extern int xputc(int, FILE *);
-extern scaled extxnoverd(scaled, scaled, scaled);
-extern size_t xfwrite(void *, size_t size, size_t nmemb, FILE *);
-extern strnumber getresnameprefix(void);
-extern strnumber maketexstring(const char *);
-extern integer fb_offset(void);
-extern void fb_flush(void);
-extern void fb_putchar(eightbits b);
-extern void fb_seek(integer);
-extern void libpdffinish(void);
-extern void make_subset_tag(fd_entry *);
-extern void setjobid(int, int, int, int);
-extern void writestreamlength(longinteger, longinteger);
-extern void printID(strnumber);
-extern void printIDalt(strnumber);
-extern void printcreationdate(void);
-extern void printmoddate(void);
-extern void escapename(poolpointer in);
-extern void escapestring(poolpointer in);
-extern void escapehex(poolpointer in);
-extern void unescapehex(poolpointer in);
-extern void getmd5sum(strnumber s, boolean file);
-extern void matchstrings(strnumber s, strnumber t, int subcount, boolean icase);
-extern void getmatch(int i);
-extern void makepdftexbanner(void);
-extern void removepdffile(void);
-extern void garbagewarning(void);
-extern void initversionstring(char **versions);
-extern int newcolorstack(integer s, integer literal_mode, boolean pagestart);
-extern int colorstackused(void);
-extern integer colorstackset(int colstack_no, integer s);
-extern integer colorstackpush(int colstack_no, integer s);
-extern integer colorstackpop(int colstack_no);
-extern integer colorstackcurrent(int colstack_no);
-extern integer colorstackskippagestart(int colstack_no);
-extern void checkpdfsave(int cur_h, int cur_v);
-extern void checkpdfrestore(int cur_h, int cur_v);
-extern void pdfshipoutbegin(boolean shipping_page);
-extern void pdfshipoutend(boolean shipping_page);
-extern integer pdfsetmatrix(poolpointer in, scaled cur_h, scaled cur_v);
-extern void matrixtransformpoint(scaled x, scaled y);
-extern void matrixtransformrect(scaled llx, scaled lly, scaled urx, scaled ury);
-extern boolean matrixused(void);
-extern void matrixrecalculate(scaled urx);
-extern scaled getllx(void);
-extern scaled getlly(void);
-extern scaled geturx(void);
-extern scaled getury(void);
-extern void allocvffnts(void);
-
-/* vfpacket.c */
-extern integer newvfpacket(internalfontnumber);
-extern void storepacket(internalfontnumber, integer, strnumber);
-extern void startpacket(internalfontnumber, eightbits);
-extern eightbits packetbyte(void);
-extern void poppacketstate(void);
-extern void pushpacketstate(void);
-extern void vf_free(void);
-
-/* writeenc.c */
-extern fe_entry *get_fe_entry(char *);
-extern void enc_free(void);
-extern void write_fontencodings(void);
-
-/* writefont.c */
-extern void dopdffont(integer, internalfontnumber);
-extern fd_entry *lookup_fd_entry(char *, integer, integer);
-extern fd_entry *new_fd_entry(void);
-extern void writefontstuff(void);
-extern void register_fd_entry(fd_entry *);
-
-/* writeimg.c */
-extern boolean checkimageb(integer);
-extern boolean checkimagec(integer);
-extern boolean checkimagei(integer);
-extern boolean ispdfimage(integer);
-extern boolean ispngimage(integer);
-extern integer epdforigx(integer);
-extern integer epdforigy(integer);
-extern integer imagecolor(integer);
-extern integer imageheight(integer);
-extern integer imagerotate(integer);
-extern integer imagepages(integer);
-extern integer imagewidth(integer);
-extern integer imagexres(integer);
-extern integer imageyres(integer);
-extern integer imagecolordepth(integer);
-extern integer getimagegroupref(integer);
-extern void setimagegroupref(integer,integer);
-extern integer readimage(strnumber, integer, strnumber, integer, integer,
- integer, integer, integer);
-extern void deleteimage(integer);
-extern void img_free(void);
-extern void updateimageprocset(integer);
-extern void writeimage(integer);
-extern void dumpimagemeta(void);
-extern void undumpimagemeta(integer, integer, integer);
-
-/* writejbig2.c */
-extern void flushjbig2page0objects(void);
-
-/* writet1.c */
-extern boolean t1_subset(char *, char *, unsigned char *);
-extern char **load_enc_file(char *);
-extern void writet1(fd_entry *);
-extern void t1_free(void);
-
-/* writet3.c */
-extern void writet3(fm_entry *, int, internalfontnumber);
-extern scaled getpkcharwidth(internalfontnumber, scaled);
-
-/* writettf.c */
-extern void writettf(fd_entry *);
-extern void writeotf(fd_entry *);
-extern void ttf_free(void);
-
-/* writezip.c */
-extern void writezip(boolean);
-extern void zip_free(void);
-
-/* avlstuff.c */
-extern int comp_int_entry(const void *, const void *, void *);
-extern int comp_string_entry(const void *, const void *, void *);
-extern void avlputobj(integer, integer);
-extern integer avlfindobj(integer, integer, integer);
-
-/**********************************************************************/
-static const key_entry font_key[FONT_KEYS_NUM] = {
- {"Ascent", "Ascender"}
- , {"CapHeight", "CapHeight"}
- , {"Descent", "Descender"}
- , {"ItalicAngle", "ItalicAngle"}
- , {"StemV", "StdVW"}
- , {"XHeight", "XHeight"}
- , {"FontBBox", "FontBBox"}
- , {"", "", 0}
- , {"", "", 0}
- , {"", "", 0}
- , {"FontName", "FontName"}
-};
-
-/**********************************************************************/
-#endif /* PDFTEXLIB */
-// vim: ts=4
diff --git a/Build/source/texk/web2c/pdftexdir/ptexmac.h b/Build/source/texk/web2c/pdftexdir/ptexmac.h
deleted file mode 100644
index 30e8e744c61..00000000000
--- a/Build/source/texk/web2c/pdftexdir/ptexmac.h
+++ /dev/null
@@ -1,246 +0,0 @@
-/* ptexmac.h: common macros for pdfTeX.
-Copyright 1996-2021 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#ifndef PDFTEXMAC
-# define PDFTEXMAC
-
-# ifdef WIN32
-/* Why relying on gmalloc() ??? */
-# define gmalloc(n) xmalloc(n)
-# define gfree(p) free(p)
-# define inline __inline
-# define srandom(n) srand(n)
-# define random() rand()
-# endif
-
-/* Pascal WEB macros */
-# define maxinteger 0x7FFFFFFF
-# define maxdimen 0x3FFFFFFF
-
-# define objinfo(n) objtab[n].int0
-
-# define pdfroom(n) do { \
- if ((unsigned)(n + pdfptr) > (unsigned)pdfbufsize) { \
- if (pdfosmode) \
- pdfosgetosbuf(n); \
- else { \
- if ((unsigned)(n) > (unsigned)pdfbufsize) \
- pdftex_fail("PDF output buffer overflowed"); \
- else \
- pdfflush(); \
- } \
- } \
-} while (0)
-
-# define pdfout(c) do { \
- pdfroom(1); \
- pdfbuf[pdfptr++] = c; \
-} while (0)
-
-# define pdfoffset() (pdfgone + pdfptr)
-
-# define MAX_CHAR_CODE 255
-# define PRINTF_BUF_SIZE 1024
-# define MAX_CSTRING_LEN 1024 * 1024
-# define MAX_PSTRING_LEN 1024
-# define SMALL_BUF_SIZE 256
-# define SMALL_ARRAY_SIZE 256
-# define FONTNAME_BUF_SIZE 128
- /* a PDF name can be maximum 127 chars long */
-
-# define pdftex_debug tex_printf
-
-# define check_buf(size, buf_size) \
- if ((unsigned)(size) > (unsigned)(buf_size)) \
- pdftex_fail("buffer overflow at file %s, line %d", __FILE__, __LINE__ )
-
-# define append_char_to_buf(c, p, buf, buf_size) do { \
- if (c == 9) \
- c = 32; \
- if (c == 13 || c == EOF) \
- c = 10; \
- if (c != ' ' || (p > buf && p[-1] != 32)) { \
- check_buf(p - buf + 1, (buf_size)); \
- *p++ = c; \
- } \
-} while (0)
-
-# define append_eol(p, buf, buf_size) do { \
- check_buf(p - buf + 2, (buf_size)); \
- if (p - buf > 1 && p[-1] != 10) \
- *p++ = 10; \
- if (p - buf > 2 && p[-2] == 32) { \
- p[-2] = 10; \
- p--; \
- } \
- *p = 0; \
-} while (0)
-
-# define remove_eol(p, buf) do { \
- p = strend(buf) - 1; \
- if (*p == 10) \
- *p = 0; \
-} while (0)
-
-# define skip(p, c) if (*p == c) p++
-
-# define alloc_array(T, n, s) do { \
- if (T##_array == NULL) { \
- T##_limit = (s); \
- if ((unsigned)(n) > (unsigned)(T##_limit)) \
- T##_limit = (n); \
- T##_array = xtalloc(T##_limit, T##_entry); \
- T##_ptr = T##_array; \
- } \
- else if ((unsigned)(T##_ptr - T##_array + (n)) > (unsigned)(T##_limit)) { \
- last_ptr_index = T##_ptr - T##_array; \
- T##_limit *= 2; \
- if ((unsigned)(T##_ptr - T##_array + (n)) > (unsigned)(T##_limit)) \
- T##_limit = T##_ptr - T##_array + (n); \
- if ((unsigned)(T##_limit) > INT_MAX) \
- pdftex_fail(#T "_array exceeds size limit"); \
- xretalloc(T##_array, T##_limit, T##_entry); \
- T##_ptr = T##_array + last_ptr_index; \
- } \
-} while (0)
-
-# define is_cfg_comment(c) \
- (c == 10 || c == '*' || c == '#' || c == ';' || c == '%')
-
-# define define_array(T) \
-T##_entry *T##_ptr, *T##_array = NULL; \
-size_t T##_limit
-
-# define xfree(p) do { if (p != NULL) free(p); p = NULL; } while (0)
-# define strend(s) strchr(s, 0)
-# define xtalloc XTALLOC
-# define xretalloc XRETALLOC
-
-# define ASCENT_CODE 0
-# define CAPHEIGHT_CODE 1
-# define DESCENT_CODE 2
-# define ITALIC_ANGLE_CODE 3
-# define STEMV_CODE 4
-# define XHEIGHT_CODE 5
-# define FONTBBOX1_CODE 6
-# define FONTBBOX2_CODE 7
-# define FONTBBOX3_CODE 8
-# define FONTBBOX4_CODE 9
-# define FONTNAME_CODE 10
-# define GEN_KEY_NUM (XHEIGHT_CODE + 1)
-# define MAX_KEY_CODE (FONTBBOX1_CODE + 1)
-# define INT_KEYS_NUM (FONTBBOX4_CODE + 1)
-# define FONT_KEYS_NUM (FONTNAME_CODE + 1)
-
-# define F_INCLUDED 0x01
-# define F_SUBSETTED 0x02
-# define F_STDT1FONT 0x04
-# define F_SUBFONT 0x08
-# define F_TYPE1 0x10
-# define F_TRUETYPE 0x20
-# define F_OTF 0x40
-# define F_PK 0x80
-
-# define set_included(fm) ((fm)->type |= F_INCLUDED)
-# define set_subsetted(fm) ((fm)->type |= F_SUBSETTED)
-# define set_std_t1font(fm) ((fm)->type |= F_STDT1FONT)
-# define set_subfont(fm) ((fm)->type |= F_SUBFONT)
-# define set_type1(fm) ((fm)->type |= F_TYPE1)
-# define set_truetype(fm) ((fm)->type |= F_TRUETYPE)
-# define set_opentype(fm) ((fm)->type |= F_OTF)
-# define set_pk(fm) ((fm)->type |= F_PK)
-
-# define unset_included(fm) ((fm)->type &= ~F_INCLUDED)
-# define unset_subsetted(fm) ((fm)->type &= ~F_SUBSETTED)
-# define unset_std_t1font(fm)((fm)->type &= ~F_STDT1FONT)
-# define unset_subfont(fm) ((fm)->type &= ~F_SUBFONT)
-# define unset_type1(fm) ((fm)->type &= ~F_TYPE1)
-# define unset_truetype(fm) ((fm)->type &= ~F_TRUETYPE)
-# define unset_opentype(fm) ((fm)->type &= ~F_OTF)
-# define unset_pk(fm) ((fm)->type &= ~F_PK)
-
-# define is_included(fm) (((fm)->type & F_INCLUDED) != 0)
-# define is_subsetted(fm) (((fm)->type & F_SUBSETTED) != 0)
-# define is_std_t1font(fm) (((fm)->type & F_STDT1FONT) != 0)
-# define is_subfont(fm) (((fm)->type & F_SUBFONT) != 0)
-# define is_type1(fm) (((fm)->type & F_TYPE1) != 0)
-# define is_truetype(fm) (((fm)->type & F_TRUETYPE) != 0)
-# define is_opentype(fm) (((fm)->type & F_OTF) != 0)
-# define is_pk(fm) (((fm)->type & F_PK) != 0)
-
-# define fm_slant(fm) (fm)->slant
-# define fm_extend(fm) (fm)->extend
-# define fm_fontfile(fm) (fm)->ff_name
-
-# define is_reencoded(fm) ((fm)->encname != NULL)
-# define is_fontfile(fm) (fm_fontfile(fm) != NULL)
-# define is_t1fontfile(fm) (is_fontfile(fm) && is_type1(fm))
-# define is_builtin(fm) (!is_fontfile(fm))
-
-# define LINK_TFM 0x01
-# define LINK_PS 0x02
-# define set_tfmlink(fm) ((fm)->links |= LINK_TFM)
-# define set_pslink(fm) ((fm)->links |= LINK_PS)
-# define unset_tfmlink(fm) ((fm)->links &= ~LINK_TFM)
-# define unset_pslink(fm) ((fm)->links &= ~LINK_PS)
-# define has_tfmlink(fm) ((fm)->links & LINK_TFM)
-# define has_pslink(fm) ((fm)->links & LINK_PS)
-
-
-# define set_cur_file_name(s) \
- cur_file_name = s; \
- packfilename(maketexstring(cur_file_name), getnullstr(), getnullstr())
-
-# define cmp_return(a, b) \
- if ((a) > (b)) \
- return 1; \
- if ((a) < (b)) \
- return -1
-
-# define str_prefix(s1, s2) (strncmp((s1), (s2), strlen(s2)) == 0)
-
-/* (un)dumping a string means dumping the allocation size, followed
- * by the bytes. The trailing \0 is (un)dumped as well, because that
- * makes the code simpler.
- */
-
-#define dumpcharptr(a) \
- do { \
- integer x; \
- if (a!=NULL) { \
- x = strlen(a)+1; \
- generic_dump(x); dumpthings(*a, x); \
- } else { \
- x = 0; generic_dump(x); \
- } \
- } while (0)
-
-#define undumpcharptr(s) \
- do { \
- integer x; \
- char *a; \
- generic_undump (x); \
- if (x>0) { \
- a = xmalloc(x); \
- undumpthings(*a,x); \
- s = a ; \
- } else { s = NULL; } \
- } while (0)
-
-#endif /* PDFTEXMAC */
diff --git a/Build/source/texk/web2c/pdftexdir/regex/COPYING.LIB b/Build/source/texk/web2c/pdftexdir/regex/COPYING.LIB
deleted file mode 100644
index cf9b6b99726..00000000000
--- a/Build/source/texk/web2c/pdftexdir/regex/COPYING.LIB
+++ /dev/null
@@ -1,510 +0,0 @@
-
- GNU LESSER GENERAL PUBLIC LICENSE
- Version 2.1, February 1999
-
- Copyright (C) 1991, 1999 Free Software Foundation, Inc.
- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-[This is the first released version of the Lesser GPL. It also counts
- as the successor of the GNU Library Public License, version 2, hence
- the version number 2.1.]
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-Licenses are intended to guarantee your freedom to share and change
-free software--to make sure the software is free for all its users.
-
- This license, the Lesser General Public License, applies to some
-specially designated software packages--typically libraries--of the
-Free Software Foundation and other authors who decide to use it. You
-can use it too, but we suggest you first think carefully about whether
-this license or the ordinary General Public License is the better
-strategy to use in any particular case, based on the explanations
-below.
-
- When we speak of free software, we are referring to freedom of use,
-not price. Our General Public Licenses are designed to make sure that
-you have the freedom to distribute copies of free software (and charge
-for this service if you wish); that you receive source code or can get
-it if you want it; that you can change the software and use pieces of
-it in new free programs; and that you are informed that you can do
-these things.
-
- To protect your rights, we need to make restrictions that forbid
-distributors to deny you these rights or to ask you to surrender these
-rights. These restrictions translate to certain responsibilities for
-you if you distribute copies of the library or if you modify it.
-
- For example, if you distribute copies of the library, whether gratis
-or for a fee, you must give the recipients all the rights that we gave
-you. You must make sure that they, too, receive or can get the source
-code. If you link other code with the library, you must provide
-complete object files to the recipients, so that they can relink them
-with the library after making changes to the library and recompiling
-it. And you must show them these terms so they know their rights.
-
- We protect your rights with a two-step method: (1) we copyright the
-library, and (2) we offer you this license, which gives you legal
-permission to copy, distribute and/or modify the library.
-
- To protect each distributor, we want to make it very clear that
-there is no warranty for the free library. Also, if the library is
-modified by someone else and passed on, the recipients should know
-that what they have is not the original version, so that the original
-author's reputation will not be affected by problems that might be
-introduced by others.
-^L
- Finally, software patents pose a constant threat to the existence of
-any free program. We wish to make sure that a company cannot
-effectively restrict the users of a free program by obtaining a
-restrictive license from a patent holder. Therefore, we insist that
-any patent license obtained for a version of the library must be
-consistent with the full freedom of use specified in this license.
-
- Most GNU software, including some libraries, is covered by the
-ordinary GNU General Public License. This license, the GNU Lesser
-General Public License, applies to certain designated libraries, and
-is quite different from the ordinary General Public License. We use
-this license for certain libraries in order to permit linking those
-libraries into non-free programs.
-
- When a program is linked with a library, whether statically or using
-a shared library, the combination of the two is legally speaking a
-combined work, a derivative of the original library. The ordinary
-General Public License therefore permits such linking only if the
-entire combination fits its criteria of freedom. The Lesser General
-Public License permits more lax criteria for linking other code with
-the library.
-
- We call this license the "Lesser" General Public License because it
-does Less to protect the user's freedom than the ordinary General
-Public License. It also provides other free software developers Less
-of an advantage over competing non-free programs. These disadvantages
-are the reason we use the ordinary General Public License for many
-libraries. However, the Lesser license provides advantages in certain
-special circumstances.
-
- For example, on rare occasions, there may be a special need to
-encourage the widest possible use of a certain library, so that it
-becomes a de-facto standard. To achieve this, non-free programs must
-be allowed to use the library. A more frequent case is that a free
-library does the same job as widely used non-free libraries. In this
-case, there is little to gain by limiting the free library to free
-software only, so we use the Lesser General Public License.
-
- In other cases, permission to use a particular library in non-free
-programs enables a greater number of people to use a large body of
-free software. For example, permission to use the GNU C Library in
-non-free programs enables many more people to use the whole GNU
-operating system, as well as its variant, the GNU/Linux operating
-system.
-
- Although the Lesser General Public License is Less protective of the
-users' freedom, it does ensure that the user of a program that is
-linked with the Library has the freedom and the wherewithal to run
-that program using a modified version of the Library.
-
- The precise terms and conditions for copying, distribution and
-modification follow. Pay close attention to the difference between a
-"work based on the library" and a "work that uses the library". The
-former contains code derived from the library, whereas the latter must
-be combined with the library in order to run.
-^L
- GNU LESSER GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License Agreement applies to any software library or other
-program which contains a notice placed by the copyright holder or
-other authorized party saying it may be distributed under the terms of
-this Lesser General Public License (also called "this License").
-Each licensee is addressed as "you".
-
- A "library" means a collection of software functions and/or data
-prepared so as to be conveniently linked with application programs
-(which use some of those functions and data) to form executables.
-
- The "Library", below, refers to any such software library or work
-which has been distributed under these terms. A "work based on the
-Library" means either the Library or any derivative work under
-copyright law: that is to say, a work containing the Library or a
-portion of it, either verbatim or with modifications and/or translated
-straightforwardly into another language. (Hereinafter, translation is
-included without limitation in the term "modification".)
-
- "Source code" for a work means the preferred form of the work for
-making modifications to it. For a library, complete source code means
-all the source code for all modules it contains, plus any associated
-interface definition files, plus the scripts used to control
-compilation and installation of the library.
-
- Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running a program using the Library is not restricted, and output from
-such a program is covered only if its contents constitute a work based
-on the Library (independent of the use of the Library in a tool for
-writing it). Whether that is true depends on what the Library does
-and what the program that uses the Library does.
-
- 1. You may copy and distribute verbatim copies of the Library's
-complete source code as you receive it, in any medium, provided that
-you conspicuously and appropriately publish on each copy an
-appropriate copyright notice and disclaimer of warranty; keep intact
-all the notices that refer to this License and to the absence of any
-warranty; and distribute a copy of this License along with the
-Library.
-
- You may charge a fee for the physical act of transferring a copy,
-and you may at your option offer warranty protection in exchange for a
-fee.
-
- 2. You may modify your copy or copies of the Library or any portion
-of it, thus forming a work based on the Library, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) The modified work must itself be a software library.
-
- b) You must cause the files modified to carry prominent notices
- stating that you changed the files and the date of any change.
-
- c) You must cause the whole of the work to be licensed at no
- charge to all third parties under the terms of this License.
-
- d) If a facility in the modified Library refers to a function or a
- table of data to be supplied by an application program that uses
- the facility, other than as an argument passed when the facility
- is invoked, then you must make a good faith effort to ensure that,
- in the event an application does not supply such function or
- table, the facility still operates, and performs whatever part of
- its purpose remains meaningful.
-
- (For example, a function in a library to compute square roots has
- a purpose that is entirely well-defined independent of the
- application. Therefore, Subsection 2d requires that any
- application-supplied function or table used by this function must
- be optional: if the application does not supply it, the square
- root function must still compute square roots.)
-
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Library,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Library, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote
-it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Library.
-
-In addition, mere aggregation of another work not based on the Library
-with the Library (or with a work based on the Library) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may opt to apply the terms of the ordinary GNU General Public
-License instead of this License to a given copy of the Library. To do
-this, you must alter all the notices that refer to this License, so
-that they refer to the ordinary GNU General Public License, version 2,
-instead of to this License. (If a newer version than version 2 of the
-ordinary GNU General Public License has appeared, then you can specify
-that version instead if you wish.) Do not make any other change in
-these notices.
-^L
- Once this change is made in a given copy, it is irreversible for
-that copy, so the ordinary GNU General Public License applies to all
-subsequent copies and derivative works made from that copy.
-
- This option is useful when you wish to copy part of the code of
-the Library into a program that is not a library.
-
- 4. You may copy and distribute the Library (or a portion or
-derivative of it, under Section 2) in object code or executable form
-under the terms of Sections 1 and 2 above provided that you accompany
-it with the complete corresponding machine-readable source code, which
-must be distributed under the terms of Sections 1 and 2 above on a
-medium customarily used for software interchange.
-
- If distribution of object code is made by offering access to copy
-from a designated place, then offering equivalent access to copy the
-source code from the same place satisfies the requirement to
-distribute the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
- 5. A program that contains no derivative of any portion of the
-Library, but is designed to work with the Library by being compiled or
-linked with it, is called a "work that uses the Library". Such a
-work, in isolation, is not a derivative work of the Library, and
-therefore falls outside the scope of this License.
-
- However, linking a "work that uses the Library" with the Library
-creates an executable that is a derivative of the Library (because it
-contains portions of the Library), rather than a "work that uses the
-library". The executable is therefore covered by this License.
-Section 6 states terms for distribution of such executables.
-
- When a "work that uses the Library" uses material from a header file
-that is part of the Library, the object code for the work may be a
-derivative work of the Library even though the source code is not.
-Whether this is true is especially significant if the work can be
-linked without the Library, or if the work is itself a library. The
-threshold for this to be true is not precisely defined by law.
-
- If such an object file uses only numerical parameters, data
-structure layouts and accessors, and small macros and small inline
-functions (ten lines or less in length), then the use of the object
-file is unrestricted, regardless of whether it is legally a derivative
-work. (Executables containing this object code plus portions of the
-Library will still fall under Section 6.)
-
- Otherwise, if the work is a derivative of the Library, you may
-distribute the object code for the work under the terms of Section 6.
-Any executables containing that work also fall under Section 6,
-whether or not they are linked directly with the Library itself.
-^L
- 6. As an exception to the Sections above, you may also combine or
-link a "work that uses the Library" with the Library to produce a
-work containing portions of the Library, and distribute that work
-under terms of your choice, provided that the terms permit
-modification of the work for the customer's own use and reverse
-engineering for debugging such modifications.
-
- You must give prominent notice with each copy of the work that the
-Library is used in it and that the Library and its use are covered by
-this License. You must supply a copy of this License. If the work
-during execution displays copyright notices, you must include the
-copyright notice for the Library among them, as well as a reference
-directing the user to the copy of this License. Also, you must do one
-of these things:
-
- a) Accompany the work with the complete corresponding
- machine-readable source code for the Library including whatever
- changes were used in the work (which must be distributed under
- Sections 1 and 2 above); and, if the work is an executable linked
- with the Library, with the complete machine-readable "work that
- uses the Library", as object code and/or source code, so that the
- user can modify the Library and then relink to produce a modified
- executable containing the modified Library. (It is understood
- that the user who changes the contents of definitions files in the
- Library will not necessarily be able to recompile the application
- to use the modified definitions.)
-
- b) Use a suitable shared library mechanism for linking with the
- Library. A suitable mechanism is one that (1) uses at run time a
- copy of the library already present on the user's computer system,
- rather than copying library functions into the executable, and (2)
- will operate properly with a modified version of the library, if
- the user installs one, as long as the modified version is
- interface-compatible with the version that the work was made with.
-
- c) Accompany the work with a written offer, valid for at least
- three years, to give the same user the materials specified in
- Subsection 6a, above, for a charge no more than the cost of
- performing this distribution.
-
- d) If distribution of the work is made by offering access to copy
- from a designated place, offer equivalent access to copy the above
- specified materials from the same place.
-
- e) Verify that the user has already received a copy of these
- materials or that you have already sent this user a copy.
-
- For an executable, the required form of the "work that uses the
-Library" must include any data and utility programs needed for
-reproducing the executable from it. However, as a special exception,
-the materials to be distributed need not include anything that is
-normally distributed (in either source or binary form) with the major
-components (compiler, kernel, and so on) of the operating system on
-which the executable runs, unless that component itself accompanies
-the executable.
-
- It may happen that this requirement contradicts the license
-restrictions of other proprietary libraries that do not normally
-accompany the operating system. Such a contradiction means you cannot
-use both them and the Library together in an executable that you
-distribute.
-^L
- 7. You may place library facilities that are a work based on the
-Library side-by-side in a single library together with other library
-facilities not covered by this License, and distribute such a combined
-library, provided that the separate distribution of the work based on
-the Library and of the other library facilities is otherwise
-permitted, and provided that you do these two things:
-
- a) Accompany the combined library with a copy of the same work
- based on the Library, uncombined with any other library
- facilities. This must be distributed under the terms of the
- Sections above.
-
- b) Give prominent notice with the combined library of the fact
- that part of it is a work based on the Library, and explaining
- where to find the accompanying uncombined form of the same work.
-
- 8. You may not copy, modify, sublicense, link with, or distribute
-the Library except as expressly provided under this License. Any
-attempt otherwise to copy, modify, sublicense, link with, or
-distribute the Library is void, and will automatically terminate your
-rights under this License. However, parties who have received copies,
-or rights, from you under this License will not have their licenses
-terminated so long as such parties remain in full compliance.
-
- 9. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Library or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Library (or any work based on the
-Library), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Library or works based on it.
-
- 10. Each time you redistribute the Library (or any work based on the
-Library), the recipient automatically receives a license from the
-original licensor to copy, distribute, link with or modify the Library
-subject to these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties with
-this License.
-^L
- 11. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Library at all. For example, if a patent
-license would not permit royalty-free redistribution of the Library by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Library.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply, and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
- 12. If the distribution and/or use of the Library is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Library under this License
-may add an explicit geographical distribution limitation excluding those
-countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 13. The Free Software Foundation may publish revised and/or new
-versions of the Lesser General Public License from time to time.
-Such new versions will be similar in spirit to the present version,
-but may differ in detail to address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Library
-specifies a version number of this License which applies to it and
-"any later version", you have the option of following the terms and
-conditions either of that version or of any later version published by
-the Free Software Foundation. If the Library does not specify a
-license version number, you may choose any version ever published by
-the Free Software Foundation.
-^L
- 14. If you wish to incorporate parts of the Library into other free
-programs whose distribution conditions are incompatible with these,
-write to the author to ask for permission. For software which is
-copyrighted by the Free Software Foundation, write to the Free
-Software Foundation; we sometimes make exceptions for this. Our
-decision will be guided by the two goals of preserving the free status
-of all derivatives of our free software and of promoting the sharing
-and reuse of software generally.
-
- NO WARRANTY
-
- 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
-WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
-EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
-OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
-KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
-LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
-THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
- 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
-WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
-AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
-FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
-CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
-LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
-FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGES.
-
- END OF TERMS AND CONDITIONS
-^L
- How to Apply These Terms to Your New Libraries
-
- If you develop a new library, and you want it to be of the greatest
-possible use to the public, we recommend making it free software that
-everyone can redistribute and change. You can do so by permitting
-redistribution under these terms (or, alternatively, under the terms
-of the ordinary General Public License).
-
- To apply these terms, attach the following notices to the library.
-It is safest to attach them to the start of each source file to most
-effectively convey the exclusion of warranty; and each file should
-have at least the "copyright" line and a pointer to where the full
-notice is found.
-
-
- <one line to give the library's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-Also add information on how to contact you by electronic and paper mail.
-
-You should also get your employer (if you work as a programmer) or
-your school, if any, to sign a "copyright disclaimer" for the library,
-if necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the
- library `Frob' (a library for tweaking knobs) written by James
- Random Hacker.
-
- <signature of Ty Coon>, 1 April 1990
- Ty Coon, President of Vice
-
-That's all there is to it!
-
-
diff --git a/Build/source/texk/web2c/pdftexdir/regex/README b/Build/source/texk/web2c/pdftexdir/regex/README
deleted file mode 100644
index 9b3e8979205..00000000000
--- a/Build/source/texk/web2c/pdftexdir/regex/README
+++ /dev/null
@@ -1,122 +0,0 @@
-This is the regex functionality from glibc 2.5 extracted into a
-separate library, for Win32. It may be built, from the sources
-provided, using the command sequence:--
-
- ./configure [--options...] && make
-
-For a list of available configuration options, run:--
-
- ./configure --help
-
-After building, as above, the resultant DLL, and optionally the
-associated development kit, may be installed by:--
-
- make install
-
-while redistributable binary DLL and development library kits may
-be created by:--
-
- make dist
-
-
-The original sources, on which this port is based, remain
-copyright of their respective authors, or of the Free Software
-Foundation Inc., as indicated in individual file headers; all are
-redistributed with permission, as granted by the GNU Lesser
-General Public License.
-
-This is free software. It is provided AS IS, in the hope that
-it may be useful, but WITHOUT WARRANTY OF ANY KIND, not even an
-IMPLIED WARRANTY of MERCHANTABILITY, nor of FITNESS FOR ANY
-PARTICULAR PURPOSE.
-
-Permission is granted to redistribute this software, either
-"as is" or in modified form, under the terms of the GNU Lesser
-General Public License, as published by the Free Software
-Foundation; either version 2.1, or (at your option) any later
-version.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this software; see the file COPYING.LIB. If
-not, write to the Free Software Foundation, 51 Franklin St -
-Fifth Floor, Boston, MA 02110-1301, USA.
-
-The original port of this functionality was implemented by Tor
-Lillqvist; I've adapted his work, to make it somewhat more MinGW
-friendly. I have *not* modified any of the `C' sources provided
-by Tor; nor have I changed the naming conventions he adopted for
-generated distributables. I *have*:--
-
-1) Replaced Tor's original `Makefile' with an autoconf generated
- configure script, and a backwardly compatible `Makefile.in';
- this provides a more flexible build procedure, which I find
- more convenient, when cross-compiling on a GNU/Linux host.
-
-2) Added VPATH support, for `out of tree' builds.
-
-3) Adapted the build procedure, to avoid a dependency on the `lib'
- program from Microsoft's MSVC tool chain. This is achieved by
- providing an option to configure, which is disabled by default;
- it may by activated by specifying `--enable-msvc-implib' on the
- configure command line. If this option is not activated, or if
- the MSVC `lib' tool is not present, the Makefile is configured
- without binding the rule for building an MSVC compatible import
- library, to the default target, (although the rule is left in
- place for explicit use).
-
- If the `--enable-msvc-implib' option is specified, but `lib' is
- not present, then configure will issue a warning message, and
- will again configure the Makefile without binding this rule to
- the default target.
-
- Only if the `--enable-msvc-implib' option is specified, *and*
- the `lib' tool is present, will building of an MSVC compatible
- import library be configured as a default deliverable.
-
-4) Added `install', `install-dll' and `install-dev' targets, to
- support direct installation of the DLL, and its associated
- development kit.
-
-5) Changed the default packaging format for distributables, from
- Tor's exclusive choice of `zip', to my own preferred `tar.gz';
- `zip' format remains available, as an option, by configuring
- with `--enable-dist=zip'.
-
-6) Added `bindist', `devdist' and `srcdist' targets, for greater
- flexibility in building distribution kits.
-
-The original text of Tor's README file will be found below.
-
---Keith Marshall <keithmarshall@users.sourceforge.net>
-
-I call the DLL libgnurx-0.dll which hopefully should be unique. At
-least it isn't "regex.dll" which has been used by the
-gnuwin32.sourceforge.net site for *two* incompatible DLLs. (That mess,
-and the mess with their build of Henry Spencer's regex library, was
-what lead me to build my own GNU regex library. See the
-gnuwin32-users mailing list archives from December 2006.)
-
-The "-0" is so that if at some point I build a release that isn't
-binary compatible, I can then increment that and use a different name.
-
-The import library for gcc is called libgnurx.dll.a, but I also
-distribute a copy of it called libregex.a so that configure scripts
-that look for -lregex will work.
-
-Note that none of the wide-character and i18n functionality which is
-built when this is part of glibc gets compiled. Thus things like
-character classes most probably work only for single-byte codepages.
-
-Compiling that stuff would drag in lots of glibc's locale handling
-stuff which is completely incompatible with Microsoft's C library's
-locale handling anyway. Also, I am not sure whether the GNU regex code
-is prepared to handle a two-byte wchar_t, or does it assume that
-wchar_t is int as it is on Linux? Hmm, actually there is lots of
-sizeof(wchar_t) in glibc, so maybe it *is* prepared? Maybe
-later... But anyway, it would presumably mean we should have not just
-the regex functionality but a larger subset of glibc that would
-include all locale, ctype, wchar, mbs, etc stuff, presumably ending up
-with a very large part of glibc (not the system calls,
-obviously). Indeed, something to save for later, or never...
-
---Tor Lillqvist <tml@iki.fi>, <tml@novell.com>
diff --git a/Build/source/texk/web2c/pdftexdir/regex/regcomp.c b/Build/source/texk/web2c/pdftexdir/regex/regcomp.c
deleted file mode 100644
index 9a6cd159baf..00000000000
--- a/Build/source/texk/web2c/pdftexdir/regex/regcomp.c
+++ /dev/null
@@ -1,3797 +0,0 @@
-/* Extended regular expression matching and search library.
- Copyright (C) 2002,2003,2004,2005,2006 Free Software Foundation, Inc.
- This file is part of the GNU C Library.
- Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
-
- The GNU C Library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- The GNU C Library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with the GNU C Library; if not, write to the Free
- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
- 02111-1307 USA. */
-
-static reg_errcode_t re_compile_internal (regex_t *preg, const char * pattern,
- size_t length, reg_syntax_t syntax);
-static void re_compile_fastmap_iter (regex_t *bufp,
- const re_dfastate_t *init_state,
- char *fastmap);
-static reg_errcode_t init_dfa (re_dfa_t *dfa, size_t pat_len);
-#ifdef RE_ENABLE_I18N
-static void free_charset (re_charset_t *cset);
-#endif /* RE_ENABLE_I18N */
-static void free_workarea_compile (regex_t *preg);
-static reg_errcode_t create_initial_state (re_dfa_t *dfa);
-#ifdef RE_ENABLE_I18N
-static void optimize_utf8 (re_dfa_t *dfa);
-#endif
-static reg_errcode_t analyze (regex_t *preg);
-static reg_errcode_t preorder (bin_tree_t *root,
- reg_errcode_t (fn (void *, bin_tree_t *)),
- void *extra);
-static reg_errcode_t postorder (bin_tree_t *root,
- reg_errcode_t (fn (void *, bin_tree_t *)),
- void *extra);
-static reg_errcode_t optimize_subexps (void *extra, bin_tree_t *node);
-static reg_errcode_t lower_subexps (void *extra, bin_tree_t *node);
-static bin_tree_t *lower_subexp (reg_errcode_t *err, regex_t *preg,
- bin_tree_t *node);
-static reg_errcode_t calc_first (void *extra, bin_tree_t *node);
-static reg_errcode_t calc_next (void *extra, bin_tree_t *node);
-static reg_errcode_t link_nfa_nodes (void *extra, bin_tree_t *node);
-static int duplicate_node (re_dfa_t *dfa, int org_idx, unsigned int constraint);
-static int search_duplicated_node (const re_dfa_t *dfa, int org_node,
- unsigned int constraint);
-static reg_errcode_t calc_eclosure (re_dfa_t *dfa);
-static reg_errcode_t calc_eclosure_iter (re_node_set *new_set, re_dfa_t *dfa,
- int node, int root);
-static reg_errcode_t calc_inveclosure (re_dfa_t *dfa);
-static int fetch_number (re_string_t *input, re_token_t *token,
- reg_syntax_t syntax);
-static int peek_token (re_token_t *token, re_string_t *input,
- reg_syntax_t syntax) internal_function;
-static bin_tree_t *parse (re_string_t *regexp, regex_t *preg,
- reg_syntax_t syntax, reg_errcode_t *err);
-static bin_tree_t *parse_reg_exp (re_string_t *regexp, regex_t *preg,
- re_token_t *token, reg_syntax_t syntax,
- int nest, reg_errcode_t *err);
-static bin_tree_t *parse_branch (re_string_t *regexp, regex_t *preg,
- re_token_t *token, reg_syntax_t syntax,
- int nest, reg_errcode_t *err);
-static bin_tree_t *parse_expression (re_string_t *regexp, regex_t *preg,
- re_token_t *token, reg_syntax_t syntax,
- int nest, reg_errcode_t *err);
-static bin_tree_t *parse_sub_exp (re_string_t *regexp, regex_t *preg,
- re_token_t *token, reg_syntax_t syntax,
- int nest, reg_errcode_t *err);
-static bin_tree_t *parse_dup_op (bin_tree_t *dup_elem, re_string_t *regexp,
- re_dfa_t *dfa, re_token_t *token,
- reg_syntax_t syntax, reg_errcode_t *err);
-static bin_tree_t *parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa,
- re_token_t *token, reg_syntax_t syntax,
- reg_errcode_t *err);
-static reg_errcode_t parse_bracket_element (bracket_elem_t *elem,
- re_string_t *regexp,
- re_token_t *token, int token_len,
- re_dfa_t *dfa,
- reg_syntax_t syntax,
- int accept_hyphen);
-static reg_errcode_t parse_bracket_symbol (bracket_elem_t *elem,
- re_string_t *regexp,
- re_token_t *token);
-#ifdef RE_ENABLE_I18N
-static reg_errcode_t build_equiv_class (bitset_t sbcset,
- re_charset_t *mbcset,
- int *equiv_class_alloc,
- const unsigned char *name);
-static reg_errcode_t build_charclass (RE_TRANSLATE_TYPE trans,
- bitset_t sbcset,
- re_charset_t *mbcset,
- int *char_class_alloc,
- const unsigned char *class_name,
- reg_syntax_t syntax);
-#else /* not RE_ENABLE_I18N */
-static reg_errcode_t build_equiv_class (bitset_t sbcset,
- const unsigned char *name);
-static reg_errcode_t build_charclass (RE_TRANSLATE_TYPE trans,
- bitset_t sbcset,
- const unsigned char *class_name,
- reg_syntax_t syntax);
-#endif /* not RE_ENABLE_I18N */
-static bin_tree_t *build_charclass_op (re_dfa_t *dfa,
- RE_TRANSLATE_TYPE trans,
- const unsigned char *class_name,
- const unsigned char *extra,
- int non_match, reg_errcode_t *err);
-static bin_tree_t *create_tree (re_dfa_t *dfa,
- bin_tree_t *left, bin_tree_t *right,
- re_token_type_t type);
-static bin_tree_t *create_token_tree (re_dfa_t *dfa,
- bin_tree_t *left, bin_tree_t *right,
- const re_token_t *token);
-static bin_tree_t *duplicate_tree (const bin_tree_t *src, re_dfa_t *dfa);
-static void free_token (re_token_t *node);
-static reg_errcode_t free_tree (void *extra, bin_tree_t *node);
-static reg_errcode_t mark_opt_subexp (void *extra, bin_tree_t *node);
-
-/* This table gives an error message for each of the error codes listed
- in regex.h. Obviously the order here has to be same as there.
- POSIX doesn't require that we do anything for REG_NOERROR,
- but why not be nice? */
-
-const char __re_error_msgid[] attribute_hidden =
- {
-#define REG_NOERROR_IDX 0
- gettext_noop ("Success") /* REG_NOERROR */
- "\0"
-#define REG_NOMATCH_IDX (REG_NOERROR_IDX + sizeof "Success")
- gettext_noop ("No match") /* REG_NOMATCH */
- "\0"
-#define REG_BADPAT_IDX (REG_NOMATCH_IDX + sizeof "No match")
- gettext_noop ("Invalid regular expression") /* REG_BADPAT */
- "\0"
-#define REG_ECOLLATE_IDX (REG_BADPAT_IDX + sizeof "Invalid regular expression")
- gettext_noop ("Invalid collation character") /* REG_ECOLLATE */
- "\0"
-#define REG_ECTYPE_IDX (REG_ECOLLATE_IDX + sizeof "Invalid collation character")
- gettext_noop ("Invalid character class name") /* REG_ECTYPE */
- "\0"
-#define REG_EESCAPE_IDX (REG_ECTYPE_IDX + sizeof "Invalid character class name")
- gettext_noop ("Trailing backslash") /* REG_EESCAPE */
- "\0"
-#define REG_ESUBREG_IDX (REG_EESCAPE_IDX + sizeof "Trailing backslash")
- gettext_noop ("Invalid back reference") /* REG_ESUBREG */
- "\0"
-#define REG_EBRACK_IDX (REG_ESUBREG_IDX + sizeof "Invalid back reference")
- gettext_noop ("Unmatched [ or [^") /* REG_EBRACK */
- "\0"
-#define REG_EPAREN_IDX (REG_EBRACK_IDX + sizeof "Unmatched [ or [^")
- gettext_noop ("Unmatched ( or \\(") /* REG_EPAREN */
- "\0"
-#define REG_EBRACE_IDX (REG_EPAREN_IDX + sizeof "Unmatched ( or \\(")
- gettext_noop ("Unmatched \\{") /* REG_EBRACE */
- "\0"
-#define REG_BADBR_IDX (REG_EBRACE_IDX + sizeof "Unmatched \\{")
- gettext_noop ("Invalid content of \\{\\}") /* REG_BADBR */
- "\0"
-#define REG_ERANGE_IDX (REG_BADBR_IDX + sizeof "Invalid content of \\{\\}")
- gettext_noop ("Invalid range end") /* REG_ERANGE */
- "\0"
-#define REG_ESPACE_IDX (REG_ERANGE_IDX + sizeof "Invalid range end")
- gettext_noop ("Memory exhausted") /* REG_ESPACE */
- "\0"
-#define REG_BADRPT_IDX (REG_ESPACE_IDX + sizeof "Memory exhausted")
- gettext_noop ("Invalid preceding regular expression") /* REG_BADRPT */
- "\0"
-#define REG_EEND_IDX (REG_BADRPT_IDX + sizeof "Invalid preceding regular expression")
- gettext_noop ("Premature end of regular expression") /* REG_EEND */
- "\0"
-#define REG_ESIZE_IDX (REG_EEND_IDX + sizeof "Premature end of regular expression")
- gettext_noop ("Regular expression too big") /* REG_ESIZE */
- "\0"
-#define REG_ERPAREN_IDX (REG_ESIZE_IDX + sizeof "Regular expression too big")
- gettext_noop ("Unmatched ) or \\)") /* REG_ERPAREN */
- };
-
-const size_t __re_error_msgid_idx[] attribute_hidden =
- {
- REG_NOERROR_IDX,
- REG_NOMATCH_IDX,
- REG_BADPAT_IDX,
- REG_ECOLLATE_IDX,
- REG_ECTYPE_IDX,
- REG_EESCAPE_IDX,
- REG_ESUBREG_IDX,
- REG_EBRACK_IDX,
- REG_EPAREN_IDX,
- REG_EBRACE_IDX,
- REG_BADBR_IDX,
- REG_ERANGE_IDX,
- REG_ESPACE_IDX,
- REG_BADRPT_IDX,
- REG_EEND_IDX,
- REG_ESIZE_IDX,
- REG_ERPAREN_IDX
- };
-
-/* Entry points for GNU code. */
-
-/* re_compile_pattern is the GNU regular expression compiler: it
- compiles PATTERN (of length LENGTH) and puts the result in BUFP.
- Returns 0 if the pattern was valid, otherwise an error string.
-
- Assumes the `allocated' (and perhaps `buffer') and `translate' fields
- are set in BUFP on entry. */
-
-const char *
-re_compile_pattern (const char *pattern, size_t length,
- struct re_pattern_buffer *bufp)
-{
- reg_errcode_t ret;
-
- /* And GNU code determines whether or not to get register information
- by passing null for the REGS argument to re_match, etc., not by
- setting no_sub, unless RE_NO_SUB is set. */
- bufp->no_sub = !!(re_syntax_options & RE_NO_SUB);
-
- /* Match anchors at newline. */
- bufp->newline_anchor = 1;
-
- ret = re_compile_internal (bufp, pattern, length, re_syntax_options);
-
- if (!ret)
- return NULL;
- return gettext (__re_error_msgid + __re_error_msgid_idx[(int) ret]);
-}
-#ifdef _LIBC
-weak_alias (__re_compile_pattern, re_compile_pattern)
-#endif
-
-/* Set by `re_set_syntax' to the current regexp syntax to recognize. Can
- also be assigned to arbitrarily: each pattern buffer stores its own
- syntax, so it can be changed between regex compilations. */
-/* This has no initializer because initialized variables in Emacs
- become read-only after dumping. */
-reg_syntax_t re_syntax_options;
-
-
-/* Specify the precise syntax of regexps for compilation. This provides
- for compatibility for various utilities which historically have
- different, incompatible syntaxes.
-
- The argument SYNTAX is a bit mask comprised of the various bits
- defined in regex.h. We return the old syntax. */
-
-reg_syntax_t
-re_set_syntax (reg_syntax_t syntax)
-{
- reg_syntax_t ret = re_syntax_options;
-
- re_syntax_options = syntax;
- return ret;
-}
-#ifdef _LIBC
-weak_alias (__re_set_syntax, re_set_syntax)
-#endif
-
-int
-re_compile_fastmap (struct re_pattern_buffer *bufp)
-{
- re_dfa_t *dfa = (re_dfa_t *) bufp->buffer;
- char *fastmap = bufp->fastmap;
-
- memset (fastmap, '\0', sizeof (char) * SBC_MAX);
- re_compile_fastmap_iter (bufp, dfa->init_state, fastmap);
- if (dfa->init_state != dfa->init_state_word)
- re_compile_fastmap_iter (bufp, dfa->init_state_word, fastmap);
- if (dfa->init_state != dfa->init_state_nl)
- re_compile_fastmap_iter (bufp, dfa->init_state_nl, fastmap);
- if (dfa->init_state != dfa->init_state_begbuf)
- re_compile_fastmap_iter (bufp, dfa->init_state_begbuf, fastmap);
- bufp->fastmap_accurate = 1;
- return 0;
-}
-#ifdef _LIBC
-weak_alias (__re_compile_fastmap, re_compile_fastmap)
-#endif
-
-static inline void
-__attribute ((always_inline))
-re_set_fastmap (char *fastmap, int icase, int ch)
-{
- fastmap[ch] = 1;
- if (icase)
- fastmap[tolower (ch)] = 1;
-}
-
-/* Helper function for re_compile_fastmap.
- Compile fastmap for the initial_state INIT_STATE. */
-
-static void
-re_compile_fastmap_iter (regex_t *bufp, const re_dfastate_t *init_state,
- char *fastmap)
-{
- re_dfa_t *dfa = (re_dfa_t *) bufp->buffer;
- int node_cnt;
- int icase = (dfa->mb_cur_max == 1 && (bufp->syntax & RE_ICASE));
- for (node_cnt = 0; node_cnt < init_state->nodes.nelem; ++node_cnt)
- {
- int node = init_state->nodes.elems[node_cnt];
- re_token_type_t type = dfa->nodes[node].type;
-
- if (type == CHARACTER)
- {
- re_set_fastmap (fastmap, icase, dfa->nodes[node].opr.c);
-#ifdef RE_ENABLE_I18N
- if ((bufp->syntax & RE_ICASE) && dfa->mb_cur_max > 1)
- {
- unsigned char *buf = alloca (dfa->mb_cur_max), *p;
- wchar_t wc;
- mbstate_t state;
-
- p = buf;
- *p++ = dfa->nodes[node].opr.c;
- while (++node < dfa->nodes_len
- && dfa->nodes[node].type == CHARACTER
- && dfa->nodes[node].mb_partial)
- *p++ = dfa->nodes[node].opr.c;
- memset (&state, '\0', sizeof (state));
- if (mbrtowc (&wc, (const char *) buf, p - buf,
- &state) == p - buf
- && (__wcrtomb ((char *) buf, towlower (wc), &state)
- != (size_t) -1))
- re_set_fastmap (fastmap, 0, buf[0]);
- }
-#endif
- }
- else if (type == SIMPLE_BRACKET)
- {
- int i, ch;
- for (i = 0, ch = 0; i < BITSET_WORDS; ++i)
- {
- int j;
- bitset_word_t w = dfa->nodes[node].opr.sbcset[i];
- for (j = 0; j < BITSET_WORD_BITS; ++j, ++ch)
- if (w & ((bitset_word_t) 1 << j))
- re_set_fastmap (fastmap, icase, ch);
- }
- }
-#ifdef RE_ENABLE_I18N
- else if (type == COMPLEX_BRACKET)
- {
- int i;
- re_charset_t *cset = dfa->nodes[node].opr.mbcset;
- if (cset->non_match || cset->ncoll_syms || cset->nequiv_classes
- || cset->nranges || cset->nchar_classes)
- {
-# ifdef _LIBC
- if (_NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES) != 0)
- {
- /* In this case we want to catch the bytes which are
- the first byte of any collation elements.
- e.g. In da_DK, we want to catch 'a' since "aa"
- is a valid collation element, and don't catch
- 'b' since 'b' is the only collation element
- which starts from 'b'. */
- const int32_t *table = (const int32_t *)
- _NL_CURRENT (LC_COLLATE, _NL_COLLATE_TABLEMB);
- for (i = 0; i < SBC_MAX; ++i)
- if (table[i] < 0)
- re_set_fastmap (fastmap, icase, i);
- }
-# else
- if (dfa->mb_cur_max > 1)
- for (i = 0; i < SBC_MAX; ++i)
- if (__btowc (i) == WEOF)
- re_set_fastmap (fastmap, icase, i);
-# endif /* not _LIBC */
- }
- for (i = 0; i < cset->nmbchars; ++i)
- {
- char buf[256];
- mbstate_t state;
- memset (&state, '\0', sizeof (state));
- if (__wcrtomb (buf, cset->mbchars[i], &state) != (size_t) -1)
- re_set_fastmap (fastmap, icase, *(unsigned char *) buf);
- if ((bufp->syntax & RE_ICASE) && dfa->mb_cur_max > 1)
- {
- if (__wcrtomb (buf, towlower (cset->mbchars[i]), &state)
- != (size_t) -1)
- re_set_fastmap (fastmap, 0, *(unsigned char *) buf);
- }
- }
- }
-#endif /* RE_ENABLE_I18N */
- else if (type == OP_PERIOD
-#ifdef RE_ENABLE_I18N
- || type == OP_UTF8_PERIOD
-#endif /* RE_ENABLE_I18N */
- || type == END_OF_RE)
- {
- memset (fastmap, '\1', sizeof (char) * SBC_MAX);
- if (type == END_OF_RE)
- bufp->can_be_null = 1;
- return;
- }
- }
-}
-
-/* Entry point for POSIX code. */
-/* regcomp takes a regular expression as a string and compiles it.
-
- PREG is a regex_t *. We do not expect any fields to be initialized,
- since POSIX says we shouldn't. Thus, we set
-
- `buffer' to the compiled pattern;
- `used' to the length of the compiled pattern;
- `syntax' to RE_SYNTAX_POSIX_EXTENDED if the
- REG_EXTENDED bit in CFLAGS is set; otherwise, to
- RE_SYNTAX_POSIX_BASIC;
- `newline_anchor' to REG_NEWLINE being set in CFLAGS;
- `fastmap' to an allocated space for the fastmap;
- `fastmap_accurate' to zero;
- `re_nsub' to the number of subexpressions in PATTERN.
-
- PATTERN is the address of the pattern string.
-
- CFLAGS is a series of bits which affect compilation.
-
- If REG_EXTENDED is set, we use POSIX extended syntax; otherwise, we
- use POSIX basic syntax.
-
- If REG_NEWLINE is set, then . and [^...] don't match newline.
- Also, regexec will try a match beginning after every newline.
-
- If REG_ICASE is set, then we considers upper- and lowercase
- versions of letters to be equivalent when matching.
-
- If REG_NOSUB is set, then when PREG is passed to regexec, that
- routine will report only success or failure, and nothing about the
- registers.
-
- It returns 0 if it succeeds, nonzero if it doesn't. (See regex.h for
- the return codes and their meanings.) */
-
-int
-regcomp (regex_t *__restrict preg, const char *__restrict pattern, int cflags)
-{
- reg_errcode_t ret;
- reg_syntax_t syntax = ((cflags & REG_EXTENDED) ? RE_SYNTAX_POSIX_EXTENDED
- : RE_SYNTAX_POSIX_BASIC);
-
- preg->buffer = NULL;
- preg->allocated = 0;
- preg->used = 0;
-
- /* Try to allocate space for the fastmap. */
- preg->fastmap = re_malloc (char, SBC_MAX);
- if (BE (preg->fastmap == NULL, 0))
- return REG_ESPACE;
-
- syntax |= (cflags & REG_ICASE) ? RE_ICASE : 0;
-
- /* If REG_NEWLINE is set, newlines are treated differently. */
- if (cflags & REG_NEWLINE)
- { /* REG_NEWLINE implies neither . nor [^...] match newline. */
- syntax &= ~RE_DOT_NEWLINE;
- syntax |= RE_HAT_LISTS_NOT_NEWLINE;
- /* It also changes the matching behavior. */
- preg->newline_anchor = 1;
- }
- else
- preg->newline_anchor = 0;
- preg->no_sub = !!(cflags & REG_NOSUB);
- preg->translate = NULL;
-
- ret = re_compile_internal (preg, pattern, strlen (pattern), syntax);
-
- /* POSIX doesn't distinguish between an unmatched open-group and an
- unmatched close-group: both are REG_EPAREN. */
- if (ret == REG_ERPAREN)
- ret = REG_EPAREN;
-
- /* We have already checked preg->fastmap != NULL. */
- if (BE (ret == REG_NOERROR, 1))
- /* Compute the fastmap now, since regexec cannot modify the pattern
- buffer. This function never fails in this implementation. */
- (void) re_compile_fastmap (preg);
- else
- {
- /* Some error occurred while compiling the expression. */
- re_free (preg->fastmap);
- preg->fastmap = NULL;
- }
-
- return (int) ret;
-}
-#ifdef _LIBC
-weak_alias (__regcomp, regcomp)
-#endif
-
-/* Returns a message corresponding to an error code, ERRCODE, returned
- from either regcomp or regexec. We don't use PREG here. */
-
-size_t
-regerror (int errcode, const regex_t *__restrict preg,
- char *__restrict errbuf, size_t errbuf_size)
-{
- const char *msg;
- size_t msg_size;
-
- if (BE (errcode < 0
- || errcode >= (int) (sizeof (__re_error_msgid_idx)
- / sizeof (__re_error_msgid_idx[0])), 0))
- /* Only error codes returned by the rest of the code should be passed
- to this routine. If we are given anything else, or if other regex
- code generates an invalid error code, then the program has a bug.
- Dump core so we can fix it. */
- abort ();
-
- msg = gettext (__re_error_msgid + __re_error_msgid_idx[errcode]);
-
- msg_size = strlen (msg) + 1; /* Includes the null. */
-
- if (BE (errbuf_size != 0, 1))
- {
- if (BE (msg_size > errbuf_size, 0))
- {
-#if defined HAVE_MEMPCPY || defined _LIBC
- *((char *) __mempcpy (errbuf, msg, errbuf_size - 1)) = '\0';
-#else
- memcpy (errbuf, msg, errbuf_size - 1);
- errbuf[errbuf_size - 1] = 0;
-#endif
- }
- else
- memcpy (errbuf, msg, msg_size);
- }
-
- return msg_size;
-}
-#ifdef _LIBC
-weak_alias (__regerror, regerror)
-#endif
-
-
-#ifdef RE_ENABLE_I18N
-/* This static array is used for the map to single-byte characters when
- UTF-8 is used. Otherwise we would allocate memory just to initialize
- it the same all the time. UTF-8 is the preferred encoding so this is
- a worthwhile optimization. */
-static const bitset_t utf8_sb_map =
-{
- /* Set the first 128 bits. */
- [0 ... 0x80 / BITSET_WORD_BITS - 1] = BITSET_WORD_MAX
-};
-#endif
-
-
-static void
-free_dfa_content (re_dfa_t *dfa)
-{
- int i, j;
-
- if (dfa->nodes)
- for (i = 0; i < dfa->nodes_len; ++i)
- free_token (dfa->nodes + i);
- re_free (dfa->nexts);
- for (i = 0; i < dfa->nodes_len; ++i)
- {
- if (dfa->eclosures != NULL)
- re_node_set_free (dfa->eclosures + i);
- if (dfa->inveclosures != NULL)
- re_node_set_free (dfa->inveclosures + i);
- if (dfa->edests != NULL)
- re_node_set_free (dfa->edests + i);
- }
- re_free (dfa->edests);
- re_free (dfa->eclosures);
- re_free (dfa->inveclosures);
- re_free (dfa->nodes);
-
- if (dfa->state_table)
- for (i = 0; i <= dfa->state_hash_mask; ++i)
- {
- struct re_state_table_entry *entry = dfa->state_table + i;
- for (j = 0; j < entry->num; ++j)
- {
- re_dfastate_t *state = entry->array[j];
- free_state (state);
- }
- re_free (entry->array);
- }
- re_free (dfa->state_table);
-#ifdef RE_ENABLE_I18N
- if (dfa->sb_char != utf8_sb_map)
- re_free (dfa->sb_char);
-#endif
- re_free (dfa->subexp_map);
-#ifdef DEBUG
- re_free (dfa->re_str);
-#endif
-
- re_free (dfa);
-}
-
-
-/* Free dynamically allocated space used by PREG. */
-
-void
-regfree (regex_t *preg)
-{
- re_dfa_t *dfa = (re_dfa_t *) preg->buffer;
- if (BE (dfa != NULL, 1))
- free_dfa_content (dfa);
- preg->buffer = NULL;
- preg->allocated = 0;
-
- re_free (preg->fastmap);
- preg->fastmap = NULL;
-
- re_free (preg->translate);
- preg->translate = NULL;
-}
-#ifdef _LIBC
-weak_alias (__regfree, regfree)
-#endif
-
-/* Entry points compatible with 4.2 BSD regex library. We don't define
- them unless specifically requested. */
-
-#if defined _REGEX_RE_COMP || defined _LIBC
-
-/* BSD has one and only one pattern buffer. */
-static struct re_pattern_buffer re_comp_buf;
-
-char *
-# ifdef _LIBC
-/* Make these definitions weak in libc, so POSIX programs can redefine
- these names if they don't use our functions, and still use
- regcomp/regexec above without link errors. */
-weak_function
-# endif
-re_comp (s)
- const char *s;
-{
- reg_errcode_t ret;
- char *fastmap;
-
- if (!s)
- {
- if (!re_comp_buf.buffer)
- return gettext ("No previous regular expression");
- return 0;
- }
-
- if (re_comp_buf.buffer)
- {
- fastmap = re_comp_buf.fastmap;
- re_comp_buf.fastmap = NULL;
- __regfree (&re_comp_buf);
- memset (&re_comp_buf, '\0', sizeof (re_comp_buf));
- re_comp_buf.fastmap = fastmap;
- }
-
- if (re_comp_buf.fastmap == NULL)
- {
- re_comp_buf.fastmap = (char *) malloc (SBC_MAX);
- if (re_comp_buf.fastmap == NULL)
- return (char *) gettext (__re_error_msgid
- + __re_error_msgid_idx[(int) REG_ESPACE]);
- }
-
- /* Since `re_exec' always passes NULL for the `regs' argument, we
- don't need to initialize the pattern buffer fields which affect it. */
-
- /* Match anchors at newlines. */
- re_comp_buf.newline_anchor = 1;
-
- ret = re_compile_internal (&re_comp_buf, s, strlen (s), re_syntax_options);
-
- if (!ret)
- return NULL;
-
- /* Yes, we're discarding `const' here if !HAVE_LIBINTL. */
- return (char *) gettext (__re_error_msgid + __re_error_msgid_idx[(int) ret]);
-}
-
-#ifdef _LIBC
-libc_freeres_fn (free_mem)
-{
- __regfree (&re_comp_buf);
-}
-#endif
-
-#endif /* _REGEX_RE_COMP */
-
-/* Internal entry point.
- Compile the regular expression PATTERN, whose length is LENGTH.
- SYNTAX indicate regular expression's syntax. */
-
-static reg_errcode_t
-re_compile_internal (regex_t *preg, const char * pattern, size_t length,
- reg_syntax_t syntax)
-{
- reg_errcode_t err = REG_NOERROR;
- re_dfa_t *dfa;
- re_string_t regexp;
-
- /* Initialize the pattern buffer. */
- preg->fastmap_accurate = 0;
- preg->syntax = syntax;
- preg->not_bol = preg->not_eol = 0;
- preg->used = 0;
- preg->re_nsub = 0;
- preg->can_be_null = 0;
- preg->regs_allocated = REGS_UNALLOCATED;
-
- /* Initialize the dfa. */
- dfa = (re_dfa_t *) preg->buffer;
- if (BE (preg->allocated < sizeof (re_dfa_t), 0))
- {
- /* If zero allocated, but buffer is non-null, try to realloc
- enough space. This loses if buffer's address is bogus, but
- that is the user's responsibility. If ->buffer is NULL this
- is a simple allocation. */
- dfa = re_realloc (preg->buffer, re_dfa_t, 1);
- if (dfa == NULL)
- return REG_ESPACE;
- preg->allocated = sizeof (re_dfa_t);
- preg->buffer = (unsigned char *) dfa;
- }
- preg->used = sizeof (re_dfa_t);
-
- err = init_dfa (dfa, length);
- if (BE (err != REG_NOERROR, 0))
- {
- free_dfa_content (dfa);
- preg->buffer = NULL;
- preg->allocated = 0;
- return err;
- }
-#ifdef DEBUG
- /* Note: length+1 will not overflow since it is checked in init_dfa. */
- dfa->re_str = re_malloc (char, length + 1);
- strncpy (dfa->re_str, pattern, length + 1);
-#endif
-
- __libc_lock_init (dfa->lock);
-
- err = re_string_construct (&regexp, pattern, length, preg->translate,
- syntax & RE_ICASE, dfa);
- if (BE (err != REG_NOERROR, 0))
- {
- re_compile_internal_free_return:
- free_workarea_compile (preg);
- re_string_destruct (&regexp);
- free_dfa_content (dfa);
- preg->buffer = NULL;
- preg->allocated = 0;
- return err;
- }
-
- /* Parse the regular expression, and build a structure tree. */
- preg->re_nsub = 0;
- dfa->str_tree = parse (&regexp, preg, syntax, &err);
- if (BE (dfa->str_tree == NULL, 0))
- goto re_compile_internal_free_return;
-
- /* Analyze the tree and create the nfa. */
- err = analyze (preg);
- if (BE (err != REG_NOERROR, 0))
- goto re_compile_internal_free_return;
-
-#ifdef RE_ENABLE_I18N
- /* If possible, do searching in single byte encoding to speed things up. */
- if (dfa->is_utf8 && !(syntax & RE_ICASE) && preg->translate == NULL)
- optimize_utf8 (dfa);
-#endif
-
- /* Then create the initial state of the dfa. */
- err = create_initial_state (dfa);
-
- /* Release work areas. */
- free_workarea_compile (preg);
- re_string_destruct (&regexp);
-
- if (BE (err != REG_NOERROR, 0))
- {
- free_dfa_content (dfa);
- preg->buffer = NULL;
- preg->allocated = 0;
- }
-
- return err;
-}
-
-/* Initialize DFA. We use the length of the regular expression PAT_LEN
- as the initial length of some arrays. */
-
-static reg_errcode_t
-init_dfa (re_dfa_t *dfa, size_t pat_len)
-{
- unsigned int table_size;
-#ifndef _LIBC
- const char *codeset_name;
-#endif
-
- memset (dfa, '\0', sizeof (re_dfa_t));
-
- /* Force allocation of str_tree_storage the first time. */
- dfa->str_tree_storage_idx = BIN_TREE_STORAGE_SIZE;
-
- /* Avoid overflows. */
- if (pat_len == SIZE_MAX)
- return REG_ESPACE;
-
- dfa->nodes_alloc = pat_len + 1;
- dfa->nodes = re_malloc (re_token_t, dfa->nodes_alloc);
-
- /* table_size = 2 ^ ceil(log pat_len) */
- for (table_size = 1; ; table_size <<= 1)
- if (table_size > pat_len)
- break;
-
- dfa->state_table = calloc (sizeof (struct re_state_table_entry), table_size);
- dfa->state_hash_mask = table_size - 1;
-
- dfa->mb_cur_max = MB_CUR_MAX;
-#ifdef _LIBC
- if (dfa->mb_cur_max == 6
- && strcmp (_NL_CURRENT (LC_CTYPE, _NL_CTYPE_CODESET_NAME), "UTF-8") == 0)
- dfa->is_utf8 = 1;
- dfa->map_notascii = (_NL_CURRENT_WORD (LC_CTYPE, _NL_CTYPE_MAP_TO_NONASCII)
- != 0);
-#else
-# ifdef HAVE_LANGINFO_CODESET
- codeset_name = nl_langinfo (CODESET);
-# else
- codeset_name = getenv ("LC_ALL");
- if (codeset_name == NULL || codeset_name[0] == '\0')
- codeset_name = getenv ("LC_CTYPE");
- if (codeset_name == NULL || codeset_name[0] == '\0')
- codeset_name = getenv ("LANG");
- if (codeset_name == NULL)
- codeset_name = "";
- else if (strchr (codeset_name, '.') != NULL)
- codeset_name = strchr (codeset_name, '.') + 1;
-# endif
-
- if (strcasecmp (codeset_name, "UTF-8") == 0
- || strcasecmp (codeset_name, "UTF8") == 0)
- dfa->is_utf8 = 1;
-
- /* We check exhaustively in the loop below if this charset is a
- superset of ASCII. */
- dfa->map_notascii = 0;
-#endif
-
-#ifdef RE_ENABLE_I18N
- if (dfa->mb_cur_max > 1)
- {
- if (dfa->is_utf8)
- dfa->sb_char = (re_bitset_ptr_t) utf8_sb_map;
- else
- {
- int i, j, ch;
-
- dfa->sb_char = (re_bitset_ptr_t) calloc (sizeof (bitset_t), 1);
- if (BE (dfa->sb_char == NULL, 0))
- return REG_ESPACE;
-
- /* Set the bits corresponding to single byte chars. */
- for (i = 0, ch = 0; i < BITSET_WORDS; ++i)
- for (j = 0; j < BITSET_WORD_BITS; ++j, ++ch)
- {
- wint_t wch = __btowc (ch);
- if (wch != WEOF)
- dfa->sb_char[i] |= (bitset_word_t) 1 << j;
-# ifndef _LIBC
- if (isascii (ch) && wch != ch)
- dfa->map_notascii = 1;
-# endif
- }
- }
- }
-#endif
-
- if (BE (dfa->nodes == NULL || dfa->state_table == NULL, 0))
- return REG_ESPACE;
- return REG_NOERROR;
-}
-
-/* Initialize WORD_CHAR table, which indicate which character is
- "word". In this case "word" means that it is the word construction
- character used by some operators like "\<", "\>", etc. */
-
-static void
-internal_function
-init_word_char (re_dfa_t *dfa)
-{
- int i, j, ch;
- dfa->word_ops_used = 1;
- for (i = 0, ch = 0; i < BITSET_WORDS; ++i)
- for (j = 0; j < BITSET_WORD_BITS; ++j, ++ch)
- if (isalnum (ch) || ch == '_')
- dfa->word_char[i] |= (bitset_word_t) 1 << j;
-}
-
-/* Free the work area which are only used while compiling. */
-
-static void
-free_workarea_compile (regex_t *preg)
-{
- re_dfa_t *dfa = (re_dfa_t *) preg->buffer;
- bin_tree_storage_t *storage, *next;
- for (storage = dfa->str_tree_storage; storage; storage = next)
- {
- next = storage->next;
- re_free (storage);
- }
- dfa->str_tree_storage = NULL;
- dfa->str_tree_storage_idx = BIN_TREE_STORAGE_SIZE;
- dfa->str_tree = NULL;
- re_free (dfa->org_indices);
- dfa->org_indices = NULL;
-}
-
-/* Create initial states for all contexts. */
-
-static reg_errcode_t
-create_initial_state (re_dfa_t *dfa)
-{
- int first, i;
- reg_errcode_t err;
- re_node_set init_nodes;
-
- /* Initial states have the epsilon closure of the node which is
- the first node of the regular expression. */
- first = dfa->str_tree->first->node_idx;
- dfa->init_node = first;
- err = re_node_set_init_copy (&init_nodes, dfa->eclosures + first);
- if (BE (err != REG_NOERROR, 0))
- return err;
-
- /* The back-references which are in initial states can epsilon transit,
- since in this case all of the subexpressions can be null.
- Then we add epsilon closures of the nodes which are the next nodes of
- the back-references. */
- if (dfa->nbackref > 0)
- for (i = 0; i < init_nodes.nelem; ++i)
- {
- int node_idx = init_nodes.elems[i];
- re_token_type_t type = dfa->nodes[node_idx].type;
-
- int clexp_idx;
- if (type != OP_BACK_REF)
- continue;
- for (clexp_idx = 0; clexp_idx < init_nodes.nelem; ++clexp_idx)
- {
- re_token_t *clexp_node;
- clexp_node = dfa->nodes + init_nodes.elems[clexp_idx];
- if (clexp_node->type == OP_CLOSE_SUBEXP
- && clexp_node->opr.idx == dfa->nodes[node_idx].opr.idx)
- break;
- }
- if (clexp_idx == init_nodes.nelem)
- continue;
-
- if (type == OP_BACK_REF)
- {
- int dest_idx = dfa->edests[node_idx].elems[0];
- if (!re_node_set_contains (&init_nodes, dest_idx))
- {
- re_node_set_merge (&init_nodes, dfa->eclosures + dest_idx);
- i = 0;
- }
- }
- }
-
- /* It must be the first time to invoke acquire_state. */
- dfa->init_state = re_acquire_state_context (&err, dfa, &init_nodes, 0);
- /* We don't check ERR here, since the initial state must not be NULL. */
- if (BE (dfa->init_state == NULL, 0))
- return err;
- if (dfa->init_state->has_constraint)
- {
- dfa->init_state_word = re_acquire_state_context (&err, dfa, &init_nodes,
- CONTEXT_WORD);
- dfa->init_state_nl = re_acquire_state_context (&err, dfa, &init_nodes,
- CONTEXT_NEWLINE);
- dfa->init_state_begbuf = re_acquire_state_context (&err, dfa,
- &init_nodes,
- CONTEXT_NEWLINE
- | CONTEXT_BEGBUF);
- if (BE (dfa->init_state_word == NULL || dfa->init_state_nl == NULL
- || dfa->init_state_begbuf == NULL, 0))
- return err;
- }
- else
- dfa->init_state_word = dfa->init_state_nl
- = dfa->init_state_begbuf = dfa->init_state;
-
- re_node_set_free (&init_nodes);
- return REG_NOERROR;
-}
-
-#ifdef RE_ENABLE_I18N
-/* If it is possible to do searching in single byte encoding instead of UTF-8
- to speed things up, set dfa->mb_cur_max to 1, clear is_utf8 and change
- DFA nodes where needed. */
-
-static void
-optimize_utf8 (re_dfa_t *dfa)
-{
- int node, i, mb_chars = 0, has_period = 0;
-
- for (node = 0; node < dfa->nodes_len; ++node)
- switch (dfa->nodes[node].type)
- {
- case CHARACTER:
- if (dfa->nodes[node].opr.c >= 0x80)
- mb_chars = 1;
- break;
- case ANCHOR:
- switch (dfa->nodes[node].opr.idx)
- {
- case LINE_FIRST:
- case LINE_LAST:
- case BUF_FIRST:
- case BUF_LAST:
- break;
- default:
- /* Word anchors etc. cannot be handled. */
- return;
- }
- break;
- case OP_PERIOD:
- has_period = 1;
- break;
- case OP_BACK_REF:
- case OP_ALT:
- case END_OF_RE:
- case OP_DUP_ASTERISK:
- case OP_OPEN_SUBEXP:
- case OP_CLOSE_SUBEXP:
- break;
- case COMPLEX_BRACKET:
- return;
- case SIMPLE_BRACKET:
- /* Just double check. The non-ASCII range starts at 0x80. */
- assert (0x80 % BITSET_WORD_BITS == 0);
- for (i = 0x80 / BITSET_WORD_BITS; i < BITSET_WORDS; ++i)
- if (dfa->nodes[node].opr.sbcset[i])
- return;
- break;
- default:
- abort ();
- }
-
- if (mb_chars || has_period)
- for (node = 0; node < dfa->nodes_len; ++node)
- {
- if (dfa->nodes[node].type == CHARACTER
- && dfa->nodes[node].opr.c >= 0x80)
- dfa->nodes[node].mb_partial = 0;
- else if (dfa->nodes[node].type == OP_PERIOD)
- dfa->nodes[node].type = OP_UTF8_PERIOD;
- }
-
- /* The search can be in single byte locale. */
- dfa->mb_cur_max = 1;
- dfa->is_utf8 = 0;
- dfa->has_mb_node = dfa->nbackref > 0 || has_period;
-}
-#endif
-
-/* Analyze the structure tree, and calculate "first", "next", "edest",
- "eclosure", and "inveclosure". */
-
-static reg_errcode_t
-analyze (regex_t *preg)
-{
- re_dfa_t *dfa = (re_dfa_t *) preg->buffer;
- reg_errcode_t ret;
-
- /* Allocate arrays. */
- dfa->nexts = re_malloc (int, dfa->nodes_alloc);
- dfa->org_indices = re_malloc (int, dfa->nodes_alloc);
- dfa->edests = re_malloc (re_node_set, dfa->nodes_alloc);
- dfa->eclosures = re_malloc (re_node_set, dfa->nodes_alloc);
- if (BE (dfa->nexts == NULL || dfa->org_indices == NULL || dfa->edests == NULL
- || dfa->eclosures == NULL, 0))
- return REG_ESPACE;
-
- dfa->subexp_map = re_malloc (int, preg->re_nsub);
- if (dfa->subexp_map != NULL)
- {
- int i;
- for (i = 0; i < preg->re_nsub; i++)
- dfa->subexp_map[i] = i;
- preorder (dfa->str_tree, optimize_subexps, dfa);
- for (i = 0; i < preg->re_nsub; i++)
- if (dfa->subexp_map[i] != i)
- break;
- if (i == preg->re_nsub)
- {
- free (dfa->subexp_map);
- dfa->subexp_map = NULL;
- }
- }
-
- ret = postorder (dfa->str_tree, lower_subexps, preg);
- if (BE (ret != REG_NOERROR, 0))
- return ret;
- ret = postorder (dfa->str_tree, calc_first, dfa);
- if (BE (ret != REG_NOERROR, 0))
- return ret;
- preorder (dfa->str_tree, calc_next, dfa);
- ret = preorder (dfa->str_tree, link_nfa_nodes, dfa);
- if (BE (ret != REG_NOERROR, 0))
- return ret;
- ret = calc_eclosure (dfa);
- if (BE (ret != REG_NOERROR, 0))
- return ret;
-
- /* We only need this during the prune_impossible_nodes pass in regexec.c;
- skip it if p_i_n will not run, as calc_inveclosure can be quadratic. */
- if ((!preg->no_sub && preg->re_nsub > 0 && dfa->has_plural_match)
- || dfa->nbackref)
- {
- dfa->inveclosures = re_malloc (re_node_set, dfa->nodes_len);
- if (BE (dfa->inveclosures == NULL, 0))
- return REG_ESPACE;
- ret = calc_inveclosure (dfa);
- }
-
- return ret;
-}
-
-/* Our parse trees are very unbalanced, so we cannot use a stack to
- implement parse tree visits. Instead, we use parent pointers and
- some hairy code in these two functions. */
-static reg_errcode_t
-postorder (bin_tree_t *root, reg_errcode_t (fn (void *, bin_tree_t *)),
- void *extra)
-{
- bin_tree_t *node, *prev;
-
- for (node = root; ; )
- {
- /* Descend down the tree, preferably to the left (or to the right
- if that's the only child). */
- while (node->left || node->right)
- if (node->left)
- node = node->left;
- else
- node = node->right;
-
- do
- {
- reg_errcode_t err = fn (extra, node);
- if (BE (err != REG_NOERROR, 0))
- return err;
- if (node->parent == NULL)
- return REG_NOERROR;
- prev = node;
- node = node->parent;
- }
- /* Go up while we have a node that is reached from the right. */
- while (node->right == prev || node->right == NULL);
- node = node->right;
- }
-}
-
-static reg_errcode_t
-preorder (bin_tree_t *root, reg_errcode_t (fn (void *, bin_tree_t *)),
- void *extra)
-{
- bin_tree_t *node;
-
- for (node = root; ; )
- {
- reg_errcode_t err = fn (extra, node);
- if (BE (err != REG_NOERROR, 0))
- return err;
-
- /* Go to the left node, or up and to the right. */
- if (node->left)
- node = node->left;
- else
- {
- bin_tree_t *prev = NULL;
- while (node->right == prev || node->right == NULL)
- {
- prev = node;
- node = node->parent;
- if (!node)
- return REG_NOERROR;
- }
- node = node->right;
- }
- }
-}
-
-/* Optimization pass: if a SUBEXP is entirely contained, strip it and tell
- re_search_internal to map the inner one's opr.idx to this one's. Adjust
- backreferences as well. Requires a preorder visit. */
-static reg_errcode_t
-optimize_subexps (void *extra, bin_tree_t *node)
-{
- re_dfa_t *dfa = (re_dfa_t *) extra;
-
- if (node->token.type == OP_BACK_REF && dfa->subexp_map)
- {
- int idx = node->token.opr.idx;
- node->token.opr.idx = dfa->subexp_map[idx];
- dfa->used_bkref_map |= 1 << node->token.opr.idx;
- }
-
- else if (node->token.type == SUBEXP
- && node->left && node->left->token.type == SUBEXP)
- {
- int other_idx = node->left->token.opr.idx;
-
- node->left = node->left->left;
- if (node->left)
- node->left->parent = node;
-
- dfa->subexp_map[other_idx] = dfa->subexp_map[node->token.opr.idx];
- if (other_idx < BITSET_WORD_BITS)
- dfa->used_bkref_map &= ~((bitset_word_t) 1 << other_idx);
- }
-
- return REG_NOERROR;
-}
-
-/* Lowering pass: Turn each SUBEXP node into the appropriate concatenation
- of OP_OPEN_SUBEXP, the body of the SUBEXP (if any) and OP_CLOSE_SUBEXP. */
-static reg_errcode_t
-lower_subexps (void *extra, bin_tree_t *node)
-{
- regex_t *preg = (regex_t *) extra;
- reg_errcode_t err = REG_NOERROR;
-
- if (node->left && node->left->token.type == SUBEXP)
- {
- node->left = lower_subexp (&err, preg, node->left);
- if (node->left)
- node->left->parent = node;
- }
- if (node->right && node->right->token.type == SUBEXP)
- {
- node->right = lower_subexp (&err, preg, node->right);
- if (node->right)
- node->right->parent = node;
- }
-
- return err;
-}
-
-static bin_tree_t *
-lower_subexp (reg_errcode_t *err, regex_t *preg, bin_tree_t *node)
-{
- re_dfa_t *dfa = (re_dfa_t *) preg->buffer;
- bin_tree_t *body = node->left;
- bin_tree_t *op, *cls, *tree1, *tree;
-
- if (preg->no_sub
- /* We do not optimize empty subexpressions, because otherwise we may
- have bad CONCAT nodes with NULL children. This is obviously not
- very common, so we do not lose much. An example that triggers
- this case is the sed "script" /\(\)/x. */
- && node->left != NULL
- && (node->token.opr.idx >= BITSET_WORD_BITS
- || !(dfa->used_bkref_map
- & ((bitset_word_t) 1 << node->token.opr.idx))))
- return node->left;
-
- /* Convert the SUBEXP node to the concatenation of an
- OP_OPEN_SUBEXP, the contents, and an OP_CLOSE_SUBEXP. */
- op = create_tree (dfa, NULL, NULL, OP_OPEN_SUBEXP);
- cls = create_tree (dfa, NULL, NULL, OP_CLOSE_SUBEXP);
- tree1 = body ? create_tree (dfa, body, cls, CONCAT) : cls;
- tree = create_tree (dfa, op, tree1, CONCAT);
- if (BE (tree == NULL || tree1 == NULL || op == NULL || cls == NULL, 0))
- {
- *err = REG_ESPACE;
- return NULL;
- }
-
- op->token.opr.idx = cls->token.opr.idx = node->token.opr.idx;
- op->token.opt_subexp = cls->token.opt_subexp = node->token.opt_subexp;
- return tree;
-}
-
-/* Pass 1 in building the NFA: compute FIRST and create unlinked automaton
- nodes. Requires a postorder visit. */
-static reg_errcode_t
-calc_first (void *extra, bin_tree_t *node)
-{
- re_dfa_t *dfa = (re_dfa_t *) extra;
- if (node->token.type == CONCAT)
- {
- node->first = node->left->first;
- node->node_idx = node->left->node_idx;
- }
- else
- {
- node->first = node;
- node->node_idx = re_dfa_add_node (dfa, node->token);
- if (BE (node->node_idx == -1, 0))
- return REG_ESPACE;
- }
- return REG_NOERROR;
-}
-
-/* Pass 2: compute NEXT on the tree. Preorder visit. */
-static reg_errcode_t
-calc_next (void *extra, bin_tree_t *node)
-{
- switch (node->token.type)
- {
- case OP_DUP_ASTERISK:
- node->left->next = node;
- break;
- case CONCAT:
- node->left->next = node->right->first;
- node->right->next = node->next;
- break;
- default:
- if (node->left)
- node->left->next = node->next;
- if (node->right)
- node->right->next = node->next;
- break;
- }
- return REG_NOERROR;
-}
-
-/* Pass 3: link all DFA nodes to their NEXT node (any order will do). */
-static reg_errcode_t
-link_nfa_nodes (void *extra, bin_tree_t *node)
-{
- re_dfa_t *dfa = (re_dfa_t *) extra;
- int idx = node->node_idx;
- reg_errcode_t err = REG_NOERROR;
-
- switch (node->token.type)
- {
- case CONCAT:
- break;
-
- case END_OF_RE:
- assert (node->next == NULL);
- break;
-
- case OP_DUP_ASTERISK:
- case OP_ALT:
- {
- int left, right;
- dfa->has_plural_match = 1;
- if (node->left != NULL)
- left = node->left->first->node_idx;
- else
- left = node->next->node_idx;
- if (node->right != NULL)
- right = node->right->first->node_idx;
- else
- right = node->next->node_idx;
- assert (left > -1);
- assert (right > -1);
- err = re_node_set_init_2 (dfa->edests + idx, left, right);
- }
- break;
-
- case ANCHOR:
- case OP_OPEN_SUBEXP:
- case OP_CLOSE_SUBEXP:
- err = re_node_set_init_1 (dfa->edests + idx, node->next->node_idx);
- break;
-
- case OP_BACK_REF:
- dfa->nexts[idx] = node->next->node_idx;
- if (node->token.type == OP_BACK_REF)
- re_node_set_init_1 (dfa->edests + idx, dfa->nexts[idx]);
- break;
-
- default:
- assert (!IS_EPSILON_NODE (node->token.type));
- dfa->nexts[idx] = node->next->node_idx;
- break;
- }
-
- return err;
-}
-
-/* Duplicate the epsilon closure of the node ROOT_NODE.
- Note that duplicated nodes have constraint INIT_CONSTRAINT in addition
- to their own constraint. */
-
-static reg_errcode_t
-internal_function
-duplicate_node_closure (re_dfa_t *dfa, int top_org_node, int top_clone_node,
- int root_node, unsigned int init_constraint)
-{
- int org_node, clone_node, ret;
- unsigned int constraint = init_constraint;
- for (org_node = top_org_node, clone_node = top_clone_node;;)
- {
- int org_dest, clone_dest;
- if (dfa->nodes[org_node].type == OP_BACK_REF)
- {
- /* If the back reference epsilon-transit, its destination must
- also have the constraint. Then duplicate the epsilon closure
- of the destination of the back reference, and store it in
- edests of the back reference. */
- org_dest = dfa->nexts[org_node];
- re_node_set_empty (dfa->edests + clone_node);
- clone_dest = duplicate_node (dfa, org_dest, constraint);
- if (BE (clone_dest == -1, 0))
- return REG_ESPACE;
- dfa->nexts[clone_node] = dfa->nexts[org_node];
- ret = re_node_set_insert (dfa->edests + clone_node, clone_dest);
- if (BE (ret < 0, 0))
- return REG_ESPACE;
- }
- else if (dfa->edests[org_node].nelem == 0)
- {
- /* In case of the node can't epsilon-transit, don't duplicate the
- destination and store the original destination as the
- destination of the node. */
- dfa->nexts[clone_node] = dfa->nexts[org_node];
- break;
- }
- else if (dfa->edests[org_node].nelem == 1)
- {
- /* In case of the node can epsilon-transit, and it has only one
- destination. */
- org_dest = dfa->edests[org_node].elems[0];
- re_node_set_empty (dfa->edests + clone_node);
- if (dfa->nodes[org_node].type == ANCHOR)
- {
- /* In case of the node has another constraint, append it. */
- if (org_node == root_node && clone_node != org_node)
- {
- /* ...but if the node is root_node itself, it means the
- epsilon closure have a loop, then tie it to the
- destination of the root_node. */
- ret = re_node_set_insert (dfa->edests + clone_node,
- org_dest);
- if (BE (ret < 0, 0))
- return REG_ESPACE;
- break;
- }
- constraint |= dfa->nodes[org_node].opr.ctx_type;
- }
- clone_dest = duplicate_node (dfa, org_dest, constraint);
- if (BE (clone_dest == -1, 0))
- return REG_ESPACE;
- ret = re_node_set_insert (dfa->edests + clone_node, clone_dest);
- if (BE (ret < 0, 0))
- return REG_ESPACE;
- }
- else /* dfa->edests[org_node].nelem == 2 */
- {
- /* In case of the node can epsilon-transit, and it has two
- destinations. In the bin_tree_t and DFA, that's '|' and '*'. */
- org_dest = dfa->edests[org_node].elems[0];
- re_node_set_empty (dfa->edests + clone_node);
- /* Search for a duplicated node which satisfies the constraint. */
- clone_dest = search_duplicated_node (dfa, org_dest, constraint);
- if (clone_dest == -1)
- {
- /* There are no such a duplicated node, create a new one. */
- reg_errcode_t err;
- clone_dest = duplicate_node (dfa, org_dest, constraint);
- if (BE (clone_dest == -1, 0))
- return REG_ESPACE;
- ret = re_node_set_insert (dfa->edests + clone_node, clone_dest);
- if (BE (ret < 0, 0))
- return REG_ESPACE;
- err = duplicate_node_closure (dfa, org_dest, clone_dest,
- root_node, constraint);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- else
- {
- /* There are a duplicated node which satisfy the constraint,
- use it to avoid infinite loop. */
- ret = re_node_set_insert (dfa->edests + clone_node, clone_dest);
- if (BE (ret < 0, 0))
- return REG_ESPACE;
- }
-
- org_dest = dfa->edests[org_node].elems[1];
- clone_dest = duplicate_node (dfa, org_dest, constraint);
- if (BE (clone_dest == -1, 0))
- return REG_ESPACE;
- ret = re_node_set_insert (dfa->edests + clone_node, clone_dest);
- if (BE (ret < 0, 0))
- return REG_ESPACE;
- }
- org_node = org_dest;
- clone_node = clone_dest;
- }
- return REG_NOERROR;
-}
-
-/* Search for a node which is duplicated from the node ORG_NODE, and
- satisfies the constraint CONSTRAINT. */
-
-static int
-search_duplicated_node (const re_dfa_t *dfa, int org_node,
- unsigned int constraint)
-{
- int idx;
- for (idx = dfa->nodes_len - 1; dfa->nodes[idx].duplicated && idx > 0; --idx)
- {
- if (org_node == dfa->org_indices[idx]
- && constraint == dfa->nodes[idx].constraint)
- return idx; /* Found. */
- }
- return -1; /* Not found. */
-}
-
-/* Duplicate the node whose index is ORG_IDX and set the constraint CONSTRAINT.
- Return the index of the new node, or -1 if insufficient storage is
- available. */
-
-static int
-duplicate_node (re_dfa_t *dfa, int org_idx, unsigned int constraint)
-{
- int dup_idx = re_dfa_add_node (dfa, dfa->nodes[org_idx]);
- if (BE (dup_idx != -1, 1))
- {
- dfa->nodes[dup_idx].constraint = constraint;
- if (dfa->nodes[org_idx].type == ANCHOR)
- dfa->nodes[dup_idx].constraint |= dfa->nodes[org_idx].opr.ctx_type;
- dfa->nodes[dup_idx].duplicated = 1;
-
- /* Store the index of the original node. */
- dfa->org_indices[dup_idx] = org_idx;
- }
- return dup_idx;
-}
-
-static reg_errcode_t
-calc_inveclosure (re_dfa_t *dfa)
-{
- int src, idx, ret;
- for (idx = 0; idx < dfa->nodes_len; ++idx)
- re_node_set_init_empty (dfa->inveclosures + idx);
-
- for (src = 0; src < dfa->nodes_len; ++src)
- {
- int *elems = dfa->eclosures[src].elems;
- for (idx = 0; idx < dfa->eclosures[src].nelem; ++idx)
- {
- ret = re_node_set_insert_last (dfa->inveclosures + elems[idx], src);
- if (BE (ret == -1, 0))
- return REG_ESPACE;
- }
- }
-
- return REG_NOERROR;
-}
-
-/* Calculate "eclosure" for all the node in DFA. */
-
-static reg_errcode_t
-calc_eclosure (re_dfa_t *dfa)
-{
- int node_idx, incomplete;
-#ifdef DEBUG
- assert (dfa->nodes_len > 0);
-#endif
- incomplete = 0;
- /* For each nodes, calculate epsilon closure. */
- for (node_idx = 0; ; ++node_idx)
- {
- reg_errcode_t err;
- re_node_set eclosure_elem;
- if (node_idx == dfa->nodes_len)
- {
- if (!incomplete)
- break;
- incomplete = 0;
- node_idx = 0;
- }
-
-#ifdef DEBUG
- assert (dfa->eclosures[node_idx].nelem != -1);
-#endif
-
- /* If we have already calculated, skip it. */
- if (dfa->eclosures[node_idx].nelem != 0)
- continue;
- /* Calculate epsilon closure of `node_idx'. */
- err = calc_eclosure_iter (&eclosure_elem, dfa, node_idx, 1);
- if (BE (err != REG_NOERROR, 0))
- return err;
-
- if (dfa->eclosures[node_idx].nelem == 0)
- {
- incomplete = 1;
- re_node_set_free (&eclosure_elem);
- }
- }
- return REG_NOERROR;
-}
-
-/* Calculate epsilon closure of NODE. */
-
-static reg_errcode_t
-calc_eclosure_iter (re_node_set *new_set, re_dfa_t *dfa, int node, int root)
-{
- reg_errcode_t err;
- unsigned int constraint;
- int i, incomplete;
- re_node_set eclosure;
- incomplete = 0;
- err = re_node_set_alloc (&eclosure, dfa->edests[node].nelem + 1);
- if (BE (err != REG_NOERROR, 0))
- return err;
-
- /* This indicates that we are calculating this node now.
- We reference this value to avoid infinite loop. */
- dfa->eclosures[node].nelem = -1;
-
- constraint = ((dfa->nodes[node].type == ANCHOR)
- ? dfa->nodes[node].opr.ctx_type : 0);
- /* If the current node has constraints, duplicate all nodes.
- Since they must inherit the constraints. */
- if (constraint
- && dfa->edests[node].nelem
- && !dfa->nodes[dfa->edests[node].elems[0]].duplicated)
- {
- err = duplicate_node_closure (dfa, node, node, node, constraint);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
-
- /* Expand each epsilon destination nodes. */
- if (IS_EPSILON_NODE(dfa->nodes[node].type))
- for (i = 0; i < dfa->edests[node].nelem; ++i)
- {
- re_node_set eclosure_elem;
- int edest = dfa->edests[node].elems[i];
- /* If calculating the epsilon closure of `edest' is in progress,
- return intermediate result. */
- if (dfa->eclosures[edest].nelem == -1)
- {
- incomplete = 1;
- continue;
- }
- /* If we haven't calculated the epsilon closure of `edest' yet,
- calculate now. Otherwise use calculated epsilon closure. */
- if (dfa->eclosures[edest].nelem == 0)
- {
- err = calc_eclosure_iter (&eclosure_elem, dfa, edest, 0);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- else
- eclosure_elem = dfa->eclosures[edest];
- /* Merge the epsilon closure of `edest'. */
- re_node_set_merge (&eclosure, &eclosure_elem);
- /* If the epsilon closure of `edest' is incomplete,
- the epsilon closure of this node is also incomplete. */
- if (dfa->eclosures[edest].nelem == 0)
- {
- incomplete = 1;
- re_node_set_free (&eclosure_elem);
- }
- }
-
- /* Epsilon closures include itself. */
- re_node_set_insert (&eclosure, node);
- if (incomplete && !root)
- dfa->eclosures[node].nelem = 0;
- else
- dfa->eclosures[node] = eclosure;
- *new_set = eclosure;
- return REG_NOERROR;
-}
-
-/* Functions for token which are used in the parser. */
-
-/* Fetch a token from INPUT.
- We must not use this function inside bracket expressions. */
-
-static void
-internal_function
-fetch_token (re_token_t *result, re_string_t *input, reg_syntax_t syntax)
-{
- re_string_skip_bytes (input, peek_token (result, input, syntax));
-}
-
-/* Peek a token from INPUT, and return the length of the token.
- We must not use this function inside bracket expressions. */
-
-static int
-internal_function
-peek_token (re_token_t *token, re_string_t *input, reg_syntax_t syntax)
-{
- unsigned char c;
-
- if (re_string_eoi (input))
- {
- token->type = END_OF_RE;
- return 0;
- }
-
- c = re_string_peek_byte (input, 0);
- token->opr.c = c;
-
- token->word_char = 0;
-#ifdef RE_ENABLE_I18N
- token->mb_partial = 0;
- if (input->mb_cur_max > 1 &&
- !re_string_first_byte (input, re_string_cur_idx (input)))
- {
- token->type = CHARACTER;
- token->mb_partial = 1;
- return 1;
- }
-#endif
- if (c == '\\')
- {
- unsigned char c2;
- if (re_string_cur_idx (input) + 1 >= re_string_length (input))
- {
- token->type = BACK_SLASH;
- return 1;
- }
-
- c2 = re_string_peek_byte_case (input, 1);
- token->opr.c = c2;
- token->type = CHARACTER;
-#ifdef RE_ENABLE_I18N
- if (input->mb_cur_max > 1)
- {
- wint_t wc = re_string_wchar_at (input,
- re_string_cur_idx (input) + 1);
- token->word_char = IS_WIDE_WORD_CHAR (wc) != 0;
- }
- else
-#endif
- token->word_char = IS_WORD_CHAR (c2) != 0;
-
- switch (c2)
- {
- case '|':
- if (!(syntax & RE_LIMITED_OPS) && !(syntax & RE_NO_BK_VBAR))
- token->type = OP_ALT;
- break;
- case '1': case '2': case '3': case '4': case '5':
- case '6': case '7': case '8': case '9':
- if (!(syntax & RE_NO_BK_REFS))
- {
- token->type = OP_BACK_REF;
- token->opr.idx = c2 - '1';
- }
- break;
- case '<':
- if (!(syntax & RE_NO_GNU_OPS))
- {
- token->type = ANCHOR;
- token->opr.ctx_type = WORD_FIRST;
- }
- break;
- case '>':
- if (!(syntax & RE_NO_GNU_OPS))
- {
- token->type = ANCHOR;
- token->opr.ctx_type = WORD_LAST;
- }
- break;
- case 'b':
- if (!(syntax & RE_NO_GNU_OPS))
- {
- token->type = ANCHOR;
- token->opr.ctx_type = WORD_DELIM;
- }
- break;
- case 'B':
- if (!(syntax & RE_NO_GNU_OPS))
- {
- token->type = ANCHOR;
- token->opr.ctx_type = NOT_WORD_DELIM;
- }
- break;
- case 'w':
- if (!(syntax & RE_NO_GNU_OPS))
- token->type = OP_WORD;
- break;
- case 'W':
- if (!(syntax & RE_NO_GNU_OPS))
- token->type = OP_NOTWORD;
- break;
- case 's':
- if (!(syntax & RE_NO_GNU_OPS))
- token->type = OP_SPACE;
- break;
- case 'S':
- if (!(syntax & RE_NO_GNU_OPS))
- token->type = OP_NOTSPACE;
- break;
- case '`':
- if (!(syntax & RE_NO_GNU_OPS))
- {
- token->type = ANCHOR;
- token->opr.ctx_type = BUF_FIRST;
- }
- break;
- case '\'':
- if (!(syntax & RE_NO_GNU_OPS))
- {
- token->type = ANCHOR;
- token->opr.ctx_type = BUF_LAST;
- }
- break;
- case '(':
- if (!(syntax & RE_NO_BK_PARENS))
- token->type = OP_OPEN_SUBEXP;
- break;
- case ')':
- if (!(syntax & RE_NO_BK_PARENS))
- token->type = OP_CLOSE_SUBEXP;
- break;
- case '+':
- if (!(syntax & RE_LIMITED_OPS) && (syntax & RE_BK_PLUS_QM))
- token->type = OP_DUP_PLUS;
- break;
- case '?':
- if (!(syntax & RE_LIMITED_OPS) && (syntax & RE_BK_PLUS_QM))
- token->type = OP_DUP_QUESTION;
- break;
- case '{':
- if ((syntax & RE_INTERVALS) && (!(syntax & RE_NO_BK_BRACES)))
- token->type = OP_OPEN_DUP_NUM;
- break;
- case '}':
- if ((syntax & RE_INTERVALS) && (!(syntax & RE_NO_BK_BRACES)))
- token->type = OP_CLOSE_DUP_NUM;
- break;
- default:
- break;
- }
- return 2;
- }
-
- token->type = CHARACTER;
-#ifdef RE_ENABLE_I18N
- if (input->mb_cur_max > 1)
- {
- wint_t wc = re_string_wchar_at (input, re_string_cur_idx (input));
- token->word_char = IS_WIDE_WORD_CHAR (wc) != 0;
- }
- else
-#endif
- token->word_char = IS_WORD_CHAR (token->opr.c);
-
- switch (c)
- {
- case '\n':
- if (syntax & RE_NEWLINE_ALT)
- token->type = OP_ALT;
- break;
- case '|':
- if (!(syntax & RE_LIMITED_OPS) && (syntax & RE_NO_BK_VBAR))
- token->type = OP_ALT;
- break;
- case '*':
- token->type = OP_DUP_ASTERISK;
- break;
- case '+':
- if (!(syntax & RE_LIMITED_OPS) && !(syntax & RE_BK_PLUS_QM))
- token->type = OP_DUP_PLUS;
- break;
- case '?':
- if (!(syntax & RE_LIMITED_OPS) && !(syntax & RE_BK_PLUS_QM))
- token->type = OP_DUP_QUESTION;
- break;
- case '{':
- if ((syntax & RE_INTERVALS) && (syntax & RE_NO_BK_BRACES))
- token->type = OP_OPEN_DUP_NUM;
- break;
- case '}':
- if ((syntax & RE_INTERVALS) && (syntax & RE_NO_BK_BRACES))
- token->type = OP_CLOSE_DUP_NUM;
- break;
- case '(':
- if (syntax & RE_NO_BK_PARENS)
- token->type = OP_OPEN_SUBEXP;
- break;
- case ')':
- if (syntax & RE_NO_BK_PARENS)
- token->type = OP_CLOSE_SUBEXP;
- break;
- case '[':
- token->type = OP_OPEN_BRACKET;
- break;
- case '.':
- token->type = OP_PERIOD;
- break;
- case '^':
- if (!(syntax & (RE_CONTEXT_INDEP_ANCHORS | RE_CARET_ANCHORS_HERE)) &&
- re_string_cur_idx (input) != 0)
- {
- char prev = re_string_peek_byte (input, -1);
- if (!(syntax & RE_NEWLINE_ALT) || prev != '\n')
- break;
- }
- token->type = ANCHOR;
- token->opr.ctx_type = LINE_FIRST;
- break;
- case '$':
- if (!(syntax & RE_CONTEXT_INDEP_ANCHORS) &&
- re_string_cur_idx (input) + 1 != re_string_length (input))
- {
- re_token_t next;
- re_string_skip_bytes (input, 1);
- peek_token (&next, input, syntax);
- re_string_skip_bytes (input, -1);
- if (next.type != OP_ALT && next.type != OP_CLOSE_SUBEXP)
- break;
- }
- token->type = ANCHOR;
- token->opr.ctx_type = LINE_LAST;
- break;
- default:
- break;
- }
- return 1;
-}
-
-/* Peek a token from INPUT, and return the length of the token.
- We must not use this function out of bracket expressions. */
-
-static int
-internal_function
-peek_token_bracket (re_token_t *token, re_string_t *input, reg_syntax_t syntax)
-{
- unsigned char c;
- if (re_string_eoi (input))
- {
- token->type = END_OF_RE;
- return 0;
- }
- c = re_string_peek_byte (input, 0);
- token->opr.c = c;
-
-#ifdef RE_ENABLE_I18N
- if (input->mb_cur_max > 1 &&
- !re_string_first_byte (input, re_string_cur_idx (input)))
- {
- token->type = CHARACTER;
- return 1;
- }
-#endif /* RE_ENABLE_I18N */
-
- if (c == '\\' && (syntax & RE_BACKSLASH_ESCAPE_IN_LISTS)
- && re_string_cur_idx (input) + 1 < re_string_length (input))
- {
- /* In this case, '\' escape a character. */
- unsigned char c2;
- re_string_skip_bytes (input, 1);
- c2 = re_string_peek_byte (input, 0);
- token->opr.c = c2;
- token->type = CHARACTER;
- return 1;
- }
- if (c == '[') /* '[' is a special char in a bracket exps. */
- {
- unsigned char c2;
- int token_len;
- if (re_string_cur_idx (input) + 1 < re_string_length (input))
- c2 = re_string_peek_byte (input, 1);
- else
- c2 = 0;
- token->opr.c = c2;
- token_len = 2;
- switch (c2)
- {
- case '.':
- token->type = OP_OPEN_COLL_ELEM;
- break;
- case '=':
- token->type = OP_OPEN_EQUIV_CLASS;
- break;
- case ':':
- if (syntax & RE_CHAR_CLASSES)
- {
- token->type = OP_OPEN_CHAR_CLASS;
- break;
- }
- /* else fall through. */
- default:
- token->type = CHARACTER;
- token->opr.c = c;
- token_len = 1;
- break;
- }
- return token_len;
- }
- switch (c)
- {
- case '-':
- token->type = OP_CHARSET_RANGE;
- break;
- case ']':
- token->type = OP_CLOSE_BRACKET;
- break;
- case '^':
- token->type = OP_NON_MATCH_LIST;
- break;
- default:
- token->type = CHARACTER;
- }
- return 1;
-}
-
-/* Functions for parser. */
-
-/* Entry point of the parser.
- Parse the regular expression REGEXP and return the structure tree.
- If an error is occured, ERR is set by error code, and return NULL.
- This function build the following tree, from regular expression <reg_exp>:
- CAT
- / \
- / \
- <reg_exp> EOR
-
- CAT means concatenation.
- EOR means end of regular expression. */
-
-static bin_tree_t *
-parse (re_string_t *regexp, regex_t *preg, reg_syntax_t syntax,
- reg_errcode_t *err)
-{
- re_dfa_t *dfa = (re_dfa_t *) preg->buffer;
- bin_tree_t *tree, *eor, *root;
- re_token_t current_token;
- dfa->syntax = syntax;
- fetch_token (&current_token, regexp, syntax | RE_CARET_ANCHORS_HERE);
- tree = parse_reg_exp (regexp, preg, &current_token, syntax, 0, err);
- if (BE (*err != REG_NOERROR && tree == NULL, 0))
- return NULL;
- eor = create_tree (dfa, NULL, NULL, END_OF_RE);
- if (tree != NULL)
- root = create_tree (dfa, tree, eor, CONCAT);
- else
- root = eor;
- if (BE (eor == NULL || root == NULL, 0))
- {
- *err = REG_ESPACE;
- return NULL;
- }
- return root;
-}
-
-/* This function build the following tree, from regular expression
- <branch1>|<branch2>:
- ALT
- / \
- / \
- <branch1> <branch2>
-
- ALT means alternative, which represents the operator `|'. */
-
-static bin_tree_t *
-parse_reg_exp (re_string_t *regexp, regex_t *preg, re_token_t *token,
- reg_syntax_t syntax, int nest, reg_errcode_t *err)
-{
- re_dfa_t *dfa = (re_dfa_t *) preg->buffer;
- bin_tree_t *tree, *branch = NULL;
- tree = parse_branch (regexp, preg, token, syntax, nest, err);
- if (BE (*err != REG_NOERROR && tree == NULL, 0))
- return NULL;
-
- while (token->type == OP_ALT)
- {
- fetch_token (token, regexp, syntax | RE_CARET_ANCHORS_HERE);
- if (token->type != OP_ALT && token->type != END_OF_RE
- && (nest == 0 || token->type != OP_CLOSE_SUBEXP))
- {
- branch = parse_branch (regexp, preg, token, syntax, nest, err);
- if (BE (*err != REG_NOERROR && branch == NULL, 0))
- return NULL;
- }
- else
- branch = NULL;
- tree = create_tree (dfa, tree, branch, OP_ALT);
- if (BE (tree == NULL, 0))
- {
- *err = REG_ESPACE;
- return NULL;
- }
- }
- return tree;
-}
-
-/* This function build the following tree, from regular expression
- <exp1><exp2>:
- CAT
- / \
- / \
- <exp1> <exp2>
-
- CAT means concatenation. */
-
-static bin_tree_t *
-parse_branch (re_string_t *regexp, regex_t *preg, re_token_t *token,
- reg_syntax_t syntax, int nest, reg_errcode_t *err)
-{
- bin_tree_t *tree, *exp;
- re_dfa_t *dfa = (re_dfa_t *) preg->buffer;
- tree = parse_expression (regexp, preg, token, syntax, nest, err);
- if (BE (*err != REG_NOERROR && tree == NULL, 0))
- return NULL;
-
- while (token->type != OP_ALT && token->type != END_OF_RE
- && (nest == 0 || token->type != OP_CLOSE_SUBEXP))
- {
- exp = parse_expression (regexp, preg, token, syntax, nest, err);
- if (BE (*err != REG_NOERROR && exp == NULL, 0))
- {
- return NULL;
- }
- if (tree != NULL && exp != NULL)
- {
- tree = create_tree (dfa, tree, exp, CONCAT);
- if (tree == NULL)
- {
- *err = REG_ESPACE;
- return NULL;
- }
- }
- else if (tree == NULL)
- tree = exp;
- /* Otherwise exp == NULL, we don't need to create new tree. */
- }
- return tree;
-}
-
-/* This function build the following tree, from regular expression a*:
- *
- |
- a
-*/
-
-static bin_tree_t *
-parse_expression (re_string_t *regexp, regex_t *preg, re_token_t *token,
- reg_syntax_t syntax, int nest, reg_errcode_t *err)
-{
- re_dfa_t *dfa = (re_dfa_t *) preg->buffer;
- bin_tree_t *tree;
- switch (token->type)
- {
- case CHARACTER:
- tree = create_token_tree (dfa, NULL, NULL, token);
- if (BE (tree == NULL, 0))
- {
- *err = REG_ESPACE;
- return NULL;
- }
-#ifdef RE_ENABLE_I18N
- if (dfa->mb_cur_max > 1)
- {
- while (!re_string_eoi (regexp)
- && !re_string_first_byte (regexp, re_string_cur_idx (regexp)))
- {
- bin_tree_t *mbc_remain;
- fetch_token (token, regexp, syntax);
- mbc_remain = create_token_tree (dfa, NULL, NULL, token);
- tree = create_tree (dfa, tree, mbc_remain, CONCAT);
- if (BE (mbc_remain == NULL || tree == NULL, 0))
- {
- *err = REG_ESPACE;
- return NULL;
- }
- }
- }
-#endif
- break;
- case OP_OPEN_SUBEXP:
- tree = parse_sub_exp (regexp, preg, token, syntax, nest + 1, err);
- if (BE (*err != REG_NOERROR && tree == NULL, 0))
- return NULL;
- break;
- case OP_OPEN_BRACKET:
- tree = parse_bracket_exp (regexp, dfa, token, syntax, err);
- if (BE (*err != REG_NOERROR && tree == NULL, 0))
- return NULL;
- break;
- case OP_BACK_REF:
- if (!BE (dfa->completed_bkref_map & (1 << token->opr.idx), 1))
- {
- *err = REG_ESUBREG;
- return NULL;
- }
- dfa->used_bkref_map |= 1 << token->opr.idx;
- tree = create_token_tree (dfa, NULL, NULL, token);
- if (BE (tree == NULL, 0))
- {
- *err = REG_ESPACE;
- return NULL;
- }
- ++dfa->nbackref;
- dfa->has_mb_node = 1;
- break;
- case OP_OPEN_DUP_NUM:
- if (syntax & RE_CONTEXT_INVALID_DUP)
- {
- *err = REG_BADRPT;
- return NULL;
- }
- /* FALLTHROUGH */
- case OP_DUP_ASTERISK:
- case OP_DUP_PLUS:
- case OP_DUP_QUESTION:
- if (syntax & RE_CONTEXT_INVALID_OPS)
- {
- *err = REG_BADRPT;
- return NULL;
- }
- else if (syntax & RE_CONTEXT_INDEP_OPS)
- {
- fetch_token (token, regexp, syntax);
- return parse_expression (regexp, preg, token, syntax, nest, err);
- }
- /* else fall through */
- case OP_CLOSE_SUBEXP:
- if ((token->type == OP_CLOSE_SUBEXP) &&
- !(syntax & RE_UNMATCHED_RIGHT_PAREN_ORD))
- {
- *err = REG_ERPAREN;
- return NULL;
- }
- /* else fall through */
- case OP_CLOSE_DUP_NUM:
- /* We treat it as a normal character. */
-
- /* Then we can these characters as normal characters. */
- token->type = CHARACTER;
- /* mb_partial and word_char bits should be initialized already
- by peek_token. */
- tree = create_token_tree (dfa, NULL, NULL, token);
- if (BE (tree == NULL, 0))
- {
- *err = REG_ESPACE;
- return NULL;
- }
- break;
- case ANCHOR:
- if ((token->opr.ctx_type
- & (WORD_DELIM | NOT_WORD_DELIM | WORD_FIRST | WORD_LAST))
- && dfa->word_ops_used == 0)
- init_word_char (dfa);
- if (token->opr.ctx_type == WORD_DELIM
- || token->opr.ctx_type == NOT_WORD_DELIM)
- {
- bin_tree_t *tree_first, *tree_last;
- if (token->opr.ctx_type == WORD_DELIM)
- {
- token->opr.ctx_type = WORD_FIRST;
- tree_first = create_token_tree (dfa, NULL, NULL, token);
- token->opr.ctx_type = WORD_LAST;
- }
- else
- {
- token->opr.ctx_type = INSIDE_WORD;
- tree_first = create_token_tree (dfa, NULL, NULL, token);
- token->opr.ctx_type = INSIDE_NOTWORD;
- }
- tree_last = create_token_tree (dfa, NULL, NULL, token);
- tree = create_tree (dfa, tree_first, tree_last, OP_ALT);
- if (BE (tree_first == NULL || tree_last == NULL || tree == NULL, 0))
- {
- *err = REG_ESPACE;
- return NULL;
- }
- }
- else
- {
- tree = create_token_tree (dfa, NULL, NULL, token);
- if (BE (tree == NULL, 0))
- {
- *err = REG_ESPACE;
- return NULL;
- }
- }
- /* We must return here, since ANCHORs can't be followed
- by repetition operators.
- eg. RE"^*" is invalid or "<ANCHOR(^)><CHAR(*)>",
- it must not be "<ANCHOR(^)><REPEAT(*)>". */
- fetch_token (token, regexp, syntax);
- return tree;
- case OP_PERIOD:
- tree = create_token_tree (dfa, NULL, NULL, token);
- if (BE (tree == NULL, 0))
- {
- *err = REG_ESPACE;
- return NULL;
- }
- if (dfa->mb_cur_max > 1)
- dfa->has_mb_node = 1;
- break;
- case OP_WORD:
- case OP_NOTWORD:
- tree = build_charclass_op (dfa, regexp->trans,
- (const unsigned char *) "alnum",
- (const unsigned char *) "_",
- token->type == OP_NOTWORD, err);
- if (BE (*err != REG_NOERROR && tree == NULL, 0))
- return NULL;
- break;
- case OP_SPACE:
- case OP_NOTSPACE:
- tree = build_charclass_op (dfa, regexp->trans,
- (const unsigned char *) "space",
- (const unsigned char *) "",
- token->type == OP_NOTSPACE, err);
- if (BE (*err != REG_NOERROR && tree == NULL, 0))
- return NULL;
- break;
- case OP_ALT:
- case END_OF_RE:
- return NULL;
- case BACK_SLASH:
- *err = REG_EESCAPE;
- return NULL;
- default:
- /* Must not happen? */
-#ifdef DEBUG
- assert (0);
-#endif
- return NULL;
- }
- fetch_token (token, regexp, syntax);
-
- while (token->type == OP_DUP_ASTERISK || token->type == OP_DUP_PLUS
- || token->type == OP_DUP_QUESTION || token->type == OP_OPEN_DUP_NUM)
- {
- tree = parse_dup_op (tree, regexp, dfa, token, syntax, err);
- if (BE (*err != REG_NOERROR && tree == NULL, 0))
- return NULL;
- /* In BRE consecutive duplications are not allowed. */
- if ((syntax & RE_CONTEXT_INVALID_DUP)
- && (token->type == OP_DUP_ASTERISK
- || token->type == OP_OPEN_DUP_NUM))
- {
- *err = REG_BADRPT;
- return NULL;
- }
- }
-
- return tree;
-}
-
-/* This function build the following tree, from regular expression
- (<reg_exp>):
- SUBEXP
- |
- <reg_exp>
-*/
-
-static bin_tree_t *
-parse_sub_exp (re_string_t *regexp, regex_t *preg, re_token_t *token,
- reg_syntax_t syntax, int nest, reg_errcode_t *err)
-{
- re_dfa_t *dfa = (re_dfa_t *) preg->buffer;
- bin_tree_t *tree;
- size_t cur_nsub;
- cur_nsub = preg->re_nsub++;
-
- fetch_token (token, regexp, syntax | RE_CARET_ANCHORS_HERE);
-
- /* The subexpression may be a null string. */
- if (token->type == OP_CLOSE_SUBEXP)
- tree = NULL;
- else
- {
- tree = parse_reg_exp (regexp, preg, token, syntax, nest, err);
- if (BE (*err == REG_NOERROR && token->type != OP_CLOSE_SUBEXP, 0))
- *err = REG_EPAREN;
- if (BE (*err != REG_NOERROR, 0))
- return NULL;
- }
-
- if (cur_nsub <= '9' - '1')
- dfa->completed_bkref_map |= 1 << cur_nsub;
-
- tree = create_tree (dfa, tree, NULL, SUBEXP);
- if (BE (tree == NULL, 0))
- {
- *err = REG_ESPACE;
- return NULL;
- }
- tree->token.opr.idx = cur_nsub;
- return tree;
-}
-
-/* This function parse repetition operators like "*", "+", "{1,3}" etc. */
-
-static bin_tree_t *
-parse_dup_op (bin_tree_t *elem, re_string_t *regexp, re_dfa_t *dfa,
- re_token_t *token, reg_syntax_t syntax, reg_errcode_t *err)
-{
- bin_tree_t *tree = NULL, *old_tree = NULL;
- int i, start, end, start_idx = re_string_cur_idx (regexp);
- re_token_t start_token = *token;
-
- if (token->type == OP_OPEN_DUP_NUM)
- {
- end = 0;
- start = fetch_number (regexp, token, syntax);
- if (start == -1)
- {
- if (token->type == CHARACTER && token->opr.c == ',')
- start = 0; /* We treat "{,m}" as "{0,m}". */
- else
- {
- *err = REG_BADBR; /* <re>{} is invalid. */
- return NULL;
- }
- }
- if (BE (start != -2, 1))
- {
- /* We treat "{n}" as "{n,n}". */
- end = ((token->type == OP_CLOSE_DUP_NUM) ? start
- : ((token->type == CHARACTER && token->opr.c == ',')
- ? fetch_number (regexp, token, syntax) : -2));
- }
- if (BE (start == -2 || end == -2, 0))
- {
- /* Invalid sequence. */
- if (BE (!(syntax & RE_INVALID_INTERVAL_ORD), 0))
- {
- if (token->type == END_OF_RE)
- *err = REG_EBRACE;
- else
- *err = REG_BADBR;
-
- return NULL;
- }
-
- /* If the syntax bit is set, rollback. */
- re_string_set_index (regexp, start_idx);
- *token = start_token;
- token->type = CHARACTER;
- /* mb_partial and word_char bits should be already initialized by
- peek_token. */
- return elem;
- }
-
- if (BE (end != -1 && start > end, 0))
- {
- /* First number greater than second. */
- *err = REG_BADBR;
- return NULL;
- }
- }
- else
- {
- start = (token->type == OP_DUP_PLUS) ? 1 : 0;
- end = (token->type == OP_DUP_QUESTION) ? 1 : -1;
- }
-
- fetch_token (token, regexp, syntax);
-
- if (BE (elem == NULL, 0))
- return NULL;
- if (BE (start == 0 && end == 0, 0))
- {
- postorder (elem, free_tree, NULL);
- return NULL;
- }
-
- /* Extract "<re>{n,m}" to "<re><re>...<re><re>{0,<m-n>}". */
- if (BE (start > 0, 0))
- {
- tree = elem;
- for (i = 2; i <= start; ++i)
- {
- elem = duplicate_tree (elem, dfa);
- tree = create_tree (dfa, tree, elem, CONCAT);
- if (BE (elem == NULL || tree == NULL, 0))
- goto parse_dup_op_espace;
- }
-
- if (start == end)
- return tree;
-
- /* Duplicate ELEM before it is marked optional. */
- elem = duplicate_tree (elem, dfa);
- old_tree = tree;
- }
- else
- old_tree = NULL;
-
- if (elem->token.type == SUBEXP)
-#ifdef _WIN64
- postorder (elem, mark_opt_subexp, (void *) (__int64) elem->token.opr.idx);
-#else
- postorder (elem, mark_opt_subexp, (void *) (long) elem->token.opr.idx);
-#endif
-
- tree = create_tree (dfa, elem, NULL, (end == -1 ? OP_DUP_ASTERISK : OP_ALT));
- if (BE (tree == NULL, 0))
- goto parse_dup_op_espace;
-
- /* This loop is actually executed only when end != -1,
- to rewrite <re>{0,n} as (<re>(<re>...<re>?)?)?... We have
- already created the start+1-th copy. */
- for (i = start + 2; i <= end; ++i)
- {
- elem = duplicate_tree (elem, dfa);
- tree = create_tree (dfa, tree, elem, CONCAT);
- if (BE (elem == NULL || tree == NULL, 0))
- goto parse_dup_op_espace;
-
- tree = create_tree (dfa, tree, NULL, OP_ALT);
- if (BE (tree == NULL, 0))
- goto parse_dup_op_espace;
- }
-
- if (old_tree)
- tree = create_tree (dfa, old_tree, tree, CONCAT);
-
- return tree;
-
- parse_dup_op_espace:
- *err = REG_ESPACE;
- return NULL;
-}
-
-/* Size of the names for collating symbol/equivalence_class/character_class.
- I'm not sure, but maybe enough. */
-#define BRACKET_NAME_BUF_SIZE 32
-
-#ifndef _LIBC
- /* Local function for parse_bracket_exp only used in case of NOT _LIBC.
- Build the range expression which starts from START_ELEM, and ends
- at END_ELEM. The result are written to MBCSET and SBCSET.
- RANGE_ALLOC is the allocated size of mbcset->range_starts, and
- mbcset->range_ends, is a pointer argument sinse we may
- update it. */
-
-static reg_errcode_t
-internal_function
-# ifdef RE_ENABLE_I18N
-build_range_exp (bitset_t sbcset, re_charset_t *mbcset, int *range_alloc,
- bracket_elem_t *start_elem, bracket_elem_t *end_elem)
-# else /* not RE_ENABLE_I18N */
-build_range_exp (bitset_t sbcset, bracket_elem_t *start_elem,
- bracket_elem_t *end_elem)
-# endif /* not RE_ENABLE_I18N */
-{
- unsigned int start_ch, end_ch;
- /* Equivalence Classes and Character Classes can't be a range start/end. */
- if (BE (start_elem->type == EQUIV_CLASS || start_elem->type == CHAR_CLASS
- || end_elem->type == EQUIV_CLASS || end_elem->type == CHAR_CLASS,
- 0))
- return REG_ERANGE;
-
- /* We can handle no multi character collating elements without libc
- support. */
- if (BE ((start_elem->type == COLL_SYM
- && strlen ((char *) start_elem->opr.name) > 1)
- || (end_elem->type == COLL_SYM
- && strlen ((char *) end_elem->opr.name) > 1), 0))
- return REG_ECOLLATE;
-
-# ifdef RE_ENABLE_I18N
- {
- wchar_t wc;
- wint_t start_wc;
- wint_t end_wc;
- wchar_t cmp_buf[6] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'};
-
- start_ch = ((start_elem->type == SB_CHAR) ? start_elem->opr.ch
- : ((start_elem->type == COLL_SYM) ? start_elem->opr.name[0]
- : 0));
- end_ch = ((end_elem->type == SB_CHAR) ? end_elem->opr.ch
- : ((end_elem->type == COLL_SYM) ? end_elem->opr.name[0]
- : 0));
- start_wc = ((start_elem->type == SB_CHAR || start_elem->type == COLL_SYM)
- ? __btowc (start_ch) : start_elem->opr.wch);
- end_wc = ((end_elem->type == SB_CHAR || end_elem->type == COLL_SYM)
- ? __btowc (end_ch) : end_elem->opr.wch);
- if (start_wc == WEOF || end_wc == WEOF)
- return REG_ECOLLATE;
- cmp_buf[0] = start_wc;
- cmp_buf[4] = end_wc;
- if (wcscoll (cmp_buf, cmp_buf + 4) > 0)
- return REG_ERANGE;
-
- /* Got valid collation sequence values, add them as a new entry.
- However, for !_LIBC we have no collation elements: if the
- character set is single byte, the single byte character set
- that we build below suffices. parse_bracket_exp passes
- no MBCSET if dfa->mb_cur_max == 1. */
- if (mbcset)
- {
- /* Check the space of the arrays. */
- if (BE (*range_alloc == mbcset->nranges, 0))
- {
- /* There is not enough space, need realloc. */
- wchar_t *new_array_start, *new_array_end;
- int new_nranges;
-
- /* +1 in case of mbcset->nranges is 0. */
- new_nranges = 2 * mbcset->nranges + 1;
- /* Use realloc since mbcset->range_starts and mbcset->range_ends
- are NULL if *range_alloc == 0. */
- new_array_start = re_realloc (mbcset->range_starts, wchar_t,
- new_nranges);
- new_array_end = re_realloc (mbcset->range_ends, wchar_t,
- new_nranges);
-
- if (BE (new_array_start == NULL || new_array_end == NULL, 0))
- return REG_ESPACE;
-
- mbcset->range_starts = new_array_start;
- mbcset->range_ends = new_array_end;
- *range_alloc = new_nranges;
- }
-
- mbcset->range_starts[mbcset->nranges] = start_wc;
- mbcset->range_ends[mbcset->nranges++] = end_wc;
- }
-
- /* Build the table for single byte characters. */
- for (wc = 0; wc < SBC_MAX; ++wc)
- {
- cmp_buf[2] = wc;
- if (wcscoll (cmp_buf, cmp_buf + 2) <= 0
- && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0)
- bitset_set (sbcset, wc);
- }
- }
-# else /* not RE_ENABLE_I18N */
- {
- unsigned int ch;
- start_ch = ((start_elem->type == SB_CHAR ) ? start_elem->opr.ch
- : ((start_elem->type == COLL_SYM) ? start_elem->opr.name[0]
- : 0));
- end_ch = ((end_elem->type == SB_CHAR ) ? end_elem->opr.ch
- : ((end_elem->type == COLL_SYM) ? end_elem->opr.name[0]
- : 0));
- if (start_ch > end_ch)
- return REG_ERANGE;
- /* Build the table for single byte characters. */
- for (ch = 0; ch < SBC_MAX; ++ch)
- if (start_ch <= ch && ch <= end_ch)
- bitset_set (sbcset, ch);
- }
-# endif /* not RE_ENABLE_I18N */
- return REG_NOERROR;
-}
-#endif /* not _LIBC */
-
-#ifndef _LIBC
-/* Helper function for parse_bracket_exp only used in case of NOT _LIBC..
- Build the collating element which is represented by NAME.
- The result are written to MBCSET and SBCSET.
- COLL_SYM_ALLOC is the allocated size of mbcset->coll_sym, is a
- pointer argument since we may update it. */
-
-static reg_errcode_t
-internal_function
-# ifdef RE_ENABLE_I18N
-build_collating_symbol (bitset_t sbcset, re_charset_t *mbcset,
- int *coll_sym_alloc, const unsigned char *name)
-# else /* not RE_ENABLE_I18N */
-build_collating_symbol (bitset_t sbcset, const unsigned char *name)
-# endif /* not RE_ENABLE_I18N */
-{
- size_t name_len = strlen ((const char *) name);
- if (BE (name_len != 1, 0))
- return REG_ECOLLATE;
- else
- {
- bitset_set (sbcset, name[0]);
- return REG_NOERROR;
- }
-}
-#endif /* not _LIBC */
-
-/* This function parse bracket expression like "[abc]", "[a-c]",
- "[[.a-a.]]" etc. */
-
-static bin_tree_t *
-parse_bracket_exp (re_string_t *regexp, re_dfa_t *dfa, re_token_t *token,
- reg_syntax_t syntax, reg_errcode_t *err)
-{
-#ifdef _LIBC
- const unsigned char *collseqmb;
- const char *collseqwc;
- uint32_t nrules;
- int32_t table_size;
- const int32_t *symb_table;
- const unsigned char *extra;
-
- /* Local function for parse_bracket_exp used in _LIBC environement.
- Seek the collating symbol entry correspondings to NAME.
- Return the index of the symbol in the SYMB_TABLE. */
-
- auto inline int32_t
- __attribute ((always_inline))
- seek_collating_symbol_entry (name, name_len)
- const unsigned char *name;
- size_t name_len;
- {
- int32_t hash = elem_hash ((const char *) name, name_len);
- int32_t elem = hash % table_size;
- if (symb_table[2 * elem] != 0)
- {
- int32_t second = hash % (table_size - 2) + 1;
-
- do
- {
- /* First compare the hashing value. */
- if (symb_table[2 * elem] == hash
- /* Compare the length of the name. */
- && name_len == extra[symb_table[2 * elem + 1]]
- /* Compare the name. */
- && memcmp (name, &extra[symb_table[2 * elem + 1] + 1],
- name_len) == 0)
- {
- /* Yep, this is the entry. */
- break;
- }
-
- /* Next entry. */
- elem += second;
- }
- while (symb_table[2 * elem] != 0);
- }
- return elem;
- }
-
- /* Local function for parse_bracket_exp used in _LIBC environement.
- Look up the collation sequence value of BR_ELEM.
- Return the value if succeeded, UINT_MAX otherwise. */
-
- auto inline unsigned int
- __attribute ((always_inline))
- lookup_collation_sequence_value (br_elem)
- bracket_elem_t *br_elem;
- {
- if (br_elem->type == SB_CHAR)
- {
- /*
- if (MB_CUR_MAX == 1)
- */
- if (nrules == 0)
- return collseqmb[br_elem->opr.ch];
- else
- {
- wint_t wc = __btowc (br_elem->opr.ch);
- return __collseq_table_lookup (collseqwc, wc);
- }
- }
- else if (br_elem->type == MB_CHAR)
- {
- return __collseq_table_lookup (collseqwc, br_elem->opr.wch);
- }
- else if (br_elem->type == COLL_SYM)
- {
- size_t sym_name_len = strlen ((char *) br_elem->opr.name);
- if (nrules != 0)
- {
- int32_t elem, idx;
- elem = seek_collating_symbol_entry (br_elem->opr.name,
- sym_name_len);
- if (symb_table[2 * elem] != 0)
- {
- /* We found the entry. */
- idx = symb_table[2 * elem + 1];
- /* Skip the name of collating element name. */
- idx += 1 + extra[idx];
- /* Skip the byte sequence of the collating element. */
- idx += 1 + extra[idx];
- /* Adjust for the alignment. */
- idx = (idx + 3) & ~3;
- /* Skip the multibyte collation sequence value. */
- idx += sizeof (unsigned int);
- /* Skip the wide char sequence of the collating element. */
- idx += sizeof (unsigned int) *
- (1 + *(unsigned int *) (extra + idx));
- /* Return the collation sequence value. */
- return *(unsigned int *) (extra + idx);
- }
- else if (symb_table[2 * elem] == 0 && sym_name_len == 1)
- {
- /* No valid character. Match it as a single byte
- character. */
- return collseqmb[br_elem->opr.name[0]];
- }
- }
- else if (sym_name_len == 1)
- return collseqmb[br_elem->opr.name[0]];
- }
- return UINT_MAX;
- }
-
- /* Local function for parse_bracket_exp used in _LIBC environement.
- Build the range expression which starts from START_ELEM, and ends
- at END_ELEM. The result are written to MBCSET and SBCSET.
- RANGE_ALLOC is the allocated size of mbcset->range_starts, and
- mbcset->range_ends, is a pointer argument sinse we may
- update it. */
-
- auto inline reg_errcode_t
- __attribute ((always_inline))
- build_range_exp (sbcset, mbcset, range_alloc, start_elem, end_elem)
- re_charset_t *mbcset;
- int *range_alloc;
- bitset_t sbcset;
- bracket_elem_t *start_elem, *end_elem;
- {
- unsigned int ch;
- uint32_t start_collseq;
- uint32_t end_collseq;
-
- /* Equivalence Classes and Character Classes can't be a range
- start/end. */
- if (BE (start_elem->type == EQUIV_CLASS || start_elem->type == CHAR_CLASS
- || end_elem->type == EQUIV_CLASS || end_elem->type == CHAR_CLASS,
- 0))
- return REG_ERANGE;
-
- start_collseq = lookup_collation_sequence_value (start_elem);
- end_collseq = lookup_collation_sequence_value (end_elem);
- /* Check start/end collation sequence values. */
- if (BE (start_collseq == UINT_MAX || end_collseq == UINT_MAX, 0))
- return REG_ECOLLATE;
- if (BE ((syntax & RE_NO_EMPTY_RANGES) && start_collseq > end_collseq, 0))
- return REG_ERANGE;
-
- /* Got valid collation sequence values, add them as a new entry.
- However, if we have no collation elements, and the character set
- is single byte, the single byte character set that we
- build below suffices. */
- if (nrules > 0 || dfa->mb_cur_max > 1)
- {
- /* Check the space of the arrays. */
- if (BE (*range_alloc == mbcset->nranges, 0))
- {
- /* There is not enough space, need realloc. */
- uint32_t *new_array_start;
- uint32_t *new_array_end;
- int new_nranges;
-
- /* +1 in case of mbcset->nranges is 0. */
- new_nranges = 2 * mbcset->nranges + 1;
- new_array_start = re_realloc (mbcset->range_starts, uint32_t,
- new_nranges);
- new_array_end = re_realloc (mbcset->range_ends, uint32_t,
- new_nranges);
-
- if (BE (new_array_start == NULL || new_array_end == NULL, 0))
- return REG_ESPACE;
-
- mbcset->range_starts = new_array_start;
- mbcset->range_ends = new_array_end;
- *range_alloc = new_nranges;
- }
-
- mbcset->range_starts[mbcset->nranges] = start_collseq;
- mbcset->range_ends[mbcset->nranges++] = end_collseq;
- }
-
- /* Build the table for single byte characters. */
- for (ch = 0; ch < SBC_MAX; ch++)
- {
- uint32_t ch_collseq;
- /*
- if (MB_CUR_MAX == 1)
- */
- if (nrules == 0)
- ch_collseq = collseqmb[ch];
- else
- ch_collseq = __collseq_table_lookup (collseqwc, __btowc (ch));
- if (start_collseq <= ch_collseq && ch_collseq <= end_collseq)
- bitset_set (sbcset, ch);
- }
- return REG_NOERROR;
- }
-
- /* Local function for parse_bracket_exp used in _LIBC environement.
- Build the collating element which is represented by NAME.
- The result are written to MBCSET and SBCSET.
- COLL_SYM_ALLOC is the allocated size of mbcset->coll_sym, is a
- pointer argument sinse we may update it. */
-
- auto inline reg_errcode_t
- __attribute ((always_inline))
- build_collating_symbol (sbcset, mbcset, coll_sym_alloc, name)
- re_charset_t *mbcset;
- int *coll_sym_alloc;
- bitset_t sbcset;
- const unsigned char *name;
- {
- int32_t elem, idx;
- size_t name_len = strlen ((const char *) name);
- if (nrules != 0)
- {
- elem = seek_collating_symbol_entry (name, name_len);
- if (symb_table[2 * elem] != 0)
- {
- /* We found the entry. */
- idx = symb_table[2 * elem + 1];
- /* Skip the name of collating element name. */
- idx += 1 + extra[idx];
- }
- else if (symb_table[2 * elem] == 0 && name_len == 1)
- {
- /* No valid character, treat it as a normal
- character. */
- bitset_set (sbcset, name[0]);
- return REG_NOERROR;
- }
- else
- return REG_ECOLLATE;
-
- /* Got valid collation sequence, add it as a new entry. */
- /* Check the space of the arrays. */
- if (BE (*coll_sym_alloc == mbcset->ncoll_syms, 0))
- {
- /* Not enough, realloc it. */
- /* +1 in case of mbcset->ncoll_syms is 0. */
- int new_coll_sym_alloc = 2 * mbcset->ncoll_syms + 1;
- /* Use realloc since mbcset->coll_syms is NULL
- if *alloc == 0. */
- int32_t *new_coll_syms = re_realloc (mbcset->coll_syms, int32_t,
- new_coll_sym_alloc);
- if (BE (new_coll_syms == NULL, 0))
- return REG_ESPACE;
- mbcset->coll_syms = new_coll_syms;
- *coll_sym_alloc = new_coll_sym_alloc;
- }
- mbcset->coll_syms[mbcset->ncoll_syms++] = idx;
- return REG_NOERROR;
- }
- else
- {
- if (BE (name_len != 1, 0))
- return REG_ECOLLATE;
- else
- {
- bitset_set (sbcset, name[0]);
- return REG_NOERROR;
- }
- }
- }
-#endif
-
- re_token_t br_token;
- re_bitset_ptr_t sbcset;
-#ifdef RE_ENABLE_I18N
- re_charset_t *mbcset;
- int coll_sym_alloc = 0, range_alloc = 0, mbchar_alloc = 0;
- int equiv_class_alloc = 0, char_class_alloc = 0;
-#endif /* not RE_ENABLE_I18N */
- int non_match = 0;
- bin_tree_t *work_tree;
- int token_len;
- int first_round = 1;
-#ifdef _LIBC
- collseqmb = (const unsigned char *)
- _NL_CURRENT (LC_COLLATE, _NL_COLLATE_COLLSEQMB);
- nrules = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES);
- if (nrules)
- {
- /*
- if (MB_CUR_MAX > 1)
- */
- collseqwc = _NL_CURRENT (LC_COLLATE, _NL_COLLATE_COLLSEQWC);
- table_size = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_SYMB_HASH_SIZEMB);
- symb_table = (const int32_t *) _NL_CURRENT (LC_COLLATE,
- _NL_COLLATE_SYMB_TABLEMB);
- extra = (const unsigned char *) _NL_CURRENT (LC_COLLATE,
- _NL_COLLATE_SYMB_EXTRAMB);
- }
-#endif
- sbcset = (re_bitset_ptr_t) calloc (sizeof (bitset_t), 1);
-#ifdef RE_ENABLE_I18N
- mbcset = (re_charset_t *) calloc (sizeof (re_charset_t), 1);
-#endif /* RE_ENABLE_I18N */
-#ifdef RE_ENABLE_I18N
- if (BE (sbcset == NULL || mbcset == NULL, 0))
-#else
- if (BE (sbcset == NULL, 0))
-#endif /* RE_ENABLE_I18N */
- {
- *err = REG_ESPACE;
- return NULL;
- }
-
- token_len = peek_token_bracket (token, regexp, syntax);
- if (BE (token->type == END_OF_RE, 0))
- {
- *err = REG_BADPAT;
- goto parse_bracket_exp_free_return;
- }
- if (token->type == OP_NON_MATCH_LIST)
- {
-#ifdef RE_ENABLE_I18N
- mbcset->non_match = 1;
-#endif /* not RE_ENABLE_I18N */
- non_match = 1;
- if (syntax & RE_HAT_LISTS_NOT_NEWLINE)
- bitset_set (sbcset, '\0');
- re_string_skip_bytes (regexp, token_len); /* Skip a token. */
- token_len = peek_token_bracket (token, regexp, syntax);
- if (BE (token->type == END_OF_RE, 0))
- {
- *err = REG_BADPAT;
- goto parse_bracket_exp_free_return;
- }
- }
-
- /* We treat the first ']' as a normal character. */
- if (token->type == OP_CLOSE_BRACKET)
- token->type = CHARACTER;
-
- while (1)
- {
- bracket_elem_t start_elem, end_elem;
- unsigned char start_name_buf[BRACKET_NAME_BUF_SIZE];
- unsigned char end_name_buf[BRACKET_NAME_BUF_SIZE];
- reg_errcode_t ret;
- int token_len2 = 0, is_range_exp = 0;
- re_token_t token2;
-
- start_elem.opr.name = start_name_buf;
- ret = parse_bracket_element (&start_elem, regexp, token, token_len, dfa,
- syntax, first_round);
- if (BE (ret != REG_NOERROR, 0))
- {
- *err = ret;
- goto parse_bracket_exp_free_return;
- }
- first_round = 0;
-
- /* Get information about the next token. We need it in any case. */
- token_len = peek_token_bracket (token, regexp, syntax);
-
- /* Do not check for ranges if we know they are not allowed. */
- if (start_elem.type != CHAR_CLASS && start_elem.type != EQUIV_CLASS)
- {
- if (BE (token->type == END_OF_RE, 0))
- {
- *err = REG_EBRACK;
- goto parse_bracket_exp_free_return;
- }
- if (token->type == OP_CHARSET_RANGE)
- {
- re_string_skip_bytes (regexp, token_len); /* Skip '-'. */
- token_len2 = peek_token_bracket (&token2, regexp, syntax);
- if (BE (token2.type == END_OF_RE, 0))
- {
- *err = REG_EBRACK;
- goto parse_bracket_exp_free_return;
- }
- if (token2.type == OP_CLOSE_BRACKET)
- {
- /* We treat the last '-' as a normal character. */
- re_string_skip_bytes (regexp, -token_len);
- token->type = CHARACTER;
- }
- else
- is_range_exp = 1;
- }
- }
-
- if (is_range_exp == 1)
- {
- end_elem.opr.name = end_name_buf;
- ret = parse_bracket_element (&end_elem, regexp, &token2, token_len2,
- dfa, syntax, 1);
- if (BE (ret != REG_NOERROR, 0))
- {
- *err = ret;
- goto parse_bracket_exp_free_return;
- }
-
- token_len = peek_token_bracket (token, regexp, syntax);
-
-#ifdef _LIBC
- *err = build_range_exp (sbcset, mbcset, &range_alloc,
- &start_elem, &end_elem);
-#else
-# ifdef RE_ENABLE_I18N
- *err = build_range_exp (sbcset,
- dfa->mb_cur_max > 1 ? mbcset : NULL,
- &range_alloc, &start_elem, &end_elem);
-# else
- *err = build_range_exp (sbcset, &start_elem, &end_elem);
-# endif
-#endif /* RE_ENABLE_I18N */
- if (BE (*err != REG_NOERROR, 0))
- goto parse_bracket_exp_free_return;
- }
- else
- {
- switch (start_elem.type)
- {
- case SB_CHAR:
- bitset_set (sbcset, start_elem.opr.ch);
- break;
-#ifdef RE_ENABLE_I18N
- case MB_CHAR:
- /* Check whether the array has enough space. */
- if (BE (mbchar_alloc == mbcset->nmbchars, 0))
- {
- wchar_t *new_mbchars;
- /* Not enough, realloc it. */
- /* +1 in case of mbcset->nmbchars is 0. */
- mbchar_alloc = 2 * mbcset->nmbchars + 1;
- /* Use realloc since array is NULL if *alloc == 0. */
- new_mbchars = re_realloc (mbcset->mbchars, wchar_t,
- mbchar_alloc);
- if (BE (new_mbchars == NULL, 0))
- goto parse_bracket_exp_espace;
- mbcset->mbchars = new_mbchars;
- }
- mbcset->mbchars[mbcset->nmbchars++] = start_elem.opr.wch;
- break;
-#endif /* RE_ENABLE_I18N */
- case EQUIV_CLASS:
- *err = build_equiv_class (sbcset,
-#ifdef RE_ENABLE_I18N
- mbcset, &equiv_class_alloc,
-#endif /* RE_ENABLE_I18N */
- start_elem.opr.name);
- if (BE (*err != REG_NOERROR, 0))
- goto parse_bracket_exp_free_return;
- break;
- case COLL_SYM:
- *err = build_collating_symbol (sbcset,
-#ifdef RE_ENABLE_I18N
- mbcset, &coll_sym_alloc,
-#endif /* RE_ENABLE_I18N */
- start_elem.opr.name);
- if (BE (*err != REG_NOERROR, 0))
- goto parse_bracket_exp_free_return;
- break;
- case CHAR_CLASS:
- *err = build_charclass (regexp->trans, sbcset,
-#ifdef RE_ENABLE_I18N
- mbcset, &char_class_alloc,
-#endif /* RE_ENABLE_I18N */
- start_elem.opr.name, syntax);
- if (BE (*err != REG_NOERROR, 0))
- goto parse_bracket_exp_free_return;
- break;
- default:
- assert (0);
- break;
- }
- }
- if (BE (token->type == END_OF_RE, 0))
- {
- *err = REG_EBRACK;
- goto parse_bracket_exp_free_return;
- }
- if (token->type == OP_CLOSE_BRACKET)
- break;
- }
-
- re_string_skip_bytes (regexp, token_len); /* Skip a token. */
-
- /* If it is non-matching list. */
- if (non_match)
- bitset_not (sbcset);
-
-#ifdef RE_ENABLE_I18N
- /* Ensure only single byte characters are set. */
- if (dfa->mb_cur_max > 1)
- bitset_mask (sbcset, dfa->sb_char);
-
- if (mbcset->nmbchars || mbcset->ncoll_syms || mbcset->nequiv_classes
- || mbcset->nranges || (dfa->mb_cur_max > 1 && (mbcset->nchar_classes
- || mbcset->non_match)))
- {
- bin_tree_t *mbc_tree;
- int sbc_idx;
- /* Build a tree for complex bracket. */
- dfa->has_mb_node = 1;
- br_token.type = COMPLEX_BRACKET;
- br_token.opr.mbcset = mbcset;
- mbc_tree = create_token_tree (dfa, NULL, NULL, &br_token);
- if (BE (mbc_tree == NULL, 0))
- goto parse_bracket_exp_espace;
- for (sbc_idx = 0; sbc_idx < BITSET_WORDS; ++sbc_idx)
- if (sbcset[sbc_idx])
- break;
- /* If there are no bits set in sbcset, there is no point
- of having both SIMPLE_BRACKET and COMPLEX_BRACKET. */
- if (sbc_idx < BITSET_WORDS)
- {
- /* Build a tree for simple bracket. */
- br_token.type = SIMPLE_BRACKET;
- br_token.opr.sbcset = sbcset;
- work_tree = create_token_tree (dfa, NULL, NULL, &br_token);
- if (BE (work_tree == NULL, 0))
- goto parse_bracket_exp_espace;
-
- /* Then join them by ALT node. */
- work_tree = create_tree (dfa, work_tree, mbc_tree, OP_ALT);
- if (BE (work_tree == NULL, 0))
- goto parse_bracket_exp_espace;
- }
- else
- {
- re_free (sbcset);
- work_tree = mbc_tree;
- }
- }
- else
-#endif /* not RE_ENABLE_I18N */
- {
-#ifdef RE_ENABLE_I18N
- free_charset (mbcset);
-#endif
- /* Build a tree for simple bracket. */
- br_token.type = SIMPLE_BRACKET;
- br_token.opr.sbcset = sbcset;
- work_tree = create_token_tree (dfa, NULL, NULL, &br_token);
- if (BE (work_tree == NULL, 0))
- goto parse_bracket_exp_espace;
- }
- return work_tree;
-
- parse_bracket_exp_espace:
- *err = REG_ESPACE;
- parse_bracket_exp_free_return:
- re_free (sbcset);
-#ifdef RE_ENABLE_I18N
- free_charset (mbcset);
-#endif /* RE_ENABLE_I18N */
- return NULL;
-}
-
-/* Parse an element in the bracket expression. */
-
-static reg_errcode_t
-parse_bracket_element (bracket_elem_t *elem, re_string_t *regexp,
- re_token_t *token, int token_len, re_dfa_t *dfa,
- reg_syntax_t syntax, int accept_hyphen)
-{
-#ifdef RE_ENABLE_I18N
- int cur_char_size;
- cur_char_size = re_string_char_size_at (regexp, re_string_cur_idx (regexp));
- if (cur_char_size > 1)
- {
- elem->type = MB_CHAR;
- elem->opr.wch = re_string_wchar_at (regexp, re_string_cur_idx (regexp));
- re_string_skip_bytes (regexp, cur_char_size);
- return REG_NOERROR;
- }
-#endif /* RE_ENABLE_I18N */
- re_string_skip_bytes (regexp, token_len); /* Skip a token. */
- if (token->type == OP_OPEN_COLL_ELEM || token->type == OP_OPEN_CHAR_CLASS
- || token->type == OP_OPEN_EQUIV_CLASS)
- return parse_bracket_symbol (elem, regexp, token);
- if (BE (token->type == OP_CHARSET_RANGE, 0) && !accept_hyphen)
- {
- /* A '-' must only appear as anything but a range indicator before
- the closing bracket. Everything else is an error. */
- re_token_t token2;
- (void) peek_token_bracket (&token2, regexp, syntax);
- if (token2.type != OP_CLOSE_BRACKET)
- /* The actual error value is not standardized since this whole
- case is undefined. But ERANGE makes good sense. */
- return REG_ERANGE;
- }
- elem->type = SB_CHAR;
- elem->opr.ch = token->opr.c;
- return REG_NOERROR;
-}
-
-/* Parse a bracket symbol in the bracket expression. Bracket symbols are
- such as [:<character_class>:], [.<collating_element>.], and
- [=<equivalent_class>=]. */
-
-static reg_errcode_t
-parse_bracket_symbol (bracket_elem_t *elem, re_string_t *regexp,
- re_token_t *token)
-{
- unsigned char ch, delim = token->opr.c;
- int i = 0;
- if (re_string_eoi(regexp))
- return REG_EBRACK;
- for (;; ++i)
- {
- if (i >= BRACKET_NAME_BUF_SIZE)
- return REG_EBRACK;
- if (token->type == OP_OPEN_CHAR_CLASS)
- ch = re_string_fetch_byte_case (regexp);
- else
- ch = re_string_fetch_byte (regexp);
- if (re_string_eoi(regexp))
- return REG_EBRACK;
- if (ch == delim && re_string_peek_byte (regexp, 0) == ']')
- break;
- elem->opr.name[i] = ch;
- }
- re_string_skip_bytes (regexp, 1);
- elem->opr.name[i] = '\0';
- switch (token->type)
- {
- case OP_OPEN_COLL_ELEM:
- elem->type = COLL_SYM;
- break;
- case OP_OPEN_EQUIV_CLASS:
- elem->type = EQUIV_CLASS;
- break;
- case OP_OPEN_CHAR_CLASS:
- elem->type = CHAR_CLASS;
- break;
- default:
- break;
- }
- return REG_NOERROR;
-}
-
- /* Helper function for parse_bracket_exp.
- Build the equivalence class which is represented by NAME.
- The result are written to MBCSET and SBCSET.
- EQUIV_CLASS_ALLOC is the allocated size of mbcset->equiv_classes,
- is a pointer argument sinse we may update it. */
-
-static reg_errcode_t
-#ifdef RE_ENABLE_I18N
-build_equiv_class (bitset_t sbcset, re_charset_t *mbcset,
- int *equiv_class_alloc, const unsigned char *name)
-#else /* not RE_ENABLE_I18N */
-build_equiv_class (bitset_t sbcset, const unsigned char *name)
-#endif /* not RE_ENABLE_I18N */
-{
-#ifdef _LIBC
- uint32_t nrules = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES);
- if (nrules != 0)
- {
- const int32_t *table, *indirect;
- const unsigned char *weights, *extra, *cp;
- unsigned char char_buf[2];
- int32_t idx1, idx2;
- unsigned int ch;
- size_t len;
- /* This #include defines a local function! */
-# include <locale/weight.h>
- /* Calculate the index for equivalence class. */
- cp = name;
- table = (const int32_t *) _NL_CURRENT (LC_COLLATE, _NL_COLLATE_TABLEMB);
- weights = (const unsigned char *) _NL_CURRENT (LC_COLLATE,
- _NL_COLLATE_WEIGHTMB);
- extra = (const unsigned char *) _NL_CURRENT (LC_COLLATE,
- _NL_COLLATE_EXTRAMB);
- indirect = (const int32_t *) _NL_CURRENT (LC_COLLATE,
- _NL_COLLATE_INDIRECTMB);
- idx1 = findidx (&cp);
- if (BE (idx1 == 0 || cp < name + strlen ((const char *) name), 0))
- /* This isn't a valid character. */
- return REG_ECOLLATE;
-
- /* Build single byte matcing table for this equivalence class. */
- char_buf[1] = (unsigned char) '\0';
- len = weights[idx1];
- for (ch = 0; ch < SBC_MAX; ++ch)
- {
- char_buf[0] = ch;
- cp = char_buf;
- idx2 = findidx (&cp);
-/*
- idx2 = table[ch];
-*/
- if (idx2 == 0)
- /* This isn't a valid character. */
- continue;
- if (len == weights[idx2])
- {
- int cnt = 0;
- while (cnt <= len &&
- weights[idx1 + 1 + cnt] == weights[idx2 + 1 + cnt])
- ++cnt;
-
- if (cnt > len)
- bitset_set (sbcset, ch);
- }
- }
- /* Check whether the array has enough space. */
- if (BE (*equiv_class_alloc == mbcset->nequiv_classes, 0))
- {
- /* Not enough, realloc it. */
- /* +1 in case of mbcset->nequiv_classes is 0. */
- int new_equiv_class_alloc = 2 * mbcset->nequiv_classes + 1;
- /* Use realloc since the array is NULL if *alloc == 0. */
- int32_t *new_equiv_classes = re_realloc (mbcset->equiv_classes,
- int32_t,
- new_equiv_class_alloc);
- if (BE (new_equiv_classes == NULL, 0))
- return REG_ESPACE;
- mbcset->equiv_classes = new_equiv_classes;
- *equiv_class_alloc = new_equiv_class_alloc;
- }
- mbcset->equiv_classes[mbcset->nequiv_classes++] = idx1;
- }
- else
-#endif /* _LIBC */
- {
- if (BE (strlen ((const char *) name) != 1, 0))
- return REG_ECOLLATE;
- bitset_set (sbcset, *name);
- }
- return REG_NOERROR;
-}
-
- /* Helper function for parse_bracket_exp.
- Build the character class which is represented by NAME.
- The result are written to MBCSET and SBCSET.
- CHAR_CLASS_ALLOC is the allocated size of mbcset->char_classes,
- is a pointer argument sinse we may update it. */
-
-static reg_errcode_t
-#ifdef RE_ENABLE_I18N
-build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset,
- re_charset_t *mbcset, int *char_class_alloc,
- const unsigned char *class_name, reg_syntax_t syntax)
-#else /* not RE_ENABLE_I18N */
-build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset,
- const unsigned char *class_name, reg_syntax_t syntax)
-#endif /* not RE_ENABLE_I18N */
-{
- int i;
- const char *name = (const char *) class_name;
-
- /* In case of REG_ICASE "upper" and "lower" match the both of
- upper and lower cases. */
- if ((syntax & RE_ICASE)
- && (strcmp (name, "upper") == 0 || strcmp (name, "lower") == 0))
- name = "alpha";
-
-#ifdef RE_ENABLE_I18N
- /* Check the space of the arrays. */
- if (BE (*char_class_alloc == mbcset->nchar_classes, 0))
- {
- /* Not enough, realloc it. */
- /* +1 in case of mbcset->nchar_classes is 0. */
- int new_char_class_alloc = 2 * mbcset->nchar_classes + 1;
- /* Use realloc since array is NULL if *alloc == 0. */
- wctype_t *new_char_classes = re_realloc (mbcset->char_classes, wctype_t,
- new_char_class_alloc);
- if (BE (new_char_classes == NULL, 0))
- return REG_ESPACE;
- mbcset->char_classes = new_char_classes;
- *char_class_alloc = new_char_class_alloc;
- }
- mbcset->char_classes[mbcset->nchar_classes++] = __wctype (name);
-#endif /* RE_ENABLE_I18N */
-
-#define BUILD_CHARCLASS_LOOP(ctype_func) \
- do { \
- if (BE (trans != NULL, 0)) \
- { \
- for (i = 0; i < SBC_MAX; ++i) \
- if (ctype_func (i)) \
- bitset_set (sbcset, trans[i]); \
- } \
- else \
- { \
- for (i = 0; i < SBC_MAX; ++i) \
- if (ctype_func (i)) \
- bitset_set (sbcset, i); \
- } \
- } while (0)
-
- if (strcmp (name, "alnum") == 0)
- BUILD_CHARCLASS_LOOP (isalnum);
- else if (strcmp (name, "cntrl") == 0)
- BUILD_CHARCLASS_LOOP (iscntrl);
- else if (strcmp (name, "lower") == 0)
- BUILD_CHARCLASS_LOOP (islower);
- else if (strcmp (name, "space") == 0)
- BUILD_CHARCLASS_LOOP (isspace);
- else if (strcmp (name, "alpha") == 0)
- BUILD_CHARCLASS_LOOP (isalpha);
- else if (strcmp (name, "digit") == 0)
- BUILD_CHARCLASS_LOOP (isdigit);
- else if (strcmp (name, "print") == 0)
- BUILD_CHARCLASS_LOOP (isprint);
- else if (strcmp (name, "upper") == 0)
- BUILD_CHARCLASS_LOOP (isupper);
- else if (strcmp (name, "blank") == 0)
- BUILD_CHARCLASS_LOOP (isblank);
- else if (strcmp (name, "graph") == 0)
- BUILD_CHARCLASS_LOOP (isgraph);
- else if (strcmp (name, "punct") == 0)
- BUILD_CHARCLASS_LOOP (ispunct);
- else if (strcmp (name, "xdigit") == 0)
- BUILD_CHARCLASS_LOOP (isxdigit);
- else
- return REG_ECTYPE;
-
- return REG_NOERROR;
-}
-
-static bin_tree_t *
-build_charclass_op (re_dfa_t *dfa, RE_TRANSLATE_TYPE trans,
- const unsigned char *class_name,
- const unsigned char *extra, int non_match,
- reg_errcode_t *err)
-{
- re_bitset_ptr_t sbcset;
-#ifdef RE_ENABLE_I18N
- re_charset_t *mbcset;
- int alloc = 0;
-#endif /* not RE_ENABLE_I18N */
- reg_errcode_t ret;
- re_token_t br_token;
- bin_tree_t *tree;
-
- sbcset = (re_bitset_ptr_t) calloc (sizeof (bitset_t), 1);
-#ifdef RE_ENABLE_I18N
- mbcset = (re_charset_t *) calloc (sizeof (re_charset_t), 1);
-#endif /* RE_ENABLE_I18N */
-
-#ifdef RE_ENABLE_I18N
- if (BE (sbcset == NULL || mbcset == NULL, 0))
-#else /* not RE_ENABLE_I18N */
- if (BE (sbcset == NULL, 0))
-#endif /* not RE_ENABLE_I18N */
- {
- *err = REG_ESPACE;
- return NULL;
- }
-
- if (non_match)
- {
-#ifdef RE_ENABLE_I18N
- /*
- if (syntax & RE_HAT_LISTS_NOT_NEWLINE)
- bitset_set(cset->sbcset, '\0');
- */
- mbcset->non_match = 1;
-#endif /* not RE_ENABLE_I18N */
- }
-
- /* We don't care the syntax in this case. */
- ret = build_charclass (trans, sbcset,
-#ifdef RE_ENABLE_I18N
- mbcset, &alloc,
-#endif /* RE_ENABLE_I18N */
- class_name, 0);
-
- if (BE (ret != REG_NOERROR, 0))
- {
- re_free (sbcset);
-#ifdef RE_ENABLE_I18N
- free_charset (mbcset);
-#endif /* RE_ENABLE_I18N */
- *err = ret;
- return NULL;
- }
- /* \w match '_' also. */
- for (; *extra; extra++)
- bitset_set (sbcset, *extra);
-
- /* If it is non-matching list. */
- if (non_match)
- bitset_not (sbcset);
-
-#ifdef RE_ENABLE_I18N
- /* Ensure only single byte characters are set. */
- if (dfa->mb_cur_max > 1)
- bitset_mask (sbcset, dfa->sb_char);
-#endif
-
- /* Build a tree for simple bracket. */
- br_token.type = SIMPLE_BRACKET;
- br_token.opr.sbcset = sbcset;
- tree = create_token_tree (dfa, NULL, NULL, &br_token);
- if (BE (tree == NULL, 0))
- goto build_word_op_espace;
-
-#ifdef RE_ENABLE_I18N
- if (dfa->mb_cur_max > 1)
- {
- bin_tree_t *mbc_tree;
- /* Build a tree for complex bracket. */
- br_token.type = COMPLEX_BRACKET;
- br_token.opr.mbcset = mbcset;
- dfa->has_mb_node = 1;
- mbc_tree = create_token_tree (dfa, NULL, NULL, &br_token);
- if (BE (mbc_tree == NULL, 0))
- goto build_word_op_espace;
- /* Then join them by ALT node. */
- tree = create_tree (dfa, tree, mbc_tree, OP_ALT);
- if (BE (mbc_tree != NULL, 1))
- return tree;
- }
- else
- {
- free_charset (mbcset);
- return tree;
- }
-#else /* not RE_ENABLE_I18N */
- return tree;
-#endif /* not RE_ENABLE_I18N */
-
- build_word_op_espace:
- re_free (sbcset);
-#ifdef RE_ENABLE_I18N
- free_charset (mbcset);
-#endif /* RE_ENABLE_I18N */
- *err = REG_ESPACE;
- return NULL;
-}
-
-/* This is intended for the expressions like "a{1,3}".
- Fetch a number from `input', and return the number.
- Return -1, if the number field is empty like "{,1}".
- Return -2, If an error is occured. */
-
-static int
-fetch_number (re_string_t *input, re_token_t *token, reg_syntax_t syntax)
-{
- int num = -1;
- unsigned char c;
- while (1)
- {
- fetch_token (token, input, syntax);
- c = token->opr.c;
- if (BE (token->type == END_OF_RE, 0))
- return -2;
- if (token->type == OP_CLOSE_DUP_NUM || c == ',')
- break;
- num = ((token->type != CHARACTER || c < '0' || '9' < c || num == -2)
- ? -2 : ((num == -1) ? c - '0' : num * 10 + c - '0'));
- num = (num > RE_DUP_MAX) ? -2 : num;
- }
- return num;
-}
-
-#ifdef RE_ENABLE_I18N
-static void
-free_charset (re_charset_t *cset)
-{
- re_free (cset->mbchars);
-# ifdef _LIBC
- re_free (cset->coll_syms);
- re_free (cset->equiv_classes);
- re_free (cset->range_starts);
- re_free (cset->range_ends);
-# endif
- re_free (cset->char_classes);
- re_free (cset);
-}
-#endif /* RE_ENABLE_I18N */
-
-/* Functions for binary tree operation. */
-
-/* Create a tree node. */
-
-static bin_tree_t *
-create_tree (re_dfa_t *dfa, bin_tree_t *left, bin_tree_t *right,
- re_token_type_t type)
-{
- re_token_t t;
- t.type = type;
- return create_token_tree (dfa, left, right, &t);
-}
-
-static bin_tree_t *
-create_token_tree (re_dfa_t *dfa, bin_tree_t *left, bin_tree_t *right,
- const re_token_t *token)
-{
- bin_tree_t *tree;
- if (BE (dfa->str_tree_storage_idx == BIN_TREE_STORAGE_SIZE, 0))
- {
- bin_tree_storage_t *storage = re_malloc (bin_tree_storage_t, 1);
-
- if (storage == NULL)
- return NULL;
- storage->next = dfa->str_tree_storage;
- dfa->str_tree_storage = storage;
- dfa->str_tree_storage_idx = 0;
- }
- tree = &dfa->str_tree_storage->data[dfa->str_tree_storage_idx++];
-
- tree->parent = NULL;
- tree->left = left;
- tree->right = right;
- tree->token = *token;
- tree->token.duplicated = 0;
- tree->token.opt_subexp = 0;
- tree->first = NULL;
- tree->next = NULL;
- tree->node_idx = -1;
-
- if (left != NULL)
- left->parent = tree;
- if (right != NULL)
- right->parent = tree;
- return tree;
-}
-
-/* Mark the tree SRC as an optional subexpression.
- To be called from preorder or postorder. */
-
-static reg_errcode_t
-mark_opt_subexp (void *extra, bin_tree_t *node)
-{
-#ifdef _WIN64
- int idx = (int) (__int64) extra;
-#else
- int idx = (int) (long) extra;
-#endif
- if (node->token.type == SUBEXP && node->token.opr.idx == idx)
- node->token.opt_subexp = 1;
-
- return REG_NOERROR;
-}
-
-/* Free the allocated memory inside NODE. */
-
-static void
-free_token (re_token_t *node)
-{
-#ifdef RE_ENABLE_I18N
- if (node->type == COMPLEX_BRACKET && node->duplicated == 0)
- free_charset (node->opr.mbcset);
- else
-#endif /* RE_ENABLE_I18N */
- if (node->type == SIMPLE_BRACKET && node->duplicated == 0)
- re_free (node->opr.sbcset);
-}
-
-/* Worker function for tree walking. Free the allocated memory inside NODE
- and its children. */
-
-static reg_errcode_t
-free_tree (void *extra, bin_tree_t *node)
-{
- free_token (&node->token);
- return REG_NOERROR;
-}
-
-
-/* Duplicate the node SRC, and return new node. This is a preorder
- visit similar to the one implemented by the generic visitor, but
- we need more infrastructure to maintain two parallel trees --- so,
- it's easier to duplicate. */
-
-static bin_tree_t *
-duplicate_tree (const bin_tree_t *root, re_dfa_t *dfa)
-{
- const bin_tree_t *node;
- bin_tree_t *dup_root;
- bin_tree_t **p_new = &dup_root, *dup_node = root->parent;
-
- for (node = root; ; )
- {
- /* Create a new tree and link it back to the current parent. */
- *p_new = create_token_tree (dfa, NULL, NULL, &node->token);
- if (*p_new == NULL)
- return NULL;
- (*p_new)->parent = dup_node;
- (*p_new)->token.duplicated = 1;
- dup_node = *p_new;
-
- /* Go to the left node, or up and to the right. */
- if (node->left)
- {
- node = node->left;
- p_new = &dup_node->left;
- }
- else
- {
- const bin_tree_t *prev = NULL;
- while (node->right == prev || node->right == NULL)
- {
- prev = node;
- node = node->parent;
- dup_node = dup_node->parent;
- if (!node)
- return dup_root;
- }
- node = node->right;
- p_new = &dup_node->right;
- }
- }
-}
diff --git a/Build/source/texk/web2c/pdftexdir/regex/regex.c b/Build/source/texk/web2c/pdftexdir/regex/regex.c
deleted file mode 100644
index d816df97794..00000000000
--- a/Build/source/texk/web2c/pdftexdir/regex/regex.c
+++ /dev/null
@@ -1,31 +0,0 @@
-/* Extended regular expression matching and search library.
- Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc.
- This file is part of the GNU C Library.
- Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
-
- The GNU C Library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- The GNU C Library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with the GNU C Library; if not, write to the Free
- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
- 02111-1307 USA. */
-
-/* On some systems, limits.h sets RE_DUP_MAX to a lower value than
- GNU regex allows. Include it before <regex.h>, which correctly
- #undefs RE_DUP_MAX and sets it to the right value. */
-#include <limits.h>
-
-#include <regex/regex.h>
-#include <regex/regex_internal.h>
-
-#include <regex/regex_internal.c>
-#include <regex/regcomp.c>
-#include <regex/regexec.c>
diff --git a/Build/source/texk/web2c/pdftexdir/regex/regex.h b/Build/source/texk/web2c/pdftexdir/regex/regex.h
deleted file mode 100644
index 807c404ec24..00000000000
--- a/Build/source/texk/web2c/pdftexdir/regex/regex.h
+++ /dev/null
@@ -1,556 +0,0 @@
-/* Definitions for data structures and routines for the regular
- expression library.
- Copyright (C) 1985,1989-93,1995-98,2000,2001,2002,2003,2005,2006
- Free Software Foundation, Inc.
- This file is part of the GNU C Library.
-
- The GNU C Library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- The GNU C Library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with the GNU C Library; if not, write to the Free
- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
- 02111-1307 USA. */
-
-#ifndef _REGEX_H
-#define _REGEX_H 1
-
-#include <sys/types.h>
-
-/* Allow the use in C++ code. */
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* The following two types have to be signed and unsigned integer type
- wide enough to hold a value of a pointer. For most ANSI compilers
- ptrdiff_t and size_t should be likely OK. Still size of these two
- types is 2 for Microsoft C. Ugh... */
-typedef long int s_reg_t;
-typedef unsigned long int active_reg_t;
-
-/* The following bits are used to determine the regexp syntax we
- recognize. The set/not-set meanings are chosen so that Emacs syntax
- remains the value 0. The bits are given in alphabetical order, and
- the definitions shifted by one from the previous bit; thus, when we
- add or remove a bit, only one other definition need change. */
-typedef unsigned long int reg_syntax_t;
-
-/* If this bit is not set, then \ inside a bracket expression is literal.
- If set, then such a \ quotes the following character. */
-#define RE_BACKSLASH_ESCAPE_IN_LISTS ((unsigned long int) 1)
-
-/* If this bit is not set, then + and ? are operators, and \+ and \? are
- literals.
- If set, then \+ and \? are operators and + and ? are literals. */
-#define RE_BK_PLUS_QM (RE_BACKSLASH_ESCAPE_IN_LISTS << 1)
-
-/* If this bit is set, then character classes are supported. They are:
- [:alpha:], [:upper:], [:lower:], [:digit:], [:alnum:], [:xdigit:],
- [:space:], [:print:], [:punct:], [:graph:], and [:cntrl:].
- If not set, then character classes are not supported. */
-#define RE_CHAR_CLASSES (RE_BK_PLUS_QM << 1)
-
-/* If this bit is set, then ^ and $ are always anchors (outside bracket
- expressions, of course).
- If this bit is not set, then it depends:
- ^ is an anchor if it is at the beginning of a regular
- expression or after an open-group or an alternation operator;
- $ is an anchor if it is at the end of a regular expression, or
- before a close-group or an alternation operator.
-
- This bit could be (re)combined with RE_CONTEXT_INDEP_OPS, because
- POSIX draft 11.2 says that * etc. in leading positions is undefined.
- We already implemented a previous draft which made those constructs
- invalid, though, so we haven't changed the code back. */
-#define RE_CONTEXT_INDEP_ANCHORS (RE_CHAR_CLASSES << 1)
-
-/* If this bit is set, then special characters are always special
- regardless of where they are in the pattern.
- If this bit is not set, then special characters are special only in
- some contexts; otherwise they are ordinary. Specifically,
- * + ? and intervals are only special when not after the beginning,
- open-group, or alternation operator. */
-#define RE_CONTEXT_INDEP_OPS (RE_CONTEXT_INDEP_ANCHORS << 1)
-
-/* If this bit is set, then *, +, ?, and { cannot be first in an re or
- immediately after an alternation or begin-group operator. */
-#define RE_CONTEXT_INVALID_OPS (RE_CONTEXT_INDEP_OPS << 1)
-
-/* If this bit is set, then . matches newline.
- If not set, then it doesn't. */
-#define RE_DOT_NEWLINE (RE_CONTEXT_INVALID_OPS << 1)
-
-/* If this bit is set, then . doesn't match NUL.
- If not set, then it does. */
-#define RE_DOT_NOT_NULL (RE_DOT_NEWLINE << 1)
-
-/* If this bit is set, nonmatching lists [^...] do not match newline.
- If not set, they do. */
-#define RE_HAT_LISTS_NOT_NEWLINE (RE_DOT_NOT_NULL << 1)
-
-/* If this bit is set, either \{...\} or {...} defines an
- interval, depending on RE_NO_BK_BRACES.
- If not set, \{, \}, {, and } are literals. */
-#define RE_INTERVALS (RE_HAT_LISTS_NOT_NEWLINE << 1)
-
-/* If this bit is set, +, ? and | aren't recognized as operators.
- If not set, they are. */
-#define RE_LIMITED_OPS (RE_INTERVALS << 1)
-
-/* If this bit is set, newline is an alternation operator.
- If not set, newline is literal. */
-#define RE_NEWLINE_ALT (RE_LIMITED_OPS << 1)
-
-/* If this bit is set, then `{...}' defines an interval, and \{ and \}
- are literals.
- If not set, then `\{...\}' defines an interval. */
-#define RE_NO_BK_BRACES (RE_NEWLINE_ALT << 1)
-
-/* If this bit is set, (...) defines a group, and \( and \) are literals.
- If not set, \(...\) defines a group, and ( and ) are literals. */
-#define RE_NO_BK_PARENS (RE_NO_BK_BRACES << 1)
-
-/* If this bit is set, then \<digit> matches <digit>.
- If not set, then \<digit> is a back-reference. */
-#define RE_NO_BK_REFS (RE_NO_BK_PARENS << 1)
-
-/* If this bit is set, then | is an alternation operator, and \| is literal.
- If not set, then \| is an alternation operator, and | is literal. */
-#define RE_NO_BK_VBAR (RE_NO_BK_REFS << 1)
-
-/* If this bit is set, then an ending range point collating higher
- than the starting range point, as in [z-a], is invalid.
- If not set, then when ending range point collates higher than the
- starting range point, the range is ignored. */
-#define RE_NO_EMPTY_RANGES (RE_NO_BK_VBAR << 1)
-
-/* If this bit is set, then an unmatched ) is ordinary.
- If not set, then an unmatched ) is invalid. */
-#define RE_UNMATCHED_RIGHT_PAREN_ORD (RE_NO_EMPTY_RANGES << 1)
-
-/* If this bit is set, succeed as soon as we match the whole pattern,
- without further backtracking. */
-#define RE_NO_POSIX_BACKTRACKING (RE_UNMATCHED_RIGHT_PAREN_ORD << 1)
-
-/* If this bit is set, do not process the GNU regex operators.
- If not set, then the GNU regex operators are recognized. */
-#define RE_NO_GNU_OPS (RE_NO_POSIX_BACKTRACKING << 1)
-
-/* If this bit is set, turn on internal regex debugging.
- If not set, and debugging was on, turn it off.
- This only works if regex.c is compiled -DDEBUG.
- We define this bit always, so that all that's needed to turn on
- debugging is to recompile regex.c; the calling code can always have
- this bit set, and it won't affect anything in the normal case. */
-#define RE_DEBUG (RE_NO_GNU_OPS << 1)
-
-/* If this bit is set, a syntactically invalid interval is treated as
- a string of ordinary characters. For example, the ERE 'a{1' is
- treated as 'a\{1'. */
-#define RE_INVALID_INTERVAL_ORD (RE_DEBUG << 1)
-
-/* If this bit is set, then ignore case when matching.
- If not set, then case is significant. */
-#define RE_ICASE (RE_INVALID_INTERVAL_ORD << 1)
-
-/* This bit is used internally like RE_CONTEXT_INDEP_ANCHORS but only
- for ^, because it is difficult to scan the regex backwards to find
- whether ^ should be special. */
-#define RE_CARET_ANCHORS_HERE (RE_ICASE << 1)
-
-/* If this bit is set, then \{ cannot be first in an bre or
- immediately after an alternation or begin-group operator. */
-#define RE_CONTEXT_INVALID_DUP (RE_CARET_ANCHORS_HERE << 1)
-
-/* If this bit is set, then no_sub will be set to 1 during
- re_compile_pattern. */
-#define RE_NO_SUB (RE_CONTEXT_INVALID_DUP << 1)
-
-/* This global variable defines the particular regexp syntax to use (for
- some interfaces). When a regexp is compiled, the syntax used is
- stored in the pattern buffer, so changing this does not affect
- already-compiled regexps. */
-extern reg_syntax_t re_syntax_options;
-
-/* Define combinations of the above bits for the standard possibilities.
- (The [[[ comments delimit what gets put into the Texinfo file, so
- don't delete them!) */
-/* [[[begin syntaxes]]] */
-#define RE_SYNTAX_EMACS 0
-
-#define RE_SYNTAX_AWK \
- (RE_BACKSLASH_ESCAPE_IN_LISTS | RE_DOT_NOT_NULL \
- | RE_NO_BK_PARENS | RE_NO_BK_REFS \
- | RE_NO_BK_VBAR | RE_NO_EMPTY_RANGES \
- | RE_DOT_NEWLINE | RE_CONTEXT_INDEP_ANCHORS \
- | RE_UNMATCHED_RIGHT_PAREN_ORD | RE_NO_GNU_OPS)
-
-#define RE_SYNTAX_GNU_AWK \
- ((RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS | RE_DEBUG) \
- & ~(RE_DOT_NOT_NULL | RE_INTERVALS | RE_CONTEXT_INDEP_OPS \
- | RE_CONTEXT_INVALID_OPS ))
-
-#define RE_SYNTAX_POSIX_AWK \
- (RE_SYNTAX_POSIX_EXTENDED | RE_BACKSLASH_ESCAPE_IN_LISTS \
- | RE_INTERVALS | RE_NO_GNU_OPS)
-
-#define RE_SYNTAX_GREP \
- (RE_BK_PLUS_QM | RE_CHAR_CLASSES \
- | RE_HAT_LISTS_NOT_NEWLINE | RE_INTERVALS \
- | RE_NEWLINE_ALT)
-
-#define RE_SYNTAX_EGREP \
- (RE_CHAR_CLASSES | RE_CONTEXT_INDEP_ANCHORS \
- | RE_CONTEXT_INDEP_OPS | RE_HAT_LISTS_NOT_NEWLINE \
- | RE_NEWLINE_ALT | RE_NO_BK_PARENS \
- | RE_NO_BK_VBAR)
-
-#define RE_SYNTAX_POSIX_EGREP \
- (RE_SYNTAX_EGREP | RE_INTERVALS | RE_NO_BK_BRACES \
- | RE_INVALID_INTERVAL_ORD)
-
-/* P1003.2/D11.2, section 4.20.7.1, lines 5078ff. */
-#define RE_SYNTAX_ED RE_SYNTAX_POSIX_BASIC
-
-#define RE_SYNTAX_SED RE_SYNTAX_POSIX_BASIC
-
-/* Syntax bits common to both basic and extended POSIX regex syntax. */
-#define _RE_SYNTAX_POSIX_COMMON \
- (RE_CHAR_CLASSES | RE_DOT_NEWLINE | RE_DOT_NOT_NULL \
- | RE_INTERVALS | RE_NO_EMPTY_RANGES)
-
-#define RE_SYNTAX_POSIX_BASIC \
- (_RE_SYNTAX_POSIX_COMMON | RE_BK_PLUS_QM | RE_CONTEXT_INVALID_DUP)
-
-/* Differs from ..._POSIX_BASIC only in that RE_BK_PLUS_QM becomes
- RE_LIMITED_OPS, i.e., \? \+ \| are not recognized. Actually, this
- isn't minimal, since other operators, such as \`, aren't disabled. */
-#define RE_SYNTAX_POSIX_MINIMAL_BASIC \
- (_RE_SYNTAX_POSIX_COMMON | RE_LIMITED_OPS)
-
-#define RE_SYNTAX_POSIX_EXTENDED \
- (_RE_SYNTAX_POSIX_COMMON | RE_CONTEXT_INDEP_ANCHORS \
- | RE_CONTEXT_INDEP_OPS | RE_NO_BK_BRACES \
- | RE_NO_BK_PARENS | RE_NO_BK_VBAR \
- | RE_CONTEXT_INVALID_OPS | RE_UNMATCHED_RIGHT_PAREN_ORD)
-
-/* Differs from ..._POSIX_EXTENDED in that RE_CONTEXT_INDEP_OPS is
- removed and RE_NO_BK_REFS is added. */
-#define RE_SYNTAX_POSIX_MINIMAL_EXTENDED \
- (_RE_SYNTAX_POSIX_COMMON | RE_CONTEXT_INDEP_ANCHORS \
- | RE_CONTEXT_INVALID_OPS | RE_NO_BK_BRACES \
- | RE_NO_BK_PARENS | RE_NO_BK_REFS \
- | RE_NO_BK_VBAR | RE_UNMATCHED_RIGHT_PAREN_ORD)
-/* [[[end syntaxes]]] */
-
-/* Maximum number of duplicates an interval can allow. Some systems
- (erroneously) define this in other header files, but we want our
- value, so remove any previous define. */
-#ifdef RE_DUP_MAX
-# undef RE_DUP_MAX
-#endif
-/* If sizeof(int) == 2, then ((1 << 15) - 1) overflows. */
-#define RE_DUP_MAX (0x7fff)
-
-
-/* POSIX `cflags' bits (i.e., information for `regcomp'). */
-
-/* If this bit is set, then use extended regular expression syntax.
- If not set, then use basic regular expression syntax. */
-#define REG_EXTENDED 1
-
-/* If this bit is set, then ignore case when matching.
- If not set, then case is significant. */
-#define REG_ICASE (REG_EXTENDED << 1)
-
-/* If this bit is set, then anchors do not match at newline
- characters in the string.
- If not set, then anchors do match at newlines. */
-#define REG_NEWLINE (REG_ICASE << 1)
-
-/* If this bit is set, then report only success or fail in regexec.
- If not set, then returns differ between not matching and errors. */
-#define REG_NOSUB (REG_NEWLINE << 1)
-
-
-/* POSIX `eflags' bits (i.e., information for regexec). */
-
-/* If this bit is set, then the beginning-of-line operator doesn't match
- the beginning of the string (presumably because it's not the
- beginning of a line).
- If not set, then the beginning-of-line operator does match the
- beginning of the string. */
-#define REG_NOTBOL 1
-
-/* Like REG_NOTBOL, except for the end-of-line. */
-#define REG_NOTEOL (1 << 1)
-
-/* Use PMATCH[0] to delimit the start and end of the search in the
- buffer. */
-#define REG_STARTEND (1 << 2)
-
-
-/* If any error codes are removed, changed, or added, update the
- `re_error_msg' table in regex.c. */
-typedef enum
-{
-#ifdef _XOPEN_SOURCE
- REG_ENOSYS = -1, /* This will never happen for this implementation. */
-#endif
-
- REG_NOERROR = 0, /* Success. */
- REG_NOMATCH, /* Didn't find a match (for regexec). */
-
- /* POSIX regcomp return error codes. (In the order listed in the
- standard.) */
- REG_BADPAT, /* Invalid pattern. */
- REG_ECOLLATE, /* Inalid collating element. */
- REG_ECTYPE, /* Invalid character class name. */
- REG_EESCAPE, /* Trailing backslash. */
- REG_ESUBREG, /* Invalid back reference. */
- REG_EBRACK, /* Unmatched left bracket. */
- REG_EPAREN, /* Parenthesis imbalance. */
- REG_EBRACE, /* Unmatched \{. */
- REG_BADBR, /* Invalid contents of \{\}. */
- REG_ERANGE, /* Invalid range end. */
- REG_ESPACE, /* Ran out of memory. */
- REG_BADRPT, /* No preceding re for repetition op. */
-
- /* Error codes we've added. */
- REG_EEND, /* Premature end. */
- REG_ESIZE, /* Compiled pattern bigger than 2^16 bytes. */
- REG_ERPAREN /* Unmatched ) or \); not returned from regcomp. */
-} reg_errcode_t;
-
-/* This data structure represents a compiled pattern. Before calling
- the pattern compiler, the fields `buffer', `allocated', `fastmap',
- `translate', and `no_sub' can be set. After the pattern has been
- compiled, the `re_nsub' field is available. All other fields are
- private to the regex routines. */
-
-#ifndef RE_TRANSLATE_TYPE
-# define RE_TRANSLATE_TYPE unsigned char *
-#endif
-
-struct re_pattern_buffer
-{
- /* Space that holds the compiled pattern. It is declared as
- `unsigned char *' because its elements are sometimes used as
- array indexes. */
- unsigned char *buffer;
-
- /* Number of bytes to which `buffer' points. */
- unsigned long int allocated;
-
- /* Number of bytes actually used in `buffer'. */
- unsigned long int used;
-
- /* Syntax setting with which the pattern was compiled. */
- reg_syntax_t syntax;
-
- /* Pointer to a fastmap, if any, otherwise zero. re_search uses the
- fastmap, if there is one, to skip over impossible starting points
- for matches. */
- char *fastmap;
-
- /* Either a translate table to apply to all characters before
- comparing them, or zero for no translation. The translation is
- applied to a pattern when it is compiled and to a string when it
- is matched. */
- RE_TRANSLATE_TYPE translate;
-
- /* Number of subexpressions found by the compiler. */
- size_t re_nsub;
-
- /* Zero if this pattern cannot match the empty string, one else.
- Well, in truth it's used only in `re_search_2', to see whether or
- not we should use the fastmap, so we don't set this absolutely
- perfectly; see `re_compile_fastmap' (the `duplicate' case). */
- unsigned can_be_null : 1;
-
- /* If REGS_UNALLOCATED, allocate space in the `regs' structure
- for `max (RE_NREGS, re_nsub + 1)' groups.
- If REGS_REALLOCATE, reallocate space if necessary.
- If REGS_FIXED, use what's there. */
-#define REGS_UNALLOCATED 0
-#define REGS_REALLOCATE 1
-#define REGS_FIXED 2
- unsigned regs_allocated : 2;
-
- /* Set to zero when `regex_compile' compiles a pattern; set to one
- by `re_compile_fastmap' if it updates the fastmap. */
- unsigned fastmap_accurate : 1;
-
- /* If set, `re_match_2' does not return information about
- subexpressions. */
- unsigned no_sub : 1;
-
- /* If set, a beginning-of-line anchor doesn't match at the beginning
- of the string. */
- unsigned not_bol : 1;
-
- /* Similarly for an end-of-line anchor. */
- unsigned not_eol : 1;
-
- /* If true, an anchor at a newline matches. */
- unsigned newline_anchor : 1;
-};
-
-typedef struct re_pattern_buffer regex_t;
-
-/* Type for byte offsets within the string. POSIX mandates this. */
-typedef int regoff_t;
-
-
-/* This is the structure we store register match data in. See
- regex.texinfo for a full description of what registers match. */
-struct re_registers
-{
- unsigned num_regs;
- regoff_t *start;
- regoff_t *end;
-};
-
-
-/* If `regs_allocated' is REGS_UNALLOCATED in the pattern buffer,
- `re_match_2' returns information about at least this many registers
- the first time a `regs' structure is passed. */
-#ifndef RE_NREGS
-# define RE_NREGS 30
-#endif
-
-
-/* POSIX specification for registers. Aside from the different names than
- `re_registers', POSIX uses an array of structures, instead of a
- structure of arrays. */
-typedef struct
-{
- regoff_t rm_so; /* Byte offset from string's start to substring's start. */
- regoff_t rm_eo; /* Byte offset from string's start to substring's end. */
-} regmatch_t;
-
-/* Declarations for routines. */
-
-/* Sets the current default syntax to SYNTAX, and return the old syntax.
- You can also simply assign to the `re_syntax_options' variable. */
-extern reg_syntax_t re_set_syntax (reg_syntax_t __syntax);
-
-/* Compile the regular expression PATTERN, with length LENGTH
- and syntax given by the global `re_syntax_options', into the buffer
- BUFFER. Return NULL if successful, and an error string if not. */
-extern const char *re_compile_pattern (const char *__pattern, size_t __length,
- struct re_pattern_buffer *__buffer);
-
-
-/* Compile a fastmap for the compiled pattern in BUFFER; used to
- accelerate searches. Return 0 if successful and -2 if was an
- internal error. */
-extern int re_compile_fastmap (struct re_pattern_buffer *__buffer);
-
-
-/* Search in the string STRING (with length LENGTH) for the pattern
- compiled into BUFFER. Start searching at position START, for RANGE
- characters. Return the starting position of the match, -1 for no
- match, or -2 for an internal error. Also return register
- information in REGS (if REGS and BUFFER->no_sub are nonzero). */
-extern int re_search (struct re_pattern_buffer *__buffer, const char *__string,
- int __length, int __start, int __range,
- struct re_registers *__regs);
-
-
-/* Like `re_search', but search in the concatenation of STRING1 and
- STRING2. Also, stop searching at index START + STOP. */
-extern int re_search_2 (struct re_pattern_buffer *__buffer,
- const char *__string1, int __length1,
- const char *__string2, int __length2, int __start,
- int __range, struct re_registers *__regs, int __stop);
-
-
-/* Like `re_search', but return how many characters in STRING the regexp
- in BUFFER matched, starting at position START. */
-extern int re_match (struct re_pattern_buffer *__buffer, const char *__string,
- int __length, int __start, struct re_registers *__regs);
-
-
-/* Relates to `re_match' as `re_search_2' relates to `re_search'. */
-extern int re_match_2 (struct re_pattern_buffer *__buffer,
- const char *__string1, int __length1,
- const char *__string2, int __length2, int __start,
- struct re_registers *__regs, int __stop);
-
-
-/* Set REGS to hold NUM_REGS registers, storing them in STARTS and
- ENDS. Subsequent matches using BUFFER and REGS will use this memory
- for recording register information. STARTS and ENDS must be
- allocated with malloc, and must each be at least `NUM_REGS * sizeof
- (regoff_t)' bytes long.
-
- If NUM_REGS == 0, then subsequent matches should allocate their own
- register data.
-
- Unless this function is called, the first search or match using
- PATTERN_BUFFER will allocate its own register data, without
- freeing the old data. */
-extern void re_set_registers (struct re_pattern_buffer *__buffer,
- struct re_registers *__regs,
- unsigned int __num_regs,
- regoff_t *__starts, regoff_t *__ends);
-
-#if defined _REGEX_RE_COMP || defined _LIBC
-# ifndef _CRAY
-/* 4.2 bsd compatibility. */
-extern char *re_comp (const char *);
-extern int re_exec (const char *);
-# endif
-#endif
-
-/* GCC 2.95 and later have "__restrict"; C99 compilers have
- "restrict", and "configure" may have defined "restrict". */
-#ifndef __restrict
-# if ! (2 < __GNUC__ || (2 == __GNUC__ && 95 <= __GNUC_MINOR__))
-# if defined restrict || 199901L <= __STDC_VERSION__
-# define __restrict restrict
-# else
-# define __restrict
-# endif
-# endif
-#endif
-/* gcc 3.1 and up support the [restrict] syntax. */
-#ifndef __restrict_arr
-# if (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 1)) \
- && !defined __GNUG__
-# define __restrict_arr __restrict
-# else
-# define __restrict_arr
-# endif
-#endif
-
-/* POSIX compatibility. */
-extern int regcomp (regex_t *__restrict __preg,
- const char *__restrict __pattern,
- int __cflags);
-
-extern int regexec (const regex_t *__restrict __preg,
- const char *__restrict __string, size_t __nmatch,
- regmatch_t __pmatch[__restrict_arr],
- int __eflags);
-
-extern size_t regerror (int __errcode, const regex_t *__restrict __preg,
- char *__restrict __errbuf, size_t __errbuf_size);
-
-extern void regfree (regex_t *__preg);
-
-
-#ifdef __cplusplus
-}
-#endif /* C++ */
-
-#endif /* regex.h */
diff --git a/Build/source/texk/web2c/pdftexdir/regex/regex_internal.c b/Build/source/texk/web2c/pdftexdir/regex/regex_internal.c
deleted file mode 100644
index 64c6373d265..00000000000
--- a/Build/source/texk/web2c/pdftexdir/regex/regex_internal.c
+++ /dev/null
@@ -1,1719 +0,0 @@
-/* Extended regular expression matching and search library.
- Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
- This file is part of the GNU C Library.
- Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
-
- The GNU C Library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- The GNU C Library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with the GNU C Library; if not, write to the Free
- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
- 02111-1307 USA. */
-
-static void re_string_construct_common (const char *str, int len,
- re_string_t *pstr,
- RE_TRANSLATE_TYPE trans, int icase,
- const re_dfa_t *dfa) internal_function;
-static re_dfastate_t *create_ci_newstate (const re_dfa_t *dfa,
- const re_node_set *nodes,
- unsigned int hash) internal_function;
-static re_dfastate_t *create_cd_newstate (const re_dfa_t *dfa,
- const re_node_set *nodes,
- unsigned int context,
- unsigned int hash) internal_function;
-
-/* Functions for string operation. */
-
-/* This function allocate the buffers. It is necessary to call
- re_string_reconstruct before using the object. */
-
-static reg_errcode_t
-internal_function
-re_string_allocate (re_string_t *pstr, const char *str, int len, int init_len,
- RE_TRANSLATE_TYPE trans, int icase, const re_dfa_t *dfa)
-{
- reg_errcode_t ret;
- int init_buf_len;
-
- /* Ensure at least one character fits into the buffers. */
- if (init_len < dfa->mb_cur_max)
- init_len = dfa->mb_cur_max;
- init_buf_len = (len + 1 < init_len) ? len + 1: init_len;
- re_string_construct_common (str, len, pstr, trans, icase, dfa);
-
- ret = re_string_realloc_buffers (pstr, init_buf_len);
- if (BE (ret != REG_NOERROR, 0))
- return ret;
-
- pstr->word_char = dfa->word_char;
- pstr->word_ops_used = dfa->word_ops_used;
- pstr->mbs = pstr->mbs_allocated ? pstr->mbs : (unsigned char *) str;
- pstr->valid_len = (pstr->mbs_allocated || dfa->mb_cur_max > 1) ? 0 : len;
- pstr->valid_raw_len = pstr->valid_len;
- return REG_NOERROR;
-}
-
-/* This function allocate the buffers, and initialize them. */
-
-static reg_errcode_t
-internal_function
-re_string_construct (re_string_t *pstr, const char *str, int len,
- RE_TRANSLATE_TYPE trans, int icase, const re_dfa_t *dfa)
-{
- reg_errcode_t ret;
- memset (pstr, '\0', sizeof (re_string_t));
- re_string_construct_common (str, len, pstr, trans, icase, dfa);
-
- if (len > 0)
- {
- ret = re_string_realloc_buffers (pstr, len + 1);
- if (BE (ret != REG_NOERROR, 0))
- return ret;
- }
- pstr->mbs = pstr->mbs_allocated ? pstr->mbs : (unsigned char *) str;
-
- if (icase)
- {
-#ifdef RE_ENABLE_I18N
- if (dfa->mb_cur_max > 1)
- {
- while (1)
- {
- ret = build_wcs_upper_buffer (pstr);
- if (BE (ret != REG_NOERROR, 0))
- return ret;
- if (pstr->valid_raw_len >= len)
- break;
- if (pstr->bufs_len > pstr->valid_len + dfa->mb_cur_max)
- break;
- ret = re_string_realloc_buffers (pstr, pstr->bufs_len * 2);
- if (BE (ret != REG_NOERROR, 0))
- return ret;
- }
- }
- else
-#endif /* RE_ENABLE_I18N */
- build_upper_buffer (pstr);
- }
- else
- {
-#ifdef RE_ENABLE_I18N
- if (dfa->mb_cur_max > 1)
- build_wcs_buffer (pstr);
- else
-#endif /* RE_ENABLE_I18N */
- {
- if (trans != NULL)
- re_string_translate_buffer (pstr);
- else
- {
- pstr->valid_len = pstr->bufs_len;
- pstr->valid_raw_len = pstr->bufs_len;
- }
- }
- }
-
- return REG_NOERROR;
-}
-
-/* Helper functions for re_string_allocate, and re_string_construct. */
-
-static reg_errcode_t
-internal_function
-re_string_realloc_buffers (re_string_t *pstr, int new_buf_len)
-{
-#ifdef RE_ENABLE_I18N
- if (pstr->mb_cur_max > 1)
- {
- wint_t *new_wcs = re_realloc (pstr->wcs, wint_t, new_buf_len);
- if (BE (new_wcs == NULL, 0))
- return REG_ESPACE;
- pstr->wcs = new_wcs;
- if (pstr->offsets != NULL)
- {
- int *new_offsets = re_realloc (pstr->offsets, int, new_buf_len);
- if (BE (new_offsets == NULL, 0))
- return REG_ESPACE;
- pstr->offsets = new_offsets;
- }
- }
-#endif /* RE_ENABLE_I18N */
- if (pstr->mbs_allocated)
- {
- unsigned char *new_mbs = re_realloc (pstr->mbs, unsigned char,
- new_buf_len);
- if (BE (new_mbs == NULL, 0))
- return REG_ESPACE;
- pstr->mbs = new_mbs;
- }
- pstr->bufs_len = new_buf_len;
- return REG_NOERROR;
-}
-
-
-static void
-internal_function
-re_string_construct_common (const char *str, int len, re_string_t *pstr,
- RE_TRANSLATE_TYPE trans, int icase,
- const re_dfa_t *dfa)
-{
- pstr->raw_mbs = (const unsigned char *) str;
- pstr->len = len;
- pstr->raw_len = len;
- pstr->trans = trans;
- pstr->icase = icase ? 1 : 0;
- pstr->mbs_allocated = (trans != NULL || icase);
- pstr->mb_cur_max = dfa->mb_cur_max;
- pstr->is_utf8 = dfa->is_utf8;
- pstr->map_notascii = dfa->map_notascii;
- pstr->stop = pstr->len;
- pstr->raw_stop = pstr->stop;
-}
-
-#ifdef RE_ENABLE_I18N
-
-/* Build wide character buffer PSTR->WCS.
- If the byte sequence of the string are:
- <mb1>(0), <mb1>(1), <mb2>(0), <mb2>(1), <sb3>
- Then wide character buffer will be:
- <wc1> , WEOF , <wc2> , WEOF , <wc3>
- We use WEOF for padding, they indicate that the position isn't
- a first byte of a multibyte character.
-
- Note that this function assumes PSTR->VALID_LEN elements are already
- built and starts from PSTR->VALID_LEN. */
-
-static void
-internal_function
-build_wcs_buffer (re_string_t *pstr)
-{
-#ifdef _LIBC
- unsigned char buf[MB_LEN_MAX];
- assert (MB_LEN_MAX >= pstr->mb_cur_max);
-#else
- unsigned char buf[64];
-#endif
- mbstate_t prev_st;
- int byte_idx, end_idx, remain_len;
- size_t mbclen;
-
- /* Build the buffers from pstr->valid_len to either pstr->len or
- pstr->bufs_len. */
- end_idx = (pstr->bufs_len > pstr->len) ? pstr->len : pstr->bufs_len;
- for (byte_idx = pstr->valid_len; byte_idx < end_idx;)
- {
- wchar_t wc;
- const char *p;
-
- remain_len = end_idx - byte_idx;
- prev_st = pstr->cur_state;
- /* Apply the translation if we need. */
- if (BE (pstr->trans != NULL, 0))
- {
- int i, ch;
-
- for (i = 0; i < pstr->mb_cur_max && i < remain_len; ++i)
- {
- ch = pstr->raw_mbs [pstr->raw_mbs_idx + byte_idx + i];
- buf[i] = pstr->mbs[byte_idx + i] = pstr->trans[ch];
- }
- p = (const char *) buf;
- }
- else
- p = (const char *) pstr->raw_mbs + pstr->raw_mbs_idx + byte_idx;
- mbclen = mbrtowc (&wc, p, remain_len, &pstr->cur_state);
- if (BE (mbclen == (size_t) -2, 0))
- {
- /* The buffer doesn't have enough space, finish to build. */
- pstr->cur_state = prev_st;
- break;
- }
- else if (BE (mbclen == (size_t) -1 || mbclen == 0, 0))
- {
- /* We treat these cases as a singlebyte character. */
- mbclen = 1;
- wc = (wchar_t) pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx];
- if (BE (pstr->trans != NULL, 0))
- wc = pstr->trans[wc];
- pstr->cur_state = prev_st;
- }
-
- /* Write wide character and padding. */
- pstr->wcs[byte_idx++] = wc;
- /* Write paddings. */
- for (remain_len = byte_idx + mbclen - 1; byte_idx < remain_len ;)
- pstr->wcs[byte_idx++] = WEOF;
- }
- pstr->valid_len = byte_idx;
- pstr->valid_raw_len = byte_idx;
-}
-
-/* Build wide character buffer PSTR->WCS like build_wcs_buffer,
- but for REG_ICASE. */
-
-static reg_errcode_t
-internal_function
-build_wcs_upper_buffer (re_string_t *pstr)
-{
- mbstate_t prev_st;
- int src_idx, byte_idx, end_idx, remain_len;
- size_t mbclen;
-#ifdef _LIBC
- char buf[MB_LEN_MAX];
- assert (MB_LEN_MAX >= pstr->mb_cur_max);
-#else
- char buf[64];
-#endif
-
- byte_idx = pstr->valid_len;
- end_idx = (pstr->bufs_len > pstr->len) ? pstr->len : pstr->bufs_len;
-
- /* The following optimization assumes that ASCII characters can be
- mapped to wide characters with a simple cast. */
- if (! pstr->map_notascii && pstr->trans == NULL && !pstr->offsets_needed)
- {
- while (byte_idx < end_idx)
- {
- wchar_t wc;
-
- if (isascii (pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx])
- && mbsinit (&pstr->cur_state))
- {
- /* In case of a singlebyte character. */
- pstr->mbs[byte_idx]
- = toupper (pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx]);
- /* The next step uses the assumption that wchar_t is encoded
- ASCII-safe: all ASCII values can be converted like this. */
- pstr->wcs[byte_idx] = (wchar_t) pstr->mbs[byte_idx];
- ++byte_idx;
- continue;
- }
-
- remain_len = end_idx - byte_idx;
- prev_st = pstr->cur_state;
- mbclen = mbrtowc (&wc,
- ((const char *) pstr->raw_mbs + pstr->raw_mbs_idx
- + byte_idx), remain_len, &pstr->cur_state);
- if (BE (mbclen + 2 > 2, 1))
- {
- wchar_t wcu = wc;
- if (iswlower (wc))
- {
- size_t mbcdlen;
-
- wcu = towupper (wc);
- mbcdlen = wcrtomb (buf, wcu, &prev_st);
- if (BE (mbclen == mbcdlen, 1))
- memcpy (pstr->mbs + byte_idx, buf, mbclen);
- else
- {
- src_idx = byte_idx;
- goto offsets_needed;
- }
- }
- else
- memcpy (pstr->mbs + byte_idx,
- pstr->raw_mbs + pstr->raw_mbs_idx + byte_idx, mbclen);
- pstr->wcs[byte_idx++] = wcu;
- /* Write paddings. */
- for (remain_len = byte_idx + mbclen - 1; byte_idx < remain_len ;)
- pstr->wcs[byte_idx++] = WEOF;
- }
- else if (mbclen == (size_t) -1 || mbclen == 0)
- {
- /* It is an invalid character or '\0'. Just use the byte. */
- int ch = pstr->raw_mbs[pstr->raw_mbs_idx + byte_idx];
- pstr->mbs[byte_idx] = ch;
- /* And also cast it to wide char. */
- pstr->wcs[byte_idx++] = (wchar_t) ch;
- if (BE (mbclen == (size_t) -1, 0))
- pstr->cur_state = prev_st;
- }
- else
- {
- /* The buffer doesn't have enough space, finish to build. */
- pstr->cur_state = prev_st;
- break;
- }
- }
- pstr->valid_len = byte_idx;
- pstr->valid_raw_len = byte_idx;
- return REG_NOERROR;
- }
- else
- for (src_idx = pstr->valid_raw_len; byte_idx < end_idx;)
- {
- wchar_t wc;
- const char *p;
- offsets_needed:
- remain_len = end_idx - byte_idx;
- prev_st = pstr->cur_state;
- if (BE (pstr->trans != NULL, 0))
- {
- int i, ch;
-
- for (i = 0; i < pstr->mb_cur_max && i < remain_len; ++i)
- {
- ch = pstr->raw_mbs [pstr->raw_mbs_idx + src_idx + i];
- buf[i] = pstr->trans[ch];
- }
- p = (const char *) buf;
- }
- else
- p = (const char *) pstr->raw_mbs + pstr->raw_mbs_idx + src_idx;
- mbclen = mbrtowc (&wc, p, remain_len, &pstr->cur_state);
- if (BE (mbclen + 2 > 2, 1))
- {
- wchar_t wcu = wc;
- if (iswlower (wc))
- {
- size_t mbcdlen;
-
- wcu = towupper (wc);
- mbcdlen = wcrtomb ((char *) buf, wcu, &prev_st);
- if (BE (mbclen == mbcdlen, 1))
- memcpy (pstr->mbs + byte_idx, buf, mbclen);
- else if (mbcdlen != (size_t) -1)
- {
- size_t i;
-
- if (byte_idx + mbcdlen > pstr->bufs_len)
- {
- pstr->cur_state = prev_st;
- break;
- }
-
- if (pstr->offsets == NULL)
- {
- pstr->offsets = re_malloc (int, pstr->bufs_len);
-
- if (pstr->offsets == NULL)
- return REG_ESPACE;
- }
- if (!pstr->offsets_needed)
- {
- for (i = 0; i < (size_t) byte_idx; ++i)
- pstr->offsets[i] = i;
- pstr->offsets_needed = 1;
- }
-
- memcpy (pstr->mbs + byte_idx, buf, mbcdlen);
- pstr->wcs[byte_idx] = wcu;
- pstr->offsets[byte_idx] = src_idx;
- for (i = 1; i < mbcdlen; ++i)
- {
- pstr->offsets[byte_idx + i]
- = src_idx + (i < mbclen ? i : mbclen - 1);
- pstr->wcs[byte_idx + i] = WEOF;
- }
- pstr->len += mbcdlen - mbclen;
- if (pstr->raw_stop > src_idx)
- pstr->stop += mbcdlen - mbclen;
- end_idx = (pstr->bufs_len > pstr->len)
- ? pstr->len : pstr->bufs_len;
- byte_idx += mbcdlen;
- src_idx += mbclen;
- continue;
- }
- else
- memcpy (pstr->mbs + byte_idx, p, mbclen);
- }
- else
- memcpy (pstr->mbs + byte_idx, p, mbclen);
-
- if (BE (pstr->offsets_needed != 0, 0))
- {
- size_t i;
- for (i = 0; i < mbclen; ++i)
- pstr->offsets[byte_idx + i] = src_idx + i;
- }
- src_idx += mbclen;
-
- pstr->wcs[byte_idx++] = wcu;
- /* Write paddings. */
- for (remain_len = byte_idx + mbclen - 1; byte_idx < remain_len ;)
- pstr->wcs[byte_idx++] = WEOF;
- }
- else if (mbclen == (size_t) -1 || mbclen == 0)
- {
- /* It is an invalid character or '\0'. Just use the byte. */
- int ch = pstr->raw_mbs[pstr->raw_mbs_idx + src_idx];
-
- if (BE (pstr->trans != NULL, 0))
- ch = pstr->trans [ch];
- pstr->mbs[byte_idx] = ch;
-
- if (BE (pstr->offsets_needed != 0, 0))
- pstr->offsets[byte_idx] = src_idx;
- ++src_idx;
-
- /* And also cast it to wide char. */
- pstr->wcs[byte_idx++] = (wchar_t) ch;
- if (BE (mbclen == (size_t) -1, 0))
- pstr->cur_state = prev_st;
- }
- else
- {
- /* The buffer doesn't have enough space, finish to build. */
- pstr->cur_state = prev_st;
- break;
- }
- }
- pstr->valid_len = byte_idx;
- pstr->valid_raw_len = src_idx;
- return REG_NOERROR;
-}
-
-/* Skip characters until the index becomes greater than NEW_RAW_IDX.
- Return the index. */
-
-static int
-internal_function
-re_string_skip_chars (re_string_t *pstr, int new_raw_idx, wint_t *last_wc)
-{
- mbstate_t prev_st;
- int rawbuf_idx;
- size_t mbclen;
- wchar_t wc = WEOF;
-
- /* Skip the characters which are not necessary to check. */
- for (rawbuf_idx = pstr->raw_mbs_idx + pstr->valid_raw_len;
- rawbuf_idx < new_raw_idx;)
- {
- int remain_len;
- remain_len = pstr->len - rawbuf_idx;
- prev_st = pstr->cur_state;
- mbclen = mbrtowc (&wc, (const char *) pstr->raw_mbs + rawbuf_idx,
- remain_len, &pstr->cur_state);
- if (BE (mbclen == (size_t) -2 || mbclen == (size_t) -1 || mbclen == 0, 0))
- {
- /* We treat these cases as a single byte character. */
- if (mbclen == 0 || remain_len == 0)
- wc = L'\0';
- else
- wc = *(unsigned char *) (pstr->raw_mbs + rawbuf_idx);
- mbclen = 1;
- pstr->cur_state = prev_st;
- }
- /* Then proceed the next character. */
- rawbuf_idx += mbclen;
- }
- *last_wc = (wint_t) wc;
- return rawbuf_idx;
-}
-#endif /* RE_ENABLE_I18N */
-
-/* Build the buffer PSTR->MBS, and apply the translation if we need.
- This function is used in case of REG_ICASE. */
-
-static void
-internal_function
-build_upper_buffer (re_string_t *pstr)
-{
- int char_idx, end_idx;
- end_idx = (pstr->bufs_len > pstr->len) ? pstr->len : pstr->bufs_len;
-
- for (char_idx = pstr->valid_len; char_idx < end_idx; ++char_idx)
- {
- int ch = pstr->raw_mbs[pstr->raw_mbs_idx + char_idx];
- if (BE (pstr->trans != NULL, 0))
- ch = pstr->trans[ch];
- if (islower (ch))
- pstr->mbs[char_idx] = toupper (ch);
- else
- pstr->mbs[char_idx] = ch;
- }
- pstr->valid_len = char_idx;
- pstr->valid_raw_len = char_idx;
-}
-
-/* Apply TRANS to the buffer in PSTR. */
-
-static void
-internal_function
-re_string_translate_buffer (re_string_t *pstr)
-{
- int buf_idx, end_idx;
- end_idx = (pstr->bufs_len > pstr->len) ? pstr->len : pstr->bufs_len;
-
- for (buf_idx = pstr->valid_len; buf_idx < end_idx; ++buf_idx)
- {
- int ch = pstr->raw_mbs[pstr->raw_mbs_idx + buf_idx];
- pstr->mbs[buf_idx] = pstr->trans[ch];
- }
-
- pstr->valid_len = buf_idx;
- pstr->valid_raw_len = buf_idx;
-}
-
-/* This function re-construct the buffers.
- Concretely, convert to wide character in case of pstr->mb_cur_max > 1,
- convert to upper case in case of REG_ICASE, apply translation. */
-
-static reg_errcode_t
-internal_function
-re_string_reconstruct (re_string_t *pstr, int idx, int eflags)
-{
- int offset = idx - pstr->raw_mbs_idx;
- if (BE (offset < 0, 0))
- {
- /* Reset buffer. */
-#ifdef RE_ENABLE_I18N
- if (pstr->mb_cur_max > 1)
- memset (&pstr->cur_state, '\0', sizeof (mbstate_t));
-#endif /* RE_ENABLE_I18N */
- pstr->len = pstr->raw_len;
- pstr->stop = pstr->raw_stop;
- pstr->valid_len = 0;
- pstr->raw_mbs_idx = 0;
- pstr->valid_raw_len = 0;
- pstr->offsets_needed = 0;
- pstr->tip_context = ((eflags & REG_NOTBOL) ? CONTEXT_BEGBUF
- : CONTEXT_NEWLINE | CONTEXT_BEGBUF);
- if (!pstr->mbs_allocated)
- pstr->mbs = (unsigned char *) pstr->raw_mbs;
- offset = idx;
- }
-
- if (BE (offset != 0, 1))
- {
- /* Should the already checked characters be kept? */
- if (BE (offset < pstr->valid_raw_len, 1))
- {
- /* Yes, move them to the front of the buffer. */
-#ifdef RE_ENABLE_I18N
- if (BE (pstr->offsets_needed, 0))
- {
- int low = 0, high = pstr->valid_len, mid;
- do
- {
- mid = (high + low) / 2;
- if (pstr->offsets[mid] > offset)
- high = mid;
- else if (pstr->offsets[mid] < offset)
- low = mid + 1;
- else
- break;
- }
- while (low < high);
- if (pstr->offsets[mid] < offset)
- ++mid;
- pstr->tip_context = re_string_context_at (pstr, mid - 1,
- eflags);
- /* This can be quite complicated, so handle specially
- only the common and easy case where the character with
- different length representation of lower and upper
- case is present at or after offset. */
- if (pstr->valid_len > offset
- && mid == offset && pstr->offsets[mid] == offset)
- {
- memmove (pstr->wcs, pstr->wcs + offset,
- (pstr->valid_len - offset) * sizeof (wint_t));
- memmove (pstr->mbs, pstr->mbs + offset, pstr->valid_len - offset);
- pstr->valid_len -= offset;
- pstr->valid_raw_len -= offset;
- for (low = 0; low < pstr->valid_len; low++)
- pstr->offsets[low] = pstr->offsets[low + offset] - offset;
- }
- else
- {
- /* Otherwise, just find out how long the partial multibyte
- character at offset is and fill it with WEOF/255. */
- pstr->len = pstr->raw_len - idx + offset;
- pstr->stop = pstr->raw_stop - idx + offset;
- pstr->offsets_needed = 0;
- while (mid > 0 && pstr->offsets[mid - 1] == offset)
- --mid;
- while (mid < pstr->valid_len)
- if (pstr->wcs[mid] != WEOF)
- break;
- else
- ++mid;
- if (mid == pstr->valid_len)
- pstr->valid_len = 0;
- else
- {
- pstr->valid_len = pstr->offsets[mid] - offset;
- if (pstr->valid_len)
- {
- for (low = 0; low < pstr->valid_len; ++low)
- pstr->wcs[low] = WEOF;
- memset (pstr->mbs, 255, pstr->valid_len);
- }
- }
- pstr->valid_raw_len = pstr->valid_len;
- }
- }
- else
-#endif
- {
- pstr->tip_context = re_string_context_at (pstr, offset - 1,
- eflags);
-#ifdef RE_ENABLE_I18N
- if (pstr->mb_cur_max > 1)
- memmove (pstr->wcs, pstr->wcs + offset,
- (pstr->valid_len - offset) * sizeof (wint_t));
-#endif /* RE_ENABLE_I18N */
- if (BE (pstr->mbs_allocated, 0))
- memmove (pstr->mbs, pstr->mbs + offset,
- pstr->valid_len - offset);
- pstr->valid_len -= offset;
- pstr->valid_raw_len -= offset;
-#if DEBUG
- assert (pstr->valid_len > 0);
-#endif
- }
- }
- else
- {
-#ifdef RE_ENABLE_I18N
- /* No, skip all characters until IDX. */
- int prev_valid_len = pstr->valid_len;
-
- if (BE (pstr->offsets_needed, 0))
- {
- pstr->len = pstr->raw_len - idx + offset;
- pstr->stop = pstr->raw_stop - idx + offset;
- pstr->offsets_needed = 0;
- }
-#endif
- pstr->valid_len = 0;
-#ifdef RE_ENABLE_I18N
- if (pstr->mb_cur_max > 1)
- {
- int wcs_idx;
- wint_t wc = WEOF;
-
- if (pstr->is_utf8)
- {
- const unsigned char *raw, *p, *q, *end;
-
- /* Special case UTF-8. Multi-byte chars start with any
- byte other than 0x80 - 0xbf. */
- raw = pstr->raw_mbs + pstr->raw_mbs_idx;
- end = raw + (offset - pstr->mb_cur_max);
- if (end < pstr->raw_mbs)
- end = pstr->raw_mbs;
- p = raw + offset - 1;
-#ifdef _LIBC
- /* We know the wchar_t encoding is UCS4, so for the simple
- case, ASCII characters, skip the conversion step. */
- if (isascii (*p) && BE (pstr->trans == NULL, 1))
- {
- memset (&pstr->cur_state, '\0', sizeof (mbstate_t));
- /* pstr->valid_len = 0; */
- wc = (wchar_t) *p;
- }
- else
-#endif
- for (; p >= end; --p)
- if ((*p & 0xc0) != 0x80)
- {
- mbstate_t cur_state;
- wchar_t wc2;
- int mlen = raw + pstr->len - p;
- unsigned char buf[6];
- size_t mbclen;
-
- q = p;
- if (BE (pstr->trans != NULL, 0))
- {
- int i = mlen < 6 ? mlen : 6;
- while (--i >= 0)
- buf[i] = pstr->trans[p[i]];
- q = buf;
- }
- /* XXX Don't use mbrtowc, we know which conversion
- to use (UTF-8 -> UCS4). */
- memset (&cur_state, 0, sizeof (cur_state));
- mbclen = mbrtowc (&wc2, (const char *) p, mlen,
- &cur_state);
- if (raw + offset - p <= mbclen
- && mbclen < (size_t) -2)
- {
- memset (&pstr->cur_state, '\0',
- sizeof (mbstate_t));
- pstr->valid_len = mbclen - (raw + offset - p);
- wc = wc2;
- }
- break;
- }
- }
-
- if (wc == WEOF)
- pstr->valid_len = re_string_skip_chars (pstr, idx, &wc) - idx;
- if (wc == WEOF)
- pstr->tip_context
- = re_string_context_at (pstr, prev_valid_len - 1, eflags);
- else
- pstr->tip_context = ((BE (pstr->word_ops_used != 0, 0)
- && IS_WIDE_WORD_CHAR (wc))
- ? CONTEXT_WORD
- : ((IS_WIDE_NEWLINE (wc)
- && pstr->newline_anchor)
- ? CONTEXT_NEWLINE : 0));
- if (BE (pstr->valid_len, 0))
- {
- for (wcs_idx = 0; wcs_idx < pstr->valid_len; ++wcs_idx)
- pstr->wcs[wcs_idx] = WEOF;
- if (pstr->mbs_allocated)
- memset (pstr->mbs, 255, pstr->valid_len);
- }
- pstr->valid_raw_len = pstr->valid_len;
- }
- else
-#endif /* RE_ENABLE_I18N */
- {
- int c = pstr->raw_mbs[pstr->raw_mbs_idx + offset - 1];
- pstr->valid_raw_len = 0;
- if (pstr->trans)
- c = pstr->trans[c];
- pstr->tip_context = (bitset_contain (pstr->word_char, c)
- ? CONTEXT_WORD
- : ((IS_NEWLINE (c) && pstr->newline_anchor)
- ? CONTEXT_NEWLINE : 0));
- }
- }
- if (!BE (pstr->mbs_allocated, 0))
- pstr->mbs += offset;
- }
- pstr->raw_mbs_idx = idx;
- pstr->len -= offset;
- pstr->stop -= offset;
-
- /* Then build the buffers. */
-#ifdef RE_ENABLE_I18N
- if (pstr->mb_cur_max > 1)
- {
- if (pstr->icase)
- {
- reg_errcode_t ret = build_wcs_upper_buffer (pstr);
- if (BE (ret != REG_NOERROR, 0))
- return ret;
- }
- else
- build_wcs_buffer (pstr);
- }
- else
-#endif /* RE_ENABLE_I18N */
- if (BE (pstr->mbs_allocated, 0))
- {
- if (pstr->icase)
- build_upper_buffer (pstr);
- else if (pstr->trans != NULL)
- re_string_translate_buffer (pstr);
- }
- else
- pstr->valid_len = pstr->len;
-
- pstr->cur_idx = 0;
- return REG_NOERROR;
-}
-
-static unsigned char
-internal_function __attribute ((pure))
-re_string_peek_byte_case (const re_string_t *pstr, int idx)
-{
- int ch, off;
-
- /* Handle the common (easiest) cases first. */
- if (BE (!pstr->mbs_allocated, 1))
- return re_string_peek_byte (pstr, idx);
-
-#ifdef RE_ENABLE_I18N
- if (pstr->mb_cur_max > 1
- && ! re_string_is_single_byte_char (pstr, pstr->cur_idx + idx))
- return re_string_peek_byte (pstr, idx);
-#endif
-
- off = pstr->cur_idx + idx;
-#ifdef RE_ENABLE_I18N
- if (pstr->offsets_needed)
- off = pstr->offsets[off];
-#endif
-
- ch = pstr->raw_mbs[pstr->raw_mbs_idx + off];
-
-#ifdef RE_ENABLE_I18N
- /* Ensure that e.g. for tr_TR.UTF-8 BACKSLASH DOTLESS SMALL LETTER I
- this function returns CAPITAL LETTER I instead of first byte of
- DOTLESS SMALL LETTER I. The latter would confuse the parser,
- since peek_byte_case doesn't advance cur_idx in any way. */
- if (pstr->offsets_needed && !isascii (ch))
- return re_string_peek_byte (pstr, idx);
-#endif
-
- return ch;
-}
-
-static unsigned char
-internal_function __attribute ((pure))
-re_string_fetch_byte_case (re_string_t *pstr)
-{
- if (BE (!pstr->mbs_allocated, 1))
- return re_string_fetch_byte (pstr);
-
-#ifdef RE_ENABLE_I18N
- if (pstr->offsets_needed)
- {
- int off, ch;
-
- /* For tr_TR.UTF-8 [[:islower:]] there is
- [[: CAPITAL LETTER I WITH DOT lower:]] in mbs. Skip
- in that case the whole multi-byte character and return
- the original letter. On the other side, with
- [[: DOTLESS SMALL LETTER I return [[:I, as doing
- anything else would complicate things too much. */
-
- if (!re_string_first_byte (pstr, pstr->cur_idx))
- return re_string_fetch_byte (pstr);
-
- off = pstr->offsets[pstr->cur_idx];
- ch = pstr->raw_mbs[pstr->raw_mbs_idx + off];
-
- if (! isascii (ch))
- return re_string_fetch_byte (pstr);
-
- re_string_skip_bytes (pstr,
- re_string_char_size_at (pstr, pstr->cur_idx));
- return ch;
- }
-#endif
-
- return pstr->raw_mbs[pstr->raw_mbs_idx + pstr->cur_idx++];
-}
-
-static void
-internal_function
-re_string_destruct (re_string_t *pstr)
-{
-#ifdef RE_ENABLE_I18N
- re_free (pstr->wcs);
- re_free (pstr->offsets);
-#endif /* RE_ENABLE_I18N */
- if (pstr->mbs_allocated)
- re_free (pstr->mbs);
-}
-
-/* Return the context at IDX in INPUT. */
-
-static unsigned int
-internal_function
-re_string_context_at (const re_string_t *input, int idx, int eflags)
-{
- int c;
- if (BE (idx < 0, 0))
- /* In this case, we use the value stored in input->tip_context,
- since we can't know the character in input->mbs[-1] here. */
- return input->tip_context;
- if (BE (idx == input->len, 0))
- return ((eflags & REG_NOTEOL) ? CONTEXT_ENDBUF
- : CONTEXT_NEWLINE | CONTEXT_ENDBUF);
-#ifdef RE_ENABLE_I18N
- if (input->mb_cur_max > 1)
- {
- wint_t wc;
- int wc_idx = idx;
- while(input->wcs[wc_idx] == WEOF)
- {
-#ifdef DEBUG
- /* It must not happen. */
- assert (wc_idx >= 0);
-#endif
- --wc_idx;
- if (wc_idx < 0)
- return input->tip_context;
- }
- wc = input->wcs[wc_idx];
- if (BE (input->word_ops_used != 0, 0) && IS_WIDE_WORD_CHAR (wc))
- return CONTEXT_WORD;
- return (IS_WIDE_NEWLINE (wc) && input->newline_anchor
- ? CONTEXT_NEWLINE : 0);
- }
- else
-#endif
- {
- c = re_string_byte_at (input, idx);
- if (bitset_contain (input->word_char, c))
- return CONTEXT_WORD;
- return IS_NEWLINE (c) && input->newline_anchor ? CONTEXT_NEWLINE : 0;
- }
-}
-
-/* Functions for set operation. */
-
-static reg_errcode_t
-internal_function
-re_node_set_alloc (re_node_set *set, int size)
-{
- set->alloc = size;
- set->nelem = 0;
- set->elems = re_malloc (int, size);
- if (BE (set->elems == NULL, 0))
- return REG_ESPACE;
- return REG_NOERROR;
-}
-
-static reg_errcode_t
-internal_function
-re_node_set_init_1 (re_node_set *set, int elem)
-{
- set->alloc = 1;
- set->nelem = 1;
- set->elems = re_malloc (int, 1);
- if (BE (set->elems == NULL, 0))
- {
- set->alloc = set->nelem = 0;
- return REG_ESPACE;
- }
- set->elems[0] = elem;
- return REG_NOERROR;
-}
-
-static reg_errcode_t
-internal_function
-re_node_set_init_2 (re_node_set *set, int elem1, int elem2)
-{
- set->alloc = 2;
- set->elems = re_malloc (int, 2);
- if (BE (set->elems == NULL, 0))
- return REG_ESPACE;
- if (elem1 == elem2)
- {
- set->nelem = 1;
- set->elems[0] = elem1;
- }
- else
- {
- set->nelem = 2;
- if (elem1 < elem2)
- {
- set->elems[0] = elem1;
- set->elems[1] = elem2;
- }
- else
- {
- set->elems[0] = elem2;
- set->elems[1] = elem1;
- }
- }
- return REG_NOERROR;
-}
-
-static reg_errcode_t
-internal_function
-re_node_set_init_copy (re_node_set *dest, const re_node_set *src)
-{
- dest->nelem = src->nelem;
- if (src->nelem > 0)
- {
- dest->alloc = dest->nelem;
- dest->elems = re_malloc (int, dest->alloc);
- if (BE (dest->elems == NULL, 0))
- {
- dest->alloc = dest->nelem = 0;
- return REG_ESPACE;
- }
- memcpy (dest->elems, src->elems, src->nelem * sizeof (int));
- }
- else
- re_node_set_init_empty (dest);
- return REG_NOERROR;
-}
-
-/* Calculate the intersection of the sets SRC1 and SRC2. And merge it to
- DEST. Return value indicate the error code or REG_NOERROR if succeeded.
- Note: We assume dest->elems is NULL, when dest->alloc is 0. */
-
-static reg_errcode_t
-internal_function
-re_node_set_add_intersect (re_node_set *dest, const re_node_set *src1,
- const re_node_set *src2)
-{
- int i1, i2, is, id, delta, sbase;
- if (src1->nelem == 0 || src2->nelem == 0)
- return REG_NOERROR;
-
- /* We need dest->nelem + 2 * elems_in_intersection; this is a
- conservative estimate. */
- if (src1->nelem + src2->nelem + dest->nelem > dest->alloc)
- {
- int new_alloc = src1->nelem + src2->nelem + dest->alloc;
- int *new_elems = re_realloc (dest->elems, int, new_alloc);
- if (BE (new_elems == NULL, 0))
- return REG_ESPACE;
- dest->elems = new_elems;
- dest->alloc = new_alloc;
- }
-
- /* Find the items in the intersection of SRC1 and SRC2, and copy
- into the top of DEST those that are not already in DEST itself. */
- sbase = dest->nelem + src1->nelem + src2->nelem;
- i1 = src1->nelem - 1;
- i2 = src2->nelem - 1;
- id = dest->nelem - 1;
- for (;;)
- {
- if (src1->elems[i1] == src2->elems[i2])
- {
- /* Try to find the item in DEST. Maybe we could binary search? */
- while (id >= 0 && dest->elems[id] > src1->elems[i1])
- --id;
-
- if (id < 0 || dest->elems[id] != src1->elems[i1])
- dest->elems[--sbase] = src1->elems[i1];
-
- if (--i1 < 0 || --i2 < 0)
- break;
- }
-
- /* Lower the highest of the two items. */
- else if (src1->elems[i1] < src2->elems[i2])
- {
- if (--i2 < 0)
- break;
- }
- else
- {
- if (--i1 < 0)
- break;
- }
- }
-
- id = dest->nelem - 1;
- is = dest->nelem + src1->nelem + src2->nelem - 1;
- delta = is - sbase + 1;
-
- /* Now copy. When DELTA becomes zero, the remaining
- DEST elements are already in place; this is more or
- less the same loop that is in re_node_set_merge. */
- dest->nelem += delta;
- if (delta > 0 && id >= 0)
- for (;;)
- {
- if (dest->elems[is] > dest->elems[id])
- {
- /* Copy from the top. */
- dest->elems[id + delta--] = dest->elems[is--];
- if (delta == 0)
- break;
- }
- else
- {
- /* Slide from the bottom. */
- dest->elems[id + delta] = dest->elems[id];
- if (--id < 0)
- break;
- }
- }
-
- /* Copy remaining SRC elements. */
- memcpy (dest->elems, dest->elems + sbase, delta * sizeof (int));
-
- return REG_NOERROR;
-}
-
-/* Calculate the union set of the sets SRC1 and SRC2. And store it to
- DEST. Return value indicate the error code or REG_NOERROR if succeeded. */
-
-static reg_errcode_t
-internal_function
-re_node_set_init_union (re_node_set *dest, const re_node_set *src1,
- const re_node_set *src2)
-{
- int i1, i2, id;
- if (src1 != NULL && src1->nelem > 0 && src2 != NULL && src2->nelem > 0)
- {
- dest->alloc = src1->nelem + src2->nelem;
- dest->elems = re_malloc (int, dest->alloc);
- if (BE (dest->elems == NULL, 0))
- return REG_ESPACE;
- }
- else
- {
- if (src1 != NULL && src1->nelem > 0)
- return re_node_set_init_copy (dest, src1);
- else if (src2 != NULL && src2->nelem > 0)
- return re_node_set_init_copy (dest, src2);
- else
- re_node_set_init_empty (dest);
- return REG_NOERROR;
- }
- for (i1 = i2 = id = 0 ; i1 < src1->nelem && i2 < src2->nelem ;)
- {
- if (src1->elems[i1] > src2->elems[i2])
- {
- dest->elems[id++] = src2->elems[i2++];
- continue;
- }
- if (src1->elems[i1] == src2->elems[i2])
- ++i2;
- dest->elems[id++] = src1->elems[i1++];
- }
- if (i1 < src1->nelem)
- {
- memcpy (dest->elems + id, src1->elems + i1,
- (src1->nelem - i1) * sizeof (int));
- id += src1->nelem - i1;
- }
- else if (i2 < src2->nelem)
- {
- memcpy (dest->elems + id, src2->elems + i2,
- (src2->nelem - i2) * sizeof (int));
- id += src2->nelem - i2;
- }
- dest->nelem = id;
- return REG_NOERROR;
-}
-
-/* Calculate the union set of the sets DEST and SRC. And store it to
- DEST. Return value indicate the error code or REG_NOERROR if succeeded. */
-
-static reg_errcode_t
-internal_function
-re_node_set_merge (re_node_set *dest, const re_node_set *src)
-{
- int is, id, sbase, delta;
- if (src == NULL || src->nelem == 0)
- return REG_NOERROR;
- if (dest->alloc < 2 * src->nelem + dest->nelem)
- {
- int new_alloc = 2 * (src->nelem + dest->alloc);
- int *new_buffer = re_realloc (dest->elems, int, new_alloc);
- if (BE (new_buffer == NULL, 0))
- return REG_ESPACE;
- dest->elems = new_buffer;
- dest->alloc = new_alloc;
- }
-
- if (BE (dest->nelem == 0, 0))
- {
- dest->nelem = src->nelem;
- memcpy (dest->elems, src->elems, src->nelem * sizeof (int));
- return REG_NOERROR;
- }
-
- /* Copy into the top of DEST the items of SRC that are not
- found in DEST. Maybe we could binary search in DEST? */
- for (sbase = dest->nelem + 2 * src->nelem,
- is = src->nelem - 1, id = dest->nelem - 1; is >= 0 && id >= 0; )
- {
- if (dest->elems[id] == src->elems[is])
- is--, id--;
- else if (dest->elems[id] < src->elems[is])
- dest->elems[--sbase] = src->elems[is--];
- else /* if (dest->elems[id] > src->elems[is]) */
- --id;
- }
-
- if (is >= 0)
- {
- /* If DEST is exhausted, the remaining items of SRC must be unique. */
- sbase -= is + 1;
- memcpy (dest->elems + sbase, src->elems, (is + 1) * sizeof (int));
- }
-
- id = dest->nelem - 1;
- is = dest->nelem + 2 * src->nelem - 1;
- delta = is - sbase + 1;
- if (delta == 0)
- return REG_NOERROR;
-
- /* Now copy. When DELTA becomes zero, the remaining
- DEST elements are already in place. */
- dest->nelem += delta;
- for (;;)
- {
- if (dest->elems[is] > dest->elems[id])
- {
- /* Copy from the top. */
- dest->elems[id + delta--] = dest->elems[is--];
- if (delta == 0)
- break;
- }
- else
- {
- /* Slide from the bottom. */
- dest->elems[id + delta] = dest->elems[id];
- if (--id < 0)
- {
- /* Copy remaining SRC elements. */
- memcpy (dest->elems, dest->elems + sbase,
- delta * sizeof (int));
- break;
- }
- }
- }
-
- return REG_NOERROR;
-}
-
-/* Insert the new element ELEM to the re_node_set* SET.
- SET should not already have ELEM.
- return -1 if an error is occured, return 1 otherwise. */
-
-static int
-internal_function
-re_node_set_insert (re_node_set *set, int elem)
-{
- int idx;
- /* In case the set is empty. */
- if (set->alloc == 0)
- {
- if (BE (re_node_set_init_1 (set, elem) == REG_NOERROR, 1))
- return 1;
- else
- return -1;
- }
-
- if (BE (set->nelem, 0) == 0)
- {
- /* We already guaranteed above that set->alloc != 0. */
- set->elems[0] = elem;
- ++set->nelem;
- return 1;
- }
-
- /* Realloc if we need. */
- if (set->alloc == set->nelem)
- {
- int *new_elems;
- set->alloc = set->alloc * 2;
- new_elems = re_realloc (set->elems, int, set->alloc);
- if (BE (new_elems == NULL, 0))
- return -1;
- set->elems = new_elems;
- }
-
- /* Move the elements which follows the new element. Test the
- first element separately to skip a check in the inner loop. */
- if (elem < set->elems[0])
- {
- idx = 0;
- for (idx = set->nelem; idx > 0; idx--)
- set->elems[idx] = set->elems[idx - 1];
- }
- else
- {
- for (idx = set->nelem; set->elems[idx - 1] > elem; idx--)
- set->elems[idx] = set->elems[idx - 1];
- }
-
- /* Insert the new element. */
- set->elems[idx] = elem;
- ++set->nelem;
- return 1;
-}
-
-/* Insert the new element ELEM to the re_node_set* SET.
- SET should not already have any element greater than or equal to ELEM.
- Return -1 if an error is occured, return 1 otherwise. */
-
-static int
-internal_function
-re_node_set_insert_last (re_node_set *set, int elem)
-{
- /* Realloc if we need. */
- if (set->alloc == set->nelem)
- {
- int *new_elems;
- set->alloc = (set->alloc + 1) * 2;
- new_elems = re_realloc (set->elems, int, set->alloc);
- if (BE (new_elems == NULL, 0))
- return -1;
- set->elems = new_elems;
- }
-
- /* Insert the new element. */
- set->elems[set->nelem++] = elem;
- return 1;
-}
-
-/* Compare two node sets SET1 and SET2.
- return 1 if SET1 and SET2 are equivalent, return 0 otherwise. */
-
-static int
-internal_function __attribute ((pure))
-re_node_set_compare (const re_node_set *set1, const re_node_set *set2)
-{
- int i;
- if (set1 == NULL || set2 == NULL || set1->nelem != set2->nelem)
- return 0;
- for (i = set1->nelem ; --i >= 0 ; )
- if (set1->elems[i] != set2->elems[i])
- return 0;
- return 1;
-}
-
-/* Return (idx + 1) if SET contains the element ELEM, return 0 otherwise. */
-
-static int
-internal_function __attribute ((pure))
-re_node_set_contains (const re_node_set *set, int elem)
-{
- unsigned int idx, right, mid;
- if (set->nelem <= 0)
- return 0;
-
- /* Binary search the element. */
- idx = 0;
- right = set->nelem - 1;
- while (idx < right)
- {
- mid = (idx + right) / 2;
- if (set->elems[mid] < elem)
- idx = mid + 1;
- else
- right = mid;
- }
- return set->elems[idx] == elem ? idx + 1 : 0;
-}
-
-static void
-internal_function
-re_node_set_remove_at (re_node_set *set, int idx)
-{
- if (idx < 0 || idx >= set->nelem)
- return;
- --set->nelem;
- for (; idx < set->nelem; idx++)
- set->elems[idx] = set->elems[idx + 1];
-}
-
-
-/* Add the token TOKEN to dfa->nodes, and return the index of the token.
- Or return -1, if an error will be occured. */
-
-static int
-internal_function
-re_dfa_add_node (re_dfa_t *dfa, re_token_t token)
-{
-#ifdef RE_ENABLE_I18N
- int type = token.type;
-#endif
- if (BE (dfa->nodes_len >= dfa->nodes_alloc, 0))
- {
- size_t new_nodes_alloc = dfa->nodes_alloc * 2;
- int *new_nexts, *new_indices;
- re_node_set *new_edests, *new_eclosures;
- re_token_t *new_nodes;
-
- /* Avoid overflows. */
- if (BE (new_nodes_alloc < dfa->nodes_alloc, 0))
- return -1;
-
- new_nodes = re_realloc (dfa->nodes, re_token_t, new_nodes_alloc);
- if (BE (new_nodes == NULL, 0))
- return -1;
- dfa->nodes = new_nodes;
- new_nexts = re_realloc (dfa->nexts, int, new_nodes_alloc);
- new_indices = re_realloc (dfa->org_indices, int, new_nodes_alloc);
- new_edests = re_realloc (dfa->edests, re_node_set, new_nodes_alloc);
- new_eclosures = re_realloc (dfa->eclosures, re_node_set, new_nodes_alloc);
- if (BE (new_nexts == NULL || new_indices == NULL
- || new_edests == NULL || new_eclosures == NULL, 0))
- return -1;
- dfa->nexts = new_nexts;
- dfa->org_indices = new_indices;
- dfa->edests = new_edests;
- dfa->eclosures = new_eclosures;
- dfa->nodes_alloc = new_nodes_alloc;
- }
- dfa->nodes[dfa->nodes_len] = token;
- dfa->nodes[dfa->nodes_len].constraint = 0;
-#ifdef RE_ENABLE_I18N
- dfa->nodes[dfa->nodes_len].accept_mb =
- (type == OP_PERIOD && dfa->mb_cur_max > 1) || type == COMPLEX_BRACKET;
-#endif
- dfa->nexts[dfa->nodes_len] = -1;
- re_node_set_init_empty (dfa->edests + dfa->nodes_len);
- re_node_set_init_empty (dfa->eclosures + dfa->nodes_len);
- return dfa->nodes_len++;
-}
-
-static inline unsigned int
-internal_function
-calc_state_hash (const re_node_set *nodes, unsigned int context)
-{
- unsigned int hash = nodes->nelem + context;
- int i;
- for (i = 0 ; i < nodes->nelem ; i++)
- hash += nodes->elems[i];
- return hash;
-}
-
-/* Search for the state whose node_set is equivalent to NODES.
- Return the pointer to the state, if we found it in the DFA.
- Otherwise create the new one and return it. In case of an error
- return NULL and set the error code in ERR.
- Note: - We assume NULL as the invalid state, then it is possible that
- return value is NULL and ERR is REG_NOERROR.
- - We never return non-NULL value in case of any errors, it is for
- optimization. */
-
-static re_dfastate_t *
-internal_function
-re_acquire_state (reg_errcode_t *err, const re_dfa_t *dfa,
- const re_node_set *nodes)
-{
- unsigned int hash;
- re_dfastate_t *new_state;
- struct re_state_table_entry *spot;
- int i;
- if (BE (nodes->nelem == 0, 0))
- {
- *err = REG_NOERROR;
- return NULL;
- }
- hash = calc_state_hash (nodes, 0);
- spot = dfa->state_table + (hash & dfa->state_hash_mask);
-
- for (i = 0 ; i < spot->num ; i++)
- {
- re_dfastate_t *state = spot->array[i];
- if (hash != state->hash)
- continue;
- if (re_node_set_compare (&state->nodes, nodes))
- return state;
- }
-
- /* There are no appropriate state in the dfa, create the new one. */
- new_state = create_ci_newstate (dfa, nodes, hash);
- if (BE (new_state == NULL, 0))
- *err = REG_ESPACE;
-
- return new_state;
-}
-
-/* Search for the state whose node_set is equivalent to NODES and
- whose context is equivalent to CONTEXT.
- Return the pointer to the state, if we found it in the DFA.
- Otherwise create the new one and return it. In case of an error
- return NULL and set the error code in ERR.
- Note: - We assume NULL as the invalid state, then it is possible that
- return value is NULL and ERR is REG_NOERROR.
- - We never return non-NULL value in case of any errors, it is for
- optimization. */
-
-static re_dfastate_t *
-internal_function
-re_acquire_state_context (reg_errcode_t *err, const re_dfa_t *dfa,
- const re_node_set *nodes, unsigned int context)
-{
- unsigned int hash;
- re_dfastate_t *new_state;
- struct re_state_table_entry *spot;
- int i;
- if (nodes->nelem == 0)
- {
- *err = REG_NOERROR;
- return NULL;
- }
- hash = calc_state_hash (nodes, context);
- spot = dfa->state_table + (hash & dfa->state_hash_mask);
-
- for (i = 0 ; i < spot->num ; i++)
- {
- re_dfastate_t *state = spot->array[i];
- if (state->hash == hash
- && state->context == context
- && re_node_set_compare (state->entrance_nodes, nodes))
- return state;
- }
- /* There are no appropriate state in `dfa', create the new one. */
- new_state = create_cd_newstate (dfa, nodes, context, hash);
- if (BE (new_state == NULL, 0))
- *err = REG_ESPACE;
-
- return new_state;
-}
-
-/* Finish initialization of the new state NEWSTATE, and using its hash value
- HASH put in the appropriate bucket of DFA's state table. Return value
- indicates the error code if failed. */
-
-static reg_errcode_t
-register_state (const re_dfa_t *dfa, re_dfastate_t *newstate,
- unsigned int hash)
-{
- struct re_state_table_entry *spot;
- reg_errcode_t err;
- int i;
-
- newstate->hash = hash;
- err = re_node_set_alloc (&newstate->non_eps_nodes, newstate->nodes.nelem);
- if (BE (err != REG_NOERROR, 0))
- return REG_ESPACE;
- for (i = 0; i < newstate->nodes.nelem; i++)
- {
- int elem = newstate->nodes.elems[i];
- if (!IS_EPSILON_NODE (dfa->nodes[elem].type))
- re_node_set_insert_last (&newstate->non_eps_nodes, elem);
- }
-
- spot = dfa->state_table + (hash & dfa->state_hash_mask);
- if (BE (spot->alloc <= spot->num, 0))
- {
- int new_alloc = 2 * spot->num + 2;
- re_dfastate_t **new_array = re_realloc (spot->array, re_dfastate_t *,
- new_alloc);
- if (BE (new_array == NULL, 0))
- return REG_ESPACE;
- spot->array = new_array;
- spot->alloc = new_alloc;
- }
- spot->array[spot->num++] = newstate;
- return REG_NOERROR;
-}
-
-static void
-free_state (re_dfastate_t *state)
-{
- re_node_set_free (&state->non_eps_nodes);
- re_node_set_free (&state->inveclosure);
- if (state->entrance_nodes != &state->nodes)
- {
- re_node_set_free (state->entrance_nodes);
- re_free (state->entrance_nodes);
- }
- re_node_set_free (&state->nodes);
- re_free (state->word_trtable);
- re_free (state->trtable);
- re_free (state);
-}
-
-/* Create the new state which is independ of contexts.
- Return the new state if succeeded, otherwise return NULL. */
-
-static re_dfastate_t *
-internal_function
-create_ci_newstate (const re_dfa_t *dfa, const re_node_set *nodes,
- unsigned int hash)
-{
- int i;
- reg_errcode_t err;
- re_dfastate_t *newstate;
-
- newstate = (re_dfastate_t *) calloc (sizeof (re_dfastate_t), 1);
- if (BE (newstate == NULL, 0))
- return NULL;
- err = re_node_set_init_copy (&newstate->nodes, nodes);
- if (BE (err != REG_NOERROR, 0))
- {
- re_free (newstate);
- return NULL;
- }
-
- newstate->entrance_nodes = &newstate->nodes;
- for (i = 0 ; i < nodes->nelem ; i++)
- {
- re_token_t *node = dfa->nodes + nodes->elems[i];
- re_token_type_t type = node->type;
- if (type == CHARACTER && !node->constraint)
- continue;
-#ifdef RE_ENABLE_I18N
- newstate->accept_mb |= node->accept_mb;
-#endif /* RE_ENABLE_I18N */
-
- /* If the state has the halt node, the state is a halt state. */
- if (type == END_OF_RE)
- newstate->halt = 1;
- else if (type == OP_BACK_REF)
- newstate->has_backref = 1;
- else if (type == ANCHOR || node->constraint)
- newstate->has_constraint = 1;
- }
- err = register_state (dfa, newstate, hash);
- if (BE (err != REG_NOERROR, 0))
- {
- free_state (newstate);
- newstate = NULL;
- }
- return newstate;
-}
-
-/* Create the new state which is depend on the context CONTEXT.
- Return the new state if succeeded, otherwise return NULL. */
-
-static re_dfastate_t *
-internal_function
-create_cd_newstate (const re_dfa_t *dfa, const re_node_set *nodes,
- unsigned int context, unsigned int hash)
-{
- int i, nctx_nodes = 0;
- reg_errcode_t err;
- re_dfastate_t *newstate;
-
- newstate = (re_dfastate_t *) calloc (sizeof (re_dfastate_t), 1);
- if (BE (newstate == NULL, 0))
- return NULL;
- err = re_node_set_init_copy (&newstate->nodes, nodes);
- if (BE (err != REG_NOERROR, 0))
- {
- re_free (newstate);
- return NULL;
- }
-
- newstate->context = context;
- newstate->entrance_nodes = &newstate->nodes;
-
- for (i = 0 ; i < nodes->nelem ; i++)
- {
- unsigned int constraint = 0;
- re_token_t *node = dfa->nodes + nodes->elems[i];
- re_token_type_t type = node->type;
- if (node->constraint)
- constraint = node->constraint;
-
- if (type == CHARACTER && !constraint)
- continue;
-#ifdef RE_ENABLE_I18N
- newstate->accept_mb |= node->accept_mb;
-#endif /* RE_ENABLE_I18N */
-
- /* If the state has the halt node, the state is a halt state. */
- if (type == END_OF_RE)
- newstate->halt = 1;
- else if (type == OP_BACK_REF)
- newstate->has_backref = 1;
- else if (type == ANCHOR)
- constraint = node->opr.ctx_type;
-
- if (constraint)
- {
- if (newstate->entrance_nodes == &newstate->nodes)
- {
- newstate->entrance_nodes = re_malloc (re_node_set, 1);
- if (BE (newstate->entrance_nodes == NULL, 0))
- {
- free_state (newstate);
- return NULL;
- }
- re_node_set_init_copy (newstate->entrance_nodes, nodes);
- nctx_nodes = 0;
- newstate->has_constraint = 1;
- }
-
- if (NOT_SATISFY_PREV_CONSTRAINT (constraint,context))
- {
- re_node_set_remove_at (&newstate->nodes, i - nctx_nodes);
- ++nctx_nodes;
- }
- }
- }
- err = register_state (dfa, newstate, hash);
- if (BE (err != REG_NOERROR, 0))
- {
- free_state (newstate);
- newstate = NULL;
- }
- return newstate;
-}
diff --git a/Build/source/texk/web2c/pdftexdir/regex/regex_internal.h b/Build/source/texk/web2c/pdftexdir/regex/regex_internal.h
deleted file mode 100644
index 6b6abca9e6d..00000000000
--- a/Build/source/texk/web2c/pdftexdir/regex/regex_internal.h
+++ /dev/null
@@ -1,781 +0,0 @@
-/* Extended regular expression matching and search library.
- Copyright (C) 2017 Karl Berry <tex-live@tug.org>
- Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
- This file is part of the GNU C Library.
- Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
-
- The GNU C Library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- The GNU C Library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with the GNU C Library; if not, write to the Free
- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
- 02111-1307 USA. */
-
-#ifndef _REGEX_INTERNAL_H
-#define _REGEX_INTERNAL_H 1
-
-#include <assert.h>
-#include <ctype.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-#if defined(__MINGW32_VERSION) || defined(_MSC_VER)
-#define strcasecmp stricmp
-#endif
-
-#if defined HAVE_LANGINFO_H || defined HAVE_LANGINFO_CODESET || defined _LIBC
-# include <langinfo.h>
-#endif
-#if defined HAVE_LOCALE_H || defined _LIBC
-# include <locale.h>
-#endif
-#if defined HAVE_WCHAR_H || defined _LIBC
-# include <wchar.h>
-#endif /* HAVE_WCHAR_H || _LIBC */
-#if defined HAVE_WCTYPE_H || defined _LIBC
-# include <wctype.h>
-#endif /* HAVE_WCTYPE_H || _LIBC */
-#if defined HAVE_STDBOOL_H || defined _LIBC
-# include <stdbool.h>
-#else
-typedef enum { false, true } bool;
-#endif /* HAVE_STDBOOL_H || _LIBC */
-#if defined HAVE_STDINT_H || defined _LIBC
-# include <stdint.h>
-#endif /* HAVE_STDINT_H || _LIBC */
-#if defined _LIBC
-# include <bits/libc-lock.h>
-#else
-# define __libc_lock_define(CLASS,NAME)
-# define __libc_lock_init(NAME) do { } while (0)
-# define __libc_lock_lock(NAME) do { } while (0)
-# define __libc_lock_unlock(NAME) do { } while (0)
-#endif
-
-/* In case that the system doesn't have isblank(). */
-#if !defined _LIBC && !defined HAVE_ISBLANK && !defined isblank
-# define isblank(ch) ((ch) == ' ' || (ch) == '\t')
-#endif
-
-#ifdef _LIBC
-# ifndef _RE_DEFINE_LOCALE_FUNCTIONS
-# define _RE_DEFINE_LOCALE_FUNCTIONS 1
-# include <locale/localeinfo.h>
-# include <locale/elem-hash.h>
-# include <locale/coll-lookup.h>
-# endif
-#endif
-
-/* This is for other GNU distributions with internationalized messages. */
-#if (HAVE_LIBINTL_H && ENABLE_NLS) || defined _LIBC
-# include <libintl.h>
-# ifdef _LIBC
-# undef gettext
-# define gettext(msgid) \
- INTUSE(__dcgettext) (_libc_intl_domainname, msgid, LC_MESSAGES)
-# endif
-#else
-# define gettext(msgid) (msgid)
-#endif
-
-#ifndef gettext_noop
-/* This define is so xgettext can find the internationalizable
- strings. */
-# define gettext_noop(String) String
-#endif
-
-/* For loser systems without the definition. */
-#ifndef SIZE_MAX
-# define SIZE_MAX ((size_t) -1)
-#endif
-
-#if (defined MB_CUR_MAX && HAVE_LOCALE_H && HAVE_WCTYPE_H && HAVE_WCHAR_H && HAVE_WCRTOMB && HAVE_MBRTOWC && HAVE_WCSCOLL) || _LIBC
-# define RE_ENABLE_I18N
-#endif
-
-#if __GNUC__ >= 3
-# define BE(expr, val) __builtin_expect (expr, val)
-#else
-# define BE(expr, val) (expr)
-# define inline
-#endif
-
-/* Number of single byte character. */
-#define SBC_MAX 256
-
-#define COLL_ELEM_LEN_MAX 8
-
-/* The character which represents newline. */
-#define NEWLINE_CHAR '\n'
-#define WIDE_NEWLINE_CHAR L'\n'
-
-/* Rename to standard API for using out of glibc. */
-#ifndef _LIBC
-# define __wctype wctype
-# define __iswctype iswctype
-# define __btowc btowc
-# define __mempcpy mempcpy
-# define __wcrtomb wcrtomb
-# define __regfree regfree
-# define attribute_hidden
-#endif /* not _LIBC */
-
-#ifdef __GNUC__
-# define __attribute(arg) __attribute__ (arg)
-#else
-# define __attribute(arg)
-#endif
-
-extern const char __re_error_msgid[] attribute_hidden;
-extern const size_t __re_error_msgid_idx[] attribute_hidden;
-
-/* An integer used to represent a set of bits. It must be unsigned,
- and must be at least as wide as unsigned int. */
-typedef unsigned long int bitset_word_t;
-/* All bits set in a bitset_word_t. */
-#define BITSET_WORD_MAX ULONG_MAX
-/* Number of bits in a bitset_word_t. */
-#define BITSET_WORD_BITS (sizeof (bitset_word_t) * CHAR_BIT)
-/* Number of bitset_word_t in a bit_set. */
-#define BITSET_WORDS (SBC_MAX / BITSET_WORD_BITS)
-typedef bitset_word_t bitset_t[BITSET_WORDS];
-typedef bitset_word_t *re_bitset_ptr_t;
-typedef const bitset_word_t *re_const_bitset_ptr_t;
-
-#define bitset_set(set,i) \
- (set[i / BITSET_WORD_BITS] |= (bitset_word_t) 1 << i % BITSET_WORD_BITS)
-#define bitset_clear(set,i) \
- (set[i / BITSET_WORD_BITS] &= ~((bitset_word_t) 1 << i % BITSET_WORD_BITS))
-#define bitset_contain(set,i) \
- (set[i / BITSET_WORD_BITS] & ((bitset_word_t) 1 << i % BITSET_WORD_BITS))
-#define bitset_empty(set) memset (set, '\0', sizeof (bitset_t))
-#define bitset_set_all(set) memset (set, '\xff', sizeof (bitset_t))
-#define bitset_copy(dest,src) memcpy (dest, src, sizeof (bitset_t))
-
-#define PREV_WORD_CONSTRAINT 0x0001
-#define PREV_NOTWORD_CONSTRAINT 0x0002
-#define NEXT_WORD_CONSTRAINT 0x0004
-#define NEXT_NOTWORD_CONSTRAINT 0x0008
-#define PREV_NEWLINE_CONSTRAINT 0x0010
-#define NEXT_NEWLINE_CONSTRAINT 0x0020
-#define PREV_BEGBUF_CONSTRAINT 0x0040
-#define NEXT_ENDBUF_CONSTRAINT 0x0080
-#define WORD_DELIM_CONSTRAINT 0x0100
-#define NOT_WORD_DELIM_CONSTRAINT 0x0200
-
-typedef enum
-{
- INSIDE_WORD = PREV_WORD_CONSTRAINT | NEXT_WORD_CONSTRAINT,
- WORD_FIRST = PREV_NOTWORD_CONSTRAINT | NEXT_WORD_CONSTRAINT,
- WORD_LAST = PREV_WORD_CONSTRAINT | NEXT_NOTWORD_CONSTRAINT,
- INSIDE_NOTWORD = PREV_NOTWORD_CONSTRAINT | NEXT_NOTWORD_CONSTRAINT,
- LINE_FIRST = PREV_NEWLINE_CONSTRAINT,
- LINE_LAST = NEXT_NEWLINE_CONSTRAINT,
- BUF_FIRST = PREV_BEGBUF_CONSTRAINT,
- BUF_LAST = NEXT_ENDBUF_CONSTRAINT,
- WORD_DELIM = WORD_DELIM_CONSTRAINT,
- NOT_WORD_DELIM = NOT_WORD_DELIM_CONSTRAINT
-} re_context_type;
-
-typedef struct
-{
- int alloc;
- int nelem;
- int *elems;
-} re_node_set;
-
-typedef enum
-{
- NON_TYPE = 0,
-
- /* Node type, These are used by token, node, tree. */
- CHARACTER = 1,
- END_OF_RE = 2,
- SIMPLE_BRACKET = 3,
- OP_BACK_REF = 4,
- OP_PERIOD = 5,
-#ifdef RE_ENABLE_I18N
- COMPLEX_BRACKET = 6,
- OP_UTF8_PERIOD = 7,
-#endif /* RE_ENABLE_I18N */
-
- /* We define EPSILON_BIT as a macro so that OP_OPEN_SUBEXP is used
- when the debugger shows values of this enum type. */
-#define EPSILON_BIT 8
- OP_OPEN_SUBEXP = EPSILON_BIT | 0,
- OP_CLOSE_SUBEXP = EPSILON_BIT | 1,
- OP_ALT = EPSILON_BIT | 2,
- OP_DUP_ASTERISK = EPSILON_BIT | 3,
- ANCHOR = EPSILON_BIT | 4,
-
- /* Tree type, these are used only by tree. */
- CONCAT = 16,
- SUBEXP = 17,
-
- /* Token type, these are used only by token. */
- OP_DUP_PLUS = 18,
- OP_DUP_QUESTION,
- OP_OPEN_BRACKET,
- OP_CLOSE_BRACKET,
- OP_CHARSET_RANGE,
- OP_OPEN_DUP_NUM,
- OP_CLOSE_DUP_NUM,
- OP_NON_MATCH_LIST,
- OP_OPEN_COLL_ELEM,
- OP_CLOSE_COLL_ELEM,
- OP_OPEN_EQUIV_CLASS,
- OP_CLOSE_EQUIV_CLASS,
- OP_OPEN_CHAR_CLASS,
- OP_CLOSE_CHAR_CLASS,
- OP_WORD,
- OP_NOTWORD,
- OP_SPACE,
- OP_NOTSPACE,
- BACK_SLASH
-
-} re_token_type_t;
-
-#ifdef RE_ENABLE_I18N
-typedef struct
-{
- /* Multibyte characters. */
- wchar_t *mbchars;
-
- /* Collating symbols. */
-# ifdef _LIBC
- int32_t *coll_syms;
-# endif
-
- /* Equivalence classes. */
-# ifdef _LIBC
- int32_t *equiv_classes;
-# endif
-
- /* Range expressions. */
-# ifdef _LIBC
- uint32_t *range_starts;
- uint32_t *range_ends;
-# else /* not _LIBC */
- wchar_t *range_starts;
- wchar_t *range_ends;
-# endif /* not _LIBC */
-
- /* Character classes. */
- wctype_t *char_classes;
-
- /* If this character set is the non-matching list. */
- unsigned int non_match : 1;
-
- /* # of multibyte characters. */
- int nmbchars;
-
- /* # of collating symbols. */
- int ncoll_syms;
-
- /* # of equivalence classes. */
- int nequiv_classes;
-
- /* # of range expressions. */
- int nranges;
-
- /* # of character classes. */
- int nchar_classes;
-} re_charset_t;
-#endif /* RE_ENABLE_I18N */
-
-typedef struct
-{
- union
- {
- unsigned char c; /* for CHARACTER */
- re_bitset_ptr_t sbcset; /* for SIMPLE_BRACKET */
-#ifdef RE_ENABLE_I18N
- re_charset_t *mbcset; /* for COMPLEX_BRACKET */
-#endif /* RE_ENABLE_I18N */
- int idx; /* for BACK_REF */
- re_context_type ctx_type; /* for ANCHOR */
- } opr;
-#if __GNUC__ >= 2
- re_token_type_t type : 8;
-#else
- re_token_type_t type;
-#endif
- unsigned int constraint : 10; /* context constraint */
- unsigned int duplicated : 1;
- unsigned int opt_subexp : 1;
-#ifdef RE_ENABLE_I18N
- unsigned int accept_mb : 1;
- /* These 2 bits can be moved into the union if needed (e.g. if running out
- of bits; move opr.c to opr.c.c and move the flags to opr.c.flags). */
- unsigned int mb_partial : 1;
-#endif
- unsigned int word_char : 1;
-} re_token_t;
-
-#define IS_EPSILON_NODE(type) ((type) & EPSILON_BIT)
-
-struct re_string_t
-{
- /* Indicate the raw buffer which is the original string passed as an
- argument of regexec(), re_search(), etc.. */
- const unsigned char *raw_mbs;
- /* Store the multibyte string. In case of "case insensitive mode" like
- REG_ICASE, upper cases of the string are stored, otherwise MBS points
- the same address that RAW_MBS points. */
- unsigned char *mbs;
-#ifdef RE_ENABLE_I18N
- /* Store the wide character string which is corresponding to MBS. */
- wint_t *wcs;
- int *offsets;
- mbstate_t cur_state;
-#endif
- /* Index in RAW_MBS. Each character mbs[i] corresponds to
- raw_mbs[raw_mbs_idx + i]. */
- int raw_mbs_idx;
- /* The length of the valid characters in the buffers. */
- int valid_len;
- /* The corresponding number of bytes in raw_mbs array. */
- int valid_raw_len;
- /* The length of the buffers MBS and WCS. */
- int bufs_len;
- /* The index in MBS, which is updated by re_string_fetch_byte. */
- int cur_idx;
- /* length of RAW_MBS array. */
- int raw_len;
- /* This is RAW_LEN - RAW_MBS_IDX + VALID_LEN - VALID_RAW_LEN. */
- int len;
- /* End of the buffer may be shorter than its length in the cases such
- as re_match_2, re_search_2. Then, we use STOP for end of the buffer
- instead of LEN. */
- int raw_stop;
- /* This is RAW_STOP - RAW_MBS_IDX adjusted through OFFSETS. */
- int stop;
-
- /* The context of mbs[0]. We store the context independently, since
- the context of mbs[0] may be different from raw_mbs[0], which is
- the beginning of the input string. */
- unsigned int tip_context;
- /* The translation passed as a part of an argument of re_compile_pattern. */
- RE_TRANSLATE_TYPE trans;
- /* Copy of re_dfa_t's word_char. */
- re_const_bitset_ptr_t word_char;
- /* 1 if REG_ICASE. */
- unsigned char icase;
- unsigned char is_utf8;
- unsigned char map_notascii;
- unsigned char mbs_allocated;
- unsigned char offsets_needed;
- unsigned char newline_anchor;
- unsigned char word_ops_used;
- int mb_cur_max;
-};
-typedef struct re_string_t re_string_t;
-
-
-struct re_dfa_t;
-typedef struct re_dfa_t re_dfa_t;
-
-#ifndef _LIBC
-# ifdef __i386__
-# define internal_function __attribute ((regparm (3), stdcall))
-# else
-# define internal_function
-# endif
-#endif
-
-static reg_errcode_t re_string_realloc_buffers (re_string_t *pstr,
- int new_buf_len)
- internal_function;
-#ifdef RE_ENABLE_I18N
-static void build_wcs_buffer (re_string_t *pstr) internal_function;
-static int build_wcs_upper_buffer (re_string_t *pstr) internal_function;
-#endif /* RE_ENABLE_I18N */
-static void build_upper_buffer (re_string_t *pstr) internal_function;
-static void re_string_translate_buffer (re_string_t *pstr) internal_function;
-static unsigned int re_string_context_at (const re_string_t *input, int idx,
- int eflags)
- internal_function __attribute ((pure));
-#define re_string_peek_byte(pstr, offset) \
- ((pstr)->mbs[(pstr)->cur_idx + offset])
-#define re_string_fetch_byte(pstr) \
- ((pstr)->mbs[(pstr)->cur_idx++])
-#define re_string_first_byte(pstr, idx) \
- ((idx) == (pstr)->valid_len || (pstr)->wcs[idx] != WEOF)
-#define re_string_is_single_byte_char(pstr, idx) \
- ((pstr)->wcs[idx] != WEOF && ((pstr)->valid_len == (idx) + 1 \
- || (pstr)->wcs[(idx) + 1] != WEOF))
-#define re_string_eoi(pstr) ((pstr)->stop <= (pstr)->cur_idx)
-#define re_string_cur_idx(pstr) ((pstr)->cur_idx)
-#define re_string_get_buffer(pstr) ((pstr)->mbs)
-#define re_string_length(pstr) ((pstr)->len)
-#define re_string_byte_at(pstr,idx) ((pstr)->mbs[idx])
-#define re_string_skip_bytes(pstr,idx) ((pstr)->cur_idx += (idx))
-#define re_string_set_index(pstr,idx) ((pstr)->cur_idx = (idx))
-
-#ifndef alloca /* if alloca is already defined, fine */
-#ifdef __GNUC__
-# define alloca(size) __builtin_alloca (size)
-# define HAVE_ALLOCA 1
-#elif defined(_MSC_VER)
-# include <malloc.h>
-# define alloca _alloca
-# define HAVE_ALLOCA 1
-#else
-# error No alloca()
-#endif
-#endif /* not alloca */
-
-#ifndef _LIBC
-# if HAVE_ALLOCA
-/* The OS usually guarantees only one guard page at the bottom of the stack,
- and a page size can be as small as 4096 bytes. So we cannot safely
- allocate anything larger than 4096 bytes. Also care for the possibility
- of a few compiler-allocated temporary stack slots. */
-# define __libc_use_alloca(n) ((n) < 4032)
-# else
-/* alloca is implemented with malloc, so just use malloc. */
-# define __libc_use_alloca(n) 0
-# endif
-#endif
-
-#define re_malloc(t,n) ((t *) malloc ((n) * sizeof (t)))
-#define re_realloc(p,t,n) ((t *) realloc (p, (n) * sizeof (t)))
-#define re_free(p) free (p)
-
-struct bin_tree_t
-{
- struct bin_tree_t *parent;
- struct bin_tree_t *left;
- struct bin_tree_t *right;
- struct bin_tree_t *first;
- struct bin_tree_t *next;
-
- re_token_t token;
-
- /* `node_idx' is the index in dfa->nodes, if `type' == 0.
- Otherwise `type' indicate the type of this node. */
- int node_idx;
-};
-typedef struct bin_tree_t bin_tree_t;
-
-#define BIN_TREE_STORAGE_SIZE \
- ((1024 - sizeof (void *)) / sizeof (bin_tree_t))
-
-struct bin_tree_storage_t
-{
- struct bin_tree_storage_t *next;
- bin_tree_t data[BIN_TREE_STORAGE_SIZE];
-};
-typedef struct bin_tree_storage_t bin_tree_storage_t;
-
-#define CONTEXT_WORD 1
-#define CONTEXT_NEWLINE (CONTEXT_WORD << 1)
-#define CONTEXT_BEGBUF (CONTEXT_NEWLINE << 1)
-#define CONTEXT_ENDBUF (CONTEXT_BEGBUF << 1)
-
-#define IS_WORD_CONTEXT(c) ((c) & CONTEXT_WORD)
-#define IS_NEWLINE_CONTEXT(c) ((c) & CONTEXT_NEWLINE)
-#define IS_BEGBUF_CONTEXT(c) ((c) & CONTEXT_BEGBUF)
-#define IS_ENDBUF_CONTEXT(c) ((c) & CONTEXT_ENDBUF)
-#define IS_ORDINARY_CONTEXT(c) ((c) == 0)
-
-#define IS_WORD_CHAR(ch) (isalnum (ch) || (ch) == '_')
-#define IS_NEWLINE(ch) ((ch) == NEWLINE_CHAR)
-#define IS_WIDE_WORD_CHAR(ch) (iswalnum (ch) || (ch) == L'_')
-#define IS_WIDE_NEWLINE(ch) ((ch) == WIDE_NEWLINE_CHAR)
-
-#define NOT_SATISFY_PREV_CONSTRAINT(constraint,context) \
- ((((constraint) & PREV_WORD_CONSTRAINT) && !IS_WORD_CONTEXT (context)) \
- || ((constraint & PREV_NOTWORD_CONSTRAINT) && IS_WORD_CONTEXT (context)) \
- || ((constraint & PREV_NEWLINE_CONSTRAINT) && !IS_NEWLINE_CONTEXT (context))\
- || ((constraint & PREV_BEGBUF_CONSTRAINT) && !IS_BEGBUF_CONTEXT (context)))
-
-#define NOT_SATISFY_NEXT_CONSTRAINT(constraint,context) \
- ((((constraint) & NEXT_WORD_CONSTRAINT) && !IS_WORD_CONTEXT (context)) \
- || (((constraint) & NEXT_NOTWORD_CONSTRAINT) && IS_WORD_CONTEXT (context)) \
- || (((constraint) & NEXT_NEWLINE_CONSTRAINT) && !IS_NEWLINE_CONTEXT (context)) \
- || (((constraint) & NEXT_ENDBUF_CONSTRAINT) && !IS_ENDBUF_CONTEXT (context)))
-
-struct re_dfastate_t
-{
- unsigned int hash;
- re_node_set nodes;
- re_node_set non_eps_nodes;
- re_node_set inveclosure;
- re_node_set *entrance_nodes;
- struct re_dfastate_t **trtable, **word_trtable;
- unsigned int context : 4;
- unsigned int halt : 1;
- /* If this state can accept `multi byte'.
- Note that we refer to multibyte characters, and multi character
- collating elements as `multi byte'. */
- unsigned int accept_mb : 1;
- /* If this state has backreference node(s). */
- unsigned int has_backref : 1;
- unsigned int has_constraint : 1;
-};
-typedef struct re_dfastate_t re_dfastate_t;
-
-struct re_state_table_entry
-{
- int num;
- int alloc;
- re_dfastate_t **array;
-};
-
-/* Array type used in re_sub_match_last_t and re_sub_match_top_t. */
-
-typedef struct
-{
- int next_idx;
- int alloc;
- re_dfastate_t **array;
-} state_array_t;
-
-/* Store information about the node NODE whose type is OP_CLOSE_SUBEXP. */
-
-typedef struct
-{
- int node;
- int str_idx; /* The position NODE match at. */
- state_array_t path;
-} re_sub_match_last_t;
-
-/* Store information about the node NODE whose type is OP_OPEN_SUBEXP.
- And information about the node, whose type is OP_CLOSE_SUBEXP,
- corresponding to NODE is stored in LASTS. */
-
-typedef struct
-{
- int str_idx;
- int node;
- state_array_t *path;
- int alasts; /* Allocation size of LASTS. */
- int nlasts; /* The number of LASTS. */
- re_sub_match_last_t **lasts;
-} re_sub_match_top_t;
-
-struct re_backref_cache_entry
-{
- int node;
- int str_idx;
- int subexp_from;
- int subexp_to;
- char more;
- char unused;
- unsigned short int eps_reachable_subexps_map;
-};
-
-typedef struct
-{
- /* The string object corresponding to the input string. */
- re_string_t input;
-#if defined _LIBC || (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L)
- const re_dfa_t *const dfa;
-#else
- const re_dfa_t *dfa;
-#endif
- /* EFLAGS of the argument of regexec. */
- int eflags;
- /* Where the matching ends. */
- int match_last;
- int last_node;
- /* The state log used by the matcher. */
- re_dfastate_t **state_log;
- int state_log_top;
- /* Back reference cache. */
- int nbkref_ents;
- int abkref_ents;
- struct re_backref_cache_entry *bkref_ents;
- int max_mb_elem_len;
- int nsub_tops;
- int asub_tops;
- re_sub_match_top_t **sub_tops;
-} re_match_context_t;
-
-typedef struct
-{
- re_dfastate_t **sifted_states;
- re_dfastate_t **limited_states;
- int last_node;
- int last_str_idx;
- re_node_set limits;
-} re_sift_context_t;
-
-struct re_fail_stack_ent_t
-{
- int idx;
- int node;
- regmatch_t *regs;
- re_node_set eps_via_nodes;
-};
-
-struct re_fail_stack_t
-{
- int num;
- int alloc;
- struct re_fail_stack_ent_t *stack;
-};
-
-struct re_dfa_t
-{
- re_token_t *nodes;
- size_t nodes_alloc;
- size_t nodes_len;
- int *nexts;
- int *org_indices;
- re_node_set *edests;
- re_node_set *eclosures;
- re_node_set *inveclosures;
- struct re_state_table_entry *state_table;
- re_dfastate_t *init_state;
- re_dfastate_t *init_state_word;
- re_dfastate_t *init_state_nl;
- re_dfastate_t *init_state_begbuf;
- bin_tree_t *str_tree;
- bin_tree_storage_t *str_tree_storage;
- re_bitset_ptr_t sb_char;
- int str_tree_storage_idx;
-
- /* number of subexpressions `re_nsub' is in regex_t. */
- unsigned int state_hash_mask;
- int init_node;
- int nbackref; /* The number of backreference in this dfa. */
-
- /* Bitmap expressing which backreference is used. */
- bitset_word_t used_bkref_map;
- bitset_word_t completed_bkref_map;
-
- unsigned int has_plural_match : 1;
- /* If this dfa has "multibyte node", which is a backreference or
- a node which can accept multibyte character or multi character
- collating element. */
- unsigned int has_mb_node : 1;
- unsigned int is_utf8 : 1;
- unsigned int map_notascii : 1;
- unsigned int word_ops_used : 1;
- int mb_cur_max;
- bitset_t word_char;
- reg_syntax_t syntax;
- int *subexp_map;
-#ifdef DEBUG
- char* re_str;
-#endif
- __libc_lock_define (, lock)
-};
-
-#define re_node_set_init_empty(set) memset (set, '\0', sizeof (re_node_set))
-#define re_node_set_remove(set,id) \
- (re_node_set_remove_at (set, re_node_set_contains (set, id) - 1))
-#define re_node_set_empty(p) ((p)->nelem = 0)
-#define re_node_set_free(set) re_free ((set)->elems)
-
-
-typedef enum
-{
- SB_CHAR,
- MB_CHAR,
- EQUIV_CLASS,
- COLL_SYM,
- CHAR_CLASS
-} bracket_elem_type;
-
-typedef struct
-{
- bracket_elem_type type;
- union
- {
- unsigned char ch;
- unsigned char *name;
- wchar_t wch;
- } opr;
-} bracket_elem_t;
-
-
-/* Inline functions for bitset operation. */
-static inline void
-bitset_not (bitset_t set)
-{
- int bitset_i;
- for (bitset_i = 0; bitset_i < BITSET_WORDS; ++bitset_i)
- set[bitset_i] = ~set[bitset_i];
-}
-
-static inline void
-bitset_merge (bitset_t dest, const bitset_t src)
-{
- int bitset_i;
- for (bitset_i = 0; bitset_i < BITSET_WORDS; ++bitset_i)
- dest[bitset_i] |= src[bitset_i];
-}
-
-static inline void
-bitset_mask (bitset_t dest, const bitset_t src)
-{
- int bitset_i;
- for (bitset_i = 0; bitset_i < BITSET_WORDS; ++bitset_i)
- dest[bitset_i] &= src[bitset_i];
-}
-
-#ifdef RE_ENABLE_I18N
-/* Inline functions for re_string. */
-static inline int
-internal_function __attribute ((pure))
-re_string_char_size_at (const re_string_t *pstr, int idx)
-{
- int byte_idx;
- if (pstr->mb_cur_max == 1)
- return 1;
- for (byte_idx = 1; idx + byte_idx < pstr->valid_len; ++byte_idx)
- if (pstr->wcs[idx + byte_idx] != WEOF)
- break;
- return byte_idx;
-}
-
-static inline wint_t
-internal_function __attribute ((pure))
-re_string_wchar_at (const re_string_t *pstr, int idx)
-{
- if (pstr->mb_cur_max == 1)
- return (wint_t) pstr->mbs[idx];
- return (wint_t) pstr->wcs[idx];
-}
-
-static int
-internal_function __attribute ((pure))
-re_string_elem_size_at (const re_string_t *pstr, int idx)
-{
-# ifdef _LIBC
- const unsigned char *p, *extra;
- const int32_t *table, *indirect;
- int32_t tmp;
-# include <locale/weight.h>
- uint_fast32_t nrules = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES);
-
- if (nrules != 0)
- {
- table = (const int32_t *) _NL_CURRENT (LC_COLLATE, _NL_COLLATE_TABLEMB);
- extra = (const unsigned char *)
- _NL_CURRENT (LC_COLLATE, _NL_COLLATE_EXTRAMB);
- indirect = (const int32_t *) _NL_CURRENT (LC_COLLATE,
- _NL_COLLATE_INDIRECTMB);
- p = pstr->mbs + idx;
- tmp = findidx (&p);
- return p - pstr->mbs - idx;
- }
- else
-# endif /* _LIBC */
- return 1;
-}
-#endif /* RE_ENABLE_I18N */
-
-#endif /* _REGEX_INTERNAL_H */
diff --git a/Build/source/texk/web2c/pdftexdir/regex/regexec.c b/Build/source/texk/web2c/pdftexdir/regex/regexec.c
deleted file mode 100644
index a37da21f306..00000000000
--- a/Build/source/texk/web2c/pdftexdir/regex/regexec.c
+++ /dev/null
@@ -1,4303 +0,0 @@
-/* Extended regular expression matching and search library.
- Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
- This file is part of the GNU C Library.
- Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
-
- The GNU C Library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2.1 of the License, or (at your option) any later version.
-
- The GNU C Library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with the GNU C Library; if not, write to the Free
- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
- 02111-1307 USA. */
-
-static reg_errcode_t match_ctx_init (re_match_context_t *cache, int eflags,
- int n) internal_function;
-static void match_ctx_clean (re_match_context_t *mctx) internal_function;
-static void match_ctx_free (re_match_context_t *cache) internal_function;
-static reg_errcode_t match_ctx_add_entry (re_match_context_t *cache, int node,
- int str_idx, int from, int to)
- internal_function;
-static int search_cur_bkref_entry (const re_match_context_t *mctx, int str_idx)
- internal_function;
-static reg_errcode_t match_ctx_add_subtop (re_match_context_t *mctx, int node,
- int str_idx) internal_function;
-static re_sub_match_last_t * match_ctx_add_sublast (re_sub_match_top_t *subtop,
- int node, int str_idx)
- internal_function;
-static void sift_ctx_init (re_sift_context_t *sctx, re_dfastate_t **sifted_sts,
- re_dfastate_t **limited_sts, int last_node,
- int last_str_idx)
- internal_function;
-static reg_errcode_t re_search_internal (const regex_t *preg,
- const char *string, int length,
- int start, int range, int stop,
- size_t nmatch, regmatch_t pmatch[],
- int eflags) internal_function;
-static int re_search_2_stub (struct re_pattern_buffer *bufp,
- const char *string1, int length1,
- const char *string2, int length2,
- int start, int range, struct re_registers *regs,
- int stop, int ret_len) internal_function;
-static int re_search_stub (struct re_pattern_buffer *bufp,
- const char *string, int length, int start,
- int range, int stop, struct re_registers *regs,
- int ret_len) internal_function;
-static unsigned re_copy_regs (struct re_registers *regs, regmatch_t *pmatch,
- int nregs, int regs_allocated) internal_function;
-static reg_errcode_t prune_impossible_nodes (re_match_context_t *mctx)
- internal_function;
-static int check_matching (re_match_context_t *mctx, int fl_longest_match,
- int *p_match_first) internal_function;
-static int check_halt_state_context (const re_match_context_t *mctx,
- const re_dfastate_t *state, int idx)
- internal_function;
-static void update_regs (const re_dfa_t *dfa, regmatch_t *pmatch,
- regmatch_t *prev_idx_match, int cur_node,
- int cur_idx, int nmatch) internal_function;
-static reg_errcode_t push_fail_stack (struct re_fail_stack_t *fs,
- int str_idx, int dest_node, int nregs,
- regmatch_t *regs,
- re_node_set *eps_via_nodes)
- internal_function;
-static reg_errcode_t set_regs (const regex_t *preg,
- const re_match_context_t *mctx,
- size_t nmatch, regmatch_t *pmatch,
- int fl_backtrack) internal_function;
-static reg_errcode_t free_fail_stack_return (struct re_fail_stack_t *fs)
- internal_function;
-
-#ifdef RE_ENABLE_I18N
-static int sift_states_iter_mb (const re_match_context_t *mctx,
- re_sift_context_t *sctx,
- int node_idx, int str_idx, int max_str_idx)
- internal_function;
-#endif /* RE_ENABLE_I18N */
-static reg_errcode_t sift_states_backward (const re_match_context_t *mctx,
- re_sift_context_t *sctx)
- internal_function;
-static reg_errcode_t build_sifted_states (const re_match_context_t *mctx,
- re_sift_context_t *sctx, int str_idx,
- re_node_set *cur_dest)
- internal_function;
-static reg_errcode_t update_cur_sifted_state (const re_match_context_t *mctx,
- re_sift_context_t *sctx,
- int str_idx,
- re_node_set *dest_nodes)
- internal_function;
-static reg_errcode_t add_epsilon_src_nodes (const re_dfa_t *dfa,
- re_node_set *dest_nodes,
- const re_node_set *candidates)
- internal_function;
-static int check_dst_limits (const re_match_context_t *mctx,
- re_node_set *limits,
- int dst_node, int dst_idx, int src_node,
- int src_idx) internal_function;
-static int check_dst_limits_calc_pos_1 (const re_match_context_t *mctx,
- int boundaries, int subexp_idx,
- int from_node, int bkref_idx)
- internal_function;
-static int check_dst_limits_calc_pos (const re_match_context_t *mctx,
- int limit, int subexp_idx,
- int node, int str_idx,
- int bkref_idx) internal_function;
-static reg_errcode_t check_subexp_limits (const re_dfa_t *dfa,
- re_node_set *dest_nodes,
- const re_node_set *candidates,
- re_node_set *limits,
- struct re_backref_cache_entry *bkref_ents,
- int str_idx) internal_function;
-static reg_errcode_t sift_states_bkref (const re_match_context_t *mctx,
- re_sift_context_t *sctx,
- int str_idx, const re_node_set *candidates)
- internal_function;
-static reg_errcode_t merge_state_array (const re_dfa_t *dfa,
- re_dfastate_t **dst,
- re_dfastate_t **src, int num)
- internal_function;
-static re_dfastate_t *find_recover_state (reg_errcode_t *err,
- re_match_context_t *mctx) internal_function;
-static re_dfastate_t *transit_state (reg_errcode_t *err,
- re_match_context_t *mctx,
- re_dfastate_t *state) internal_function;
-static re_dfastate_t *merge_state_with_log (reg_errcode_t *err,
- re_match_context_t *mctx,
- re_dfastate_t *next_state)
- internal_function;
-static reg_errcode_t check_subexp_matching_top (re_match_context_t *mctx,
- re_node_set *cur_nodes,
- int str_idx) internal_function;
-#if 0
-static re_dfastate_t *transit_state_sb (reg_errcode_t *err,
- re_match_context_t *mctx,
- re_dfastate_t *pstate)
- internal_function;
-#endif
-#ifdef RE_ENABLE_I18N
-static reg_errcode_t transit_state_mb (re_match_context_t *mctx,
- re_dfastate_t *pstate)
- internal_function;
-#endif /* RE_ENABLE_I18N */
-static reg_errcode_t transit_state_bkref (re_match_context_t *mctx,
- const re_node_set *nodes)
- internal_function;
-static reg_errcode_t get_subexp (re_match_context_t *mctx,
- int bkref_node, int bkref_str_idx)
- internal_function;
-static reg_errcode_t get_subexp_sub (re_match_context_t *mctx,
- const re_sub_match_top_t *sub_top,
- re_sub_match_last_t *sub_last,
- int bkref_node, int bkref_str)
- internal_function;
-static int find_subexp_node (const re_dfa_t *dfa, const re_node_set *nodes,
- int subexp_idx, int type) internal_function;
-static reg_errcode_t check_arrival (re_match_context_t *mctx,
- state_array_t *path, int top_node,
- int top_str, int last_node, int last_str,
- int type) internal_function;
-static reg_errcode_t check_arrival_add_next_nodes (re_match_context_t *mctx,
- int str_idx,
- re_node_set *cur_nodes,
- re_node_set *next_nodes)
- internal_function;
-static reg_errcode_t check_arrival_expand_ecl (const re_dfa_t *dfa,
- re_node_set *cur_nodes,
- int ex_subexp, int type)
- internal_function;
-static reg_errcode_t check_arrival_expand_ecl_sub (const re_dfa_t *dfa,
- re_node_set *dst_nodes,
- int target, int ex_subexp,
- int type) internal_function;
-static reg_errcode_t expand_bkref_cache (re_match_context_t *mctx,
- re_node_set *cur_nodes, int cur_str,
- int subexp_num, int type)
- internal_function;
-static int build_trtable (const re_dfa_t *dfa,
- re_dfastate_t *state) internal_function;
-#ifdef RE_ENABLE_I18N
-static int check_node_accept_bytes (const re_dfa_t *dfa, int node_idx,
- const re_string_t *input, int idx)
- internal_function;
-# ifdef _LIBC
-static unsigned int find_collation_sequence_value (const unsigned char *mbs,
- size_t name_len)
- internal_function;
-# endif /* _LIBC */
-#endif /* RE_ENABLE_I18N */
-static int group_nodes_into_DFAstates (const re_dfa_t *dfa,
- const re_dfastate_t *state,
- re_node_set *states_node,
- bitset_t *states_ch) internal_function;
-static int check_node_accept (const re_match_context_t *mctx,
- const re_token_t *node, int idx)
- internal_function;
-static reg_errcode_t extend_buffers (re_match_context_t *mctx)
- internal_function;
-
-/* Entry point for POSIX code. */
-
-/* regexec searches for a given pattern, specified by PREG, in the
- string STRING.
-
- If NMATCH is zero or REG_NOSUB was set in the cflags argument to
- `regcomp', we ignore PMATCH. Otherwise, we assume PMATCH has at
- least NMATCH elements, and we set them to the offsets of the
- corresponding matched substrings.
-
- EFLAGS specifies `execution flags' which affect matching: if
- REG_NOTBOL is set, then ^ does not match at the beginning of the
- string; if REG_NOTEOL is set, then $ does not match at the end.
-
- We return 0 if we find a match and REG_NOMATCH if not. */
-
-int
-regexec (const regex_t *__restrict preg, const char *__restrict string,
- size_t nmatch, regmatch_t pmatch[], int eflags)
-{
- reg_errcode_t err;
- int start, length;
-#ifdef _LIBC
- re_dfa_t *dfa = (re_dfa_t *) preg->buffer;
-#endif
-
- if (eflags & ~(REG_NOTBOL | REG_NOTEOL | REG_STARTEND))
- return REG_BADPAT;
-
- if (eflags & REG_STARTEND)
- {
- start = pmatch[0].rm_so;
- length = pmatch[0].rm_eo;
- }
- else
- {
- start = 0;
- length = strlen (string);
- }
-
- __libc_lock_lock (dfa->lock);
- if (preg->no_sub)
- err = re_search_internal (preg, string, length, start, length - start,
- length, 0, NULL, eflags);
- else
- err = re_search_internal (preg, string, length, start, length - start,
- length, nmatch, pmatch, eflags);
- __libc_lock_unlock (dfa->lock);
- return err != REG_NOERROR;
-}
-
-#ifdef _LIBC
-# include <shlib-compat.h>
-versioned_symbol (libc, __regexec, regexec, GLIBC_2_3_4);
-
-# if SHLIB_COMPAT (libc, GLIBC_2_0, GLIBC_2_3_4)
-__typeof__ (__regexec) __compat_regexec;
-
-int
-attribute_compat_text_section
-__compat_regexec (const regex_t *__restrict preg,
- const char *__restrict string, size_t nmatch,
- regmatch_t pmatch[], int eflags)
-{
- return regexec (preg, string, nmatch, pmatch,
- eflags & (REG_NOTBOL | REG_NOTEOL));
-}
-compat_symbol (libc, __compat_regexec, regexec, GLIBC_2_0);
-# endif
-#endif
-
-/* Entry points for GNU code. */
-
-/* re_match, re_search, re_match_2, re_search_2
-
- The former two functions operate on STRING with length LENGTH,
- while the later two operate on concatenation of STRING1 and STRING2
- with lengths LENGTH1 and LENGTH2, respectively.
-
- re_match() matches the compiled pattern in BUFP against the string,
- starting at index START.
-
- re_search() first tries matching at index START, then it tries to match
- starting from index START + 1, and so on. The last start position tried
- is START + RANGE. (Thus RANGE = 0 forces re_search to operate the same
- way as re_match().)
-
- The parameter STOP of re_{match,search}_2 specifies that no match exceeding
- the first STOP characters of the concatenation of the strings should be
- concerned.
-
- If REGS is not NULL, and BUFP->no_sub is not set, the offsets of the match
- and all groups is stroed in REGS. (For the "_2" variants, the offsets are
- computed relative to the concatenation, not relative to the individual
- strings.)
-
- On success, re_match* functions return the length of the match, re_search*
- return the position of the start of the match. Return value -1 means no
- match was found and -2 indicates an internal error. */
-
-int
-re_match (struct re_pattern_buffer *bufp, const char *string, int length, int start,
- struct re_registers *regs)
-{
- return re_search_stub (bufp, string, length, start, 0, length, regs, 1);
-}
-#ifdef _LIBC
-weak_alias (__re_match, re_match)
-#endif
-
-int
-re_search (struct re_pattern_buffer *bufp, const char *string, int length, int start,
- int range, struct re_registers *regs)
-{
- return re_search_stub (bufp, string, length, start, range, length, regs, 0);
-}
-#ifdef _LIBC
-weak_alias (__re_search, re_search)
-#endif
-
-int
-re_match_2 (struct re_pattern_buffer *bufp, const char *string1, int length1,
- const char *string2, int length2, int start,
- struct re_registers *regs, int stop)
-{
- return re_search_2_stub (bufp, string1, length1, string2, length2,
- start, 0, regs, stop, 1);
-}
-#ifdef _LIBC
-weak_alias (__re_match_2, re_match_2)
-#endif
-
-int
-re_search_2 (struct re_pattern_buffer *bufp, const char *string1, int length1,
- const char *string2, int length2, int start, int range,
- struct re_registers *regs, int stop)
-{
- return re_search_2_stub (bufp, string1, length1, string2, length2,
- start, range, regs, stop, 0);
-}
-#ifdef _LIBC
-weak_alias (__re_search_2, re_search_2)
-#endif
-
-static int internal_function
-re_search_2_stub (struct re_pattern_buffer *bufp, const char *string1, int length1,
- const char *string2, int length2, int start, int range,
- struct re_registers *regs, int stop, int ret_len)
-{
- const char *str;
- int rval;
- int len = length1 + length2;
- char *s = NULL;
-
- if (BE (length1 < 0 || length2 < 0 || stop < 0, 0))
- return -2;
-
- /* Concatenate the strings. */
- if (length2 > 0)
- if (length1 > 0)
- {
- s = re_malloc (char, len);
-
- if (BE (s == NULL, 0))
- return -2;
-#ifdef _LIBC
- memcpy (__mempcpy (s, string1, length1), string2, length2);
-#else
- memcpy (s, string1, length1);
- memcpy (s + length1, string2, length2);
-#endif
- str = s;
- }
- else
- str = string2;
- else
- str = string1;
-
- rval = re_search_stub (bufp, str, len, start, range, stop, regs,
- ret_len);
- if (s)
- re_free (s);
- return rval;
-}
-
-/* The parameters have the same meaning as those of re_search.
- Additional parameters:
- If RET_LEN is nonzero the length of the match is returned (re_match style);
- otherwise the position of the match is returned. */
-
-static int internal_function
-re_search_stub (struct re_pattern_buffer *bufp, const char *string, int length,
- int start, int range, int stop, struct re_registers *regs, int ret_len)
-{
- reg_errcode_t result;
- regmatch_t *pmatch;
- int nregs, rval;
- int eflags = 0;
-#ifdef _LIBC
- re_dfa_t *dfa = (re_dfa_t *) bufp->buffer;
-#endif
-
- /* Check for out-of-range. */
- if (BE (start < 0 || start > length, 0))
- return -1;
- if (BE (start + range > length, 0))
- range = length - start;
- else if (BE (start + range < 0, 0))
- range = -start;
-
- __libc_lock_lock (dfa->lock);
-
- eflags |= (bufp->not_bol) ? REG_NOTBOL : 0;
- eflags |= (bufp->not_eol) ? REG_NOTEOL : 0;
-
- /* Compile fastmap if we haven't yet. */
- if (range > 0 && bufp->fastmap != NULL && !bufp->fastmap_accurate)
- re_compile_fastmap (bufp);
-
- if (BE (bufp->no_sub, 0))
- regs = NULL;
-
- /* We need at least 1 register. */
- if (regs == NULL)
- nregs = 1;
- else if (BE (bufp->regs_allocated == REGS_FIXED &&
- regs->num_regs < bufp->re_nsub + 1, 0))
- {
- nregs = regs->num_regs;
- if (BE (nregs < 1, 0))
- {
- /* Nothing can be copied to regs. */
- regs = NULL;
- nregs = 1;
- }
- }
- else
- nregs = bufp->re_nsub + 1;
- pmatch = re_malloc (regmatch_t, nregs);
- if (BE (pmatch == NULL, 0))
- {
- rval = -2;
- goto out;
- }
-
- result = re_search_internal (bufp, string, length, start, range, stop,
- nregs, pmatch, eflags);
-
- rval = 0;
-
- /* I hope we needn't fill ther regs with -1's when no match was found. */
- if (result != REG_NOERROR)
- rval = -1;
- else if (regs != NULL)
- {
- /* If caller wants register contents data back, copy them. */
- bufp->regs_allocated = re_copy_regs (regs, pmatch, nregs,
- bufp->regs_allocated);
- if (BE (bufp->regs_allocated == REGS_UNALLOCATED, 0))
- rval = -2;
- }
-
- if (BE (rval == 0, 1))
- {
- if (ret_len)
- {
- assert (pmatch[0].rm_so == start);
- rval = pmatch[0].rm_eo - start;
- }
- else
- rval = pmatch[0].rm_so;
- }
- re_free (pmatch);
- out:
- __libc_lock_unlock (dfa->lock);
- return rval;
-}
-
-static unsigned internal_function
-re_copy_regs (struct re_registers *regs, regmatch_t *pmatch, int nregs, int regs_allocated)
-{
- int rval = REGS_REALLOCATE;
- int i;
- int need_regs = nregs + 1;
- /* We need one extra element beyond `num_regs' for the `-1' marker GNU code
- uses. */
-
- /* Have the register data arrays been allocated? */
- if (regs_allocated == REGS_UNALLOCATED)
- { /* No. So allocate them with malloc. */
- regs->start = re_malloc (regoff_t, need_regs);
- regs->end = re_malloc (regoff_t, need_regs);
- if (BE (regs->start == NULL, 0) || BE (regs->end == NULL, 0))
- return REGS_UNALLOCATED;
- regs->num_regs = need_regs;
- }
- else if (regs_allocated == REGS_REALLOCATE)
- { /* Yes. If we need more elements than were already
- allocated, reallocate them. If we need fewer, just
- leave it alone. */
- if (BE (need_regs > regs->num_regs, 0))
- {
- regoff_t *new_start = re_realloc (regs->start, regoff_t, need_regs);
- regoff_t *new_end = re_realloc (regs->end, regoff_t, need_regs);
- if (BE (new_start == NULL, 0) || BE (new_end == NULL, 0))
- return REGS_UNALLOCATED;
- regs->start = new_start;
- regs->end = new_end;
- regs->num_regs = need_regs;
- }
- }
- else
- {
- assert (regs_allocated == REGS_FIXED);
- /* This function may not be called with REGS_FIXED and nregs too big. */
- assert (regs->num_regs >= nregs);
- rval = REGS_FIXED;
- }
-
- /* Copy the regs. */
- for (i = 0; i < nregs; ++i)
- {
- regs->start[i] = pmatch[i].rm_so;
- regs->end[i] = pmatch[i].rm_eo;
- }
- for ( ; i < regs->num_regs; ++i)
- regs->start[i] = regs->end[i] = -1;
-
- return rval;
-}
-
-/* Set REGS to hold NUM_REGS registers, storing them in STARTS and
- ENDS. Subsequent matches using PATTERN_BUFFER and REGS will use
- this memory for recording register information. STARTS and ENDS
- must be allocated using the malloc library routine, and must each
- be at least NUM_REGS * sizeof (regoff_t) bytes long.
-
- If NUM_REGS == 0, then subsequent matches should allocate their own
- register data.
-
- Unless this function is called, the first search or match using
- PATTERN_BUFFER will allocate its own register data, without
- freeing the old data. */
-
-void
-re_set_registers (struct re_pattern_buffer *bufp, struct re_registers *regs,
- unsigned num_regs, regoff_t *starts, regoff_t *ends)
-{
- if (num_regs)
- {
- bufp->regs_allocated = REGS_REALLOCATE;
- regs->num_regs = num_regs;
- regs->start = starts;
- regs->end = ends;
- }
- else
- {
- bufp->regs_allocated = REGS_UNALLOCATED;
- regs->num_regs = 0;
- regs->start = regs->end = (regoff_t *) 0;
- }
-}
-#ifdef _LIBC
-weak_alias (__re_set_registers, re_set_registers)
-#endif
-
-/* Entry points compatible with 4.2 BSD regex library. We don't define
- them unless specifically requested. */
-
-#if defined _REGEX_RE_COMP || defined _LIBC
-int
-# ifdef _LIBC
-weak_function
-# endif
-re_exec (s)
- const char *s;
-{
- return 0 == regexec (&re_comp_buf, s, 0, NULL, 0);
-}
-#endif /* _REGEX_RE_COMP */
-
-/* Internal entry point. */
-
-/* Searches for a compiled pattern PREG in the string STRING, whose
- length is LENGTH. NMATCH, PMATCH, and EFLAGS have the same
- mingings with regexec. START, and RANGE have the same meanings
- with re_search.
- Return REG_NOERROR if we find a match, and REG_NOMATCH if not,
- otherwise return the error code.
- Note: We assume front end functions already check ranges.
- (START + RANGE >= 0 && START + RANGE <= LENGTH) */
-
-static reg_errcode_t internal_function
-re_search_internal (const regex_t *preg, const char *string, int length, int start,
- int range, int stop, size_t nmatch, regmatch_t pmatch[],
- int eflags)
-{
- reg_errcode_t err;
- const re_dfa_t *dfa = (const re_dfa_t *) preg->buffer;
- int left_lim, right_lim, incr;
- int fl_longest_match, match_first, match_kind, match_last = -1;
- int extra_nmatch;
- int sb, ch;
-#if defined _LIBC || (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L)
- re_match_context_t mctx = { .dfa = dfa };
-#else
- re_match_context_t mctx;
-#endif
- char *fastmap = (preg->fastmap != NULL && preg->fastmap_accurate
- && range && !preg->can_be_null) ? preg->fastmap : NULL;
- RE_TRANSLATE_TYPE t = preg->translate;
-
-#if !(defined _LIBC || (defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L))
- memset (&mctx, '\0', sizeof (re_match_context_t));
- mctx.dfa = dfa;
-#endif
-
- extra_nmatch = (nmatch > preg->re_nsub) ? nmatch - (preg->re_nsub + 1) : 0;
- nmatch -= extra_nmatch;
-
- /* Check if the DFA haven't been compiled. */
- if (BE (preg->used == 0 || dfa->init_state == NULL
- || dfa->init_state_word == NULL || dfa->init_state_nl == NULL
- || dfa->init_state_begbuf == NULL, 0))
- return REG_NOMATCH;
-
-#ifdef DEBUG
- /* We assume front-end functions already check them. */
- assert (start + range >= 0 && start + range <= length);
-#endif
-
- /* If initial states with non-begbuf contexts have no elements,
- the regex must be anchored. If preg->newline_anchor is set,
- we'll never use init_state_nl, so do not check it. */
- if (dfa->init_state->nodes.nelem == 0
- && dfa->init_state_word->nodes.nelem == 0
- && (dfa->init_state_nl->nodes.nelem == 0
- || !preg->newline_anchor))
- {
- if (start != 0 && start + range != 0)
- return REG_NOMATCH;
- start = range = 0;
- }
-
- /* We must check the longest matching, if nmatch > 0. */
- fl_longest_match = (nmatch != 0 || dfa->nbackref);
-
- err = re_string_allocate (&mctx.input, string, length, dfa->nodes_len + 1,
- preg->translate, preg->syntax & RE_ICASE, dfa);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
- mctx.input.stop = stop;
- mctx.input.raw_stop = stop;
- mctx.input.newline_anchor = preg->newline_anchor;
-
- err = match_ctx_init (&mctx, eflags, dfa->nbackref * 2);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
-
- /* We will log all the DFA states through which the dfa pass,
- if nmatch > 1, or this dfa has "multibyte node", which is a
- back-reference or a node which can accept multibyte character or
- multi character collating element. */
- if (nmatch > 1 || dfa->has_mb_node)
- {
- mctx.state_log = re_malloc (re_dfastate_t *, mctx.input.bufs_len + 1);
- if (BE (mctx.state_log == NULL, 0))
- {
- err = REG_ESPACE;
- goto free_return;
- }
- }
- else
- mctx.state_log = NULL;
-
- match_first = start;
- mctx.input.tip_context = (eflags & REG_NOTBOL) ? CONTEXT_BEGBUF
- : CONTEXT_NEWLINE | CONTEXT_BEGBUF;
-
- /* Check incrementally whether of not the input string match. */
- incr = (range < 0) ? -1 : 1;
- left_lim = (range < 0) ? start + range : start;
- right_lim = (range < 0) ? start : start + range;
- sb = dfa->mb_cur_max == 1;
- match_kind =
- (fastmap
- ? ((sb || !(preg->syntax & RE_ICASE || t) ? 4 : 0)
- | (range >= 0 ? 2 : 0)
- | (t != NULL ? 1 : 0))
- : 8);
-
- for (;; match_first += incr)
- {
- err = REG_NOMATCH;
- if (match_first < left_lim || right_lim < match_first)
- goto free_return;
-
- /* Advance as rapidly as possible through the string, until we
- find a plausible place to start matching. This may be done
- with varying efficiency, so there are various possibilities:
- only the most common of them are specialized, in order to
- save on code size. We use a switch statement for speed. */
- switch (match_kind)
- {
- case 8:
- /* No fastmap. */
- break;
-
- case 7:
- /* Fastmap with single-byte translation, match forward. */
- while (BE (match_first < right_lim, 1)
- && !fastmap[t[(unsigned char) string[match_first]]])
- ++match_first;
- goto forward_match_found_start_or_reached_end;
-
- case 6:
- /* Fastmap without translation, match forward. */
- while (BE (match_first < right_lim, 1)
- && !fastmap[(unsigned char) string[match_first]])
- ++match_first;
-
- forward_match_found_start_or_reached_end:
- if (BE (match_first == right_lim, 0))
- {
- ch = match_first >= length
- ? 0 : (unsigned char) string[match_first];
- if (!fastmap[t ? t[ch] : ch])
- goto free_return;
- }
- break;
-
- case 4:
- case 5:
- /* Fastmap without multi-byte translation, match backwards. */
- while (match_first >= left_lim)
- {
- ch = match_first >= length
- ? 0 : (unsigned char) string[match_first];
- if (fastmap[t ? t[ch] : ch])
- break;
- --match_first;
- }
- if (match_first < left_lim)
- goto free_return;
- break;
-
- default:
- /* In this case, we can't determine easily the current byte,
- since it might be a component byte of a multibyte
- character. Then we use the constructed buffer instead. */
- for (;;)
- {
- /* If MATCH_FIRST is out of the valid range, reconstruct the
- buffers. */
- unsigned int offset = match_first - mctx.input.raw_mbs_idx;
- if (BE (offset >= (unsigned int) mctx.input.valid_raw_len, 0))
- {
- err = re_string_reconstruct (&mctx.input, match_first,
- eflags);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
-
- offset = match_first - mctx.input.raw_mbs_idx;
- }
- /* If MATCH_FIRST is out of the buffer, leave it as '\0'.
- Note that MATCH_FIRST must not be smaller than 0. */
- ch = (match_first >= length
- ? 0 : re_string_byte_at (&mctx.input, offset));
- if (fastmap[ch])
- break;
- match_first += incr;
- if (match_first < left_lim || match_first > right_lim)
- {
- err = REG_NOMATCH;
- goto free_return;
- }
- }
- break;
- }
-
- /* Reconstruct the buffers so that the matcher can assume that
- the matching starts from the beginning of the buffer. */
- err = re_string_reconstruct (&mctx.input, match_first, eflags);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
-
-#ifdef RE_ENABLE_I18N
- /* Don't consider this char as a possible match start if it part,
- yet isn't the head, of a multibyte character. */
- if (!sb && !re_string_first_byte (&mctx.input, 0))
- continue;
-#endif
-
- /* It seems to be appropriate one, then use the matcher. */
- /* We assume that the matching starts from 0. */
- mctx.state_log_top = mctx.nbkref_ents = mctx.max_mb_elem_len = 0;
- match_last = check_matching (&mctx, fl_longest_match,
- range >= 0 ? &match_first : NULL);
- if (match_last != -1)
- {
- if (BE (match_last == -2, 0))
- {
- err = REG_ESPACE;
- goto free_return;
- }
- else
- {
- mctx.match_last = match_last;
- if ((!preg->no_sub && nmatch > 1) || dfa->nbackref)
- {
- re_dfastate_t *pstate = mctx.state_log[match_last];
- mctx.last_node = check_halt_state_context (&mctx, pstate,
- match_last);
- }
- if ((!preg->no_sub && nmatch > 1 && dfa->has_plural_match)
- || dfa->nbackref)
- {
- err = prune_impossible_nodes (&mctx);
- if (err == REG_NOERROR)
- break;
- if (BE (err != REG_NOMATCH, 0))
- goto free_return;
- match_last = -1;
- }
- else
- break; /* We found a match. */
- }
- }
-
- match_ctx_clean (&mctx);
- }
-
-#ifdef DEBUG
- assert (match_last != -1);
- assert (err == REG_NOERROR);
-#endif
-
- /* Set pmatch[] if we need. */
- if (nmatch > 0)
- {
- int reg_idx;
-
- /* Initialize registers. */
- for (reg_idx = 1; reg_idx < nmatch; ++reg_idx)
- pmatch[reg_idx].rm_so = pmatch[reg_idx].rm_eo = -1;
-
- /* Set the points where matching start/end. */
- pmatch[0].rm_so = 0;
- pmatch[0].rm_eo = mctx.match_last;
-
- if (!preg->no_sub && nmatch > 1)
- {
- err = set_regs (preg, &mctx, nmatch, pmatch,
- dfa->has_plural_match && dfa->nbackref > 0);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
- }
-
- /* At last, add the offset to the each registers, since we slided
- the buffers so that we could assume that the matching starts
- from 0. */
- for (reg_idx = 0; reg_idx < nmatch; ++reg_idx)
- if (pmatch[reg_idx].rm_so != -1)
- {
-#ifdef RE_ENABLE_I18N
- if (BE (mctx.input.offsets_needed != 0, 0))
- {
- pmatch[reg_idx].rm_so =
- (pmatch[reg_idx].rm_so == mctx.input.valid_len
- ? mctx.input.valid_raw_len
- : mctx.input.offsets[pmatch[reg_idx].rm_so]);
- pmatch[reg_idx].rm_eo =
- (pmatch[reg_idx].rm_eo == mctx.input.valid_len
- ? mctx.input.valid_raw_len
- : mctx.input.offsets[pmatch[reg_idx].rm_eo]);
- }
-#else
- assert (mctx.input.offsets_needed == 0);
-#endif
- pmatch[reg_idx].rm_so += match_first;
- pmatch[reg_idx].rm_eo += match_first;
- }
- for (reg_idx = 0; reg_idx < extra_nmatch; ++reg_idx)
- {
- pmatch[nmatch + reg_idx].rm_so = -1;
- pmatch[nmatch + reg_idx].rm_eo = -1;
- }
-
- if (dfa->subexp_map)
- for (reg_idx = 0; reg_idx + 1 < nmatch; reg_idx++)
- if (dfa->subexp_map[reg_idx] != reg_idx)
- {
- pmatch[reg_idx + 1].rm_so
- = pmatch[dfa->subexp_map[reg_idx] + 1].rm_so;
- pmatch[reg_idx + 1].rm_eo
- = pmatch[dfa->subexp_map[reg_idx] + 1].rm_eo;
- }
- }
-
- free_return:
- re_free (mctx.state_log);
- if (dfa->nbackref)
- match_ctx_free (&mctx);
- re_string_destruct (&mctx.input);
- return err;
-}
-
-static reg_errcode_t internal_function
-prune_impossible_nodes (re_match_context_t *mctx)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- int halt_node, match_last;
- reg_errcode_t ret;
- re_dfastate_t **sifted_states;
- re_dfastate_t **lim_states = NULL;
- re_sift_context_t sctx;
-#ifdef DEBUG
- assert (mctx->state_log != NULL);
-#endif
- match_last = mctx->match_last;
- halt_node = mctx->last_node;
- sifted_states = re_malloc (re_dfastate_t *, match_last + 1);
- if (BE (sifted_states == NULL, 0))
- {
- ret = REG_ESPACE;
- goto free_return;
- }
- if (dfa->nbackref)
- {
- lim_states = re_malloc (re_dfastate_t *, match_last + 1);
- if (BE (lim_states == NULL, 0))
- {
- ret = REG_ESPACE;
- goto free_return;
- }
- while (1)
- {
- memset (lim_states, '\0',
- sizeof (re_dfastate_t *) * (match_last + 1));
- sift_ctx_init (&sctx, sifted_states, lim_states, halt_node,
- match_last);
- ret = sift_states_backward (mctx, &sctx);
- re_node_set_free (&sctx.limits);
- if (BE (ret != REG_NOERROR, 0))
- goto free_return;
- if (sifted_states[0] != NULL || lim_states[0] != NULL)
- break;
- do
- {
- --match_last;
- if (match_last < 0)
- {
- ret = REG_NOMATCH;
- goto free_return;
- }
- } while (mctx->state_log[match_last] == NULL
- || !mctx->state_log[match_last]->halt);
- halt_node = check_halt_state_context (mctx,
- mctx->state_log[match_last],
- match_last);
- }
- ret = merge_state_array (dfa, sifted_states, lim_states,
- match_last + 1);
- re_free (lim_states);
- lim_states = NULL;
- if (BE (ret != REG_NOERROR, 0))
- goto free_return;
- }
- else
- {
- sift_ctx_init (&sctx, sifted_states, lim_states, halt_node, match_last);
- ret = sift_states_backward (mctx, &sctx);
- re_node_set_free (&sctx.limits);
- if (BE (ret != REG_NOERROR, 0))
- goto free_return;
- }
- re_free (mctx->state_log);
- mctx->state_log = sifted_states;
- sifted_states = NULL;
- mctx->last_node = halt_node;
- mctx->match_last = match_last;
- ret = REG_NOERROR;
- free_return:
- re_free (sifted_states);
- re_free (lim_states);
- return ret;
-}
-
-/* Acquire an initial state and return it.
- We must select appropriate initial state depending on the context,
- since initial states may have constraints like "\<", "^", etc.. */
-
-static inline re_dfastate_t *
-__attribute ((always_inline)) internal_function
-acquire_init_state_context (reg_errcode_t *err, const re_match_context_t *mctx,
- int idx)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- if (dfa->init_state->has_constraint)
- {
- unsigned int context;
- context = re_string_context_at (&mctx->input, idx - 1, mctx->eflags);
- if (IS_WORD_CONTEXT (context))
- return dfa->init_state_word;
- else if (IS_ORDINARY_CONTEXT (context))
- return dfa->init_state;
- else if (IS_BEGBUF_CONTEXT (context) && IS_NEWLINE_CONTEXT (context))
- return dfa->init_state_begbuf;
- else if (IS_NEWLINE_CONTEXT (context))
- return dfa->init_state_nl;
- else if (IS_BEGBUF_CONTEXT (context))
- {
- /* It is relatively rare case, then calculate on demand. */
- return re_acquire_state_context (err, dfa,
- dfa->init_state->entrance_nodes,
- context);
- }
- else
- /* Must not happen? */
- return dfa->init_state;
- }
- else
- return dfa->init_state;
-}
-
-/* Check whether the regular expression match input string INPUT or not,
- and return the index where the matching end, return -1 if not match,
- or return -2 in case of an error.
- FL_LONGEST_MATCH means we want the POSIX longest matching.
- If P_MATCH_FIRST is not NULL, and the match fails, it is set to the
- next place where we may want to try matching.
- Note that the matcher assume that the maching starts from the current
- index of the buffer. */
-
-static int
-internal_function
-check_matching (re_match_context_t *mctx, int fl_longest_match,
- int *p_match_first)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- reg_errcode_t err;
- int match = 0;
- int match_last = -1;
- int cur_str_idx = re_string_cur_idx (&mctx->input);
- re_dfastate_t *cur_state;
- int at_init_state = p_match_first != NULL;
- int next_start_idx = cur_str_idx;
-
- err = REG_NOERROR;
- cur_state = acquire_init_state_context (&err, mctx, cur_str_idx);
- /* An initial state must not be NULL (invalid). */
- if (BE (cur_state == NULL, 0))
- {
- assert (err == REG_ESPACE);
- return -2;
- }
-
- if (mctx->state_log != NULL)
- {
- mctx->state_log[cur_str_idx] = cur_state;
-
- /* Check OP_OPEN_SUBEXP in the initial state in case that we use them
- later. E.g. Processing back references. */
- if (BE (dfa->nbackref, 0))
- {
- at_init_state = 0;
- err = check_subexp_matching_top (mctx, &cur_state->nodes, 0);
- if (BE (err != REG_NOERROR, 0))
- return err;
-
- if (cur_state->has_backref)
- {
- err = transit_state_bkref (mctx, &cur_state->nodes);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- }
- }
-
- /* If the RE accepts NULL string. */
- if (BE (cur_state->halt, 0))
- {
- if (!cur_state->has_constraint
- || check_halt_state_context (mctx, cur_state, cur_str_idx))
- {
- if (!fl_longest_match)
- return cur_str_idx;
- else
- {
- match_last = cur_str_idx;
- match = 1;
- }
- }
- }
-
- while (!re_string_eoi (&mctx->input))
- {
- re_dfastate_t *old_state = cur_state;
- int next_char_idx = re_string_cur_idx (&mctx->input) + 1;
-
- if (BE (next_char_idx >= mctx->input.bufs_len, 0)
- || (BE (next_char_idx >= mctx->input.valid_len, 0)
- && mctx->input.valid_len < mctx->input.len))
- {
- err = extend_buffers (mctx);
- if (BE (err != REG_NOERROR, 0))
- {
- assert (err == REG_ESPACE);
- return -2;
- }
- }
-
- cur_state = transit_state (&err, mctx, cur_state);
- if (mctx->state_log != NULL)
- cur_state = merge_state_with_log (&err, mctx, cur_state);
-
- if (cur_state == NULL)
- {
- /* Reached the invalid state or an error. Try to recover a valid
- state using the state log, if available and if we have not
- already found a valid (even if not the longest) match. */
- if (BE (err != REG_NOERROR, 0))
- return -2;
-
- if (mctx->state_log == NULL
- || (match && !fl_longest_match)
- || (cur_state = find_recover_state (&err, mctx)) == NULL)
- break;
- }
-
- if (BE (at_init_state, 0))
- {
- if (old_state == cur_state)
- next_start_idx = next_char_idx;
- else
- at_init_state = 0;
- }
-
- if (cur_state->halt)
- {
- /* Reached a halt state.
- Check the halt state can satisfy the current context. */
- if (!cur_state->has_constraint
- || check_halt_state_context (mctx, cur_state,
- re_string_cur_idx (&mctx->input)))
- {
- /* We found an appropriate halt state. */
- match_last = re_string_cur_idx (&mctx->input);
- match = 1;
-
- /* We found a match, do not modify match_first below. */
- p_match_first = NULL;
- if (!fl_longest_match)
- break;
- }
- }
- }
-
- if (p_match_first)
- *p_match_first += next_start_idx;
-
- return match_last;
-}
-
-/* Check NODE match the current context. */
-
-static int
-internal_function
-check_halt_node_context (const re_dfa_t *dfa, int node, unsigned int context)
-{
- re_token_type_t type = dfa->nodes[node].type;
- unsigned int constraint = dfa->nodes[node].constraint;
- if (type != END_OF_RE)
- return 0;
- if (!constraint)
- return 1;
- if (NOT_SATISFY_NEXT_CONSTRAINT (constraint, context))
- return 0;
- return 1;
-}
-
-/* Check the halt state STATE match the current context.
- Return 0 if not match, if the node, STATE has, is a halt node and
- match the context, return the node. */
-
-static int
-internal_function
-check_halt_state_context (const re_match_context_t *mctx,
- const re_dfastate_t *state, int idx)
-{
- int i;
- unsigned int context;
-#ifdef DEBUG
- assert (state->halt);
-#endif
- context = re_string_context_at (&mctx->input, idx, mctx->eflags);
- for (i = 0; i < state->nodes.nelem; ++i)
- if (check_halt_node_context (mctx->dfa, state->nodes.elems[i], context))
- return state->nodes.elems[i];
- return 0;
-}
-
-/* Compute the next node to which "NFA" transit from NODE("NFA" is a NFA
- corresponding to the DFA).
- Return the destination node, and update EPS_VIA_NODES, return -1 in case
- of errors. */
-
-static int
-internal_function
-proceed_next_node (const re_match_context_t *mctx, int nregs, regmatch_t *regs,
- int *pidx, int node, re_node_set *eps_via_nodes,
- struct re_fail_stack_t *fs)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- int i, err;
- if (IS_EPSILON_NODE (dfa->nodes[node].type))
- {
- re_node_set *cur_nodes = &mctx->state_log[*pidx]->nodes;
- re_node_set *edests = &dfa->edests[node];
- int dest_node;
- err = re_node_set_insert (eps_via_nodes, node);
- if (BE (err < 0, 0))
- return -2;
- /* Pick up a valid destination, or return -1 if none is found. */
- for (dest_node = -1, i = 0; i < edests->nelem; ++i)
- {
- int candidate = edests->elems[i];
- if (!re_node_set_contains (cur_nodes, candidate))
- continue;
- if (dest_node == -1)
- dest_node = candidate;
-
- else
- {
- /* In order to avoid infinite loop like "(a*)*", return the second
- epsilon-transition if the first was already considered. */
- if (re_node_set_contains (eps_via_nodes, dest_node))
- return candidate;
-
- /* Otherwise, push the second epsilon-transition on the fail stack. */
- else if (fs != NULL
- && push_fail_stack (fs, *pidx, candidate, nregs, regs,
- eps_via_nodes))
- return -2;
-
- /* We know we are going to exit. */
- break;
- }
- }
- return dest_node;
- }
- else
- {
- int naccepted = 0;
- re_token_type_t type = dfa->nodes[node].type;
-
-#ifdef RE_ENABLE_I18N
- if (dfa->nodes[node].accept_mb)
- naccepted = check_node_accept_bytes (dfa, node, &mctx->input, *pidx);
- else
-#endif /* RE_ENABLE_I18N */
- if (type == OP_BACK_REF)
- {
- int subexp_idx = dfa->nodes[node].opr.idx + 1;
- naccepted = regs[subexp_idx].rm_eo - regs[subexp_idx].rm_so;
- if (fs != NULL)
- {
- if (regs[subexp_idx].rm_so == -1 || regs[subexp_idx].rm_eo == -1)
- return -1;
- else if (naccepted)
- {
- char *buf = (char *) re_string_get_buffer (&mctx->input);
- if (memcmp (buf + regs[subexp_idx].rm_so, buf + *pidx,
- naccepted) != 0)
- return -1;
- }
- }
-
- if (naccepted == 0)
- {
- int dest_node;
- err = re_node_set_insert (eps_via_nodes, node);
- if (BE (err < 0, 0))
- return -2;
- dest_node = dfa->edests[node].elems[0];
- if (re_node_set_contains (&mctx->state_log[*pidx]->nodes,
- dest_node))
- return dest_node;
- }
- }
-
- if (naccepted != 0
- || check_node_accept (mctx, dfa->nodes + node, *pidx))
- {
- int dest_node = dfa->nexts[node];
- *pidx = (naccepted == 0) ? *pidx + 1 : *pidx + naccepted;
- if (fs && (*pidx > mctx->match_last || mctx->state_log[*pidx] == NULL
- || !re_node_set_contains (&mctx->state_log[*pidx]->nodes,
- dest_node)))
- return -1;
- re_node_set_empty (eps_via_nodes);
- return dest_node;
- }
- }
- return -1;
-}
-
-static reg_errcode_t
-internal_function
-push_fail_stack (struct re_fail_stack_t *fs, int str_idx, int dest_node,
- int nregs, regmatch_t *regs, re_node_set *eps_via_nodes)
-{
- reg_errcode_t err;
- int num = fs->num++;
- if (fs->num == fs->alloc)
- {
- struct re_fail_stack_ent_t *new_array;
- new_array = realloc (fs->stack, (sizeof (struct re_fail_stack_ent_t)
- * fs->alloc * 2));
- if (new_array == NULL)
- return REG_ESPACE;
- fs->alloc *= 2;
- fs->stack = new_array;
- }
- fs->stack[num].idx = str_idx;
- fs->stack[num].node = dest_node;
- fs->stack[num].regs = re_malloc (regmatch_t, nregs);
- if (fs->stack[num].regs == NULL)
- return REG_ESPACE;
- memcpy (fs->stack[num].regs, regs, sizeof (regmatch_t) * nregs);
- err = re_node_set_init_copy (&fs->stack[num].eps_via_nodes, eps_via_nodes);
- return err;
-}
-
-static int
-internal_function
-pop_fail_stack (struct re_fail_stack_t *fs, int *pidx, int nregs,
- regmatch_t *regs, re_node_set *eps_via_nodes)
-{
- int num = --fs->num;
- assert (num >= 0);
- *pidx = fs->stack[num].idx;
- memcpy (regs, fs->stack[num].regs, sizeof (regmatch_t) * nregs);
- re_node_set_free (eps_via_nodes);
- re_free (fs->stack[num].regs);
- *eps_via_nodes = fs->stack[num].eps_via_nodes;
- return fs->stack[num].node;
-}
-
-/* Set the positions where the subexpressions are starts/ends to registers
- PMATCH.
- Note: We assume that pmatch[0] is already set, and
- pmatch[i].rm_so == pmatch[i].rm_eo == -1 for 0 < i < nmatch. */
-
-static reg_errcode_t
-internal_function
-set_regs (const regex_t *preg, const re_match_context_t *mctx, size_t nmatch,
- regmatch_t *pmatch, int fl_backtrack)
-{
- const re_dfa_t *dfa = (const re_dfa_t *) preg->buffer;
- int idx, cur_node;
- re_node_set eps_via_nodes;
- struct re_fail_stack_t *fs;
- struct re_fail_stack_t fs_body = { 0, 2, NULL };
- regmatch_t *prev_idx_match;
- int prev_idx_match_malloced = 0;
-
-#ifdef DEBUG
- assert (nmatch > 1);
- assert (mctx->state_log != NULL);
-#endif
- if (fl_backtrack)
- {
- fs = &fs_body;
- fs->stack = re_malloc (struct re_fail_stack_ent_t, fs->alloc);
- if (fs->stack == NULL)
- return REG_ESPACE;
- }
- else
- fs = NULL;
-
- cur_node = dfa->init_node;
- re_node_set_init_empty (&eps_via_nodes);
-
- if (__libc_use_alloca (nmatch * sizeof (regmatch_t)))
- prev_idx_match = (regmatch_t *) alloca (nmatch * sizeof (regmatch_t));
- else
- {
- prev_idx_match = re_malloc (regmatch_t, nmatch);
- if (prev_idx_match == NULL)
- {
- free_fail_stack_return (fs);
- return REG_ESPACE;
- }
- prev_idx_match_malloced = 1;
- }
- memcpy (prev_idx_match, pmatch, sizeof (regmatch_t) * nmatch);
-
- for (idx = pmatch[0].rm_so; idx <= pmatch[0].rm_eo ;)
- {
- update_regs (dfa, pmatch, prev_idx_match, cur_node, idx, nmatch);
-
- if (idx == pmatch[0].rm_eo && cur_node == mctx->last_node)
- {
- int reg_idx;
- if (fs)
- {
- for (reg_idx = 0; reg_idx < nmatch; ++reg_idx)
- if (pmatch[reg_idx].rm_so > -1 && pmatch[reg_idx].rm_eo == -1)
- break;
- if (reg_idx == nmatch)
- {
- re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
- return free_fail_stack_return (fs);
- }
- cur_node = pop_fail_stack (fs, &idx, nmatch, pmatch,
- &eps_via_nodes);
- }
- else
- {
- re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
- return REG_NOERROR;
- }
- }
-
- /* Proceed to next node. */
- cur_node = proceed_next_node (mctx, nmatch, pmatch, &idx, cur_node,
- &eps_via_nodes, fs);
-
- if (BE (cur_node < 0, 0))
- {
- if (BE (cur_node == -2, 0))
- {
- re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
- free_fail_stack_return (fs);
- return REG_ESPACE;
- }
- if (fs)
- cur_node = pop_fail_stack (fs, &idx, nmatch, pmatch,
- &eps_via_nodes);
- else
- {
- re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
- return REG_NOMATCH;
- }
- }
- }
- re_node_set_free (&eps_via_nodes);
- if (prev_idx_match_malloced)
- re_free (prev_idx_match);
- return free_fail_stack_return (fs);
-}
-
-static reg_errcode_t
-internal_function
-free_fail_stack_return (struct re_fail_stack_t *fs)
-{
- if (fs)
- {
- int fs_idx;
- for (fs_idx = 0; fs_idx < fs->num; ++fs_idx)
- {
- re_node_set_free (&fs->stack[fs_idx].eps_via_nodes);
- re_free (fs->stack[fs_idx].regs);
- }
- re_free (fs->stack);
- }
- return REG_NOERROR;
-}
-
-static void
-internal_function
-update_regs (const re_dfa_t *dfa, regmatch_t *pmatch,
- regmatch_t *prev_idx_match, int cur_node, int cur_idx, int nmatch)
-{
- int type = dfa->nodes[cur_node].type;
- if (type == OP_OPEN_SUBEXP)
- {
- int reg_num = dfa->nodes[cur_node].opr.idx + 1;
-
- /* We are at the first node of this sub expression. */
- if (reg_num < nmatch)
- {
- pmatch[reg_num].rm_so = cur_idx;
- pmatch[reg_num].rm_eo = -1;
- }
- }
- else if (type == OP_CLOSE_SUBEXP)
- {
- int reg_num = dfa->nodes[cur_node].opr.idx + 1;
- if (reg_num < nmatch)
- {
- /* We are at the last node of this sub expression. */
- if (pmatch[reg_num].rm_so < cur_idx)
- {
- pmatch[reg_num].rm_eo = cur_idx;
- /* This is a non-empty match or we are not inside an optional
- subexpression. Accept this right away. */
- memcpy (prev_idx_match, pmatch, sizeof (regmatch_t) * nmatch);
- }
- else
- {
- if (dfa->nodes[cur_node].opt_subexp
- && prev_idx_match[reg_num].rm_so != -1)
- /* We transited through an empty match for an optional
- subexpression, like (a?)*, and this is not the subexp's
- first match. Copy back the old content of the registers
- so that matches of an inner subexpression are undone as
- well, like in ((a?))*. */
- memcpy (pmatch, prev_idx_match, sizeof (regmatch_t) * nmatch);
- else
- /* We completed a subexpression, but it may be part of
- an optional one, so do not update PREV_IDX_MATCH. */
- pmatch[reg_num].rm_eo = cur_idx;
- }
- }
- }
-}
-
-/* This function checks the STATE_LOG from the SCTX->last_str_idx to 0
- and sift the nodes in each states according to the following rules.
- Updated state_log will be wrote to STATE_LOG.
-
- Rules: We throw away the Node `a' in the STATE_LOG[STR_IDX] if...
- 1. When STR_IDX == MATCH_LAST(the last index in the state_log):
- If `a' isn't the LAST_NODE and `a' can't epsilon transit to
- the LAST_NODE, we throw away the node `a'.
- 2. When 0 <= STR_IDX < MATCH_LAST and `a' accepts
- string `s' and transit to `b':
- i. If 'b' isn't in the STATE_LOG[STR_IDX+strlen('s')], we throw
- away the node `a'.
- ii. If 'b' is in the STATE_LOG[STR_IDX+strlen('s')] but 'b' is
- thrown away, we throw away the node `a'.
- 3. When 0 <= STR_IDX < MATCH_LAST and 'a' epsilon transit to 'b':
- i. If 'b' isn't in the STATE_LOG[STR_IDX], we throw away the
- node `a'.
- ii. If 'b' is in the STATE_LOG[STR_IDX] but 'b' is thrown away,
- we throw away the node `a'. */
-
-#define STATE_NODE_CONTAINS(state,node) \
- ((state) != NULL && re_node_set_contains (&(state)->nodes, node))
-
-static reg_errcode_t
-internal_function
-sift_states_backward (const re_match_context_t *mctx, re_sift_context_t *sctx)
-{
- reg_errcode_t err;
- int null_cnt = 0;
- int str_idx = sctx->last_str_idx;
- re_node_set cur_dest;
-
-#ifdef DEBUG
- assert (mctx->state_log != NULL && mctx->state_log[str_idx] != NULL);
-#endif
-
- /* Build sifted state_log[str_idx]. It has the nodes which can epsilon
- transit to the last_node and the last_node itself. */
- err = re_node_set_init_1 (&cur_dest, sctx->last_node);
- if (BE (err != REG_NOERROR, 0))
- return err;
- err = update_cur_sifted_state (mctx, sctx, str_idx, &cur_dest);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
-
- /* Then check each states in the state_log. */
- while (str_idx > 0)
- {
- /* Update counters. */
- null_cnt = (sctx->sifted_states[str_idx] == NULL) ? null_cnt + 1 : 0;
- if (null_cnt > mctx->max_mb_elem_len)
- {
- memset (sctx->sifted_states, '\0',
- sizeof (re_dfastate_t *) * str_idx);
- re_node_set_free (&cur_dest);
- return REG_NOERROR;
- }
- re_node_set_empty (&cur_dest);
- --str_idx;
-
- if (mctx->state_log[str_idx])
- {
- err = build_sifted_states (mctx, sctx, str_idx, &cur_dest);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
- }
-
- /* Add all the nodes which satisfy the following conditions:
- - It can epsilon transit to a node in CUR_DEST.
- - It is in CUR_SRC.
- And update state_log. */
- err = update_cur_sifted_state (mctx, sctx, str_idx, &cur_dest);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
- }
- err = REG_NOERROR;
- free_return:
- re_node_set_free (&cur_dest);
- return err;
-}
-
-static reg_errcode_t
-internal_function
-build_sifted_states (const re_match_context_t *mctx, re_sift_context_t *sctx,
- int str_idx, re_node_set *cur_dest)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- const re_node_set *cur_src = &mctx->state_log[str_idx]->non_eps_nodes;
- int i;
-
- /* Then build the next sifted state.
- We build the next sifted state on `cur_dest', and update
- `sifted_states[str_idx]' with `cur_dest'.
- Note:
- `cur_dest' is the sifted state from `state_log[str_idx + 1]'.
- `cur_src' points the node_set of the old `state_log[str_idx]'
- (with the epsilon nodes pre-filtered out). */
- for (i = 0; i < cur_src->nelem; i++)
- {
- int prev_node = cur_src->elems[i];
- int naccepted = 0;
- int ret;
-
-#ifdef DEBUG
- re_token_type_t type = dfa->nodes[prev_node].type;
- assert (!IS_EPSILON_NODE (type));
-#endif
-#ifdef RE_ENABLE_I18N
- /* If the node may accept `multi byte'. */
- if (dfa->nodes[prev_node].accept_mb)
- naccepted = sift_states_iter_mb (mctx, sctx, prev_node,
- str_idx, sctx->last_str_idx);
-#endif /* RE_ENABLE_I18N */
-
- /* We don't check backreferences here.
- See update_cur_sifted_state(). */
- if (!naccepted
- && check_node_accept (mctx, dfa->nodes + prev_node, str_idx)
- && STATE_NODE_CONTAINS (sctx->sifted_states[str_idx + 1],
- dfa->nexts[prev_node]))
- naccepted = 1;
-
- if (naccepted == 0)
- continue;
-
- if (sctx->limits.nelem)
- {
- int to_idx = str_idx + naccepted;
- if (check_dst_limits (mctx, &sctx->limits,
- dfa->nexts[prev_node], to_idx,
- prev_node, str_idx))
- continue;
- }
- ret = re_node_set_insert (cur_dest, prev_node);
- if (BE (ret == -1, 0))
- return REG_ESPACE;
- }
-
- return REG_NOERROR;
-}
-
-/* Helper functions. */
-
-static reg_errcode_t
-internal_function
-clean_state_log_if_needed (re_match_context_t *mctx, int next_state_log_idx)
-{
- int top = mctx->state_log_top;
-
- if (next_state_log_idx >= mctx->input.bufs_len
- || (next_state_log_idx >= mctx->input.valid_len
- && mctx->input.valid_len < mctx->input.len))
- {
- reg_errcode_t err;
- err = extend_buffers (mctx);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
-
- if (top < next_state_log_idx)
- {
- memset (mctx->state_log + top + 1, '\0',
- sizeof (re_dfastate_t *) * (next_state_log_idx - top));
- mctx->state_log_top = next_state_log_idx;
- }
- return REG_NOERROR;
-}
-
-static reg_errcode_t
-internal_function
-merge_state_array (const re_dfa_t *dfa, re_dfastate_t **dst,
- re_dfastate_t **src, int num)
-{
- int st_idx;
- reg_errcode_t err;
- for (st_idx = 0; st_idx < num; ++st_idx)
- {
- if (dst[st_idx] == NULL)
- dst[st_idx] = src[st_idx];
- else if (src[st_idx] != NULL)
- {
- re_node_set merged_set;
- err = re_node_set_init_union (&merged_set, &dst[st_idx]->nodes,
- &src[st_idx]->nodes);
- if (BE (err != REG_NOERROR, 0))
- return err;
- dst[st_idx] = re_acquire_state (&err, dfa, &merged_set);
- re_node_set_free (&merged_set);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- }
- return REG_NOERROR;
-}
-
-static reg_errcode_t
-internal_function
-update_cur_sifted_state (const re_match_context_t *mctx,
- re_sift_context_t *sctx, int str_idx,
- re_node_set *dest_nodes)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- reg_errcode_t err = REG_NOERROR;
- const re_node_set *candidates;
- candidates = ((mctx->state_log[str_idx] == NULL) ? NULL
- : &mctx->state_log[str_idx]->nodes);
-
- if (dest_nodes->nelem == 0)
- sctx->sifted_states[str_idx] = NULL;
- else
- {
- if (candidates)
- {
- /* At first, add the nodes which can epsilon transit to a node in
- DEST_NODE. */
- err = add_epsilon_src_nodes (dfa, dest_nodes, candidates);
- if (BE (err != REG_NOERROR, 0))
- return err;
-
- /* Then, check the limitations in the current sift_context. */
- if (sctx->limits.nelem)
- {
- err = check_subexp_limits (dfa, dest_nodes, candidates, &sctx->limits,
- mctx->bkref_ents, str_idx);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- }
-
- sctx->sifted_states[str_idx] = re_acquire_state (&err, dfa, dest_nodes);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
-
- if (candidates && mctx->state_log[str_idx]->has_backref)
- {
- err = sift_states_bkref (mctx, sctx, str_idx, candidates);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- return REG_NOERROR;
-}
-
-static reg_errcode_t
-internal_function
-add_epsilon_src_nodes (const re_dfa_t *dfa, re_node_set *dest_nodes,
- const re_node_set *candidates)
-{
- reg_errcode_t err = REG_NOERROR;
- int i;
-
- re_dfastate_t *state = re_acquire_state (&err, dfa, dest_nodes);
- if (BE (err != REG_NOERROR, 0))
- return err;
-
- if (!state->inveclosure.alloc)
- {
- err = re_node_set_alloc (&state->inveclosure, dest_nodes->nelem);
- if (BE (err != REG_NOERROR, 0))
- return REG_ESPACE;
- for (i = 0; i < dest_nodes->nelem; i++)
- re_node_set_merge (&state->inveclosure,
- dfa->inveclosures + dest_nodes->elems[i]);
- }
- return re_node_set_add_intersect (dest_nodes, candidates,
- &state->inveclosure);
-}
-
-static reg_errcode_t
-internal_function
-sub_epsilon_src_nodes (const re_dfa_t *dfa, int node, re_node_set *dest_nodes,
- const re_node_set *candidates)
-{
- int ecl_idx;
- reg_errcode_t err;
- re_node_set *inv_eclosure = dfa->inveclosures + node;
- re_node_set except_nodes;
- re_node_set_init_empty (&except_nodes);
- for (ecl_idx = 0; ecl_idx < inv_eclosure->nelem; ++ecl_idx)
- {
- int cur_node = inv_eclosure->elems[ecl_idx];
- if (cur_node == node)
- continue;
- if (IS_EPSILON_NODE (dfa->nodes[cur_node].type))
- {
- int edst1 = dfa->edests[cur_node].elems[0];
- int edst2 = ((dfa->edests[cur_node].nelem > 1)
- ? dfa->edests[cur_node].elems[1] : -1);
- if ((!re_node_set_contains (inv_eclosure, edst1)
- && re_node_set_contains (dest_nodes, edst1))
- || (edst2 > 0
- && !re_node_set_contains (inv_eclosure, edst2)
- && re_node_set_contains (dest_nodes, edst2)))
- {
- err = re_node_set_add_intersect (&except_nodes, candidates,
- dfa->inveclosures + cur_node);
- if (BE (err != REG_NOERROR, 0))
- {
- re_node_set_free (&except_nodes);
- return err;
- }
- }
- }
- }
- for (ecl_idx = 0; ecl_idx < inv_eclosure->nelem; ++ecl_idx)
- {
- int cur_node = inv_eclosure->elems[ecl_idx];
- if (!re_node_set_contains (&except_nodes, cur_node))
- {
- int idx = re_node_set_contains (dest_nodes, cur_node) - 1;
- re_node_set_remove_at (dest_nodes, idx);
- }
- }
- re_node_set_free (&except_nodes);
- return REG_NOERROR;
-}
-
-static int
-internal_function
-check_dst_limits (const re_match_context_t *mctx, re_node_set *limits,
- int dst_node, int dst_idx, int src_node, int src_idx)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- int lim_idx, src_pos, dst_pos;
-
- int dst_bkref_idx = search_cur_bkref_entry (mctx, dst_idx);
- int src_bkref_idx = search_cur_bkref_entry (mctx, src_idx);
- for (lim_idx = 0; lim_idx < limits->nelem; ++lim_idx)
- {
- int subexp_idx;
- struct re_backref_cache_entry *ent;
- ent = mctx->bkref_ents + limits->elems[lim_idx];
- subexp_idx = dfa->nodes[ent->node].opr.idx;
-
- dst_pos = check_dst_limits_calc_pos (mctx, limits->elems[lim_idx],
- subexp_idx, dst_node, dst_idx,
- dst_bkref_idx);
- src_pos = check_dst_limits_calc_pos (mctx, limits->elems[lim_idx],
- subexp_idx, src_node, src_idx,
- src_bkref_idx);
-
- /* In case of:
- <src> <dst> ( <subexp> )
- ( <subexp> ) <src> <dst>
- ( <subexp1> <src> <subexp2> <dst> <subexp3> ) */
- if (src_pos == dst_pos)
- continue; /* This is unrelated limitation. */
- else
- return 1;
- }
- return 0;
-}
-
-static int
-internal_function
-check_dst_limits_calc_pos_1 (const re_match_context_t *mctx, int boundaries,
- int subexp_idx, int from_node, int bkref_idx)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- const re_node_set *eclosures = dfa->eclosures + from_node;
- int node_idx;
-
- /* Else, we are on the boundary: examine the nodes on the epsilon
- closure. */
- for (node_idx = 0; node_idx < eclosures->nelem; ++node_idx)
- {
- int node = eclosures->elems[node_idx];
- switch (dfa->nodes[node].type)
- {
- case OP_BACK_REF:
- if (bkref_idx != -1)
- {
- struct re_backref_cache_entry *ent = mctx->bkref_ents + bkref_idx;
- do
- {
- int dst, cpos;
-
- if (ent->node != node)
- continue;
-
- if (subexp_idx < BITSET_WORD_BITS
- && !(ent->eps_reachable_subexps_map
- & ((bitset_word_t) 1 << subexp_idx)))
- continue;
-
- /* Recurse trying to reach the OP_OPEN_SUBEXP and
- OP_CLOSE_SUBEXP cases below. But, if the
- destination node is the same node as the source
- node, don't recurse because it would cause an
- infinite loop: a regex that exhibits this behavior
- is ()\1*\1* */
- dst = dfa->edests[node].elems[0];
- if (dst == from_node)
- {
- if (boundaries & 1)
- return -1;
- else /* if (boundaries & 2) */
- return 0;
- }
-
- cpos =
- check_dst_limits_calc_pos_1 (mctx, boundaries, subexp_idx,
- dst, bkref_idx);
- if (cpos == -1 /* && (boundaries & 1) */)
- return -1;
- if (cpos == 0 && (boundaries & 2))
- return 0;
-
- if (subexp_idx < BITSET_WORD_BITS)
- ent->eps_reachable_subexps_map
- &= ~((bitset_word_t) 1 << subexp_idx);
- }
- while (ent++->more);
- }
- break;
-
- case OP_OPEN_SUBEXP:
- if ((boundaries & 1) && subexp_idx == dfa->nodes[node].opr.idx)
- return -1;
- break;
-
- case OP_CLOSE_SUBEXP:
- if ((boundaries & 2) && subexp_idx == dfa->nodes[node].opr.idx)
- return 0;
- break;
-
- default:
- break;
- }
- }
-
- return (boundaries & 2) ? 1 : 0;
-}
-
-static int
-internal_function
-check_dst_limits_calc_pos (const re_match_context_t *mctx, int limit,
- int subexp_idx, int from_node, int str_idx,
- int bkref_idx)
-{
- struct re_backref_cache_entry *lim = mctx->bkref_ents + limit;
- int boundaries;
-
- /* If we are outside the range of the subexpression, return -1 or 1. */
- if (str_idx < lim->subexp_from)
- return -1;
-
- if (lim->subexp_to < str_idx)
- return 1;
-
- /* If we are within the subexpression, return 0. */
- boundaries = (str_idx == lim->subexp_from);
- boundaries |= (str_idx == lim->subexp_to) << 1;
- if (boundaries == 0)
- return 0;
-
- /* Else, examine epsilon closure. */
- return check_dst_limits_calc_pos_1 (mctx, boundaries, subexp_idx,
- from_node, bkref_idx);
-}
-
-/* Check the limitations of sub expressions LIMITS, and remove the nodes
- which are against limitations from DEST_NODES. */
-
-static reg_errcode_t
-internal_function
-check_subexp_limits (const re_dfa_t *dfa, re_node_set *dest_nodes,
- const re_node_set *candidates, re_node_set *limits,
- struct re_backref_cache_entry *bkref_ents, int str_idx)
-{
- reg_errcode_t err;
- int node_idx, lim_idx;
-
- for (lim_idx = 0; lim_idx < limits->nelem; ++lim_idx)
- {
- int subexp_idx;
- struct re_backref_cache_entry *ent;
- ent = bkref_ents + limits->elems[lim_idx];
-
- if (str_idx <= ent->subexp_from || ent->str_idx < str_idx)
- continue; /* This is unrelated limitation. */
-
- subexp_idx = dfa->nodes[ent->node].opr.idx;
- if (ent->subexp_to == str_idx)
- {
- int ops_node = -1;
- int cls_node = -1;
- for (node_idx = 0; node_idx < dest_nodes->nelem; ++node_idx)
- {
- int node = dest_nodes->elems[node_idx];
- re_token_type_t type = dfa->nodes[node].type;
- if (type == OP_OPEN_SUBEXP
- && subexp_idx == dfa->nodes[node].opr.idx)
- ops_node = node;
- else if (type == OP_CLOSE_SUBEXP
- && subexp_idx == dfa->nodes[node].opr.idx)
- cls_node = node;
- }
-
- /* Check the limitation of the open subexpression. */
- /* Note that (ent->subexp_to = str_idx != ent->subexp_from). */
- if (ops_node >= 0)
- {
- err = sub_epsilon_src_nodes (dfa, ops_node, dest_nodes,
- candidates);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
-
- /* Check the limitation of the close subexpression. */
- if (cls_node >= 0)
- for (node_idx = 0; node_idx < dest_nodes->nelem; ++node_idx)
- {
- int node = dest_nodes->elems[node_idx];
- if (!re_node_set_contains (dfa->inveclosures + node,
- cls_node)
- && !re_node_set_contains (dfa->eclosures + node,
- cls_node))
- {
- /* It is against this limitation.
- Remove it form the current sifted state. */
- err = sub_epsilon_src_nodes (dfa, node, dest_nodes,
- candidates);
- if (BE (err != REG_NOERROR, 0))
- return err;
- --node_idx;
- }
- }
- }
- else /* (ent->subexp_to != str_idx) */
- {
- for (node_idx = 0; node_idx < dest_nodes->nelem; ++node_idx)
- {
- int node = dest_nodes->elems[node_idx];
- re_token_type_t type = dfa->nodes[node].type;
- if (type == OP_CLOSE_SUBEXP || type == OP_OPEN_SUBEXP)
- {
- if (subexp_idx != dfa->nodes[node].opr.idx)
- continue;
- /* It is against this limitation.
- Remove it form the current sifted state. */
- err = sub_epsilon_src_nodes (dfa, node, dest_nodes,
- candidates);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- }
- }
- }
- return REG_NOERROR;
-}
-
-static reg_errcode_t
-internal_function
-sift_states_bkref (const re_match_context_t *mctx, re_sift_context_t *sctx,
- int str_idx, const re_node_set *candidates)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- reg_errcode_t err;
- int node_idx, node;
- re_sift_context_t local_sctx;
- int first_idx = search_cur_bkref_entry (mctx, str_idx);
-
- if (first_idx == -1)
- return REG_NOERROR;
-
- local_sctx.sifted_states = NULL; /* Mark that it hasn't been initialized. */
-
- for (node_idx = 0; node_idx < candidates->nelem; ++node_idx)
- {
- int enabled_idx;
- re_token_type_t type;
- struct re_backref_cache_entry *entry;
- node = candidates->elems[node_idx];
- type = dfa->nodes[node].type;
- /* Avoid infinite loop for the REs like "()\1+". */
- if (node == sctx->last_node && str_idx == sctx->last_str_idx)
- continue;
- if (type != OP_BACK_REF)
- continue;
-
- entry = mctx->bkref_ents + first_idx;
- enabled_idx = first_idx;
- do
- {
- int subexp_len;
- int to_idx;
- int dst_node;
- int ret;
- re_dfastate_t *cur_state;
-
- if (entry->node != node)
- continue;
- subexp_len = entry->subexp_to - entry->subexp_from;
- to_idx = str_idx + subexp_len;
- dst_node = (subexp_len ? dfa->nexts[node]
- : dfa->edests[node].elems[0]);
-
- if (to_idx > sctx->last_str_idx
- || sctx->sifted_states[to_idx] == NULL
- || !STATE_NODE_CONTAINS (sctx->sifted_states[to_idx], dst_node)
- || check_dst_limits (mctx, &sctx->limits, node,
- str_idx, dst_node, to_idx))
- continue;
-
- if (local_sctx.sifted_states == NULL)
- {
- local_sctx = *sctx;
- err = re_node_set_init_copy (&local_sctx.limits, &sctx->limits);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
- }
- local_sctx.last_node = node;
- local_sctx.last_str_idx = str_idx;
- ret = re_node_set_insert (&local_sctx.limits, enabled_idx);
- if (BE (ret < 0, 0))
- {
- err = REG_ESPACE;
- goto free_return;
- }
- cur_state = local_sctx.sifted_states[str_idx];
- err = sift_states_backward (mctx, &local_sctx);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
- if (sctx->limited_states != NULL)
- {
- err = merge_state_array (dfa, sctx->limited_states,
- local_sctx.sifted_states,
- str_idx + 1);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
- }
- local_sctx.sifted_states[str_idx] = cur_state;
- re_node_set_remove (&local_sctx.limits, enabled_idx);
-
- /* mctx->bkref_ents may have changed, reload the pointer. */
- entry = mctx->bkref_ents + enabled_idx;
- }
- while (enabled_idx++, entry++->more);
- }
- err = REG_NOERROR;
- free_return:
- if (local_sctx.sifted_states != NULL)
- {
- re_node_set_free (&local_sctx.limits);
- }
-
- return err;
-}
-
-
-#ifdef RE_ENABLE_I18N
-static int
-internal_function
-sift_states_iter_mb (const re_match_context_t *mctx, re_sift_context_t *sctx,
- int node_idx, int str_idx, int max_str_idx)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- int naccepted;
- /* Check the node can accept `multi byte'. */
- naccepted = check_node_accept_bytes (dfa, node_idx, &mctx->input, str_idx);
- if (naccepted > 0 && str_idx + naccepted <= max_str_idx &&
- !STATE_NODE_CONTAINS (sctx->sifted_states[str_idx + naccepted],
- dfa->nexts[node_idx]))
- /* The node can't accept the `multi byte', or the
- destination was already thrown away, then the node
- could't accept the current input `multi byte'. */
- naccepted = 0;
- /* Otherwise, it is sure that the node could accept
- `naccepted' bytes input. */
- return naccepted;
-}
-#endif /* RE_ENABLE_I18N */
-
-
-/* Functions for state transition. */
-
-/* Return the next state to which the current state STATE will transit by
- accepting the current input byte, and update STATE_LOG if necessary.
- If STATE can accept a multibyte char/collating element/back reference
- update the destination of STATE_LOG. */
-
-static re_dfastate_t *
-internal_function
-transit_state (reg_errcode_t *err, re_match_context_t *mctx,
- re_dfastate_t *state)
-{
- re_dfastate_t **trtable;
- unsigned char ch;
-
-#ifdef RE_ENABLE_I18N
- /* If the current state can accept multibyte. */
- if (BE (state->accept_mb, 0))
- {
- *err = transit_state_mb (mctx, state);
- if (BE (*err != REG_NOERROR, 0))
- return NULL;
- }
-#endif /* RE_ENABLE_I18N */
-
- /* Then decide the next state with the single byte. */
-#if 0
- if (0)
- /* don't use transition table */
- return transit_state_sb (err, mctx, state);
-#endif
-
- /* Use transition table */
- ch = re_string_fetch_byte (&mctx->input);
- for (;;)
- {
- trtable = state->trtable;
- if (BE (trtable != NULL, 1))
- return trtable[ch];
-
- trtable = state->word_trtable;
- if (BE (trtable != NULL, 1))
- {
- unsigned int context;
- context
- = re_string_context_at (&mctx->input,
- re_string_cur_idx (&mctx->input) - 1,
- mctx->eflags);
- if (IS_WORD_CONTEXT (context))
- return trtable[ch + SBC_MAX];
- else
- return trtable[ch];
- }
-
- if (!build_trtable (mctx->dfa, state))
- {
- *err = REG_ESPACE;
- return NULL;
- }
-
- /* Retry, we now have a transition table. */
- }
-}
-
-/* Update the state_log if we need */
-re_dfastate_t *
-internal_function
-merge_state_with_log (reg_errcode_t *err, re_match_context_t *mctx,
- re_dfastate_t *next_state)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- int cur_idx = re_string_cur_idx (&mctx->input);
-
- if (cur_idx > mctx->state_log_top)
- {
- mctx->state_log[cur_idx] = next_state;
- mctx->state_log_top = cur_idx;
- }
- else if (mctx->state_log[cur_idx] == 0)
- {
- mctx->state_log[cur_idx] = next_state;
- }
- else
- {
- re_dfastate_t *pstate;
- unsigned int context;
- re_node_set next_nodes, *log_nodes, *table_nodes = NULL;
- /* If (state_log[cur_idx] != 0), it implies that cur_idx is
- the destination of a multibyte char/collating element/
- back reference. Then the next state is the union set of
- these destinations and the results of the transition table. */
- pstate = mctx->state_log[cur_idx];
- log_nodes = pstate->entrance_nodes;
- if (next_state != NULL)
- {
- table_nodes = next_state->entrance_nodes;
- *err = re_node_set_init_union (&next_nodes, table_nodes,
- log_nodes);
- if (BE (*err != REG_NOERROR, 0))
- return NULL;
- }
- else
- next_nodes = *log_nodes;
- /* Note: We already add the nodes of the initial state,
- then we don't need to add them here. */
-
- context = re_string_context_at (&mctx->input,
- re_string_cur_idx (&mctx->input) - 1,
- mctx->eflags);
- next_state = mctx->state_log[cur_idx]
- = re_acquire_state_context (err, dfa, &next_nodes, context);
- /* We don't need to check errors here, since the return value of
- this function is next_state and ERR is already set. */
-
- if (table_nodes != NULL)
- re_node_set_free (&next_nodes);
- }
-
- if (BE (dfa->nbackref, 0) && next_state != NULL)
- {
- /* Check OP_OPEN_SUBEXP in the current state in case that we use them
- later. We must check them here, since the back references in the
- next state might use them. */
- *err = check_subexp_matching_top (mctx, &next_state->nodes,
- cur_idx);
- if (BE (*err != REG_NOERROR, 0))
- return NULL;
-
- /* If the next state has back references. */
- if (next_state->has_backref)
- {
- *err = transit_state_bkref (mctx, &next_state->nodes);
- if (BE (*err != REG_NOERROR, 0))
- return NULL;
- next_state = mctx->state_log[cur_idx];
- }
- }
-
- return next_state;
-}
-
-/* Skip bytes in the input that correspond to part of a
- multi-byte match, then look in the log for a state
- from which to restart matching. */
-re_dfastate_t *
-internal_function
-find_recover_state (reg_errcode_t *err, re_match_context_t *mctx)
-{
- re_dfastate_t *cur_state;
- do
- {
- int max = mctx->state_log_top;
- int cur_str_idx = re_string_cur_idx (&mctx->input);
-
- do
- {
- if (++cur_str_idx > max)
- return NULL;
- re_string_skip_bytes (&mctx->input, 1);
- }
- while (mctx->state_log[cur_str_idx] == NULL);
-
- cur_state = merge_state_with_log (err, mctx, NULL);
- }
- while (*err == REG_NOERROR && cur_state == NULL);
- return cur_state;
-}
-
-/* Helper functions for transit_state. */
-
-/* From the node set CUR_NODES, pick up the nodes whose types are
- OP_OPEN_SUBEXP and which have corresponding back references in the regular
- expression. And register them to use them later for evaluating the
- correspoding back references. */
-
-static reg_errcode_t
-internal_function
-check_subexp_matching_top (re_match_context_t *mctx, re_node_set *cur_nodes,
- int str_idx)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- int node_idx;
- reg_errcode_t err;
-
- /* TODO: This isn't efficient.
- Because there might be more than one nodes whose types are
- OP_OPEN_SUBEXP and whose index is SUBEXP_IDX, we must check all
- nodes.
- E.g. RE: (a){2} */
- for (node_idx = 0; node_idx < cur_nodes->nelem; ++node_idx)
- {
- int node = cur_nodes->elems[node_idx];
- if (dfa->nodes[node].type == OP_OPEN_SUBEXP
- && dfa->nodes[node].opr.idx < BITSET_WORD_BITS
- && (dfa->used_bkref_map
- & ((bitset_word_t) 1 << dfa->nodes[node].opr.idx)))
- {
- err = match_ctx_add_subtop (mctx, node, str_idx);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- }
- return REG_NOERROR;
-}
-
-#if 0
-/* Return the next state to which the current state STATE will transit by
- accepting the current input byte. */
-
-static re_dfastate_t *
-transit_state_sb (reg_errcode_t *err, re_match_context_t *mctx,
- re_dfastate_t *state)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- re_node_set next_nodes;
- re_dfastate_t *next_state;
- int node_cnt, cur_str_idx = re_string_cur_idx (&mctx->input);
- unsigned int context;
-
- *err = re_node_set_alloc (&next_nodes, state->nodes.nelem + 1);
- if (BE (*err != REG_NOERROR, 0))
- return NULL;
- for (node_cnt = 0; node_cnt < state->nodes.nelem; ++node_cnt)
- {
- int cur_node = state->nodes.elems[node_cnt];
- if (check_node_accept (mctx, dfa->nodes + cur_node, cur_str_idx))
- {
- *err = re_node_set_merge (&next_nodes,
- dfa->eclosures + dfa->nexts[cur_node]);
- if (BE (*err != REG_NOERROR, 0))
- {
- re_node_set_free (&next_nodes);
- return NULL;
- }
- }
- }
- context = re_string_context_at (&mctx->input, cur_str_idx, mctx->eflags);
- next_state = re_acquire_state_context (err, dfa, &next_nodes, context);
- /* We don't need to check errors here, since the return value of
- this function is next_state and ERR is already set. */
-
- re_node_set_free (&next_nodes);
- re_string_skip_bytes (&mctx->input, 1);
- return next_state;
-}
-#endif
-
-#ifdef RE_ENABLE_I18N
-static reg_errcode_t
-internal_function
-transit_state_mb (re_match_context_t *mctx, re_dfastate_t *pstate)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- reg_errcode_t err;
- int i;
-
- for (i = 0; i < pstate->nodes.nelem; ++i)
- {
- re_node_set dest_nodes, *new_nodes;
- int cur_node_idx = pstate->nodes.elems[i];
- int naccepted, dest_idx;
- unsigned int context;
- re_dfastate_t *dest_state;
-
- if (!dfa->nodes[cur_node_idx].accept_mb)
- continue;
-
- if (dfa->nodes[cur_node_idx].constraint)
- {
- context = re_string_context_at (&mctx->input,
- re_string_cur_idx (&mctx->input),
- mctx->eflags);
- if (NOT_SATISFY_NEXT_CONSTRAINT (dfa->nodes[cur_node_idx].constraint,
- context))
- continue;
- }
-
- /* How many bytes the node can accept? */
- naccepted = check_node_accept_bytes (dfa, cur_node_idx, &mctx->input,
- re_string_cur_idx (&mctx->input));
- if (naccepted == 0)
- continue;
-
- /* The node can accepts `naccepted' bytes. */
- dest_idx = re_string_cur_idx (&mctx->input) + naccepted;
- mctx->max_mb_elem_len = ((mctx->max_mb_elem_len < naccepted) ? naccepted
- : mctx->max_mb_elem_len);
- err = clean_state_log_if_needed (mctx, dest_idx);
- if (BE (err != REG_NOERROR, 0))
- return err;
-#ifdef DEBUG
- assert (dfa->nexts[cur_node_idx] != -1);
-#endif
- new_nodes = dfa->eclosures + dfa->nexts[cur_node_idx];
-
- dest_state = mctx->state_log[dest_idx];
- if (dest_state == NULL)
- dest_nodes = *new_nodes;
- else
- {
- err = re_node_set_init_union (&dest_nodes,
- dest_state->entrance_nodes, new_nodes);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- context = re_string_context_at (&mctx->input, dest_idx - 1,
- mctx->eflags);
- mctx->state_log[dest_idx]
- = re_acquire_state_context (&err, dfa, &dest_nodes, context);
- if (dest_state != NULL)
- re_node_set_free (&dest_nodes);
- if (BE (mctx->state_log[dest_idx] == NULL && err != REG_NOERROR, 0))
- return err;
- }
- return REG_NOERROR;
-}
-#endif /* RE_ENABLE_I18N */
-
-static reg_errcode_t
-internal_function
-transit_state_bkref (re_match_context_t *mctx, const re_node_set *nodes)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- reg_errcode_t err;
- int i;
- int cur_str_idx = re_string_cur_idx (&mctx->input);
-
- for (i = 0; i < nodes->nelem; ++i)
- {
- int dest_str_idx, prev_nelem, bkc_idx;
- int node_idx = nodes->elems[i];
- unsigned int context;
- const re_token_t *node = dfa->nodes + node_idx;
- re_node_set *new_dest_nodes;
-
- /* Check whether `node' is a backreference or not. */
- if (node->type != OP_BACK_REF)
- continue;
-
- if (node->constraint)
- {
- context = re_string_context_at (&mctx->input, cur_str_idx,
- mctx->eflags);
- if (NOT_SATISFY_NEXT_CONSTRAINT (node->constraint, context))
- continue;
- }
-
- /* `node' is a backreference.
- Check the substring which the substring matched. */
- bkc_idx = mctx->nbkref_ents;
- err = get_subexp (mctx, node_idx, cur_str_idx);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
-
- /* And add the epsilon closures (which is `new_dest_nodes') of
- the backreference to appropriate state_log. */
-#ifdef DEBUG
- assert (dfa->nexts[node_idx] != -1);
-#endif
- for (; bkc_idx < mctx->nbkref_ents; ++bkc_idx)
- {
- int subexp_len;
- re_dfastate_t *dest_state;
- struct re_backref_cache_entry *bkref_ent;
- bkref_ent = mctx->bkref_ents + bkc_idx;
- if (bkref_ent->node != node_idx || bkref_ent->str_idx != cur_str_idx)
- continue;
- subexp_len = bkref_ent->subexp_to - bkref_ent->subexp_from;
- new_dest_nodes = (subexp_len == 0
- ? dfa->eclosures + dfa->edests[node_idx].elems[0]
- : dfa->eclosures + dfa->nexts[node_idx]);
- dest_str_idx = (cur_str_idx + bkref_ent->subexp_to
- - bkref_ent->subexp_from);
- context = re_string_context_at (&mctx->input, dest_str_idx - 1,
- mctx->eflags);
- dest_state = mctx->state_log[dest_str_idx];
- prev_nelem = ((mctx->state_log[cur_str_idx] == NULL) ? 0
- : mctx->state_log[cur_str_idx]->nodes.nelem);
- /* Add `new_dest_node' to state_log. */
- if (dest_state == NULL)
- {
- mctx->state_log[dest_str_idx]
- = re_acquire_state_context (&err, dfa, new_dest_nodes,
- context);
- if (BE (mctx->state_log[dest_str_idx] == NULL
- && err != REG_NOERROR, 0))
- goto free_return;
- }
- else
- {
- re_node_set dest_nodes;
- err = re_node_set_init_union (&dest_nodes,
- dest_state->entrance_nodes,
- new_dest_nodes);
- if (BE (err != REG_NOERROR, 0))
- {
- re_node_set_free (&dest_nodes);
- goto free_return;
- }
- mctx->state_log[dest_str_idx]
- = re_acquire_state_context (&err, dfa, &dest_nodes, context);
- re_node_set_free (&dest_nodes);
- if (BE (mctx->state_log[dest_str_idx] == NULL
- && err != REG_NOERROR, 0))
- goto free_return;
- }
- /* We need to check recursively if the backreference can epsilon
- transit. */
- if (subexp_len == 0
- && mctx->state_log[cur_str_idx]->nodes.nelem > prev_nelem)
- {
- err = check_subexp_matching_top (mctx, new_dest_nodes,
- cur_str_idx);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
- err = transit_state_bkref (mctx, new_dest_nodes);
- if (BE (err != REG_NOERROR, 0))
- goto free_return;
- }
- }
- }
- err = REG_NOERROR;
- free_return:
- return err;
-}
-
-/* Enumerate all the candidates which the backreference BKREF_NODE can match
- at BKREF_STR_IDX, and register them by match_ctx_add_entry().
- Note that we might collect inappropriate candidates here.
- However, the cost of checking them strictly here is too high, then we
- delay these checking for prune_impossible_nodes(). */
-
-static reg_errcode_t
-internal_function
-get_subexp (re_match_context_t *mctx, int bkref_node, int bkref_str_idx)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- int subexp_num, sub_top_idx;
- const char *buf = (const char *) re_string_get_buffer (&mctx->input);
- /* Return if we have already checked BKREF_NODE at BKREF_STR_IDX. */
- int cache_idx = search_cur_bkref_entry (mctx, bkref_str_idx);
- if (cache_idx != -1)
- {
- const struct re_backref_cache_entry *entry
- = mctx->bkref_ents + cache_idx;
- do
- if (entry->node == bkref_node)
- return REG_NOERROR; /* We already checked it. */
- while (entry++->more);
- }
-
- subexp_num = dfa->nodes[bkref_node].opr.idx;
-
- /* For each sub expression */
- for (sub_top_idx = 0; sub_top_idx < mctx->nsub_tops; ++sub_top_idx)
- {
- reg_errcode_t err;
- re_sub_match_top_t *sub_top = mctx->sub_tops[sub_top_idx];
- re_sub_match_last_t *sub_last;
- int sub_last_idx, sl_str, bkref_str_off;
-
- if (dfa->nodes[sub_top->node].opr.idx != subexp_num)
- continue; /* It isn't related. */
-
- sl_str = sub_top->str_idx;
- bkref_str_off = bkref_str_idx;
- /* At first, check the last node of sub expressions we already
- evaluated. */
- for (sub_last_idx = 0; sub_last_idx < sub_top->nlasts; ++sub_last_idx)
- {
- int sl_str_diff;
- sub_last = sub_top->lasts[sub_last_idx];
- sl_str_diff = sub_last->str_idx - sl_str;
- /* The matched string by the sub expression match with the substring
- at the back reference? */
- if (sl_str_diff > 0)
- {
- if (BE (bkref_str_off + sl_str_diff > mctx->input.valid_len, 0))
- {
- /* Not enough chars for a successful match. */
- if (bkref_str_off + sl_str_diff > mctx->input.len)
- break;
-
- err = clean_state_log_if_needed (mctx,
- bkref_str_off
- + sl_str_diff);
- if (BE (err != REG_NOERROR, 0))
- return err;
- buf = (const char *) re_string_get_buffer (&mctx->input);
- }
- if (memcmp (buf + bkref_str_off, buf + sl_str, sl_str_diff) != 0)
- /* We don't need to search this sub expression any more. */
- break;
- }
- bkref_str_off += sl_str_diff;
- sl_str += sl_str_diff;
- err = get_subexp_sub (mctx, sub_top, sub_last, bkref_node,
- bkref_str_idx);
-
- /* Reload buf, since the preceding call might have reallocated
- the buffer. */
- buf = (const char *) re_string_get_buffer (&mctx->input);
-
- if (err == REG_NOMATCH)
- continue;
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
-
- if (sub_last_idx < sub_top->nlasts)
- continue;
- if (sub_last_idx > 0)
- ++sl_str;
- /* Then, search for the other last nodes of the sub expression. */
- for (; sl_str <= bkref_str_idx; ++sl_str)
- {
- int cls_node, sl_str_off;
- const re_node_set *nodes;
- sl_str_off = sl_str - sub_top->str_idx;
- /* The matched string by the sub expression match with the substring
- at the back reference? */
- if (sl_str_off > 0)
- {
- if (BE (bkref_str_off >= mctx->input.valid_len, 0))
- {
- /* If we are at the end of the input, we cannot match. */
- if (bkref_str_off >= mctx->input.len)
- break;
-
- err = extend_buffers (mctx);
- if (BE (err != REG_NOERROR, 0))
- return err;
-
- buf = (const char *) re_string_get_buffer (&mctx->input);
- }
- if (buf [bkref_str_off++] != buf[sl_str - 1])
- break; /* We don't need to search this sub expression
- any more. */
- }
- if (mctx->state_log[sl_str] == NULL)
- continue;
- /* Does this state have a ')' of the sub expression? */
- nodes = &mctx->state_log[sl_str]->nodes;
- cls_node = find_subexp_node (dfa, nodes, subexp_num,
- OP_CLOSE_SUBEXP);
- if (cls_node == -1)
- continue; /* No. */
- if (sub_top->path == NULL)
- {
- sub_top->path = calloc (sizeof (state_array_t),
- sl_str - sub_top->str_idx + 1);
- if (sub_top->path == NULL)
- return REG_ESPACE;
- }
- /* Can the OP_OPEN_SUBEXP node arrive the OP_CLOSE_SUBEXP node
- in the current context? */
- err = check_arrival (mctx, sub_top->path, sub_top->node,
- sub_top->str_idx, cls_node, sl_str,
- OP_CLOSE_SUBEXP);
- if (err == REG_NOMATCH)
- continue;
- if (BE (err != REG_NOERROR, 0))
- return err;
- sub_last = match_ctx_add_sublast (sub_top, cls_node, sl_str);
- if (BE (sub_last == NULL, 0))
- return REG_ESPACE;
- err = get_subexp_sub (mctx, sub_top, sub_last, bkref_node,
- bkref_str_idx);
- if (err == REG_NOMATCH)
- continue;
- }
- }
- return REG_NOERROR;
-}
-
-/* Helper functions for get_subexp(). */
-
-/* Check SUB_LAST can arrive to the back reference BKREF_NODE at BKREF_STR.
- If it can arrive, register the sub expression expressed with SUB_TOP
- and SUB_LAST. */
-
-static reg_errcode_t
-internal_function
-get_subexp_sub (re_match_context_t *mctx, const re_sub_match_top_t *sub_top,
- re_sub_match_last_t *sub_last, int bkref_node, int bkref_str)
-{
- reg_errcode_t err;
- int to_idx;
- /* Can the subexpression arrive the back reference? */
- err = check_arrival (mctx, &sub_last->path, sub_last->node,
- sub_last->str_idx, bkref_node, bkref_str,
- OP_OPEN_SUBEXP);
- if (err != REG_NOERROR)
- return err;
- err = match_ctx_add_entry (mctx, bkref_node, bkref_str, sub_top->str_idx,
- sub_last->str_idx);
- if (BE (err != REG_NOERROR, 0))
- return err;
- to_idx = bkref_str + sub_last->str_idx - sub_top->str_idx;
- return clean_state_log_if_needed (mctx, to_idx);
-}
-
-/* Find the first node which is '(' or ')' and whose index is SUBEXP_IDX.
- Search '(' if FL_OPEN, or search ')' otherwise.
- TODO: This function isn't efficient...
- Because there might be more than one nodes whose types are
- OP_OPEN_SUBEXP and whose index is SUBEXP_IDX, we must check all
- nodes.
- E.g. RE: (a){2} */
-
-static int
-internal_function
-find_subexp_node (const re_dfa_t *dfa, const re_node_set *nodes,
- int subexp_idx, int type)
-{
- int cls_idx;
- for (cls_idx = 0; cls_idx < nodes->nelem; ++cls_idx)
- {
- int cls_node = nodes->elems[cls_idx];
- const re_token_t *node = dfa->nodes + cls_node;
- if (node->type == type
- && node->opr.idx == subexp_idx)
- return cls_node;
- }
- return -1;
-}
-
-/* Check whether the node TOP_NODE at TOP_STR can arrive to the node
- LAST_NODE at LAST_STR. We record the path onto PATH since it will be
- heavily reused.
- Return REG_NOERROR if it can arrive, or REG_NOMATCH otherwise. */
-
-static reg_errcode_t
-internal_function
-check_arrival (re_match_context_t *mctx, state_array_t *path, int top_node,
- int top_str, int last_node, int last_str, int type)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- reg_errcode_t err = REG_NOERROR;
- int subexp_num, backup_cur_idx, str_idx, null_cnt;
- re_dfastate_t *cur_state = NULL;
- re_node_set *cur_nodes, next_nodes;
- re_dfastate_t **backup_state_log;
- unsigned int context;
-
- subexp_num = dfa->nodes[top_node].opr.idx;
- /* Extend the buffer if we need. */
- if (BE (path->alloc < last_str + mctx->max_mb_elem_len + 1, 0))
- {
- re_dfastate_t **new_array;
- int old_alloc = path->alloc;
- path->alloc += last_str + mctx->max_mb_elem_len + 1;
- new_array = re_realloc (path->array, re_dfastate_t *, path->alloc);
- if (BE (new_array == NULL, 0))
- {
- path->alloc = old_alloc;
- return REG_ESPACE;
- }
- path->array = new_array;
- memset (new_array + old_alloc, '\0',
- sizeof (re_dfastate_t *) * (path->alloc - old_alloc));
- }
-
- str_idx = path->next_idx ?: top_str;
-
- /* Temporary modify MCTX. */
- backup_state_log = mctx->state_log;
- backup_cur_idx = mctx->input.cur_idx;
- mctx->state_log = path->array;
- mctx->input.cur_idx = str_idx;
-
- /* Setup initial node set. */
- context = re_string_context_at (&mctx->input, str_idx - 1, mctx->eflags);
- if (str_idx == top_str)
- {
- err = re_node_set_init_1 (&next_nodes, top_node);
- if (BE (err != REG_NOERROR, 0))
- return err;
- err = check_arrival_expand_ecl (dfa, &next_nodes, subexp_num, type);
- if (BE (err != REG_NOERROR, 0))
- {
- re_node_set_free (&next_nodes);
- return err;
- }
- }
- else
- {
- cur_state = mctx->state_log[str_idx];
- if (cur_state && cur_state->has_backref)
- {
- err = re_node_set_init_copy (&next_nodes, &cur_state->nodes);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- else
- re_node_set_init_empty (&next_nodes);
- }
- if (str_idx == top_str || (cur_state && cur_state->has_backref))
- {
- if (next_nodes.nelem)
- {
- err = expand_bkref_cache (mctx, &next_nodes, str_idx,
- subexp_num, type);
- if (BE (err != REG_NOERROR, 0))
- {
- re_node_set_free (&next_nodes);
- return err;
- }
- }
- cur_state = re_acquire_state_context (&err, dfa, &next_nodes, context);
- if (BE (cur_state == NULL && err != REG_NOERROR, 0))
- {
- re_node_set_free (&next_nodes);
- return err;
- }
- mctx->state_log[str_idx] = cur_state;
- }
-
- for (null_cnt = 0; str_idx < last_str && null_cnt <= mctx->max_mb_elem_len;)
- {
- re_node_set_empty (&next_nodes);
- if (mctx->state_log[str_idx + 1])
- {
- err = re_node_set_merge (&next_nodes,
- &mctx->state_log[str_idx + 1]->nodes);
- if (BE (err != REG_NOERROR, 0))
- {
- re_node_set_free (&next_nodes);
- return err;
- }
- }
- if (cur_state)
- {
- err = check_arrival_add_next_nodes (mctx, str_idx,
- &cur_state->non_eps_nodes,
- &next_nodes);
- if (BE (err != REG_NOERROR, 0))
- {
- re_node_set_free (&next_nodes);
- return err;
- }
- }
- ++str_idx;
- if (next_nodes.nelem)
- {
- err = check_arrival_expand_ecl (dfa, &next_nodes, subexp_num, type);
- if (BE (err != REG_NOERROR, 0))
- {
- re_node_set_free (&next_nodes);
- return err;
- }
- err = expand_bkref_cache (mctx, &next_nodes, str_idx,
- subexp_num, type);
- if (BE (err != REG_NOERROR, 0))
- {
- re_node_set_free (&next_nodes);
- return err;
- }
- }
- context = re_string_context_at (&mctx->input, str_idx - 1, mctx->eflags);
- cur_state = re_acquire_state_context (&err, dfa, &next_nodes, context);
- if (BE (cur_state == NULL && err != REG_NOERROR, 0))
- {
- re_node_set_free (&next_nodes);
- return err;
- }
- mctx->state_log[str_idx] = cur_state;
- null_cnt = cur_state == NULL ? null_cnt + 1 : 0;
- }
- re_node_set_free (&next_nodes);
- cur_nodes = (mctx->state_log[last_str] == NULL ? NULL
- : &mctx->state_log[last_str]->nodes);
- path->next_idx = str_idx;
-
- /* Fix MCTX. */
- mctx->state_log = backup_state_log;
- mctx->input.cur_idx = backup_cur_idx;
-
- /* Then check the current node set has the node LAST_NODE. */
- if (cur_nodes != NULL && re_node_set_contains (cur_nodes, last_node))
- return REG_NOERROR;
-
- return REG_NOMATCH;
-}
-
-/* Helper functions for check_arrival. */
-
-/* Calculate the destination nodes of CUR_NODES at STR_IDX, and append them
- to NEXT_NODES.
- TODO: This function is similar to the functions transit_state*(),
- however this function has many additional works.
- Can't we unify them? */
-
-static reg_errcode_t
-internal_function
-check_arrival_add_next_nodes (re_match_context_t *mctx, int str_idx,
- re_node_set *cur_nodes, re_node_set *next_nodes)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- int result;
- int cur_idx;
-#ifdef RE_ENABLE_I18N
- reg_errcode_t err = REG_NOERROR;
-#endif
- re_node_set union_set;
- re_node_set_init_empty (&union_set);
- for (cur_idx = 0; cur_idx < cur_nodes->nelem; ++cur_idx)
- {
- int naccepted = 0;
- int cur_node = cur_nodes->elems[cur_idx];
-#ifdef DEBUG
- re_token_type_t type = dfa->nodes[cur_node].type;
- assert (!IS_EPSILON_NODE (type));
-#endif
-#ifdef RE_ENABLE_I18N
- /* If the node may accept `multi byte'. */
- if (dfa->nodes[cur_node].accept_mb)
- {
- naccepted = check_node_accept_bytes (dfa, cur_node, &mctx->input,
- str_idx);
- if (naccepted > 1)
- {
- re_dfastate_t *dest_state;
- int next_node = dfa->nexts[cur_node];
- int next_idx = str_idx + naccepted;
- dest_state = mctx->state_log[next_idx];
- re_node_set_empty (&union_set);
- if (dest_state)
- {
- err = re_node_set_merge (&union_set, &dest_state->nodes);
- if (BE (err != REG_NOERROR, 0))
- {
- re_node_set_free (&union_set);
- return err;
- }
- }
- result = re_node_set_insert (&union_set, next_node);
- if (BE (result < 0, 0))
- {
- re_node_set_free (&union_set);
- return REG_ESPACE;
- }
- mctx->state_log[next_idx] = re_acquire_state (&err, dfa,
- &union_set);
- if (BE (mctx->state_log[next_idx] == NULL
- && err != REG_NOERROR, 0))
- {
- re_node_set_free (&union_set);
- return err;
- }
- }
- }
-#endif /* RE_ENABLE_I18N */
- if (naccepted
- || check_node_accept (mctx, dfa->nodes + cur_node, str_idx))
- {
- result = re_node_set_insert (next_nodes, dfa->nexts[cur_node]);
- if (BE (result < 0, 0))
- {
- re_node_set_free (&union_set);
- return REG_ESPACE;
- }
- }
- }
- re_node_set_free (&union_set);
- return REG_NOERROR;
-}
-
-/* For all the nodes in CUR_NODES, add the epsilon closures of them to
- CUR_NODES, however exclude the nodes which are:
- - inside the sub expression whose number is EX_SUBEXP, if FL_OPEN.
- - out of the sub expression whose number is EX_SUBEXP, if !FL_OPEN.
-*/
-
-static reg_errcode_t
-internal_function
-check_arrival_expand_ecl (const re_dfa_t *dfa, re_node_set *cur_nodes,
- int ex_subexp, int type)
-{
- reg_errcode_t err;
- int idx, outside_node;
- re_node_set new_nodes;
-#ifdef DEBUG
- assert (cur_nodes->nelem);
-#endif
- err = re_node_set_alloc (&new_nodes, cur_nodes->nelem);
- if (BE (err != REG_NOERROR, 0))
- return err;
- /* Create a new node set NEW_NODES with the nodes which are epsilon
- closures of the node in CUR_NODES. */
-
- for (idx = 0; idx < cur_nodes->nelem; ++idx)
- {
- int cur_node = cur_nodes->elems[idx];
- const re_node_set *eclosure = dfa->eclosures + cur_node;
- outside_node = find_subexp_node (dfa, eclosure, ex_subexp, type);
- if (outside_node == -1)
- {
- /* There are no problematic nodes, just merge them. */
- err = re_node_set_merge (&new_nodes, eclosure);
- if (BE (err != REG_NOERROR, 0))
- {
- re_node_set_free (&new_nodes);
- return err;
- }
- }
- else
- {
- /* There are problematic nodes, re-calculate incrementally. */
- err = check_arrival_expand_ecl_sub (dfa, &new_nodes, cur_node,
- ex_subexp, type);
- if (BE (err != REG_NOERROR, 0))
- {
- re_node_set_free (&new_nodes);
- return err;
- }
- }
- }
- re_node_set_free (cur_nodes);
- *cur_nodes = new_nodes;
- return REG_NOERROR;
-}
-
-/* Helper function for check_arrival_expand_ecl.
- Check incrementally the epsilon closure of TARGET, and if it isn't
- problematic append it to DST_NODES. */
-
-static reg_errcode_t
-internal_function
-check_arrival_expand_ecl_sub (const re_dfa_t *dfa, re_node_set *dst_nodes,
- int target, int ex_subexp, int type)
-{
- int cur_node;
- for (cur_node = target; !re_node_set_contains (dst_nodes, cur_node);)
- {
- int err;
-
- if (dfa->nodes[cur_node].type == type
- && dfa->nodes[cur_node].opr.idx == ex_subexp)
- {
- if (type == OP_CLOSE_SUBEXP)
- {
- err = re_node_set_insert (dst_nodes, cur_node);
- if (BE (err == -1, 0))
- return REG_ESPACE;
- }
- break;
- }
- err = re_node_set_insert (dst_nodes, cur_node);
- if (BE (err == -1, 0))
- return REG_ESPACE;
- if (dfa->edests[cur_node].nelem == 0)
- break;
- if (dfa->edests[cur_node].nelem == 2)
- {
- err = check_arrival_expand_ecl_sub (dfa, dst_nodes,
- dfa->edests[cur_node].elems[1],
- ex_subexp, type);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- cur_node = dfa->edests[cur_node].elems[0];
- }
- return REG_NOERROR;
-}
-
-
-/* For all the back references in the current state, calculate the
- destination of the back references by the appropriate entry
- in MCTX->BKREF_ENTS. */
-
-static reg_errcode_t
-internal_function
-expand_bkref_cache (re_match_context_t *mctx, re_node_set *cur_nodes,
- int cur_str, int subexp_num, int type)
-{
- const re_dfa_t *const dfa = mctx->dfa;
- reg_errcode_t err;
- int cache_idx_start = search_cur_bkref_entry (mctx, cur_str);
- struct re_backref_cache_entry *ent;
-
- if (cache_idx_start == -1)
- return REG_NOERROR;
-
- restart:
- ent = mctx->bkref_ents + cache_idx_start;
- do
- {
- int to_idx, next_node;
-
- /* Is this entry ENT is appropriate? */
- if (!re_node_set_contains (cur_nodes, ent->node))
- continue; /* No. */
-
- to_idx = cur_str + ent->subexp_to - ent->subexp_from;
- /* Calculate the destination of the back reference, and append it
- to MCTX->STATE_LOG. */
- if (to_idx == cur_str)
- {
- /* The backreference did epsilon transit, we must re-check all the
- node in the current state. */
- re_node_set new_dests;
- reg_errcode_t err2, err3;
- next_node = dfa->edests[ent->node].elems[0];
- if (re_node_set_contains (cur_nodes, next_node))
- continue;
- err = re_node_set_init_1 (&new_dests, next_node);
- err2 = check_arrival_expand_ecl (dfa, &new_dests, subexp_num, type);
- err3 = re_node_set_merge (cur_nodes, &new_dests);
- re_node_set_free (&new_dests);
- if (BE (err != REG_NOERROR || err2 != REG_NOERROR
- || err3 != REG_NOERROR, 0))
- {
- err = (err != REG_NOERROR ? err
- : (err2 != REG_NOERROR ? err2 : err3));
- return err;
- }
- /* TODO: It is still inefficient... */
- goto restart;
- }
- else
- {
- re_node_set union_set;
- next_node = dfa->nexts[ent->node];
- if (mctx->state_log[to_idx])
- {
- int ret;
- if (re_node_set_contains (&mctx->state_log[to_idx]->nodes,
- next_node))
- continue;
- err = re_node_set_init_copy (&union_set,
- &mctx->state_log[to_idx]->nodes);
- ret = re_node_set_insert (&union_set, next_node);
- if (BE (err != REG_NOERROR || ret < 0, 0))
- {
- re_node_set_free (&union_set);
- err = err != REG_NOERROR ? err : REG_ESPACE;
- return err;
- }
- }
- else
- {
- err = re_node_set_init_1 (&union_set, next_node);
- if (BE (err != REG_NOERROR, 0))
- return err;
- }
- mctx->state_log[to_idx] = re_acquire_state (&err, dfa, &union_set);
- re_node_set_free (&union_set);
- if (BE (mctx->state_log[to_idx] == NULL
- && err != REG_NOERROR, 0))
- return err;
- }
- }
- while (ent++->more);
- return REG_NOERROR;
-}
-
-/* Build transition table for the state.
- Return 1 if succeeded, otherwise return NULL. */
-
-static int
-internal_function
-build_trtable (const re_dfa_t *dfa, re_dfastate_t *state)
-{
- reg_errcode_t err;
- int i, j, ch, need_word_trtable = 0;
- bitset_word_t elem, mask;
- bool dests_node_malloced = false;
- bool dest_states_malloced = false;
- int ndests; /* Number of the destination states from `state'. */
- re_dfastate_t **trtable;
- re_dfastate_t **dest_states = NULL, **dest_states_word, **dest_states_nl;
- re_node_set follows, *dests_node;
- bitset_t *dests_ch;
- bitset_t acceptable;
-
- struct dests_alloc
- {
- re_node_set dests_node[SBC_MAX];
- bitset_t dests_ch[SBC_MAX];
- } *dests_alloc;
-
- /* We build DFA states which corresponds to the destination nodes
- from `state'. `dests_node[i]' represents the nodes which i-th
- destination state contains, and `dests_ch[i]' represents the
- characters which i-th destination state accepts. */
- if (__libc_use_alloca (sizeof (struct dests_alloc)))
- dests_alloc = (struct dests_alloc *) alloca (sizeof (struct dests_alloc));
- else
- {
- dests_alloc = re_malloc (struct dests_alloc, 1);
- if (BE (dests_alloc == NULL, 0))
- return 0;
- dests_node_malloced = true;
- }
- dests_node = dests_alloc->dests_node;
- dests_ch = dests_alloc->dests_ch;
-
- /* Initialize transiton table. */
- state->word_trtable = state->trtable = NULL;
-
- /* At first, group all nodes belonging to `state' into several
- destinations. */
- ndests = group_nodes_into_DFAstates (dfa, state, dests_node, dests_ch);
- if (BE (ndests <= 0, 0))
- {
- if (dests_node_malloced)
- free (dests_alloc);
- /* Return 0 in case of an error, 1 otherwise. */
- if (ndests == 0)
- {
- state->trtable = (re_dfastate_t **)
- calloc (sizeof (re_dfastate_t *), SBC_MAX);
- return 1;
- }
- return 0;
- }
-
- err = re_node_set_alloc (&follows, ndests + 1);
- if (BE (err != REG_NOERROR, 0))
- goto out_free;
-
- if (__libc_use_alloca ((sizeof (re_node_set) + sizeof (bitset_t)) * SBC_MAX
- + ndests * 3 * sizeof (re_dfastate_t *)))
- dest_states = (re_dfastate_t **)
- alloca (ndests * 3 * sizeof (re_dfastate_t *));
- else
- {
- dest_states = (re_dfastate_t **)
- malloc (ndests * 3 * sizeof (re_dfastate_t *));
- if (BE (dest_states == NULL, 0))
- {
-out_free:
- if (dest_states_malloced)
- free (dest_states);
- re_node_set_free (&follows);
- for (i = 0; i < ndests; ++i)
- re_node_set_free (dests_node + i);
- if (dests_node_malloced)
- free (dests_alloc);
- return 0;
- }
- dest_states_malloced = true;
- }
- dest_states_word = dest_states + ndests;
- dest_states_nl = dest_states_word + ndests;
- bitset_empty (acceptable);
-
- /* Then build the states for all destinations. */
- for (i = 0; i < ndests; ++i)
- {
- int next_node;
- re_node_set_empty (&follows);
- /* Merge the follows of this destination states. */
- for (j = 0; j < dests_node[i].nelem; ++j)
- {
- next_node = dfa->nexts[dests_node[i].elems[j]];
- if (next_node != -1)
- {
- err = re_node_set_merge (&follows, dfa->eclosures + next_node);
- if (BE (err != REG_NOERROR, 0))
- goto out_free;
- }
- }
- dest_states[i] = re_acquire_state_context (&err, dfa, &follows, 0);
- if (BE (dest_states[i] == NULL && err != REG_NOERROR, 0))
- goto out_free;
- /* If the new state has context constraint,
- build appropriate states for these contexts. */
- if (dest_states[i]->has_constraint)
- {
- dest_states_word[i] = re_acquire_state_context (&err, dfa, &follows,
- CONTEXT_WORD);
- if (BE (dest_states_word[i] == NULL && err != REG_NOERROR, 0))
- goto out_free;
-
- if (dest_states[i] != dest_states_word[i] && dfa->mb_cur_max > 1)
- need_word_trtable = 1;
-
- dest_states_nl[i] = re_acquire_state_context (&err, dfa, &follows,
- CONTEXT_NEWLINE);
- if (BE (dest_states_nl[i] == NULL && err != REG_NOERROR, 0))
- goto out_free;
- }
- else
- {
- dest_states_word[i] = dest_states[i];
- dest_states_nl[i] = dest_states[i];
- }
- bitset_merge (acceptable, dests_ch[i]);
- }
-
- if (!BE (need_word_trtable, 0))
- {
- /* We don't care about whether the following character is a word
- character, or we are in a single-byte character set so we can
- discern by looking at the character code: allocate a
- 256-entry transition table. */
- trtable = state->trtable =
- (re_dfastate_t **) calloc (sizeof (re_dfastate_t *), SBC_MAX);
- if (BE (trtable == NULL, 0))
- goto out_free;
-
- /* For all characters ch...: */
- for (i = 0; i < BITSET_WORDS; ++i)
- for (ch = i * BITSET_WORD_BITS, elem = acceptable[i], mask = 1;
- elem;
- mask <<= 1, elem >>= 1, ++ch)
- if (BE (elem & 1, 0))
- {
- /* There must be exactly one destination which accepts
- character ch. See group_nodes_into_DFAstates. */
- for (j = 0; (dests_ch[j][i] & mask) == 0; ++j)
- ;
-
- /* j-th destination accepts the word character ch. */
- if (dfa->word_char[i] & mask)
- trtable[ch] = dest_states_word[j];
- else
- trtable[ch] = dest_states[j];
- }
- }
- else
- {
- /* We care about whether the following character is a word
- character, and we are in a multi-byte character set: discern
- by looking at the character code: build two 256-entry
- transition tables, one starting at trtable[0] and one
- starting at trtable[SBC_MAX]. */
- trtable = state->word_trtable =
- (re_dfastate_t **) calloc (sizeof (re_dfastate_t *), 2 * SBC_MAX);
- if (BE (trtable == NULL, 0))
- goto out_free;
-
- /* For all characters ch...: */
- for (i = 0; i < BITSET_WORDS; ++i)
- for (ch = i * BITSET_WORD_BITS, elem = acceptable[i], mask = 1;
- elem;
- mask <<= 1, elem >>= 1, ++ch)
- if (BE (elem & 1, 0))
- {
- /* There must be exactly one destination which accepts
- character ch. See group_nodes_into_DFAstates. */
- for (j = 0; (dests_ch[j][i] & mask) == 0; ++j)
- ;
-
- /* j-th destination accepts the word character ch. */
- trtable[ch] = dest_states[j];
- trtable[ch + SBC_MAX] = dest_states_word[j];
- }
- }
-
- /* new line */
- if (bitset_contain (acceptable, NEWLINE_CHAR))
- {
- /* The current state accepts newline character. */
- for (j = 0; j < ndests; ++j)
- if (bitset_contain (dests_ch[j], NEWLINE_CHAR))
- {
- /* k-th destination accepts newline character. */
- trtable[NEWLINE_CHAR] = dest_states_nl[j];
- if (need_word_trtable)
- trtable[NEWLINE_CHAR + SBC_MAX] = dest_states_nl[j];
- /* There must be only one destination which accepts
- newline. See group_nodes_into_DFAstates. */
- break;
- }
- }
-
- if (dest_states_malloced)
- free (dest_states);
-
- re_node_set_free (&follows);
- for (i = 0; i < ndests; ++i)
- re_node_set_free (dests_node + i);
-
- if (dests_node_malloced)
- free (dests_alloc);
-
- return 1;
-}
-
-/* Group all nodes belonging to STATE into several destinations.
- Then for all destinations, set the nodes belonging to the destination
- to DESTS_NODE[i] and set the characters accepted by the destination
- to DEST_CH[i]. This function return the number of destinations. */
-
-static int
-internal_function
-group_nodes_into_DFAstates (const re_dfa_t *dfa, const re_dfastate_t *state,
- re_node_set *dests_node, bitset_t *dests_ch)
-{
- reg_errcode_t err;
- int result;
- int i, j, k;
- int ndests; /* Number of the destinations from `state'. */
- bitset_t accepts; /* Characters a node can accept. */
- const re_node_set *cur_nodes = &state->nodes;
- bitset_empty (accepts);
- ndests = 0;
-
- /* For all the nodes belonging to `state', */
- for (i = 0; i < cur_nodes->nelem; ++i)
- {
- re_token_t *node = &dfa->nodes[cur_nodes->elems[i]];
- re_token_type_t type = node->type;
- unsigned int constraint = node->constraint;
-
- /* Enumerate all single byte character this node can accept. */
- if (type == CHARACTER)
- bitset_set (accepts, node->opr.c);
- else if (type == SIMPLE_BRACKET)
- {
- bitset_merge (accepts, node->opr.sbcset);
- }
- else if (type == OP_PERIOD)
- {
-#ifdef RE_ENABLE_I18N
- if (dfa->mb_cur_max > 1)
- bitset_merge (accepts, dfa->sb_char);
- else
-#endif
- bitset_set_all (accepts);
- if (!(dfa->syntax & RE_DOT_NEWLINE))
- bitset_clear (accepts, '\n');
- if (dfa->syntax & RE_DOT_NOT_NULL)
- bitset_clear (accepts, '\0');
- }
-#ifdef RE_ENABLE_I18N
- else if (type == OP_UTF8_PERIOD)
- {
- memset (accepts, '\xff', sizeof (bitset_t) / 2);
- if (!(dfa->syntax & RE_DOT_NEWLINE))
- bitset_clear (accepts, '\n');
- if (dfa->syntax & RE_DOT_NOT_NULL)
- bitset_clear (accepts, '\0');
- }
-#endif
- else
- continue;
-
- /* Check the `accepts' and sift the characters which are not
- match it the context. */
- if (constraint)
- {
- if (constraint & NEXT_NEWLINE_CONSTRAINT)
- {
- bool accepts_newline = bitset_contain (accepts, NEWLINE_CHAR);
- bitset_empty (accepts);
- if (accepts_newline)
- bitset_set (accepts, NEWLINE_CHAR);
- else
- continue;
- }
- if (constraint & NEXT_ENDBUF_CONSTRAINT)
- {
- bitset_empty (accepts);
- continue;
- }
-
- if (constraint & NEXT_WORD_CONSTRAINT)
- {
- bitset_word_t any_set = 0;
- if (type == CHARACTER && !node->word_char)
- {
- bitset_empty (accepts);
- continue;
- }
-#ifdef RE_ENABLE_I18N
- if (dfa->mb_cur_max > 1)
- for (j = 0; j < BITSET_WORDS; ++j)
- any_set |= (accepts[j] &= (dfa->word_char[j] | ~dfa->sb_char[j]));
- else
-#endif
- for (j = 0; j < BITSET_WORDS; ++j)
- any_set |= (accepts[j] &= dfa->word_char[j]);
- if (!any_set)
- continue;
- }
- if (constraint & NEXT_NOTWORD_CONSTRAINT)
- {
- bitset_word_t any_set = 0;
- if (type == CHARACTER && node->word_char)
- {
- bitset_empty (accepts);
- continue;
- }
-#ifdef RE_ENABLE_I18N
- if (dfa->mb_cur_max > 1)
- for (j = 0; j < BITSET_WORDS; ++j)
- any_set |= (accepts[j] &= ~(dfa->word_char[j] & dfa->sb_char[j]));
- else
-#endif
- for (j = 0; j < BITSET_WORDS; ++j)
- any_set |= (accepts[j] &= ~dfa->word_char[j]);
- if (!any_set)
- continue;
- }
- }
-
- /* Then divide `accepts' into DFA states, or create a new
- state. Above, we make sure that accepts is not empty. */
- for (j = 0; j < ndests; ++j)
- {
- bitset_t intersec; /* Intersection sets, see below. */
- bitset_t remains;
- /* Flags, see below. */
- bitset_word_t has_intersec, not_subset, not_consumed;
-
- /* Optimization, skip if this state doesn't accept the character. */
- if (type == CHARACTER && !bitset_contain (dests_ch[j], node->opr.c))
- continue;
-
- /* Enumerate the intersection set of this state and `accepts'. */
- has_intersec = 0;
- for (k = 0; k < BITSET_WORDS; ++k)
- has_intersec |= intersec[k] = accepts[k] & dests_ch[j][k];
- /* And skip if the intersection set is empty. */
- if (!has_intersec)
- continue;
-
- /* Then check if this state is a subset of `accepts'. */
- not_subset = not_consumed = 0;
- for (k = 0; k < BITSET_WORDS; ++k)
- {
- not_subset |= remains[k] = ~accepts[k] & dests_ch[j][k];
- not_consumed |= accepts[k] = accepts[k] & ~dests_ch[j][k];
- }
-
- /* If this state isn't a subset of `accepts', create a
- new group state, which has the `remains'. */
- if (not_subset)
- {
- bitset_copy (dests_ch[ndests], remains);
- bitset_copy (dests_ch[j], intersec);
- err = re_node_set_init_copy (dests_node + ndests, &dests_node[j]);
- if (BE (err != REG_NOERROR, 0))
- goto error_return;
- ++ndests;
- }
-
- /* Put the position in the current group. */
- result = re_node_set_insert (&dests_node[j], cur_nodes->elems[i]);
- if (BE (result < 0, 0))
- goto error_return;
-
- /* If all characters are consumed, go to next node. */
- if (!not_consumed)
- break;
- }
- /* Some characters remain, create a new group. */
- if (j == ndests)
- {
- bitset_copy (dests_ch[ndests], accepts);
- err = re_node_set_init_1 (dests_node + ndests, cur_nodes->elems[i]);
- if (BE (err != REG_NOERROR, 0))
- goto error_return;
- ++ndests;
- bitset_empty (accepts);
- }
- }
- return ndests;
- error_return:
- for (j = 0; j < ndests; ++j)
- re_node_set_free (dests_node + j);
- return -1;
-}
-
-#ifdef RE_ENABLE_I18N
-/* Check how many bytes the node `dfa->nodes[node_idx]' accepts.
- Return the number of the bytes the node accepts.
- STR_IDX is the current index of the input string.
-
- This function handles the nodes which can accept one character, or
- one collating element like '.', '[a-z]', opposite to the other nodes
- can only accept one byte. */
-
-static int
-internal_function
-check_node_accept_bytes (const re_dfa_t *dfa, int node_idx,
- const re_string_t *input, int str_idx)
-{
- const re_token_t *node = dfa->nodes + node_idx;
- int char_len, elem_len;
- int i;
-
- if (BE (node->type == OP_UTF8_PERIOD, 0))
- {
- unsigned char c = re_string_byte_at (input, str_idx), d;
- if (BE (c < 0xc2, 1))
- return 0;
-
- if (str_idx + 2 > input->len)
- return 0;
-
- d = re_string_byte_at (input, str_idx + 1);
- if (c < 0xe0)
- return (d < 0x80 || d > 0xbf) ? 0 : 2;
- else if (c < 0xf0)
- {
- char_len = 3;
- if (c == 0xe0 && d < 0xa0)
- return 0;
- }
- else if (c < 0xf8)
- {
- char_len = 4;
- if (c == 0xf0 && d < 0x90)
- return 0;
- }
- else if (c < 0xfc)
- {
- char_len = 5;
- if (c == 0xf8 && d < 0x88)
- return 0;
- }
- else if (c < 0xfe)
- {
- char_len = 6;
- if (c == 0xfc && d < 0x84)
- return 0;
- }
- else
- return 0;
-
- if (str_idx + char_len > input->len)
- return 0;
-
- for (i = 1; i < char_len; ++i)
- {
- d = re_string_byte_at (input, str_idx + i);
- if (d < 0x80 || d > 0xbf)
- return 0;
- }
- return char_len;
- }
-
- char_len = re_string_char_size_at (input, str_idx);
- if (node->type == OP_PERIOD)
- {
- if (char_len <= 1)
- return 0;
- /* FIXME: I don't think this if is needed, as both '\n'
- and '\0' are char_len == 1. */
- /* '.' accepts any one character except the following two cases. */
- if ((!(dfa->syntax & RE_DOT_NEWLINE) &&
- re_string_byte_at (input, str_idx) == '\n') ||
- ((dfa->syntax & RE_DOT_NOT_NULL) &&
- re_string_byte_at (input, str_idx) == '\0'))
- return 0;
- return char_len;
- }
-
- elem_len = re_string_elem_size_at (input, str_idx);
- if ((elem_len <= 1 && char_len <= 1) || char_len == 0)
- return 0;
-
- if (node->type == COMPLEX_BRACKET)
- {
- const re_charset_t *cset = node->opr.mbcset;
-# ifdef _LIBC
- const unsigned char *pin
- = ((const unsigned char *) re_string_get_buffer (input) + str_idx);
- int j;
- uint32_t nrules;
-# endif /* _LIBC */
- int match_len = 0;
- wchar_t wc = ((cset->nranges || cset->nchar_classes || cset->nmbchars)
- ? re_string_wchar_at (input, str_idx) : 0);
-
- /* match with multibyte character? */
- for (i = 0; i < cset->nmbchars; ++i)
- if (wc == cset->mbchars[i])
- {
- match_len = char_len;
- goto check_node_accept_bytes_match;
- }
- /* match with character_class? */
- for (i = 0; i < cset->nchar_classes; ++i)
- {
- wctype_t wt = cset->char_classes[i];
- if (__iswctype (wc, wt))
- {
- match_len = char_len;
- goto check_node_accept_bytes_match;
- }
- }
-
-# ifdef _LIBC
- nrules = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES);
- if (nrules != 0)
- {
- unsigned int in_collseq = 0;
- const int32_t *table, *indirect;
- const unsigned char *weights, *extra;
- const char *collseqwc;
- int32_t idx;
- /* This #include defines a local function! */
-# include <locale/weight.h>
-
- /* match with collating_symbol? */
- if (cset->ncoll_syms)
- extra = (const unsigned char *)
- _NL_CURRENT (LC_COLLATE, _NL_COLLATE_SYMB_EXTRAMB);
- for (i = 0; i < cset->ncoll_syms; ++i)
- {
- const unsigned char *coll_sym = extra + cset->coll_syms[i];
- /* Compare the length of input collating element and
- the length of current collating element. */
- if (*coll_sym != elem_len)
- continue;
- /* Compare each bytes. */
- for (j = 0; j < *coll_sym; j++)
- if (pin[j] != coll_sym[1 + j])
- break;
- if (j == *coll_sym)
- {
- /* Match if every bytes is equal. */
- match_len = j;
- goto check_node_accept_bytes_match;
- }
- }
-
- if (cset->nranges)
- {
- if (elem_len <= char_len)
- {
- collseqwc = _NL_CURRENT (LC_COLLATE, _NL_COLLATE_COLLSEQWC);
- in_collseq = __collseq_table_lookup (collseqwc, wc);
- }
- else
- in_collseq = find_collation_sequence_value (pin, elem_len);
- }
- /* match with range expression? */
- for (i = 0; i < cset->nranges; ++i)
- if (cset->range_starts[i] <= in_collseq
- && in_collseq <= cset->range_ends[i])
- {
- match_len = elem_len;
- goto check_node_accept_bytes_match;
- }
-
- /* match with equivalence_class? */
- if (cset->nequiv_classes)
- {
- const unsigned char *cp = pin;
- table = (const int32_t *)
- _NL_CURRENT (LC_COLLATE, _NL_COLLATE_TABLEMB);
- weights = (const unsigned char *)
- _NL_CURRENT (LC_COLLATE, _NL_COLLATE_WEIGHTMB);
- extra = (const unsigned char *)
- _NL_CURRENT (LC_COLLATE, _NL_COLLATE_EXTRAMB);
- indirect = (const int32_t *)
- _NL_CURRENT (LC_COLLATE, _NL_COLLATE_INDIRECTMB);
- idx = findidx (&cp);
- if (idx > 0)
- for (i = 0; i < cset->nequiv_classes; ++i)
- {
- int32_t equiv_class_idx = cset->equiv_classes[i];
- size_t weight_len = weights[idx];
- if (weight_len == weights[equiv_class_idx])
- {
- int cnt = 0;
- while (cnt <= weight_len
- && (weights[equiv_class_idx + 1 + cnt]
- == weights[idx + 1 + cnt]))
- ++cnt;
- if (cnt > weight_len)
- {
- match_len = elem_len;
- goto check_node_accept_bytes_match;
- }
- }
- }
- }
- }
- else
-# endif /* _LIBC */
- {
- /* match with range expression? */
-#if __GNUC__ >= 2
- wchar_t cmp_buf[] = {L'\0', L'\0', wc, L'\0', L'\0', L'\0'};
-#else
- wchar_t cmp_buf[] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'};
- cmp_buf[2] = wc;
-#endif
- for (i = 0; i < cset->nranges; ++i)
- {
- cmp_buf[0] = cset->range_starts[i];
- cmp_buf[4] = cset->range_ends[i];
- if (wcscoll (cmp_buf, cmp_buf + 2) <= 0
- && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0)
- {
- match_len = char_len;
- goto check_node_accept_bytes_match;
- }
- }
- }
- check_node_accept_bytes_match:
- if (!cset->non_match)
- return match_len;
- else
- {
- if (match_len > 0)
- return 0;
- else
- return (elem_len > char_len) ? elem_len : char_len;
- }
- }
- return 0;
-}
-
-# ifdef _LIBC
-static unsigned int
-internal_function
-find_collation_sequence_value (const unsigned char *mbs, size_t mbs_len)
-{
- uint32_t nrules = _NL_CURRENT_WORD (LC_COLLATE, _NL_COLLATE_NRULES);
- if (nrules == 0)
- {
- if (mbs_len == 1)
- {
- /* No valid character. Match it as a single byte character. */
- const unsigned char *collseq = (const unsigned char *)
- _NL_CURRENT (LC_COLLATE, _NL_COLLATE_COLLSEQMB);
- return collseq[mbs[0]];
- }
- return UINT_MAX;
- }
- else
- {
- int32_t idx;
- const unsigned char *extra = (const unsigned char *)
- _NL_CURRENT (LC_COLLATE, _NL_COLLATE_SYMB_EXTRAMB);
- int32_t extrasize = (const unsigned char *)
- _NL_CURRENT (LC_COLLATE, _NL_COLLATE_SYMB_EXTRAMB + 1) - extra;
-
- for (idx = 0; idx < extrasize;)
- {
- int mbs_cnt, found = 0;
- int32_t elem_mbs_len;
- /* Skip the name of collating element name. */
- idx = idx + extra[idx] + 1;
- elem_mbs_len = extra[idx++];
- if (mbs_len == elem_mbs_len)
- {
- for (mbs_cnt = 0; mbs_cnt < elem_mbs_len; ++mbs_cnt)
- if (extra[idx + mbs_cnt] != mbs[mbs_cnt])
- break;
- if (mbs_cnt == elem_mbs_len)
- /* Found the entry. */
- found = 1;
- }
- /* Skip the byte sequence of the collating element. */
- idx += elem_mbs_len;
- /* Adjust for the alignment. */
- idx = (idx + 3) & ~3;
- /* Skip the collation sequence value. */
- idx += sizeof (uint32_t);
- /* Skip the wide char sequence of the collating element. */
- idx = idx + sizeof (uint32_t) * (extra[idx] + 1);
- /* If we found the entry, return the sequence value. */
- if (found)
- return *(uint32_t *) (extra + idx);
- /* Skip the collation sequence value. */
- idx += sizeof (uint32_t);
- }
- return UINT_MAX;
- }
-}
-# endif /* _LIBC */
-#endif /* RE_ENABLE_I18N */
-
-/* Check whether the node accepts the byte which is IDX-th
- byte of the INPUT. */
-
-static int
-internal_function
-check_node_accept (const re_match_context_t *mctx, const re_token_t *node,
- int idx)
-{
- unsigned char ch;
- ch = re_string_byte_at (&mctx->input, idx);
- switch (node->type)
- {
- case CHARACTER:
- if (node->opr.c != ch)
- return 0;
- break;
-
- case SIMPLE_BRACKET:
- if (!bitset_contain (node->opr.sbcset, ch))
- return 0;
- break;
-
-#ifdef RE_ENABLE_I18N
- case OP_UTF8_PERIOD:
- if (ch >= 0x80)
- return 0;
- /* FALLTHROUGH */
-#endif
- case OP_PERIOD:
- if ((ch == '\n' && !(mctx->dfa->syntax & RE_DOT_NEWLINE))
- || (ch == '\0' && (mctx->dfa->syntax & RE_DOT_NOT_NULL)))
- return 0;
- break;
-
- default:
- return 0;
- }
-
- if (node->constraint)
- {
- /* The node has constraints. Check whether the current context
- satisfies the constraints. */
- unsigned int context = re_string_context_at (&mctx->input, idx,
- mctx->eflags);
- if (NOT_SATISFY_NEXT_CONSTRAINT (node->constraint, context))
- return 0;
- }
-
- return 1;
-}
-
-/* Extend the buffers, if the buffers have run out. */
-
-static reg_errcode_t
-internal_function
-extend_buffers (re_match_context_t *mctx)
-{
- reg_errcode_t ret;
- re_string_t *pstr = &mctx->input;
-
- /* Double the lengthes of the buffers. */
- ret = re_string_realloc_buffers (pstr, pstr->bufs_len * 2);
- if (BE (ret != REG_NOERROR, 0))
- return ret;
-
- if (mctx->state_log != NULL)
- {
- /* And double the length of state_log. */
- /* XXX We have no indication of the size of this buffer. If this
- allocation fail we have no indication that the state_log array
- does not have the right size. */
- re_dfastate_t **new_array = re_realloc (mctx->state_log, re_dfastate_t *,
- pstr->bufs_len + 1);
- if (BE (new_array == NULL, 0))
- return REG_ESPACE;
- mctx->state_log = new_array;
- }
-
- /* Then reconstruct the buffers. */
- if (pstr->icase)
- {
-#ifdef RE_ENABLE_I18N
- if (pstr->mb_cur_max > 1)
- {
- ret = build_wcs_upper_buffer (pstr);
- if (BE (ret != REG_NOERROR, 0))
- return ret;
- }
- else
-#endif /* RE_ENABLE_I18N */
- build_upper_buffer (pstr);
- }
- else
- {
-#ifdef RE_ENABLE_I18N
- if (pstr->mb_cur_max > 1)
- build_wcs_buffer (pstr);
- else
-#endif /* RE_ENABLE_I18N */
- {
- if (pstr->trans != NULL)
- re_string_translate_buffer (pstr);
- }
- }
- return REG_NOERROR;
-}
-
-
-/* Functions for matching context. */
-
-/* Initialize MCTX. */
-
-static reg_errcode_t
-internal_function
-match_ctx_init (re_match_context_t *mctx, int eflags, int n)
-{
- mctx->eflags = eflags;
- mctx->match_last = -1;
- if (n > 0)
- {
- mctx->bkref_ents = re_malloc (struct re_backref_cache_entry, n);
- mctx->sub_tops = re_malloc (re_sub_match_top_t *, n);
- if (BE (mctx->bkref_ents == NULL || mctx->sub_tops == NULL, 0))
- return REG_ESPACE;
- }
- /* Already zero-ed by the caller.
- else
- mctx->bkref_ents = NULL;
- mctx->nbkref_ents = 0;
- mctx->nsub_tops = 0; */
- mctx->abkref_ents = n;
- mctx->max_mb_elem_len = 1;
- mctx->asub_tops = n;
- return REG_NOERROR;
-}
-
-/* Clean the entries which depend on the current input in MCTX.
- This function must be invoked when the matcher changes the start index
- of the input, or changes the input string. */
-
-static void
-internal_function
-match_ctx_clean (re_match_context_t *mctx)
-{
- int st_idx;
- for (st_idx = 0; st_idx < mctx->nsub_tops; ++st_idx)
- {
- int sl_idx;
- re_sub_match_top_t *top = mctx->sub_tops[st_idx];
- for (sl_idx = 0; sl_idx < top->nlasts; ++sl_idx)
- {
- re_sub_match_last_t *last = top->lasts[sl_idx];
- re_free (last->path.array);
- re_free (last);
- }
- re_free (top->lasts);
- if (top->path)
- {
- re_free (top->path->array);
- re_free (top->path);
- }
- free (top);
- }
-
- mctx->nsub_tops = 0;
- mctx->nbkref_ents = 0;
-}
-
-/* Free all the memory associated with MCTX. */
-
-static void
-internal_function
-match_ctx_free (re_match_context_t *mctx)
-{
- /* First, free all the memory associated with MCTX->SUB_TOPS. */
- match_ctx_clean (mctx);
- re_free (mctx->sub_tops);
- re_free (mctx->bkref_ents);
-}
-
-/* Add a new backreference entry to MCTX.
- Note that we assume that caller never call this function with duplicate
- entry, and call with STR_IDX which isn't smaller than any existing entry.
-*/
-
-static reg_errcode_t
-internal_function
-match_ctx_add_entry (re_match_context_t *mctx, int node, int str_idx, int from,
- int to)
-{
- if (mctx->nbkref_ents >= mctx->abkref_ents)
- {
- struct re_backref_cache_entry* new_entry;
- new_entry = re_realloc (mctx->bkref_ents, struct re_backref_cache_entry,
- mctx->abkref_ents * 2);
- if (BE (new_entry == NULL, 0))
- {
- re_free (mctx->bkref_ents);
- return REG_ESPACE;
- }
- mctx->bkref_ents = new_entry;
- memset (mctx->bkref_ents + mctx->nbkref_ents, '\0',
- sizeof (struct re_backref_cache_entry) * mctx->abkref_ents);
- mctx->abkref_ents *= 2;
- }
- if (mctx->nbkref_ents > 0
- && mctx->bkref_ents[mctx->nbkref_ents - 1].str_idx == str_idx)
- mctx->bkref_ents[mctx->nbkref_ents - 1].more = 1;
-
- mctx->bkref_ents[mctx->nbkref_ents].node = node;
- mctx->bkref_ents[mctx->nbkref_ents].str_idx = str_idx;
- mctx->bkref_ents[mctx->nbkref_ents].subexp_from = from;
- mctx->bkref_ents[mctx->nbkref_ents].subexp_to = to;
-
- /* This is a cache that saves negative results of check_dst_limits_calc_pos.
- If bit N is clear, means that this entry won't epsilon-transition to
- an OP_OPEN_SUBEXP or OP_CLOSE_SUBEXP for the N+1-th subexpression. If
- it is set, check_dst_limits_calc_pos_1 will recurse and try to find one
- such node.
-
- A backreference does not epsilon-transition unless it is empty, so set
- to all zeros if FROM != TO. */
- mctx->bkref_ents[mctx->nbkref_ents].eps_reachable_subexps_map
- = (from == to ? ~0 : 0);
-
- mctx->bkref_ents[mctx->nbkref_ents++].more = 0;
- if (mctx->max_mb_elem_len < to - from)
- mctx->max_mb_elem_len = to - from;
- return REG_NOERROR;
-}
-
-/* Search for the first entry which has the same str_idx, or -1 if none is
- found. Note that MCTX->BKREF_ENTS is already sorted by MCTX->STR_IDX. */
-
-static int
-internal_function
-search_cur_bkref_entry (const re_match_context_t *mctx, int str_idx)
-{
- int left, right, mid, last;
- last = right = mctx->nbkref_ents;
- for (left = 0; left < right;)
- {
- mid = (left + right) / 2;
- if (mctx->bkref_ents[mid].str_idx < str_idx)
- left = mid + 1;
- else
- right = mid;
- }
- if (left < last && mctx->bkref_ents[left].str_idx == str_idx)
- return left;
- else
- return -1;
-}
-
-/* Register the node NODE, whose type is OP_OPEN_SUBEXP, and which matches
- at STR_IDX. */
-
-static reg_errcode_t
-internal_function
-match_ctx_add_subtop (re_match_context_t *mctx, int node, int str_idx)
-{
-#ifdef DEBUG
- assert (mctx->sub_tops != NULL);
- assert (mctx->asub_tops > 0);
-#endif
- if (BE (mctx->nsub_tops == mctx->asub_tops, 0))
- {
- int new_asub_tops = mctx->asub_tops * 2;
- re_sub_match_top_t **new_array = re_realloc (mctx->sub_tops,
- re_sub_match_top_t *,
- new_asub_tops);
- if (BE (new_array == NULL, 0))
- return REG_ESPACE;
- mctx->sub_tops = new_array;
- mctx->asub_tops = new_asub_tops;
- }
- mctx->sub_tops[mctx->nsub_tops] = calloc (1, sizeof (re_sub_match_top_t));
- if (BE (mctx->sub_tops[mctx->nsub_tops] == NULL, 0))
- return REG_ESPACE;
- mctx->sub_tops[mctx->nsub_tops]->node = node;
- mctx->sub_tops[mctx->nsub_tops++]->str_idx = str_idx;
- return REG_NOERROR;
-}
-
-/* Register the node NODE, whose type is OP_CLOSE_SUBEXP, and which matches
- at STR_IDX, whose corresponding OP_OPEN_SUBEXP is SUB_TOP. */
-
-static re_sub_match_last_t *
-internal_function
-match_ctx_add_sublast (re_sub_match_top_t *subtop, int node, int str_idx)
-{
- re_sub_match_last_t *new_entry;
- if (BE (subtop->nlasts == subtop->alasts, 0))
- {
- int new_alasts = 2 * subtop->alasts + 1;
- re_sub_match_last_t **new_array = re_realloc (subtop->lasts,
- re_sub_match_last_t *,
- new_alasts);
- if (BE (new_array == NULL, 0))
- return NULL;
- subtop->lasts = new_array;
- subtop->alasts = new_alasts;
- }
- new_entry = calloc (1, sizeof (re_sub_match_last_t));
- if (BE (new_entry != NULL, 1))
- {
- subtop->lasts[subtop->nlasts] = new_entry;
- new_entry->node = node;
- new_entry->str_idx = str_idx;
- ++subtop->nlasts;
- }
- return new_entry;
-}
-
-static void
-internal_function
-sift_ctx_init (re_sift_context_t *sctx, re_dfastate_t **sifted_sts,
- re_dfastate_t **limited_sts, int last_node, int last_str_idx)
-{
- sctx->sifted_states = sifted_sts;
- sctx->limited_states = limited_sts;
- sctx->last_node = last_node;
- sctx->last_str_idx = last_str_idx;
- re_node_set_init_empty (&sctx->limits);
-}
diff --git a/Build/source/texk/web2c/pdftexdir/subfont.c b/Build/source/texk/web2c/pdftexdir/subfont.c
deleted file mode 100644
index 32dbef73cae..00000000000
--- a/Build/source/texk/web2c/pdftexdir/subfont.c
+++ /dev/null
@@ -1,228 +0,0 @@
-/*
-Copyright 2005-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-#include <string.h>
-
-static struct avl_table *sfd_tree = NULL;
-
-#define SFD_BUF_SIZE SMALL_BUF_SIZE
-#define sfd_getchar() getc(sfd_file)
-#define sfd_eof() feof(sfd_file)
-#define sfd_close() xfclose(sfd_file, cur_file_name)
-#define sfd_open() open_input(&sfd_file, kpse_sfd_format, FOPEN_RBIN_MODE)
-static FILE *sfd_file;
-static char sfd_line[SFD_BUF_SIZE];
-
-static subfont_entry *new_subfont_entry(void)
-{
- int i;
- subfont_entry *subfont;
- subfont = xtalloc(1, subfont_entry);
- subfont->infix = NULL;
- for (i = 0; i < 256; i++)
- subfont->charcodes[i] = -1; /* unassigned */
- subfont->next = NULL;
- return subfont;
-}
-
-static sfd_entry *new_sfd_entry(void)
-{
- sfd_entry *sfd;
- sfd = xtalloc(1, sfd_entry);
- sfd->name = NULL;
- sfd->subfont = NULL;
- return sfd;
-}
-
-static void destroy_sfd_entry(void *pa, void *pb)
-{
- subfont_entry *p, *q;
- sfd_entry *sfd;
- sfd = (sfd_entry *) pa;
- p = sfd->subfont;
- while (p != NULL) {
- q = p->next;
- xfree(p->infix);
- xfree(p);
- p = q;
- }
- xfree(sfd->name);
-}
-
-static int comp_sfd_entry(const void *pa, const void *pb, void *p)
-{
- return strcmp(((const sfd_entry *) pa)->name,
- ((const sfd_entry *) pb)->name);
-}
-
-void sfd_free(void)
-{
- if (sfd_tree != NULL)
- avl_destroy(sfd_tree, destroy_sfd_entry);
-}
-
-static void sfd_getline(boolean expect_eof)
-{
- char *p;
- int c;
- restart:
- if (sfd_eof()) {
- if (expect_eof)
- return;
- else
- pdftex_fail("unexpected end of file");
- }
- p = sfd_line;
- do {
- c = sfd_getchar();
- append_char_to_buf(c, p, sfd_line, SFD_BUF_SIZE);
- } while (c != 10);
- append_eol(p, sfd_line, SFD_BUF_SIZE);
- if (p - sfd_line < 2 || *sfd_line == '#')
- goto restart;
-}
-
-static sfd_entry *read_sfd(char *sfd_name)
-{
- void **aa;
- sfd_entry *sfd, tmp_sfd;
- subfont_entry *sf;
- char buf[SMALL_BUF_SIZE], *p;
- long int i, j, k;
- int n;
- /* check whether this sfd has been read */
- tmp_sfd.name = sfd_name;
- if (sfd_tree == NULL) {
- sfd_tree = avl_create(comp_sfd_entry, NULL, &avl_xallocator);
- assert(sfd_tree != NULL);
- }
- sfd = (sfd_entry *) avl_find(sfd_tree, &tmp_sfd);
- if (sfd != NULL)
- return sfd;
- set_cur_file_name(sfd_name);
- if (!sfd_open()) {
- pdftex_warn("cannot open SFD file for reading");
- cur_file_name = NULL;
- return NULL;
- }
- tex_printf("{");
- tex_printf("%s", cur_file_name);
- sfd = new_sfd_entry();
- sfd->name = xstrdup(sfd_name);
- while (!sfd_eof()) {
- sfd_getline(true);
- if (*sfd_line == 10) /* empty line indicating eof */
- break;
- sf = new_subfont_entry();
- sf->next = sfd->subfont;
- sfd->subfont = sf;
- sscanf(sfd_line, "%s %n", buf, &n);
- sf->infix = xstrdup(buf);
- p = sfd_line + n; /* skip to the next word */
- k = 0;
- read_ranges:
- for (;;) {
- if (*p == '\\') { /* continue on next line */
- sfd_getline(false);
- p = sfd_line;
- goto read_ranges;
- } else if (*p == 0) /* end of subfont */
- break;
- if (sscanf(p, " %li %n", &i, &n) == 0)
- pdftex_fail("invalid token:\n%s", p);
- p += n;
- if (*p == ':') { /* offset */
- k = i;
- p++;
- } else if (*p == '_') { /* range */
- if (sscanf(p + 1, " %li %n", &j, &n) == 0)
- pdftex_fail("invalid token:\n%s", p);
- if (i > j || k + (j - i) > 255)
- pdftex_fail("invalid range:\n%s", p);
- while (i <= j)
- sf->charcodes[k++] = i++;
- p += n + 1;
- } else /* codepoint */
- sf->charcodes[k++] = i;
- }
- }
- sfd_close();
- tex_printf("}");
- aa = avl_probe(sfd_tree, sfd);
- assert(aa != NULL);
- return sfd;
-}
-
-boolean handle_subfont_fm(fm_entry * fm, int mode)
-{
- size_t l;
- char *p, *q, *r;
- sfd_entry *sfd;
- subfont_entry *sf;
- fm_entry *fm2;
- char buf[SMALL_BUF_SIZE];
- assert(fm->tfm_name != NULL);
-
- p = fm->tfm_name;
- q = strchr(p, '@'); /* search for the first '@' */
- if (q == NULL)
- return false;
- r = strchr(q + 1, '@'); /* search for the second '@' */
- if (r == NULL)
- return false;
- if (q <= p || r <= q + 1 /* prefix or sfd name is empty */
- || r - p != strlen(p) - 1) /* or the second '@' is not the last char yet */
- return false;
- l = r - (q + 1); /* length of sfd name */
- strncpy(buf, q + 1, l);
- buf[l] = 0;
- check_buf(strlen(buf) + 4, SMALL_BUF_SIZE);
- strcat(buf, ".sfd");
- sfd = read_sfd(buf);
- if (sfd == NULL)
- return false;
-
- /* at this point we know fm is a subfont */
- set_subfont(fm);
- xfree(fm->ps_name);
- fm->ps_name = NULL;
- /* set default values for PidEid */
- if (fm->pid == -1) {
- fm->pid = 3;
- fm->eid = 1;
- }
- l = q - p; /* length of base tfm name (prefix) */
- for (sf = sfd->subfont; sf != NULL; sf = sf->next) {
- strncpy(buf, p, l);
- buf[l] = 0;
- strcat(buf, sf->infix);
- fm2 = new_fm_entry();
- fm2->tfm_name = xstrdup(buf);
- fm2->ff_name = xstrdup(fm->ff_name);
- fm2->type = fm->type;
- fm2->pid = fm->pid;
- fm2->eid = fm->eid;
- fm2->subfont = sf;
- if (avl_do_entry(fm2, mode) != 0) /* try to insert the entry */
- delete_fm_entry(fm2); /* delete it if failed */
- }
- delete_fm_entry(fm);
- return true;
-}
diff --git a/Build/source/texk/web2c/pdftexdir/tests/cnfline.test b/Build/source/texk/web2c/pdftexdir/tests/cnfline.test
deleted file mode 100755
index b295b81ea90..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/cnfline.test
+++ /dev/null
@@ -1,23 +0,0 @@
-#! /bin/sh -vx
-# $Id$
-# Public domain. Originally written by Karl Berry
-# Basic check that --cnf-line does something.
-
-LC_ALL=C; export LC_ALL; LANGUAGE=C; export LANGUAGE
-
-TEXMFCNF=$srcdir/../kpathsea; export TEXMFCNF
-TEXINPUTS=$srcdir/pdftexdir/tests; export TEXINPUTS
-
-./pdftex -ini --interaction=batchmode \
- --cnf-line=max_print_line=500 cnfline.tex || exit $?
-
-if grep 'those hyphens are' cnfline.log >/dev/null; then
- : # ok, all ended up on one line
-else
- echo "log message got broken despite max_print_line" >&2
- cat cnfline.log >&2
- exit 1
-fi
-
-exit 0
-
diff --git a/Build/source/texk/web2c/pdftexdir/tests/cnfline.tex b/Build/source/texk/web2c/pdftexdir/tests/cnfline.tex
deleted file mode 100644
index f9f694aacde..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/cnfline.tex
+++ /dev/null
@@ -1,13 +0,0 @@
-% $Id$
-% Public domain. Test file for --cnf-line.
-% Originally written 2019 by Karl Berry.
-
-\catcode`\{=1 \catcode`\}=2 % can run under -ini
-
-\write-1{the idea is to write a message longer than the default
- max-print-line (those hyphens are really underscores).}
-\end
-
-% with the default max_print_line, we get:
-% the idea is to write a message longer than the default max-print-line (those hy
-% phens are really underscores).
diff --git a/Build/source/texk/web2c/pdftexdir/tests/expanded.tex b/Build/source/texk/web2c/pdftexdir/tests/expanded.tex
deleted file mode 100644
index 50484cb9533..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/expanded.tex
+++ /dev/null
@@ -1,46 +0,0 @@
-% $Id$
-% Public domain.
-% Originally written 2018 by David Carlisle, Bruno Le Floch.
-
-\catcode`\{=1 \catcode`\}=2 \catcode`\#=6
-\def\typ#1{\immediate\write-1 {#1}}
-\def\space{ }
-\let\bgroup{ \let\egroup}
-
-\typ{START}
-\typ{EXPANDED TEST 1}
-% Check the primitive exists
-\show\expanded
-
-\typ{EXPANDED TEST 2}
-% Simple expansion test
-\def\aaa{x}
-\def\bbb{\aaa\aaa}
-\expandafter\def\expandafter\ccc\expandafter{\expanded{\bbb,\aaa}}
-\show\ccc
-
-\typ{EXPANDED TEST 3: the}
-% Expanding \the
-\typ{\expanded{\bbb,\the\numexpr100+20+3\relax}}
-
-\typ{EXPANDED TEST 4: macro param}
-% Constructed #1 is still #1
-\expandafter\def\expandafter\ddd\expandafter#\expanded{1{#\number--1}}
-\show\ddd
-
-\typ{EXPANDED TEST 5: torture}
-% Torture test from Bruno Le Floch testing various tricky interactions
-\expanded\relax\space\ifincsname \BOOM\fi{\ifincsname \BOOM\fi}
-\showtokens\expandafter{\expanded{#,\noexpand\aaa,\unexpanded{\aaa}}}
-\showtokens\expandafter{\expanded{#,\unexpanded{#}}}
-\showtokens\expandafter{\expanded\expandafter{\noexpand\aaa}}
-\showtokens\expandafter{\expanded\expandafter{\unexpanded{\aaa}}}
-\showtokens\expanded{{\expanded{\aaa\noexpand\aaa\noexpand\noexpand\noexpand\aaa}}}
-\toks0{\aaa}
-\showtokens\expanded{{\the\toks0}}
-\expanded\bgroup\show\egroup}
-\edef\foo{\expanded{##}}
-\show\foo
-
-\typ{END}
-\end
diff --git a/Build/source/texk/web2c/pdftexdir/tests/expanded.txt b/Build/source/texk/web2c/pdftexdir/tests/expanded.txt
deleted file mode 100644
index d9b7c275c36..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/expanded.txt
+++ /dev/null
@@ -1,61 +0,0 @@
-START
-EXPANDED TEST 1
-> \expanded=\expanded.
-l.13 \show\expanded
-
-
-EXPANDED TEST 2
-> \ccc=macro:
-->xx,x.
-l.20 \show\ccc
-
-
-EXPANDED TEST 3: the
-xx,123
-EXPANDED TEST 4: macro param
-> \ddd=macro:
-#1->#1.
-l.29 \show\ddd
-
-
-EXPANDED TEST 5: torture
-> ##,\aaa ,\aaa .
-l.34 ...panded{#,\noexpand\aaa,\unexpanded{\aaa}}}
-
-
-> ##,##.
-l.35 ...s\expandafter{\expanded{#,\unexpanded{#}}}
-
-
-> \aaa .
-l.36 ...fter{\expanded\expandafter{\noexpand\aaa}}
-
-
-> x.
-l.37 ...{\expanded\expandafter{\unexpanded{\aaa}}}
-
-
-> xx\aaa .
-<inserted text> {xx\aaa }
-
-l.38 ...pand\aaa\noexpand\noexpand\noexpand\aaa}}}
-
-
-> \aaa .
-<inserted text> {\aaa }
-
-l.40 \showtokens\expanded{{\the\toks0}}
-
-
-> \egroup=end-group character }.
-<inserted text> \show \egroup
-
-l.41 \expanded\bgroup\show\egroup}
-
-
-> \foo=macro:
-->##.
-l.43 \show\foo
-
-
-END
diff --git a/Build/source/texk/web2c/pdftexdir/tests/pdfimage.tex b/Build/source/texk/web2c/pdftexdir/tests/pdfimage.tex
deleted file mode 100644
index 76bf8758a15..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/pdfimage.tex
+++ /dev/null
@@ -1,27 +0,0 @@
-% Copyright (C) 2013 Peter Breitenlohner <tex-live@tug.org>
-% You may freely use, modify and/or distribute this file.
-%
-\ifx\fmtname\undefined
- \input basic
- \def\fmtname{basic}
- \expandafter\dump
-\fi
-%==================
-\pdfoutput=1
-\pdfcompresslevel=0
-
-\topskip0pt
-
-\pdfximage width \hsize height \vsize {1-4.jpg}
-\hbox{\pdfrefximage\pdflastximage}
-\eject
-
-\pdfximage width \hsize height \vsize {B.pdf}
-\hbox{\pdfrefximage\pdflastximage}
-\eject
-
-\pdfximage width \hsize height \vsize {lily-ledger-broken.png}
-\hbox{\pdfrefximage\pdflastximage}
-\eject
-
-\bye
diff --git a/Build/source/texk/web2c/pdftexdir/tests/postV3.afm b/Build/source/texk/web2c/pdftexdir/tests/postV3.afm
deleted file mode 100644
index 1ca0acb0fbf..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/postV3.afm
+++ /dev/null
@@ -1,69 +0,0 @@
-StartFontMetrics 2.0
-FontName FonetikaDaniaIwonaeRegular
-FullName Fonetika Dania Iwonae Regular
-FamilyName FonetikaDaniaIwonae
-Weight Normal
-ItalicAngle 0
-IsFixedPitch false
-FontBBox -63 -250 733 750
-UnderlinePosition -100
-UnderlineThickness 50
-Version Version 001.000
-Notice Created by Palle Jżrgensen, with FontForge 1.0 (http://fontforge.sf.net)\nThe license is GUST Font Nosource License.
-EncodingScheme FontSpecific
-Ascender 750
-Descender -250
-StartCharMetrics 51
-C -1 ; WX 432 ; N .notdef ; B 33 0 366 666 ;
-C -1 ; WX 0 ; N .null ; B 108 471 286 700 ;
-C -1 ; WX 333 ; N CR ; B 108 471 286 700 ;
-C -1 ; WX 222 ; N quoteright ; B 108 471 286 700 ;
-C -1 ; WX 278 ; N comma ; B 108 -229 170 121 ;
-C -1 ; WX 278 ; N period ; B 90 362 188 460 ;
-C -1 ; WX 295 ; N zero ; B 19 -158 261 162 ;
-C -1 ; WX 491 ; N A ; B 62 -10 541 460 ;
-C -1 ; WX 591 ; N B ; B 62 -10 733 649 ;
-C -1 ; WX 442 ; N C ; B 71 -10 467 655 ;
-C -1 ; WX 460 ; N D ; B 54 -10 540 700 ;
-C -1 ; WX 438 ; N E ; B 62 -10 434 460 ;
-C -1 ; WX 249 ; N I ; B 13 -240 278 661 ;
-C -1 ; WX 455 ; N N ; B 43 -163 447 460 ;
-C -1 ; WX 307 ; N R ; B -15 0 307 457 ;
-C -1 ; WX 382 ; N S ; B 13 -240 394 460 ;
-C -1 ; WX 222 ; N bracketleft ; B 34 -250 188 750 ;
-C -1 ; WX 222 ; N bracketright ; B 34 -250 188 750 ;
-C -1 ; WX 462 ; N a ; B 57 -10 472 460 ;
-C -1 ; WX 462 ; N b ; B 43 -10 458 700 ;
-C -1 ; WX 442 ; N c ; B 71 -10 431 460 ;
-C -1 ; WX 462 ; N d ; B 57 -10 526 700 ;
-C -1 ; WX 438 ; N e ; B 62 -10 434 460 ;
-C -1 ; WX 243 ; N f ; B 51 0 399 710 ;
-C -1 ; WX 462 ; N g ; B 51 -240 472 460 ;
-C -1 ; WX 455 ; N h ; B 43 0 447 700 ;
-C -1 ; WX 249 ; N i ; B 58 -10 274 661 ;
-C -1 ; WX 224 ; N j ; B -63 -240 279 661 ;
-C -1 ; WX 426 ; N k ; B 43 0 483 700 ;
-C -1 ; WX 253 ; N l ; B 62 -10 288 700 ;
-C -1 ; WX 612 ; N m ; B 43 0 605 460 ;
-C -1 ; WX 455 ; N n ; B 43 0 447 460 ;
-C -1 ; WX 442 ; N o ; B 60 -10 436 460 ;
-C -1 ; WX 458 ; N p ; B -10 -230 454 460 ;
-C -1 ; WX 307 ; N r ; B 43 0 365 457 ;
-C -1 ; WX 382 ; N s ; B 13 -10 394 460 ;
-C -1 ; WX 271 ; N t ; B 86 -10 321 600 ;
-C -1 ; WX 455 ; N u ; B 61 -10 465 450 ;
-C -1 ; WX 370 ; N v ; B 82 0 436 450 ;
-C -1 ; WX 568 ; N w ; B 90 0 627 450 ;
-C -1 ; WX 455 ; N y ; B 61 -240 465 450 ;
-C -1 ; WX 278 ; N bar ; B 108 400 170 750 ;
-C -1 ; WX 455 ; N eng ; B 43 -163 447 460 ;
-C -1 ; WX 462 ; N Aring ; B 47 -10 442 685 ;
-C -1 ; WX 462 ; N AE ; B 57 -10 472 661 ;
-C -1 ; WX 442 ; N Oslash ; B 60 -10 467 655 ;
-C -1 ; WX 462 ; N aring ; B 57 -10 472 685 ;
-C -1 ; WX 690 ; N ae ; B 49 -10 686 460 ;
-C -1 ; WX 460 ; N eth ; B 54 -10 540 700 ;
-C -1 ; WX 442 ; N odieresis ; B 60 -10 467 655 ;
-C -1 ; WX 442 ; N oslash ; B 13 -47 482 497 ;
-EndCharMetrics
-EndFontMetrics
diff --git a/Build/source/texk/web2c/pdftexdir/tests/postV3.ttf b/Build/source/texk/web2c/pdftexdir/tests/postV3.ttf
deleted file mode 100644
index 95e09e4eb9f..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/postV3.ttf
+++ /dev/null
Binary files differ
diff --git a/Build/source/texk/web2c/pdftexdir/tests/postV7.afm b/Build/source/texk/web2c/pdftexdir/tests/postV7.afm
deleted file mode 100644
index ec5d1a9391f..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/postV7.afm
+++ /dev/null
@@ -1,69 +0,0 @@
-StartFontMetrics 2.0
-FontName FonetikaDaniaIwonaeRegular
-FullName Fonetika Dania Iwonae Regular
-FamilyName FonetikaDaniaIwonae
-Weight Normal
-ItalicAngle 0
-IsFixedPitch false
-FontBBox -63 -250 733 750
-UnderlinePosition -100
-UnderlineThickness 50
-Version Version 001.000
-Notice Created by Palle Jżrgensen, with FontForge 1.0 (http://fontforge.sf.net)\nThe license is GUST Font Nosource License.
-EncodingScheme FontSpecific
-Ascender 750
-Descender -250
-StartCharMetrics 51
-C -1 ; WX 432 ; N index0 ; B 33 0 366 666 ;
-C -1 ; WX 0 ; N index1 ; B 108 471 286 700 ;
-C -1 ; WX 333 ; N index2 ; B 108 471 286 700 ;
-C -1 ; WX 222 ; N index3 ; B 108 471 286 700 ;
-C -1 ; WX 278 ; N index4 ; B 108 -229 170 121 ;
-C -1 ; WX 278 ; N index5 ; B 90 362 188 460 ;
-C -1 ; WX 295 ; N index6 ; B 19 -158 261 162 ;
-C -1 ; WX 491 ; N index7 ; B 62 -10 541 460 ;
-C -1 ; WX 591 ; N index8 ; B 62 -10 733 649 ;
-C -1 ; WX 442 ; N index9 ; B 71 -10 467 655 ;
-C -1 ; WX 460 ; N index10 ; B 54 -10 540 700 ;
-C -1 ; WX 438 ; N index11 ; B 62 -10 434 460 ;
-C -1 ; WX 249 ; N index12 ; B 13 -240 278 661 ;
-C -1 ; WX 455 ; N index13 ; B 43 -163 447 460 ;
-C -1 ; WX 307 ; N index14 ; B -15 0 307 457 ;
-C -1 ; WX 382 ; N index15 ; B 13 -240 394 460 ;
-C -1 ; WX 222 ; N index16 ; B 34 -250 188 750 ;
-C -1 ; WX 222 ; N index17 ; B 34 -250 188 750 ;
-C -1 ; WX 462 ; N index18 ; B 57 -10 472 460 ;
-C -1 ; WX 462 ; N index19 ; B 43 -10 458 700 ;
-C -1 ; WX 442 ; N index20 ; B 71 -10 431 460 ;
-C -1 ; WX 462 ; N index21 ; B 57 -10 526 700 ;
-C -1 ; WX 438 ; N index22 ; B 62 -10 434 460 ;
-C -1 ; WX 243 ; N index23 ; B 51 0 399 710 ;
-C -1 ; WX 462 ; N index24 ; B 51 -240 472 460 ;
-C -1 ; WX 455 ; N index25 ; B 43 0 447 700 ;
-C -1 ; WX 249 ; N index26 ; B 58 -10 274 661 ;
-C -1 ; WX 224 ; N index27 ; B -63 -240 279 661 ;
-C -1 ; WX 426 ; N index28 ; B 43 0 483 700 ;
-C -1 ; WX 253 ; N index29 ; B 62 -10 288 700 ;
-C -1 ; WX 612 ; N index30 ; B 43 0 605 460 ;
-C -1 ; WX 455 ; N index31 ; B 43 0 447 460 ;
-C -1 ; WX 442 ; N index32 ; B 60 -10 436 460 ;
-C -1 ; WX 458 ; N index33 ; B -10 -230 454 460 ;
-C -1 ; WX 307 ; N index34 ; B 43 0 365 457 ;
-C -1 ; WX 382 ; N index35 ; B 13 -10 394 460 ;
-C -1 ; WX 271 ; N index36 ; B 86 -10 321 600 ;
-C -1 ; WX 455 ; N index37 ; B 61 -10 465 450 ;
-C -1 ; WX 370 ; N index38 ; B 82 0 436 450 ;
-C -1 ; WX 568 ; N index39 ; B 90 0 627 450 ;
-C -1 ; WX 455 ; N index40 ; B 61 -240 465 450 ;
-C -1 ; WX 278 ; N index41 ; B 108 400 170 750 ;
-C -1 ; WX 455 ; N index42 ; B 43 -163 447 460 ;
-C -1 ; WX 462 ; N index43 ; B 47 -10 442 685 ;
-C -1 ; WX 462 ; N index44 ; B 57 -10 472 661 ;
-C -1 ; WX 442 ; N index45 ; B 60 -10 467 655 ;
-C -1 ; WX 462 ; N index46 ; B 57 -10 472 685 ;
-C -1 ; WX 690 ; N index47 ; B 49 -10 686 460 ;
-C -1 ; WX 460 ; N index48 ; B 54 -10 540 700 ;
-C -1 ; WX 442 ; N index49 ; B 60 -10 467 655 ;
-C -1 ; WX 442 ; N index50 ; B 13 -47 482 497 ;
-EndCharMetrics
-EndFontMetrics
diff --git a/Build/source/texk/web2c/pdftexdir/tests/postV7.ttf b/Build/source/texk/web2c/pdftexdir/tests/postV7.ttf
deleted file mode 100644
index 7f298cfd037..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/postV7.ttf
+++ /dev/null
Binary files differ
diff --git a/Build/source/texk/web2c/pdftexdir/tests/test-13.pdf b/Build/source/texk/web2c/pdftexdir/tests/test-13.pdf
deleted file mode 100644
index 8255d131c61..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/test-13.pdf
+++ /dev/null
Binary files differ
diff --git a/Build/source/texk/web2c/pdftexdir/tests/test-13.xref b/Build/source/texk/web2c/pdftexdir/tests/test-13.xref
deleted file mode 100644
index 81cafae715b..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/test-13.xref
+++ /dev/null
@@ -1,13 +0,0 @@
-xref
-0 11
-0000000000 65535 f
-0000000916 00000 n
-0000000813 00000 n
-0000000015 00000 n
-0000017227 00000 n
-0000017353 00000 n
-0000000973 00000 n
-0000001338 00000 n
-0000016948 00000 n
-0000017404 00000 n
-0000017449 00000 n
diff --git a/Build/source/texk/web2c/pdftexdir/tests/test-15.pdf b/Build/source/texk/web2c/pdftexdir/tests/test-15.pdf
deleted file mode 100644
index e5d1feb715a..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/test-15.pdf
+++ /dev/null
Binary files differ
diff --git a/Build/source/texk/web2c/pdftexdir/tests/test-15.xref b/Build/source/texk/web2c/pdftexdir/tests/test-15.xref
deleted file mode 100644
index 1e5ced2b8c6..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tests/test-15.xref
+++ /dev/null
@@ -1,15 +0,0 @@
-xref
-0 13
-0000000000 00255 f
-0000016640 00000 n
-0000016552 00000 n
-0000000015 00000 n
-0000017296 00000 n
-0000017407 00000 n
-0000016423 00000 n
-0000016682 00000 n
-0000000813 00000 n
-0000017032 00000 n
-0000017443 00000 n
-0000017473 00000 n
-0000017155 00000 n
diff --git a/Build/source/texk/web2c/pdftexdir/tex.ch0 b/Build/source/texk/web2c/pdftexdir/tex.ch0
deleted file mode 100644
index 012f6b31f42..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tex.ch0
+++ /dev/null
@@ -1,38 +0,0 @@
-% Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-%
-% This file is part of pdfTeX.
-%
-% pdfTeX is free software; you can redistribute it and/or modify
-% it under the terms of the GNU General Public License as published by
-% the Free Software Foundation; either version 2 of the License, or
-% (at your option) any later version.
-%
-% pdfTeX is distributed in the hope that it will be useful,
-% but WITHOUT ANY WARRANTY; without even the implied warranty of
-% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-% GNU General Public License for more details.
-%
-% You should have received a copy of the GNU General Public License along with
-% this program. If not, see <http://www.gnu.org/licenses/>.
-%
-% Change file to assist in creating the web2c-specific change file.
-% This one comes first, resolves inconsistencies between the generated
-% pdfetex.web and tex.ch
-
-@x [1.2] l.188
-@d TeX_banner=='This is TeX, Version 3.141592653' {printed when \TeX\ starts}
-@#
-@d banner==pdfTeX_banner
-@y
-@d banner=='This is TeX, Version 3.141592653' {printed when \TeX\ starts}
-@z
-
-@x [17.236] l.4960 - first web2c, then pdfTeX, then e-TeX additional integer parameters
-@d tex_int_pars=55 {total number of \TeX's integer parameters}
-@#
-@d pdftex_first_integer_code = tex_int_pars {base for \pdfTeX's integer parameters}
-@y
-@d int_pars=55 {total number of integer parameters}
-@#
-@d etex_int_base=tex_int_pars {base for \eTeX's integer parameters}
-@z
diff --git a/Build/source/texk/web2c/pdftexdir/tounicode.c b/Build/source/texk/web2c/pdftexdir/tounicode.c
deleted file mode 100644
index 858954efde4..00000000000
--- a/Build/source/texk/web2c/pdftexdir/tounicode.c
+++ /dev/null
@@ -1,531 +0,0 @@
-/*
-Copyright 2006-2021 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-
-#define isXdigit(c) (isdigit(c) || ('A' <= (c) && (c) <= 'F'))
-#define UNI_UNDEF -1
-#define UNI_STRING -2 /* string allocated by deftounicode() */
-#define UNI_EXTRA_STRING -3 /* string allocated by set_glyph_unicode() */
-
-static struct avl_table *glyph_unicode_tree = NULL;
-
-static int comp_glyph_unicode_entry(const void *pa, const void *pb, void *p)
-{
- return strcmp(((const glyph_unicode_entry *) pa)->name,
- ((const glyph_unicode_entry *) pb)->name);
-}
-
-static glyph_unicode_entry *new_glyph_unicode_entry(void)
-{
- glyph_unicode_entry *e;
- e = xtalloc(1, glyph_unicode_entry);
- e->name = NULL;
- e->code = UNI_UNDEF;
- e->unicode_seq = NULL;
- return e;
-}
-
-static void destroy_glyph_unicode_entry(void *pa, void *pb)
-{
- glyph_unicode_entry *e = (glyph_unicode_entry *) pa;
- xfree(e->name);
- if (e->code == UNI_STRING) {
- assert(e->unicode_seq != NULL);
- xfree(e->unicode_seq);
- }
-}
-
-void glyph_unicode_free(void)
-{
- if (glyph_unicode_tree != NULL)
- avl_destroy(glyph_unicode_tree, destroy_glyph_unicode_entry);
-}
-
-void deftounicode(strnumber glyph, strnumber unistr)
-{
- char buf[SMALL_BUF_SIZE], *p;
- char buf2[SMALL_BUF_SIZE], *q;
- int valid_unistr; /* 0: invalid; 1: unicode value; 2: string */
- int i, l;
- glyph_unicode_entry *gu, t;
- void **aa;
-
- p = makecstring(glyph);
- assert(strlen(p) < SMALL_BUF_SIZE);
- strcpy(buf, p); /* copy the result to buf before next call of makecstring() */
- p = makecstring(unistr);
- while (*p == ' ')
- p++; /* ignore leading spaces */
- l = strlen(p);
- while (l > 0 && p[l - 1] == ' ')
- l--; /* ignore trailing spaces */
- valid_unistr = 1; /* a unicode value is the most common case */
- for (i = 0; i < l; i++) {
- if (p[i] == ' ')
- valid_unistr = 2; /* if a space occurs we treat this entry as a string */
- else if (!isXdigit((unsigned char)p[i])) {
- valid_unistr = 0;
- break;
- }
- }
- if (l == 0 || valid_unistr == 0 || strlen(buf) == 0
- || strcmp(buf, notdef) == 0) {
- pdftex_warn("ToUnicode: invalid parameter(s): `%s' => `%s'", buf, p);
- return;
- }
- if (glyph_unicode_tree == NULL) {
- glyph_unicode_tree =
- avl_create(comp_glyph_unicode_entry, NULL, &avl_xallocator);
- assert(glyph_unicode_tree != NULL);
- }
- t.name = buf;
- /* allow overriding existing entries */
- if ((gu = (glyph_unicode_entry *) avl_find(glyph_unicode_tree, &t)) != NULL) {
- if (gu->code == UNI_STRING) {
- assert(gu->unicode_seq != NULL);
- xfree(gu->unicode_seq);
- }
- } else { /* make new entry */
- gu = new_glyph_unicode_entry();
- gu->name = xstrdup(buf);
- }
- if (valid_unistr == 2) { /* a string with space(s) */
- /* copy p to buf2, ignoring spaces */
- for (q = buf2; *p != 0; p++)
- if (*p != ' ')
- *q++ = *p;
- *q = 0;
- gu->code = UNI_STRING;
- gu->unicode_seq = xstrdup(buf2);
- } else {
- i = sscanf(p, "%lX", &(gu->code));
- assert(i == 1);
- if (gu->code < 0 || gu->code > 0x10FFFF) {
- pdftex_warn("ToUnicode: value out of range [0,10FFFF]: %lX",
- gu->code);
- gu->code = UNI_UNDEF;
- }
- }
- aa = avl_probe(glyph_unicode_tree, gu);
- assert(aa != NULL);
-}
-
-
-static long check_unicode_value(const char *s, boolean multiple_value)
-{
- int l = strlen(s);
- int i;
- long code;
-
- if (l == 0)
- return UNI_UNDEF;
- if (multiple_value && l % 4 != 0)
- return UNI_UNDEF;
- if (!multiple_value && !(4 <= l && l <= 6))
- return UNI_UNDEF;
-
- for (i = 0; i < l; i++) {
- if (!isXdigit((unsigned char)s[i]))
- return UNI_UNDEF;
- if (multiple_value) {
- if (i % 4 == 3) {
- if (sscanf(s + i - 3, "%4lX", &code) != 1)
- return UNI_UNDEF;
- if (!((0x0000 <= code && code <= 0xD7FF) ||
- (0xE000 <= code && code <= 0xFFFF)))
- return UNI_UNDEF;
- }
- } else { /* single value */
- if (i == l - 1) {
- if (sscanf(s, "%lX", &code) != 1)
- return UNI_UNDEF;
- if (!((0x0000 <= code && code <= 0xD7FF) ||
- (0xE000 <= code && code <= 0x10FFFF)))
- return UNI_UNDEF;
- }
- }
- }
- return code;
-}
-
-static char *utf16be_str(long code)
-{
- static char buf[SMALL_BUF_SIZE];
- long v;
- unsigned vh, vl;
-
- assert(code >= 0);
-
- if (code <= 0xFFFF)
- sprintf(buf, "%04lX", code);
- else {
- v = code - 0x10000;
- vh = v / 0x400 + 0xD800;
- vl = v % 0x400 + 0xDC00;
- sprintf(buf, "%04X%04X", vh, vl);
- }
- return buf;
-}
-
-
-/* this function writes /ToUnicode data to *gp based on glyph name s and
- * taking into account tfmname; in case it returns
- * gp->code == UNI_EXTRA_STRING then the caller is responsible for freeing
- * gp->unicode_seq too */
-static void set_glyph_unicode(const char *s, const char* tfmname,
- glyph_unicode_entry *gp)
-{
- char buf[SMALL_BUF_SIZE], buf2[SMALL_BUF_SIZE], *p;
- const char *p2; /* p2 points in s; p above points in writable copies */
- long code;
- boolean last_component;
- glyph_unicode_entry tmp, *ptmp;
-
- /* skip dummy entries */
- if (s == NULL || s == notdef)
- return;
-
- /* strip everything after the first dot */
- p = strchr(s, '.');
- if (p != NULL) {
- *buf = 0;
- strncat(buf, s, p - s);
- s = buf;
- }
-
- if (strlen(s) == 0)
- return;
-
- /* check for case of multiple components separated by '_' */
- p = strchr(s, '_');
- if (p != NULL) {
- assert(strlen(s) < sizeof(buf));
- if (s != buf) {
- strcpy(buf, s);
- p = strchr(buf, '_');
- s = buf;
- }
- *buf2 = 0;
- last_component = false;
- for (;;) {
- *p = 0;
- tmp.code = UNI_UNDEF;
- set_glyph_unicode(s, tfmname, &tmp);
- switch (tmp.code) {
- case UNI_UNDEF: /* not found, do nothing */
- break;
- case UNI_STRING: /* s matched an entry with string value in the database */
- assert(tmp.unicode_seq != NULL);
- assert(strlen(buf2) + strlen(tmp.unicode_seq) < sizeof(buf2));
- strcat(buf2, tmp.unicode_seq);
- break;
- case UNI_EXTRA_STRING: /* s is a multiple value of form "uniXXXX" */
- assert(strlen(buf2) + strlen(tmp.unicode_seq) < sizeof(buf2));
- strcat(buf2, tmp.unicode_seq);
- xfree(tmp.unicode_seq);
- break;
- default: /* s matched an entry with numeric value in the
- database, or a value derived from "uXXXX" */
- assert(tmp.code >= 0);
- strcat(buf2, utf16be_str(tmp.code));
- }
- if (last_component)
- break;
- s = p + 1;
- p = strchr(s, '_');
- if (p == NULL) {
- p = strend(s);
- last_component = true;
- }
- }
- gp->code = UNI_EXTRA_STRING;
- gp->unicode_seq = xstrdup(buf2);
- return;
- }
-
- /* Glyph name search strategy: first look up the glyph name in the
- tfm's namespace, failing that look it up in the main database. */
- /* Note: buf may alias s in the code below, but s and buf2 are
- guaranteed to be distinct because the code changing buf2 above
- always returns before reaching the code below. */
-
- /* lookup for glyph name in the tfm's namespace */
- snprintf(buf2, SMALL_BUF_SIZE, "tfm:%s/%s", tfmname, s);
- tmp.name = buf2;
- tmp.code = UNI_UNDEF;
- ptmp = (glyph_unicode_entry *) avl_find(glyph_unicode_tree, &tmp);
- if (ptmp != NULL) {
- gp->code = ptmp->code;
- gp->unicode_seq = ptmp->unicode_seq;
- return;
- }
-
- /* lookup for glyph name in the main database */
- snprintf(buf2, SMALL_BUF_SIZE, "%s", s);
- tmp.name = buf2;
- tmp.code = UNI_UNDEF;
- ptmp = (glyph_unicode_entry *) avl_find(glyph_unicode_tree, &tmp);
- if (ptmp != NULL) {
- gp->code = ptmp->code;
- gp->unicode_seq = ptmp->unicode_seq;
- return;
- }
-
- /* check for case of "uniXXXX" (multiple 4-hex-digit values allowed) */
- if (str_prefix(s, "uni")) {
- p2 = s + strlen("uni");
- code = check_unicode_value(p2, true);
- if (code != UNI_UNDEF) {
- if (strlen(p2) == 4) /* single value */
- gp->code = code;
- else { /* multiple value */
- gp->code = UNI_EXTRA_STRING;
- gp->unicode_seq = xstrdup(p2);
- }
- }
- return; /* since the last case cannot happen */
- }
-
- /* check for case of "uXXXX" (single value up to 6 hex digits) */
- if (str_prefix(s, "u")) {
- p2 = s + strlen("u");
- code = check_unicode_value(p2, false);
- if (code != UNI_UNDEF) {
- assert(code >= 0);
- gp->code = code;
- }
- }
-}
-
-
-/* tfmname is without .tfm extension, but encname ends in .enc; */
-integer write_tounicode(char **glyph_names, const char *tfmname,
- const char* encname)
-{
- char buf[SMALL_BUF_SIZE], *p;
- static char builtin_suffix[] = "builtin";
- short range_size[257];
- glyph_unicode_entry gtab[257];
- integer objnum;
- int i, j;
- int bfchar_count, bfrange_count, subrange_count;
-
- if (glyph_unicode_tree == NULL) {
- pdftex_warn("no GlyphToUnicode entry has been inserted yet!");
- fixedgentounicode = 0;
- return 0;
- }
-
- /* build the name for this CMap as <tfmname>-<encname>; if encname is NULL
- * then this is a builtin encoding so use instead builtin_suffix */
- strcpy(buf, tfmname);
- strcat(buf, "-");
- if (encname) {
- assert(strlen(tfmname) + strlen(encname) + 1 < SMALL_BUF_SIZE);
- strcat(buf, encname);
- if ((p = strrchr(buf, '.')) != NULL && strcmp(p, ".enc") == 0)
- *p = 0; /* strip ".enc" from encoding name */
- else /* some silly encoding file name not ending in enc; use as-is */
- pdftex_warn("Dubious encoding file name: `%s'", encname);
- } else { /* this is a builtin encoding, so name is e.g. "cmr10-builtin" */
- assert(strlen(tfmname) + strlen(builtin_suffix) + 1 < SMALL_BUF_SIZE);
- strcat(buf, builtin_suffix);
- }
-
- objnum = pdfnewobjnum();
- pdfbegindict(objnum, 0);
- pdfbeginstream();
- pdf_printf("%%!PS-Adobe-3.0 Resource-CMap\n"
- "%%%%DocumentNeededResources: ProcSet (CIDInit)\n"
- "%%%%IncludeResource: ProcSet (CIDInit)\n"
- "%%%%BeginResource: CMap (TeX-%s-0)\n"
- "%%%%Title: (TeX-%s-0 TeX %s 0)\n"
- "%%%%Version: 1.000\n"
- "%%%%EndComments\n"
- "/CIDInit /ProcSet findresource begin\n"
- "12 dict begin\n"
- "begincmap\n"
- "/CIDSystemInfo\n"
- "<< /Registry (TeX)\n"
- "/Ordering (%s)\n"
- "/Supplement 0\n"
- ">> def\n"
- "/CMapName /TeX-%s-0 def\n"
- "/CMapType 2 def\n"
- "1 begincodespacerange\n"
- "<00> <FF>\n" "endcodespacerange\n", buf, buf, buf, buf, buf);
-
- /* set gtab */
- for (i = 0; i < 256; ++i) {
- gtab[i].code = UNI_UNDEF;
- set_glyph_unicode(glyph_names[i], tfmname, &gtab[i]);
- }
- gtab[256].code = UNI_UNDEF;
-
- /* set range_size */
- for (i = 0; i < 256;) {
- if (gtab[i].code == UNI_STRING || gtab[i].code == UNI_EXTRA_STRING) {
- range_size[i] = 1; /* single entry */
- i++;
- } else if (gtab[i].code == UNI_UNDEF) {
- range_size[i] = 0; /* no entry */
- i++;
- } else { /* gtab[i].code >= 0 */
- j = i;
- while (i < 256 && gtab[i + 1].code >= 0 &&
- gtab[i].code + 1 == gtab[i + 1].code)
- i++;
- /* at this point i is the last entry of the subrange */
- i++; /* move i to the next entry */
- range_size[j] = i - j;
- }
- }
-
- /* calculate bfrange_count and bfchar_count */
- bfrange_count = 0;
- bfchar_count = 0;
- for (i = 0; i < 256;) {
- if (range_size[i] == 1) {
- bfchar_count++;
- i++;
- } else if (range_size[i] > 1) {
- bfrange_count++;
- i += range_size[i];
- } else
- i++;
- }
-
- /* write out bfrange */
- i = 0;
- write_bfrange:
- if (bfrange_count > 100)
- subrange_count = 100;
- else
- subrange_count = bfrange_count;
- bfrange_count -= subrange_count;
- pdf_printf("%i beginbfrange\n", subrange_count);
- for (j = 0; j < subrange_count; j++) {
- while (range_size[i] <= 1 && i < 256)
- i++;
- assert(i < 256);
- pdf_printf("<%02X> <%02X> <%s>\n", i, i + range_size[i] - 1,
- utf16be_str(gtab[i].code));
- i += range_size[i];
- }
- pdf_printf("endbfrange\n");
- if (bfrange_count > 0)
- goto write_bfrange;
-
- /* write out bfchar */
- i = 0;
- write_bfchar:
- if (bfchar_count > 100)
- subrange_count = 100;
- else
- subrange_count = bfchar_count;
- bfchar_count -= subrange_count;
- pdf_printf("%i beginbfchar\n", subrange_count);
- for (j = 0; j < subrange_count; j++) {
- while (i < 256) {
- if (range_size[i] > 1)
- i += range_size[i];
- else if (range_size[i] == 0)
- i++;
- else /* range_size[i] == 1 */
- break;
- }
- assert(i < 256 && gtab[i].code != UNI_UNDEF);
- if (gtab[i].code == UNI_STRING || gtab[i].code == UNI_EXTRA_STRING) {
- assert(gtab[i].unicode_seq != NULL);
- pdf_printf("<%02X> <%s>\n", i, gtab[i].unicode_seq);
- } else
- pdf_printf("<%02X> <%s>\n", i, utf16be_str(gtab[i].code));
- i++;
- }
- pdf_printf("endbfchar\n");
- if (bfchar_count > 0)
- goto write_bfchar;
-
- /* free strings allocated by set_glyph_unicode() */
- for (i = 0; i < 256; ++i) {
- if (gtab[i].code == UNI_EXTRA_STRING)
- xfree(gtab[i].unicode_seq);
- }
-
- pdf_printf("endcmap\n"
- "CMapName currentdict /CMap defineresource pop\n"
- "end\n" "end\n" "%%%%EndResource\n" "%%%%EOF\n");
- pdfendstream();
- return objnum;
-}
-
-void dumptounicode(void)
-{
- struct avl_traverser traverse;
- integer count;
- glyph_unicode_entry *gu;
-
- if (glyph_unicode_tree == NULL) {
- count = 0;
- generic_dump(count);
- return;
- }
-
- count = avl_count(glyph_unicode_tree);
- generic_dump(count);
-
- avl_t_init(&traverse, glyph_unicode_tree);
- while (gu = avl_t_next(&traverse)) {
- dumpcharptr(gu->name);
- generic_dump(gu->code);
-
- if (gu->code == UNI_STRING)
- dumpcharptr(gu->unicode_seq);
- }
-}
-
-void undumptounicode(void)
-{
- glyph_unicode_entry *tmp;
- integer remaining;
-
- generic_undump(remaining);
-
- if (remaining == 0)
- return;
-
- assert(glyph_unicode_tree == NULL);
- glyph_unicode_tree =
- avl_create(comp_glyph_unicode_entry, NULL, &avl_xallocator);
- assert(glyph_unicode_tree != NULL);
-
- while (remaining--) {
- void **result;
- glyph_unicode_entry *gu = new_glyph_unicode_entry();
- undumpcharptr(gu->name);
- generic_undump(gu->code);
-
- if (gu->code == UNI_STRING)
- undumpcharptr(gu->unicode_seq);
-
- result = avl_probe(glyph_unicode_tree, gu);
- assert(*result == gu);
- }
-}
diff --git a/Build/source/texk/web2c/pdftexdir/ttf2afm.c b/Build/source/texk/web2c/pdftexdir/ttf2afm.c
deleted file mode 100644
index 0750173355c..00000000000
--- a/Build/source/texk/web2c/pdftexdir/ttf2afm.c
+++ /dev/null
@@ -1,1127 +0,0 @@
-/*
-Copyright 1996-2021 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-/*
-#include <kpathsea/c-auto.h>
-#include <kpathsea/c-fopen.h>
-#include <kpathsea/c-limits.h>
-#include <kpathsea/c-memstr.h>
-#include <kpathsea/c-std.h>
-#include <kpathsea/c-unistd.h>
-#include <stdarg.h>
-#include <kpathsea/getopt.h>
-*/
-#include <kpathsea/kpathsea.h>
-#include <time.h>
-#include <pdftexdir/ptexmac.h>
-#include <pdftexdir/writettf.h>
-#include <string.h>
-
-/* constants used for print_glyph */
-#define AS_NAME 0
-#define AS_INDEX 1
-#define AS_UNICODE 2
-
-#define VERSION "1.02"
-
-/* FIXME */
-#define NOGLYPH_ASSIGNED_YET USHRT_MAX
-
-#define enc_getchar() xgetc(encfile)
-#define enc_eof() feof(encfile)
-#define pdftex_fail ttf_fail
-
-#define print_str(S) if (S != NULL) fprintf(outfile, #S " %s\n", escape_eol(S))
-#define print_dimen(N) if (N != 0) fprintf(outfile, #N " %i\n", (int)get_ttf_funit(N))
-
-#define get_ttf_funit(n) \
- (n < 0 ? -((-n/upem)*1000 + ((-n%upem)*1000)/upem) :\
- ((n/upem)*1000 + ((n%upem)*1000)/upem))
-
-typedef struct _unicode_entry {
- TTF_USHORT code;
- struct _unicode_entry *next;
-} unicode_entry;
-
-typedef struct {
- TTF_ULONG wx;
- const char *name;
- TTF_USHORT index;
- TTF_LONG bbox[4];
- TTF_LONG offset;
- char found;
- unicode_entry *unicode_list;
-} mtx_entry;
-
-typedef struct _kern_entry {
- TTF_FWORD value;
- TTF_USHORT adjacent;
- struct _kern_entry *next;
-} kern_entry;
-
-
-char *FontName = NULL;
-char *FullName = NULL;
-char *FamilyName = NULL;
-char *Notice = NULL;
-char *Version = NULL;
-char *Weight = NULL;
-TTF_LONG ItalicAngle = 0;
-TTF_LONG IsFixedPitch = 0;
-TTF_LONG FontBBox1 = 0;
-TTF_LONG FontBBox2 = 0;
-TTF_LONG FontBBox3 = 0;
-TTF_LONG FontBBox4 = 0;
-TTF_LONG UnderlinePosition = 0;
-TTF_LONG UnderlineThickness = 0;
-TTF_LONG CapHeight = 0;
-TTF_LONG XHeight = 0;
-TTF_LONG Ascender = 0;
-TTF_LONG Descender = 0;
-
-char *cur_file_name = NULL;
-char *bname = NULL;
-FILE *fontfile, *encfile, *outfile = NULL;
-char enc_line[ENC_BUF_SIZE];
-int print_glyph = AS_NAME; /* print glyph as names by default */
-int print_cmap = 0;
-int use_ext_enc = 0; /* use external encoding? */
-int select_unicode = 1; /* use the first unicode mapping by default */
-int printing_enc = 0; /* set to 1 while printing encodings */
-
-
-TTF_USHORT upem;
-TTF_USHORT ntabs;
-int nhmtx;
-int post_format;
-int loca_format;
-long nglyphs;
-int nkernpairs = 0;
-int names_count = 0;
-char *ps_glyphs_buf = NULL;
-dirtab_entry *dir_tab;
-mtx_entry *mtx_tab;
-kern_entry *kern_tab;
-char *enc_names[256];
-
-cmap_entry *cmap_tab;
-TTF_USHORT ncmapsubtabs;
-long cmap_offset;
-
-TTF_USHORT unicode_map[0xFFFF];
-
-#include "macnames.c"
-
-#if defined __GNUC__ && __GNUC__ >=3
-__attribute__((__noreturn__))
-#endif
-static void ttf_fail(const char *fmt, ...)
-{
- va_list args;
- va_start(args, fmt);
- fprintf(stderr, "\nError: ttf2afm");
- if (cur_file_name)
- fprintf(stderr, " (file %s)", cur_file_name);
- fprintf(stderr, ": ");
- vfprintf(stderr, fmt, args);
- fprintf(stderr, "\n");
- va_end(args);
- exit(-1);
-}
-
-static void ttf_warn(const char *fmt, ...)
-{
- va_list args;
- va_start(args, fmt);
- fprintf(stderr, "\nWarning: ttf2afm");
- if (cur_file_name)
- fprintf(stderr, " (file %s)", cur_file_name);
- fprintf(stderr, ": ");
- vfprintf(stderr, fmt, args);
- fprintf(stderr, "\n");
- va_end(args);
-}
-
-static int xgetc(FILE * stream)
-{
- int c = getc(stream);
- if (c < 0 && c != EOF)
- ttf_fail("getc() failed");
- return c;
-}
-
-static long ttf_getnum(int s)
-{
- long i = 0;
- int c;
- while (s > 0) {
- if ((c = xgetc(fontfile)) < 0)
- ttf_fail("unexpected EOF");
- i = (i << 8) + c;
- s--;
- }
- return i;
-}
-
-static dirtab_entry *name_lookup(const char *s)
-{
- dirtab_entry *p;
- for (p = dir_tab; p - dir_tab < ntabs; p++)
- if (strncmp(p->tag, s, 4) == 0)
- break;
- if (p - dir_tab == ntabs)
- p = NULL;
- return p;
-}
-
-static void ttf_seek_tab(const char *name, TTF_LONG offset)
-{
- dirtab_entry *p = name_lookup(name);
- if (p == NULL)
- ttf_fail("can't find table `%s'", name);
- if (fseek(fontfile, p->offset + offset, SEEK_SET) < 0)
- ttf_fail("fseek() failed while reading `%s' table", name);
-}
-
-static void ttf_seek_off(const char *name, TTF_LONG offset)
-{
- if (fseek(fontfile, offset, SEEK_SET) < 0)
- ttf_fail("fseek() failed while reading `%s' table", name);
-}
-
-static void store_kern_value(TTF_USHORT i, TTF_USHORT j, TTF_FWORD v)
-{
- kern_entry *pk;
- for (pk = kern_tab + i; pk->next != NULL; pk = pk->next);
- pk->next = xtalloc(1, kern_entry);
- pk = pk->next;
- pk->next = NULL;
- pk->adjacent = j;
- pk->value = v;
-}
-
-#if 0 /* unused */
-static TTF_FWORD get_kern_value(TTF_USHORT i, TTF_USHORT j)
-{
- kern_entry *pk;
- for (pk = kern_tab + i; pk->next != NULL; pk = pk->next)
- if (pk->adjacent == j)
- return pk->value;
- return 0;
-}
-#endif
-
-static void free_tabs(void)
-{
- int i;
- kern_entry *p, *q, *r;
- unicode_entry *u, *v;
- mtx_entry *pm;
- xfree(ps_glyphs_buf);
- xfree(dir_tab);
- xfree(cmap_tab);
- for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++)
- if (pm->unicode_list != NULL) {
- for (u = pm->unicode_list; u != NULL; u = v) {
- v = u->next;
- xfree(u);
- }
- }
- xfree(mtx_tab);
- for (i = 0; i < 256; i++)
- if (enc_names[i] != notdef)
- free(enc_names[i]);
- if (kern_tab == NULL)
- return;
- for (p = kern_tab; p - kern_tab < nglyphs; p++)
- if (p->next != NULL) {
- for (q = p->next; q != NULL; q = r) {
- r = q->next;
- xfree(q);
- }
- }
- xfree(kern_tab);
-}
-
-static void enc_getline(void)
-{
- char *p;
- int c;
- restart:
- if (enc_eof())
- ttf_fail("unexpected end of file");
- p = enc_line;
- do {
- c = enc_getchar();
- append_char_to_buf(c, p, enc_line, ENC_BUF_SIZE);
- } while (c != 10);
- append_eol(p, enc_line, ENC_BUF_SIZE);
- if (p - enc_line <= 2 || *enc_line == '%')
- goto restart;
-}
-
-static void read_encoding(char *encname)
-{
- char buf[ENC_BUF_SIZE], *q, *r;
- int i;
- cur_file_name = encname;
- if ((encfile = kpse_open_file(encname, kpse_enc_format)) == NULL)
- ttf_fail("can't open encoding file for reading");
- enc_getline();
- if (*enc_line != '/' || (r = strchr(enc_line, '[')) == 0)
- ttf_fail("invalid encoding vector: name or `[' missing:\n%s", enc_line);
- for (i = 0; i < 256; i++)
- enc_names[i] = notdef;
- if (r[1] == 32)
- r += 2;
- else
- r++;
- for (;;) {
- while (*r == '/') {
- for (q = buf, r++; *r != ' ' && *r != 10 && *r != ']' && *r != '/';
- *q++ = *r++);
- *q = 0;
- if (*r == ' ')
- r++;
- if (strcmp(buf, notdef) != 0)
- enc_names[names_count] = xstrdup(buf);
- if (++names_count > 256)
- ttf_fail("encoding vector contains more than 256 names");
- }
- if (*r != 10 && *r != '%') {
- if (str_prefix(r, "] def"))
- goto done;
- else
- ttf_fail
- ("invalid encoding vector: a name or `] def' expected:\n%s",
- enc_line);
- }
- enc_getline();
- r = enc_line;
- }
- done:
- xfclose(encfile, cur_file_name);
- if (names_count != 256)
- ttf_warn("encoding vector contains only %i names (expected %i)",
- names_count, 256);
-}
-
-static void append_unicode(long glyph_index, TTF_USHORT code)
-{
- mtx_entry *m;
- unicode_entry *u, *v;
- assert(glyph_index >= 0 && glyph_index < nglyphs);
- u = xtalloc(1, unicode_entry);
- m = mtx_tab + glyph_index;
- u->next = NULL;
- u->code = code;
- if (m->unicode_list == NULL)
- m->unicode_list = u;
- else {
- for (v = m->unicode_list; v->next != NULL; v = v->next);
- v->next = u;
- }
-}
-
-static void read_cmap(void)
-{
- cmap_entry *e;
- seg_entry *seg_tab, *s;
- TTF_USHORT *glyphId, format, segCount;
- long int n, i, k, length, index;
- int unicode_map_count = 0;
- ttf_seek_tab("cmap", TTF_USHORT_SIZE); /* skip the table version number (=0) */
- ncmapsubtabs = get_ushort();
- cmap_offset = xftell(fontfile, cur_file_name) - 2 * TTF_USHORT_SIZE;
- cmap_tab = xtalloc(ncmapsubtabs, cmap_entry);
- for (e = cmap_tab; e - cmap_tab < ncmapsubtabs; e++) {
- e->platform_id = get_ushort();
- e->encoding_id = get_ushort();
- e->offset = get_ulong();
- }
- for (i = 0; i < 0xFFFF; ++i)
- unicode_map[i] = NOGLYPH_ASSIGNED_YET;
- for (e = cmap_tab; e - cmap_tab < ncmapsubtabs; e++) {
- ttf_seek_off("cmap", cmap_offset + e->offset);
- format = get_ushort();
- if (is_unicode_mapping(e) && format == 4) {
- ++unicode_map_count;
- if (unicode_map_count == select_unicode)
- goto read_unicode_mapping;
- }
- continue;
- read_unicode_mapping:
- length = get_ushort(); /* length of subtable */
- (void) get_ushort(); /* skip the version number */
- segCount = get_ushort() / 2;
- (void) get_ushort(); /* skip searchRange */
- (void) get_ushort(); /* skip entrySelector */
- (void) get_ushort(); /* skip rangeShift */
- seg_tab = xtalloc(segCount, seg_entry);
- for (s = seg_tab; s - seg_tab < segCount; s++)
- s->endCode = get_ushort();
- (void) get_ushort(); /* skip reversedPad */
- for (s = seg_tab; s - seg_tab < segCount; s++)
- s->startCode = get_ushort();
- for (s = seg_tab; s - seg_tab < segCount; s++)
- s->idDelta = get_ushort();
- for (s = seg_tab; s - seg_tab < segCount; s++)
- s->idRangeOffset = get_ushort();
- length -= 8 * TTF_USHORT_SIZE + 4 * segCount * TTF_USHORT_SIZE;
- n = length / TTF_USHORT_SIZE; /* number of glyphID's */
- glyphId = xtalloc(n, TTF_USHORT);
- for (i = 0; i < n; i++)
- glyphId[i] = get_ushort();
- for (s = seg_tab; s - seg_tab < segCount; s++) {
- for (i = s->startCode; i <= s->endCode; i++) {
- if (i == 0xFFFF)
- break;
- if (s->idRangeOffset != 0xFFFF) {
- if (s->idRangeOffset == 0)
- index = (s->idDelta + i) & 0xFFFF;
- else {
- k = (i - s->startCode) + s->idRangeOffset / 2 +
- (s - seg_tab) - segCount;
- assert(k >= 0 && k < n);
- index = glyphId[k];
- if (index != 0)
- index = (index + s->idDelta) & 0xFFFF;
- }
- if (index < 0 || index >= nglyphs)
- ttf_fail("cmap: glyph index out of range [0..%i)",
- nglyphs);
- if (unicode_map[i] != NOGLYPH_ASSIGNED_YET)
- ttf_fail
- ("cmap: unicode %.4X is mapped to multiple glyphs",
- i);
- if (unicode_map[i] == 0)
- ttf_warn("unicode %.4X is mapped to glyph 0", i);
- unicode_map[i] = index;
- append_unicode(index, i);
- }
- }
- }
- xfree(seg_tab);
- xfree(glyphId);
- break;
- }
- if (e - cmap_tab == ncmapsubtabs)
- ttf_fail("Invalid argument `-m %i': out of range [1..%i]",
- select_unicode, unicode_map_count);
-}
-
-static char *make_name(long platform_id, int len)
-{
- unsigned char buf[1024];
- unsigned char *p = buf;
- int i = 0;
-
- if (len >= sizeof(buf))
- len = sizeof(buf) - 1;
- while (i < len) {
- *p = (unsigned char) get_char();
- i++;
- if (*p == 0 && platform_id == 3) {
- /* assume this is an UTF-16BE encoded string but contains latin
- * chars, which is the most common case; simply copy the 2nd byte.
- * Note: will not work for non-latin text */
- *p = (unsigned char) get_char();
- i++;
- }
- /* sometime a UTF-16BE string will contain chars where the 1st
- or 2nd byte is in range (0..32) */
- if (*p < 32
- && *p != '\r'
- && *p != '\n'
- && *p != '\t'
- ) {
- ttf_warn("skipping unsafe character: %i", *p);
- } else {
- p++;
- }
- }
- *p = 0;
- return xstrdup(buf);
-}
-
-static void read_font(void)
-{
- long i, j, k, l, n, m, platform_id, encoding_id, name_id;
- TTF_FWORD kern_value;
- char *p;
- dirtab_entry *pd;
- kern_entry *pk;
- mtx_entry *pm;
- ttf_skip(TTF_FIXED_SIZE);
- ntabs = get_ushort();
- ttf_skip(3 * TTF_USHORT_SIZE);
- dir_tab = xtalloc(ntabs, dirtab_entry);
- for (pd = dir_tab; pd - dir_tab < ntabs; pd++) {
- pd->tag[0] = get_char();
- pd->tag[1] = get_char();
- pd->tag[2] = get_char();
- pd->tag[3] = get_char();
- ttf_skip(TTF_ULONG_SIZE);
- pd->offset = get_ulong();
- pd->length = get_ulong();
- }
- ttf_seek_tab("head",
- 2 * TTF_FIXED_SIZE + 2 * TTF_ULONG_SIZE + TTF_USHORT_SIZE);
- upem = get_ushort();
- ttf_skip(16);
- FontBBox1 = get_fword();
- FontBBox2 = get_fword();
- FontBBox3 = get_fword();
- FontBBox4 = get_fword();
- ttf_skip(TTF_USHORT_SIZE);
- ttf_skip(TTF_USHORT_SIZE + TTF_SHORT_SIZE);
- loca_format = get_short();
- ttf_seek_tab("maxp", TTF_FIXED_SIZE);
- nglyphs = get_ushort();
- mtx_tab = xtalloc(nglyphs + 1, mtx_entry);
- for (pm = mtx_tab; pm - mtx_tab < nglyphs + 1; pm++) {
- pm->name = NULL; /* notdef */
- pm->found = 0;
- pm->unicode_list = NULL;
- }
- ttf_seek_tab("hhea", TTF_FIXED_SIZE);
- Ascender = get_fword();
- Descender = get_fword();
- ttf_skip(TTF_FWORD_SIZE + TTF_UFWORD_SIZE + 3 * TTF_FWORD_SIZE +
- 8 * TTF_SHORT_SIZE);
- nhmtx = get_ushort();
- ttf_seek_tab("hmtx", 0);
- for (pm = mtx_tab; pm - mtx_tab < nhmtx; pm++) {
- pm->wx = get_ufword();
- ttf_skip(TTF_FWORD_SIZE);
- }
- i = pm[-1].wx;
- for (; pm - mtx_tab < nglyphs; pm++)
- pm->wx = i;
- ttf_seek_tab("post", 0);
- post_format = get_fixed();
- ItalicAngle = get_fixed();
- UnderlinePosition = get_fword();
- UnderlineThickness = get_fword();
- IsFixedPitch = get_ulong();
- ttf_skip(4 * TTF_ULONG_SIZE);
- switch (post_format) {
- case 0x00010000:
- for (pm = mtx_tab; pm - mtx_tab < NMACGLYPHS; pm++)
- pm->name = mac_glyph_names[pm - mtx_tab];
- break;
- case 0x00020000:
- l = get_ushort(); /* some fonts have this value different from nglyphs */
- for (pm = mtx_tab; pm - mtx_tab < l; pm++)
- pm->index = get_ushort();
- if ((pd = name_lookup("post")) == NULL)
- ttf_fail("can't find table `post'");
- n = pd->length - (xftell(fontfile, cur_file_name) - pd->offset);
- ps_glyphs_buf = xtalloc(n + 1, char);
- for (m = 0, p = ps_glyphs_buf; p - ps_glyphs_buf < n;) {
- for (i = get_byte(); i > 0; i--)
- *p++ = get_char();
- *p++ = 0;
- m++;
- }
- for (pm = mtx_tab; pm - mtx_tab < l; pm++) {
- if (pm->index < NMACGLYPHS)
- pm->name = mac_glyph_names[pm->index];
- else {
- k = pm->index - NMACGLYPHS;
- if (k < m) {
- for (p = ps_glyphs_buf; k > 0; k--)
- p = (char *) strend(p) + 1;
- pm->name = p;
- } else {
- pm->name = NULL; /* index out of valid range, fix name to notdef */
- }
- }
- }
- break;
- default:
- ttf_warn("unsupported format (%.8X) of `post' table, assuming 3.0",
- post_format);
- case 0x00030000:
- if (print_glyph == AS_NAME) {
- ttf_warn
- ("no names available in `post' table, print glyph names as indices");
- print_glyph = AS_INDEX;
- }
- }
- ttf_seek_tab("loca", 0);
- if (loca_format == 1) {
- for (pm = mtx_tab; pm - mtx_tab < nglyphs + 1; pm++)
- pm->offset = get_ulong();
- } else {
- for (pm = mtx_tab; pm - mtx_tab < nglyphs + 1; pm++)
- pm->offset = get_ushort() << 1;
- }
- if ((pd = name_lookup("glyf")) == NULL)
- ttf_fail("can't find table `glyf'");
- for (n = pd->offset, pm = mtx_tab; pm - mtx_tab < nglyphs; pm++) {
- ttf_seek_off("glyf", n + pm->offset);
- ttf_skip(TTF_SHORT_SIZE);
- pm->bbox[0] = get_fword();
- pm->bbox[1] = get_fword();
- pm->bbox[2] = get_fword();
- pm->bbox[3] = get_fword();
- }
-
- ttf_seek_tab("name", 0);
- i = ftell(fontfile);
- (void) get_ushort(); /* skip Format selector (=0) */
- n = get_ushort(); /* number of name records */
- j = get_ushort() + i; /* start of string storage */
- i += 3 * TTF_USHORT_SIZE; /* update the current offset */
- while (n-- > 0) {
- ttf_seek_off("name", i);
- platform_id = get_ushort();
- encoding_id = get_ushort();
- (void) get_ushort(); /* skip language_id */
- name_id = get_ushort(); /* name_id */
- l = get_ushort(); /* string length */
- if (((platform_id == 1 && encoding_id == 0) || /* legacy */
- (platform_id == 3 || encoding_id == 1) /* most common for modern fonts */
- ) &&
- (name_id == 0 || name_id == 1 || name_id == 4 || name_id == 5 || name_id == 6)
- )
- {
- ttf_seek_off("name", j + get_ushort());
- p = make_name(platform_id, l);
- switch (name_id) {
- case 0:
- Notice = p;
- break;
- case 1:
- FamilyName = p;
- break;
- case 4:
- FullName = p;
- break;
- case 5:
- Version = p;
- break;
- case 6:
- FontName = p;
- break;
- }
- if (Notice != NULL && FamilyName != NULL &&
- FullName != NULL && FontName != NULL && Version != NULL)
- break;
- }
- i += 6 * TTF_USHORT_SIZE;
- }
- if ((pd = name_lookup("PCLT")) != NULL) {
- ttf_seek_off("PCLT",
- pd->offset + TTF_FIXED_SIZE + TTF_ULONG_SIZE +
- TTF_USHORT_SIZE);
- XHeight = get_ushort();
- if (XHeight > FontBBox4) {
- ttf_warn("XHeight is too big (%i)\n"
- "This is likely a font bug, so I discarded this parameter.",
- (int) get_ttf_funit(XHeight));
- XHeight = 0;
- }
- ttf_skip(2 * TTF_USHORT_SIZE);
- CapHeight = get_ushort();
- if (CapHeight > FontBBox4) {
- ttf_warn("CapHeight is too big (%i)\n"
- "This is likely a font bug, so I discarded this parameter.",
- (int) get_ttf_funit(CapHeight));
- CapHeight = 0;
- }
- }
- if ((pd = name_lookup("OS/2")) != NULL) {
- ttf_seek_off("OS/2", pd->offset + TTF_USHORT_SIZE + TTF_SHORT_SIZE);
- switch (get_ushort()) {
- case 100:
- Weight = xstrdup("Thin");
- break;
- case 200:
- Weight = xstrdup("ExtraLight");
- break;
- case 300:
- Weight = xstrdup("Light");
- break;
- case 400:
- Weight = xstrdup("Normal");
- break;
- case 500:
- Weight = xstrdup("Medium");
- break;
- case 600:
- Weight = xstrdup("SemiBold");
- break;
- case 700:
- Weight = xstrdup("Bold");
- break;
- case 800:
- Weight = xstrdup("ExtraBold");
- break;
- case 900:
- Weight = xstrdup("Black");
- break;
- }
- }
- read_cmap();
- if ((pd = name_lookup("kern")) == NULL)
- return;
- kern_tab = xtalloc(nglyphs, kern_entry);
- for (pk = kern_tab; pk - kern_tab < nglyphs; pk++) {
- pk->next = NULL;
- pk->value = 0;
- }
- ttf_seek_off("kern", pd->offset + TTF_USHORT_SIZE);
- for (n = get_ushort(); n > 0; n--) {
- ttf_skip(2 * TTF_USHORT_SIZE);
- k = get_ushort();
- if (!(k & 1) || (k & 2) || (k & 4))
- return;
- if (k >> 8 != 0) {
- ttf_warn("warning: only format 0 supported of `kern' \
- subtables, others are ignored\n");
- continue;
- }
- k = get_ushort();
- ttf_skip(3 * TTF_USHORT_SIZE);
- while (k-- > 0) {
- i = get_ushort();
- j = get_ushort();
- kern_value = get_fword();
- if (kern_value != 0) {
- store_kern_value(i, j, kern_value);
- nkernpairs++;
- }
- }
- }
-}
-
-static int null_glyph(const char *s)
-{
- return (s == NULL || s == notdef);
- /*
- strcmp(s, ".null") == 0 ||
- strcmp(s, ".notdef") == 0 ||
- strcmp(s, "CR") == 0 ||
- strcmp(s, "nonmarkingreturn") == 0
- */
-}
-
-static void print_glyph_name(FILE * f, long glyph_index, int convention)
-{
- unicode_entry *u;
- static char buf[1024];
- const char *n;
- assert(glyph_index >= 0 && glyph_index < nglyphs);
- n = mtx_tab[glyph_index].name;
- if (printing_enc && (n == notdef || glyph_index == 0)) {
- fputs(notdef, f);
- return;
- }
- switch (convention) {
- case AS_NAME:
- if (!null_glyph(n))
- fprintf(f, "%s", mtx_tab[glyph_index].name);
- else if (n == notdef && glyph_index == 0)
- fputs(notdef, f);
- else
- fprintf(f, "%s%li", GLYPH_PREFIX_INDEX, glyph_index);
- break;
- case AS_INDEX:
- fprintf(f, "%s%li", GLYPH_PREFIX_INDEX, glyph_index);
- break;
- case AS_UNICODE:
- u = mtx_tab[glyph_index].unicode_list;
- if (glyph_index == 0 || u == NULL)
- fprintf(f, "%s%li", GLYPH_PREFIX_INDEX, glyph_index);
- else {
- fprintf(f, "%s%.4X", GLYPH_PREFIX_UNICODE, u->code);
- if (u->next != NULL) {
- *buf = 0;
- for (; u != NULL; u = u->next) {
- assert(strlen(buf) + strlen(GLYPH_PREFIX_UNICODE) + 4 <
- sizeof(buf));
- sprintf(strend(buf), "%s%.4X ", GLYPH_PREFIX_UNICODE,
- u->code);
- }
- ttf_warn
- ("glyph %li has multiple encodings (the first one being used): %s",
- glyph_index, buf);
- }
- }
- break;
- }
-}
-
-static void print_char_metric(FILE * f, int charcode, long glyph_index)
-{
- assert(glyph_index >= 0 && glyph_index < nglyphs);
- fprintf(f, "C %i ; WX %i ; N ", (int) charcode,
- (int) get_ttf_funit((int)mtx_tab[glyph_index].wx));
- print_glyph_name(f, glyph_index, print_glyph);
- fprintf(f, " ; B %i %i %i %i ;\n",
- (int) get_ttf_funit(mtx_tab[glyph_index].bbox[0]),
- (int) get_ttf_funit(mtx_tab[glyph_index].bbox[1]),
- (int) get_ttf_funit(mtx_tab[glyph_index].bbox[2]),
- (int) get_ttf_funit(mtx_tab[glyph_index].bbox[3]));
-}
-
-static char * escape_eol(char *s)
-{
- char *p, *e;
- char *dest, *d;
-
- if (s == NULL)
- return NULL;
-
- dest = d = xtalloc(2*strlen(s), char);
- e = strend(s);
- for (p = s; p < e; p++) {
- if (*p == 10 || *p == 13) {
- *d++ = '\\';
- *d++ = 'n';
- }
- else
- *d++ = *p;
- }
- *d = 0;
- return dest;
-}
-
-static void print_afm(char *date, char *fontname)
-{
- int ncharmetrics;
- mtx_entry *pm;
- long mtx_index[256], *idx;
- unsigned int index;
- char **pe;
- kern_entry *pk, *qk;
- char *p;
- double d;
- long l;
- fputs("StartFontMetrics 2.0\n", outfile);
- fprintf(outfile,
- "Comment Converted at %s by ttf2afm from font file `%s'\n", date,
- fontname);
- print_str(FontName);
- print_str(FullName);
- print_str(FamilyName);
- print_str(Weight);
- l = ItalicAngle >> 16;
- if (l > 0x8000)
- l = l - 0x10000;
- d = (ItalicAngle & 0xffff)/65536.0;
- if (d >= 0.1)
- fprintf(outfile, "ItalicAngle %.1f", d + l);
- else
- fprintf(outfile, "ItalicAngle %li", l);
- fputs("\n", outfile);
- fprintf(outfile, "IsFixedPitch %s\n", IsFixedPitch ? "true" : "false");
- fprintf(outfile, "FontBBox %i %i %i %i\n",
- (int) get_ttf_funit(FontBBox1),
- (int) get_ttf_funit(FontBBox2),
- (int) get_ttf_funit(FontBBox3), (int) get_ttf_funit(FontBBox4));
- print_dimen(UnderlinePosition);
- print_dimen(UnderlineThickness);
- print_str(Version);
- /* remove trailing whitespaces from Notice */
- if (Notice != NULL) {
- for (p = strend(Notice); p > Notice && isspace((unsigned char)*p); p--);
- *p = 0;
- }
- print_str(Notice);
- fputs("EncodingScheme FontSpecific\n", outfile);
- print_dimen(CapHeight);
- print_dimen(XHeight);
- print_dimen(Ascender);
- print_dimen(Descender);
- ncharmetrics = nglyphs;
- if (use_ext_enc == 0) { /* external encoding vector not given */
- fprintf(outfile, "StartCharMetrics %u\n", ncharmetrics);
- for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++) {
- pm->found = 1;
- print_char_metric(outfile, -1, pm - mtx_tab);
- }
- } else { /* external encoding vector given */
- for (idx = mtx_index; idx - mtx_index < 256; *idx++ = 0);
- for (pe = enc_names; pe - enc_names < names_count; pe++) {
- if (*pe == notdef)
- continue;
- /* scan form `uniABCD' */
- if (sscanf(*pe, GLYPH_PREFIX_UNICODE "%4X", &index) == 1) {
- if (unicode_map[index] != NOGLYPH_ASSIGNED_YET) {
- pm = mtx_tab + unicode_map[index];
- mtx_index[pe - enc_names] = pm - mtx_tab;
- pm->found = 1;
- } else
- ttf_warn("`unicode %s%.4X' is not mapped to any glyph",
- GLYPH_PREFIX_UNICODE, index);
- continue;
- }
- /* scan form `index123' */
- if (sscanf(*pe, GLYPH_PREFIX_INDEX "%u", &index) == 1) {
- if (index >= (unsigned int) nglyphs)
- ttf_fail("`%s' out of valid range [0..%i)", *pe, nglyphs);
- pm = mtx_tab + index;
- mtx_index[pe - enc_names] = pm - mtx_tab;
- pm->found = 1;
- continue;
- }
- for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++)
- if (pm->name != NULL && strcmp(*pe, pm->name) == 0)
- break;
- if (pm - mtx_tab < nglyphs) {
- mtx_index[pe - enc_names] = pm - mtx_tab;
- pm->found = 1;
- continue;
- } else
- ttf_warn("glyph `%s' not found", *pe);
- }
- fprintf(outfile, "StartCharMetrics %u\n", ncharmetrics);
- for (idx = mtx_index; idx - mtx_index < 256; idx++) {
- if (*idx != 0 && mtx_tab[*idx].found == 1)
- print_char_metric(outfile, idx - mtx_index, *idx);
- }
- for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++) {
- if (pm->found == 0)
- print_char_metric(outfile, -1, pm - mtx_tab);
- }
- }
- fputs("EndCharMetrics\n", outfile);
- if (nkernpairs == 0)
- goto end_kerns;
- fprintf(outfile, "StartKernData\nStartKernPairs %i\n", nkernpairs);
- for (pk = kern_tab; pk - kern_tab < nglyphs; pk++)
- for (qk = pk; qk != NULL; qk = qk->next)
- if (qk->value != 0) {
- fputs("KPX ", outfile);
- print_glyph_name(outfile, pk - kern_tab, print_glyph);
- fputs(" ", outfile);
- print_glyph_name(outfile, qk->adjacent, print_glyph);
- fprintf(outfile, " %i\n", get_ttf_funit(qk->value));
- }
- fputs("EndKernPairs\nEndKernData\n", outfile);
- end_kerns:
- fputs("EndFontMetrics\n", outfile);
-}
-
-static void print_encoding(char *fontname)
-{
- long int i, k, first_code, length;
- FILE *file;
- TTF_USHORT format;
- char *enc_name, *end_enc_name;
- cmap_entry *e;
- printing_enc = 1;
- enc_name = xtalloc(strlen(bname) + 20, char);
- strcpy(enc_name, bname);
- end_enc_name = strend(enc_name);
- for (e = cmap_tab; e - cmap_tab < ncmapsubtabs; e++) {
- ttf_seek_off("cmap", cmap_offset + e->offset);
- format = get_ushort();
- if (format != 0 && format != 4 && format != 6) {
- ttf_warn("format %i of encoding subtable unsupported",
- (int) format);
- continue;
- }
- sprintf(end_enc_name, ".e%i%i",
- (int) e->platform_id, (int) e->encoding_id);
- if ((file = xfopen(enc_name, FOPEN_W_MODE)) == NULL)
- ttf_fail("cannot open file for writing (%s)\n", enc_name);
- fprintf(file, "%% Encoding table from font file %s\n", fontname);
- fprintf(file, "%% Platform ID %i", (int) e->platform_id);
- switch (e->platform_id) {
- case 0:
- fprintf(file, " (Apple Unicode)");
- break;
- case 1:
- fprintf(file, " (Macintosh)");
- break;
- case 2:
- fprintf(file, " (ISO)");
- break;
- case 3:
- fprintf(file, " (Microsoft)");
- break;
- }
- fprintf(file, "\n");
- fprintf(file, "%% Encoding ID %i", (int) e->encoding_id);
- if (e->platform_id == 1 && e->encoding_id == 0)
- fprintf(file, " (Roman)");
- if (e->platform_id == 3)
- switch (e->encoding_id) {
- case 0:
- fprintf(file, " (Symbol)");
- break;
- case 1:
- fprintf(file, " (Unicode)");
- break;
- }
- fprintf(file, "\n");
- fprintf(file, "%% Format %i", (int) (format));
- switch (format) {
- case 0:
- fprintf(file, " (byte encoding table)");
- break;
- case 4:
- fprintf(file, " (segment mapping to delta values)");
- break;
- case 6:
- fprintf(file, " (trimmed table mapping)");
- break;
- }
- fprintf(file, "\n");
- fprintf(file, "/Encoding%i [\n", (int) (e - cmap_tab + 1));
- switch (format) {
- case 0:
- (void) get_ushort(); /* skip length */
- (void) get_ushort(); /* skip version number */
- for (i = 0; i < 256; i++) {
- fputs("/", file);
- print_glyph_name(file, get_byte(), print_glyph);
- fputs("\n", file);
- }
- break;
- case 4:
- for (i = 0; i < nglyphs; ++i) {
- fprintf(file, "%% Glyph %li -> ", i);
- print_glyph_name(file, i, AS_UNICODE);
- fputs("\n", file);
- }
- break;
- case 6:
- (void) get_ushort(); /* skip table length */
- (void) get_ushort(); /* skip version number */
- first_code = get_ushort(); /* first character code */
- for (i = 0; i < first_code; ++i)
- fprintf(file, "/%s\n", notdef);
- length = get_ushort(); /* number of character codes */
- for (i = first_code; i < first_code + length; i++) {
- k = get_ushort();
- if (i > 255)
- fputs("% ", file);
- fputs("/", file);
- print_glyph_name(file, k, print_glyph);
- fputs("\n", file);
- }
- for (i = first_code + length; i < 256; i++)
- fprintf(file, "/%s\n", notdef);
- break;
- default:
- ttf_warn("format %i of encoding subtable unsupported",
- (int) format);
- }
- fprintf(file, "] def\n");
- }
- xfree(enc_name);
-}
-
-static void usage(void)
-{
- cur_file_name = NULL;
- fprintf(stderr,
- "Usage: ttf2afm [-i|-u|-c|-v] [-e enc] [-o filename] [-m NUM] fontfile\n"
- " -i: force printing glyph names in form 'index123'\n"
- " -u: force printing glyph names in form 'uniABCD'\n"
- " -c: print encoding tables to `basename.e<platformID><encodingID>'\n"
- " -v: print version\n"
- " -e enc: encode the AFM output using encoding vector from `enc'\n"
- " -o filename: write output to file `filename' instead of stdout\n"
- " -m NUM: select unicode mapping (default = 1, ie the first)\n"
- " fontfile: the TrueType fontfile\n"
- "\nPlease send bug reports or feature requests to <pdftex@tug.org>\n");
- _exit(-1);
-}
-
-int main(int argc, char **argv)
-{
- char date[128], *s;
- time_t t = time(&t);
- int c;
- kpse_set_program_name(argv[0], "ttf2afm");
- kpse_init_prog("ttf2afm", 0, 0, 0);
- while ((c = getopt(argc, argv, "iucve:o:m:")) != -1)
- switch (c) {
- case 'i':
- print_glyph = AS_INDEX;
- break;
- case 'u':
- print_glyph = AS_UNICODE;
- break;
- case 'c':
- print_cmap = 1;
- break;
- case 'e':
- cur_file_name = optarg;
- read_encoding(cur_file_name);
- use_ext_enc = 1;
- break;
- case 'o':
- cur_file_name = optarg;
- outfile = xfopen(cur_file_name, FOPEN_W_MODE);
- if (outfile == NULL)
- ttf_fail("cannot open file for writing");
- break;
- case 'm':
- select_unicode = atoi(optarg);
- break;
- case 'v':
- fprintf(stderr,
- "ttf2afm version " VERSION "\n"
- "Copyright (C) 1997-2014 Han The Thanh.\n"
- "There is NO warranty. Redistribution of this software is\n"
- "covered by the terms of both the pdfTeX copyright and\n"
- "the GNU General Public License.\n"
- "For more information about these matters, see the files\n"
- "named COPYING and the pdfTeX source.\n"
- "Primary author of ttf2afm: Han The Thanh.\n");
- _exit(0);
- default:
- usage();
- }
- if (argc - optind != 1)
- usage();
- sprintf(date, "%s\n", ctime(&t));
- *(char *) strchr(date, '\n') = 0;
- cur_file_name = argv[optind];
- if (print_cmap) {
- bname = xstrdup(xbasename(cur_file_name));
- if ((s = strrchr(bname, '.')) != NULL)
- *s = 0;
- }
- if ((fontfile =
- kpse_open_file(cur_file_name, kpse_truetype_format)) == NULL)
- ttf_fail("can't open font file for reading");
- read_font();
- if (outfile == NULL)
- outfile = stdout;
- print_afm(date, cur_file_name);
- if (print_cmap)
- print_encoding(cur_file_name);
- xfree(FontName);
- xfree(FullName);
- xfree(FamilyName);
- xfree(Notice);
- xfree(Version);
- xfree(Weight);
- free_tabs();
- xfclose(fontfile, cur_file_name);
- return 0;
-}
diff --git a/Build/source/texk/web2c/pdftexdir/ttf2afm.test b/Build/source/texk/web2c/pdftexdir/ttf2afm.test
deleted file mode 100755
index 436aa0c1a1d..00000000000
--- a/Build/source/texk/web2c/pdftexdir/ttf2afm.test
+++ /dev/null
@@ -1,35 +0,0 @@
-#! /bin/sh -vx
-# $Id: ttf2afm.test 804 2018-05-17 22:29:15Z karl $
-# Copyright 2017-2018 Karl Berry <tex-live@tug.org>#
-# Copyright 2013 Peter Breitenlohner <tex-live@tug.org>
-# You may freely use, modify and/or distribute this file.
-
-LC_ALL=C; export LC_ALL; LANGUAGE=C; export LANGUAGE
-
-TEXMFCNF=$srcdir/../kpathsea; export TEXMFCNF
-TEXINPUTS=$srcdir/pdftexdir/tests:$srcdir/tests; export TEXINPUTS;
-TEXFONTS=$srcdir/pdftexdir/tests; export TEXFONTS
-
-testsrc=$srcdir/pdftexdir/tests
-
-failed=
-
-echo "*** ttf2afm postV3.ttf" \
- && ./ttf2afm postV3.ttf \
- | sed '/Converted at/d' >postV3.afm \
- && diff $testsrc/postV3.afm postV3.afm \
- && echo && echo "postV3 tests OK" && echo \
- || failed="$failed postV3"
-
-echo "*** ttf2afm postV7.ttf" \
- && ./ttf2afm postV7.ttf \
- | sed '/Converted at/d' >postV7.afm \
- && diff $testsrc/postV7.afm postV7.afm \
- && echo && echo "postV7 tests OK" && echo \
- || failed="$failed postV7"
-
-test -z "$failed" && exit 0
-echo
-echo "failed tests:$failed"
-exit 1
-
diff --git a/Build/source/texk/web2c/pdftexdir/utils.c b/Build/source/texk/web2c/pdftexdir/utils.c
deleted file mode 100644
index 7f5e50416b7..00000000000
--- a/Build/source/texk/web2c/pdftexdir/utils.c
+++ /dev/null
@@ -1,1558 +0,0 @@
-/*
-Copyright 1996-2017 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include <w2c/config.h> /* for large file support */
-#include <sys/types.h>
-#include <regex.h>
-#include <kpathsea/config.h>
-#include <kpathsea/c-proto.h>
-#include <kpathsea/c-stat.h>
-#include <kpathsea/c-fopen.h>
-#include <kpathsea/version.h>
-#include <string.h>
-#include <time.h>
-#include <float.h> /* for DBL_EPSILON */
-#include "md5.h"
-#include <zlib.h>
-#include "ptexlib.h"
-#include <png.h>
-#ifdef POPPLER_VERSION
-/* POPPLER_VERSION should be a proper version string */
-#define xpdfVersion POPPLER_VERSION
-#define xpdfString "poppler"
-#else
-#include <xpdf/config.h> /* just to get the xpdf version */
-#define xpdfString "xpdf"
-#endif
-
-#define check_nprintf(size_get, size_want) \
- if ((unsigned)(size_get) >= (unsigned)(size_want)) \
- pdftex_fail ("snprintf failed: file %s, line %d", __FILE__, __LINE__);
-
-char *cur_file_name = NULL;
-strnumber last_tex_string;
-static char print_buf[PRINTF_BUF_SIZE];
-static char *jobname_cstr = NULL;
-static char *job_id_string = NULL;
-
-size_t last_ptr_index; /* for use with alloc_array */
-
-/* define fb_ptr, fb_array & fb_limit */
-typedef char fb_entry;
-define_array(fb);
-
-/* define char_ptr, char_array & char_limit */
-typedef char char_entry;
-define_array(char);
-
-/* define vf_e_fnts_ptr, vf_e_fnts_array & vf_e_fnts_limit */
-typedef integer vf_e_fnts_entry;
-define_array(vf_e_fnts);
-
-/* define vf_i_fnts_ptr, vf_i_fnts_array & vf_i_fnts_limit */
-typedef internalfontnumber vf_i_fnts_entry;
-define_array(vf_i_fnts);
-
-integer fb_offset(void)
-{
- return fb_ptr - fb_array;
-}
-
-void fb_seek(integer offset)
-{
- fb_ptr = fb_array + offset;
-}
-
-void fb_putchar(eightbits b)
-{
- alloc_array(fb, 1, SMALL_ARRAY_SIZE);
- *fb_ptr++ = b;
-}
-
-void fb_flush(void)
-{
- fb_entry *p;
- integer n;
- for (p = fb_array; p < fb_ptr;) {
- n = pdfbufsize - pdfptr;
- if (fb_ptr - p < n)
- n = fb_ptr - p;
- memcpy(pdfbuf + pdfptr, p, (unsigned) n);
- pdfptr += n;
- if (pdfptr == pdfbufsize)
- pdfflush();
- p += n;
- }
- fb_ptr = fb_array;
-}
-
-#define SUBSET_TAG_LENGTH 6
-
-void make_subset_tag(fd_entry * fd)
-{
- int i, j = 0, a[SUBSET_TAG_LENGTH];
- md5_state_t pms;
- char *glyph;
- struct avl_traverser t;
- md5_byte_t digest[16];
- void **aa;
- static struct avl_table *st_tree = NULL;
- if (st_tree == NULL)
- st_tree = avl_create(comp_string_entry, NULL, &avl_xallocator);
- assert(fd != NULL);
- assert(fd->gl_tree != NULL);
- assert(fd->fontname != NULL);
- assert(fd->subset_tag == NULL);
- fd->subset_tag = xtalloc(SUBSET_TAG_LENGTH + 1, char);
- do {
- md5_init(&pms);
- avl_t_init(&t, fd->gl_tree);
- for (glyph = (char *) avl_t_first(&t, fd->gl_tree); glyph != NULL;
- glyph = (char *) avl_t_next(&t)) {
- md5_append(&pms, (md5_byte_t *) glyph, strlen(glyph));
- md5_append(&pms, (const md5_byte_t *) " ", 1);
- }
- md5_append(&pms, (md5_byte_t *) fd->fontname, strlen(fd->fontname));
- md5_append(&pms, (md5_byte_t *) & j, sizeof(int)); /* to resolve collision */
- md5_finish(&pms, digest);
- for (a[0] = 0, i = 0; i < 13; i++)
- a[0] += digest[i];
- for (i = 1; i < SUBSET_TAG_LENGTH; i++)
- a[i] = a[i - 1] - digest[i - 1] + digest[(i + 12) % 16];
- for (i = 0; i < SUBSET_TAG_LENGTH; i++)
- fd->subset_tag[i] = a[i] % 26 + 'A';
- fd->subset_tag[SUBSET_TAG_LENGTH] = '\0';
- j++;
- assert(j < 100);
- }
- while ((char *) avl_find(st_tree, fd->subset_tag) != NULL);
- aa = avl_probe(st_tree, fd->subset_tag);
- assert(aa != NULL);
- if (j > 2)
- pdftex_warn
- ("\nmake_subset_tag(): subset-tag collision, resolved in round %d.\n",
- j);
-}
-
-void pdf_puts(const char *s)
-{
- pdfroom(strlen(s) + 1);
- while (*s)
- pdfbuf[pdfptr++] = *s++;
- pdflastbyte = s[-1];
-}
-
-void pdf_newline(void)
-{
- if (pdflastbyte != '\n')
- pdf_puts("\n");
-}
-
-__attribute__ ((format(printf, 1, 2)))
-void pdf_printf(const char *fmt, ...)
-{
- va_list args;
- va_start(args, fmt);
- vsnprintf(print_buf, PRINTF_BUF_SIZE, fmt, args);
- pdf_puts(print_buf);
- va_end(args);
-}
-
-strnumber maketexstring(const char *s)
-{
- size_t l;
- if (s == NULL || *s == 0)
- return getnullstr();
- l = strlen(s);
- check_buf(poolptr + l, poolsize);
- while (l-- > 0)
- strpool[poolptr++] = *s++;
- last_tex_string = makestring();
- return last_tex_string;
-}
-
-__attribute__ ((format(printf, 1, 2)))
-void tex_printf(const char *fmt, ...)
-{
- va_list args;
- va_start(args, fmt);
- vsnprintf(print_buf, PRINTF_BUF_SIZE, fmt, args);
- print(maketexstring(print_buf));
- flushstr(last_tex_string);
- xfflush(stdout);
- va_end(args);
-}
-
-/* Helper for pdftex_fail. */
-static void safe_print(const char *str)
-{
- const char *c;
- for (c = str; *c; ++c)
- print(*c);
-}
-
-void removepdffile(void)
-{
- if (!kpathsea_debug && outputfilename && !fixedpdfdraftmode) {
- xfclose(pdffile, makecstring(outputfilename));
- remove(makecstring(outputfilename));
- }
-}
-
-/* pdftex_fail may be called when a buffer overflow has happened/is
- happening, therefore may not call mktexstring. However, with the
- current implementation it appears that error messages are misleading,
- possibly because pool overflows are detected too late.
-
- The output format of this fuction must be the same as pdf_error in
- pdftex.web! */
-__attribute__ ((noreturn, format(printf, 1, 2)))
-void pdftex_fail(const char *fmt, ...)
-{
- va_list args;
- va_start(args, fmt);
- println();
- safe_print("!pdfTeX error: ");
- safe_print(kpse_invocation_name);
- if (cur_file_name) {
- safe_print(" (file ");
- safe_print(cur_file_name);
- safe_print(")");
- }
- safe_print(": ");
- vsnprintf(print_buf, PRINTF_BUF_SIZE, fmt, args);
- safe_print(print_buf);
- va_end(args);
- println();
- removepdffile();
- safe_print(" ==> Fatal error occurred, no output PDF file produced!");
- println();
- if (kpathsea_debug) {
- safe_print("kpathsea_debug enabled, calling abort()...");
- println();
- abort();
- } else {
- exit(EXIT_FAILURE);
- }
-}
-
-/* The output format of this fuction must be the same as pdf_warn in
- pdftex.web! */
-__attribute__ ((format(printf, 1, 2)))
-void pdftex_warn(const char *fmt, ...)
-{
- va_list args;
- va_start(args, fmt);
- println();
- println();
- tex_printf("pdfTeX warning: %s", kpse_invocation_name);
- if (cur_file_name)
- tex_printf(" (file %s)", cur_file_name);
- tex_printf(": ");
- vsnprintf(print_buf, PRINTF_BUF_SIZE, fmt, args);
- print(maketexstring(print_buf));
- flushstr(last_tex_string);
- va_end(args);
- println();
-}
-
-void garbagewarning(void)
-{
- pdftex_warn("dangling objects discarded, no output file produced.");
- removepdffile();
-}
-
-void setjobid(int year, int month, int day, int time)
-{
- char *name_string, *format_string, *s;
- size_t slen;
- int i;
-
- if (job_id_string != NULL)
- return;
-
- name_string = xstrdup(makecstring(jobname));
- format_string = xstrdup(makecstring(formatident));
- slen = SMALL_BUF_SIZE +
- strlen(name_string) +
- strlen(format_string) +
- strlen(ptexbanner) +
- strlen(versionstring) + strlen(kpathsea_version_string);
- s = xtalloc(slen, char);
- /* The Web2c version string starts with a space. */
- i = snprintf(s, slen,
- "%.4d/%.2d/%.2d %.2d:%.2d %s %s %s%s %s",
- year, month, day, time / 60, time % 60,
- name_string, format_string, ptexbanner,
- versionstring, kpathsea_version_string);
- check_nprintf(i, slen);
- job_id_string = xstrdup(s);
- xfree(s);
- xfree(name_string);
- xfree(format_string);
-}
-
-void makepdftexbanner(void)
-{
- static boolean pdftexbanner_init = false;
- char *s;
- size_t slen;
- int i;
-
- if (pdftexbanner_init)
- return;
-
- slen = SMALL_BUF_SIZE +
- strlen(ptexbanner) +
- strlen(versionstring) + strlen(kpathsea_version_string);
- s = xtalloc(slen, char);
- /* The Web2c version string starts with a space. */
- i = snprintf(s, slen,
- "%s%s %s", ptexbanner, versionstring, kpathsea_version_string);
- check_nprintf(i, slen);
- pdftexbanner = maketexstring(s);
- xfree(s);
- pdftexbanner_init = true;
-}
-
-strnumber getresnameprefix(void)
-{
-/* static char name_str[] = */
-/* "!\"$&'*+,-.0123456789:;=?@ABCDEFGHIJKLMNOPQRSTUVWXYZ\\" */
-/* "^_`abcdefghijklmnopqrstuvwxyz|~"; */
- static char name_str[] =
- "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
- char prefix[7]; /* make a tag of 6 chars long */
- unsigned long crc;
- int i;
- size_t base = strlen(name_str);
- crc = crc32(0L, Z_NULL, 0);
- crc = crc32(crc, (Bytef *) job_id_string, strlen(job_id_string));
- for (i = 0; i < 6; i++) {
- prefix[i] = name_str[crc % base];
- crc /= base;
- }
- prefix[6] = 0;
- return maketexstring(prefix);
-}
-
-size_t xfwrite(void *ptr, size_t size, size_t nmemb, FILE * stream)
-{
- if (fwrite(ptr, size, nmemb, stream) != nmemb)
- pdftex_fail("fwrite() failed");
- return nmemb;
-}
-
-int xfflush(FILE * stream)
-{
- if (fflush(stream) != 0)
- pdftex_fail("fflush() failed (%s)", strerror(errno));
- return 0;
-}
-
-int xgetc(FILE * stream)
-{
- int c = getc(stream);
- if (c < 0 && c != EOF)
- pdftex_fail("getc() failed (%s)", strerror(errno));
- return c;
-}
-
-int xputc(int c, FILE * stream)
-{
- int i = putc(c, stream);
- if (i < 0)
- pdftex_fail("putc() failed (%s)", strerror(errno));
- return i;
-}
-
-void writestreamlength(longinteger length, longinteger offset)
-{
- if (jobname_cstr == NULL)
- jobname_cstr = xstrdup(makecstring(jobname));
- if (fixedpdfdraftmode == 0) {
- xfseeko(pdffile, (off_t) offset, SEEK_SET, jobname_cstr);
- fprintf(pdffile, "%" LONGINTEGER_PRI "i", (LONGINTEGER_TYPE) length);
- xfseeko(pdffile, (off_t) pdfoffset(), SEEK_SET, jobname_cstr);
- }
-}
-
-scaled extxnoverd(scaled x, scaled n, scaled d)
-{
- double r = (((double) x) * ((double) n)) / ((double) d);
- if (r > DBL_EPSILON)
- r += 0.5;
- else
- r -= 0.5;
- if (r >= (double) maxinteger || r <= -(double) maxinteger)
- pdftex_warn("arithmetic: number too big");
- return (scaled) r;
-}
-
-void libpdffinish(void)
-{
- xfree(fb_array);
- xfree(char_array);
- xfree(job_id_string);
- fm_free();
- t1_free();
- enc_free();
- img_free();
- vf_free();
- epdf_free();
- ttf_free();
- sfd_free();
- glyph_unicode_free();
- zip_free();
-}
-
-/* Converts any string given in in in an allowed PDF string which can be
- * handled by printf et.al.: \ is escaped to \\, parenthesis are escaped and
- * control characters are octal encoded.
- * This assumes that the string does not contain any already escaped
- * characters!
- */
-char *convertStringToPDFString(const char *in, int len)
-{
- static char pstrbuf[MAX_PSTRING_LEN];
- char *out = pstrbuf;
- int i, j = 0, k;
- char buf[5];
- for (i = 0; i < len; i++) {
- check_buf(j + sizeof(buf), MAX_PSTRING_LEN);
- if (((unsigned char) in[i] < '!') || ((unsigned char) in[i] > '~')) {
- /* convert control characters into oct */
- k = snprintf(buf, sizeof(buf),
- "\\%03o", (unsigned int) (unsigned char) in[i]);
- check_nprintf(k, sizeof(buf));
- out[j++] = buf[0];
- out[j++] = buf[1];
- out[j++] = buf[2];
- out[j++] = buf[3];
- } else if ((in[i] == '(') || (in[i] == ')')) {
- /* escape paranthesis */
- out[j++] = '\\';
- out[j++] = in[i];
- } else if (in[i] == '\\') {
- /* escape backslash */
- out[j++] = '\\';
- out[j++] = '\\';
- } else {
- /* copy char :-) */
- out[j++] = in[i];
- }
- }
- out[j] = '\0';
- return pstrbuf;
-}
-
-
-/* Converts any string given in in in an allowed PDF string which can be
- * handled by printf et.al.: \ is escaped to \\, parenthesis are escaped and
- * control characters are octal encoded.
- * This assumes that the string does not contain any already escaped
- * characters!
- *
- * See escapename for parameter description.
- */
-void escapestring(poolpointer in)
-{
- const poolpointer out = poolptr;
- unsigned char ch;
- while (in < out) {
- if (poolptr + 4 >= poolsize) {
- poolptr = poolsize;
- /* error by str_toks that calls str_room(1) */
- return;
- }
-
- ch = (unsigned char) strpool[in++];
-
- if ((ch < '!') || (ch > '~')) {
- /* convert control characters into oct */
- int i = snprintf((char *) &strpool[poolptr], 5,
- "\\%.3o", (unsigned int) ch);
- check_nprintf(i, 5);
- poolptr += i;
- continue;
- }
- if ((ch == '(') || (ch == ')') || (ch == '\\')) {
- /* escape parenthesis and backslash */
- strpool[poolptr++] = '\\';
- }
- /* copy char :-) */
- strpool[poolptr++] = ch;
- }
-}
-
-/* Convert any given string in a PDF name using escaping mechanism
- of PDF 1.2. The result does not include the leading slash.
-
- PDF specification 1.6, section 3.2.6 "Name Objects" explains:
- <blockquote>
- Beginning with PDF 1.2, any character except null (character code 0) may
- be included in a name by writing its 2-digit hexadecimal code, preceded
- by the number sign character (#); see implementation notes 3 and 4 in
- Appendix H. This syntax is required to represent any of the delimiter or
- white-space characters or the number sign character itself; it is
- recommended but not required for characters whose codes are outside the
- range 33 (!) to 126 (~).
- </blockquote>
- The following table shows the conversion that are done by this
- function:
- code result reason
- -----------------------------------
- 0 ignored not allowed
- 1..32 escaped must for white-space:
- 9 (tab), 10 (lf), 12 (ff), 13 (cr), 32 (space)
- recommended for the other control characters
- 35 escaped escape char "#"
- 37 escaped delimiter "%"
- 40..41 escaped delimiters "(" and ")"
- 47 escaped delimiter "/"
- 60 escaped delimiter "<"
- 62 escaped delimiter ">"
- 91 escaped delimiter "["
- 93 escaped delimiter "]"
- 123 escaped delimiter "{"
- 125 escaped delimiter "}"
- 127..255 escaped recommended
- else copy regular characters
-
- Parameter "in" is a pointer into the string pool where
- the input string is located. The output string is written
- as temporary string right after the input string.
- Thus at the begin of the procedure the global variable
- "poolptr" points to the start of the output string and
- after the end when the procedure returns.
-*/
-void escapename(poolpointer in)
-{
- const poolpointer out = poolptr;
- unsigned char ch;
- int i;
-
- while (in < out) {
- if (poolptr + 3 >= poolsize) {
- poolptr = poolsize;
- /* error by str_toks that calls str_room(1) */
- return;
- }
-
- ch = (unsigned char) strpool[in++];
-
- if ((ch >= 1 && ch <= 32) || ch >= 127) {
- /* escape */
- i = snprintf((char *) &strpool[poolptr], 4,
- "#%.2X", (unsigned int) ch);
- check_nprintf(i, 4);
- poolptr += i;
- continue;
- }
- switch (ch) {
- case 0:
- /* ignore */
- break;
- case 35:
- case 37:
- case 40:
- case 41:
- case 47:
- case 60:
- case 62:
- case 91:
- case 93:
- case 123:
- case 125:
- /* escape */
- i = snprintf((char *) &strpool[poolptr], 4,
- "#%.2X", (unsigned int) ch);
- check_nprintf(i, 4);
- poolptr += i;
- break;
- default:
- /* copy */
- strpool[poolptr++] = ch;
- }
- }
-}
-
-/* Convert any given string in a PDF hexadecimal string. The
- result does not include the angle brackets.
-
- This procedure uses uppercase hexadecimal letters.
-
- See escapename for description of parameters.
-*/
-void escapehex(poolpointer in)
-{
- const poolpointer out = poolptr;
- unsigned char ch;
- int i;
-
- while (in < out) {
- if (poolptr + 2 >= poolsize) {
- poolptr = poolsize;
- /* error by str_toks that calls str_room(1) */
- return;
- }
-
- ch = (unsigned char) strpool[in++];
-
- i = snprintf((char *) &strpool[poolptr], 3, "%.2X", (unsigned int) ch);
- check_nprintf(i, 3);
- poolptr += 2;
- }
-}
-
-/* Unescape any given hexadecimal string.
-
- Last hex digit can be omitted, it is replaced by zero, see
- PDF specification.
-
- Invalid digits are silently ignored.
-
- See escapename for description of parameters.
-*/
-void unescapehex(poolpointer in)
-{
- const poolpointer out = poolptr;
- unsigned char ch;
- unsigned char a = 0; /* to avoid warning about uninitialized use of a */
- boolean first = true;
-
- while (in < out) {
- if (poolptr + 1 >= poolsize) {
- poolptr = poolsize;
- /* error by str_toks that calls str_room(1) */
- return;
- }
-
- ch = (unsigned char) strpool[in++];
-
- if ((ch >= '0') && (ch <= '9')) {
- ch -= '0';
- } else if ((ch >= 'A') && (ch <= 'F')) {
- ch -= 'A' - 10;
- } else if ((ch >= 'a') && (ch <= 'f')) {
- ch -= 'a' - 10;
- } else {
- continue; /* ignore wrong character */
- }
-
- if (first) {
- a = ch << 4;
- first = false;
- continue;
- }
-
- strpool[poolptr++] = a + ch;
- first = true;
- }
- if (!first) { /* last hex digit is omitted */
- strpool[poolptr++] = a;
- }
-}
-
-/* Compute the ID string as per PDF1.4 9.3:
- <blockquote>
- File identifers are defined by the optional ID entry in a PDF file's
- trailer dictionary (see Section 3.4.4, "File Trailer"; see also
- implementation note 105 in Appendix H). The value of this entry is an
- array of two strings. The first string is a permanent identifier based
- on the contents of the file at the time it was originally created, and
- does not change when the file is incrementally updated. The second
- string is a changing identifier based on the file's contents at the
- time it was last updated. When a file is first written, both
- identifiers are set to the same value. If both identifiers match when a
- file reference is resolved, it is very likely that the correct file has
- been found; if only the first identifier matches, then a different
- version of the correct file has been found.
- To help ensure the uniqueness of file identifiers, it is recommend
- that they be computed using a message digest algorithm such as MD5
- (described in Internet RFC 1321, The MD5 Message-Digest Algorithm; see
- the Bibliography), using the following information (see implementation
- note 106 in Appendix H):
- - The current time
- - A string representation of the file's location, usually a pathname
- - The size of the file in bytes
- - The values of all entries in the file's document information
- dictionary (see Section 9.2.1, Document Information Dictionary )
- </blockquote>
- This stipulates only that the two IDs must be identical when the file is
- created and that they should be reasonably unique. Since it's difficult
- to get the file size at this point in the execution of pdfTeX, scanning
- the info dict is also difficult, and any variability in the current
- directory name leads to non-reproducible builds, we start with a
- simpler implementation using just the current time and the file name.
- */
-void printID(strnumber filename)
-{
- md5_state_t state;
- md5_byte_t digest[16];
- char id[64];
- char *file_name;
- /* start md5 */
- md5_init(&state);
- /* get the time */
- initstarttime();
- md5_append(&state, (const md5_byte_t *) start_time_str, strlen(start_time_str));
- /* get the file name */
- file_name = makecstring(filename);
- md5_append(&state, (const md5_byte_t *) file_name, strlen(file_name));
- /* finish md5 */
- md5_finish(&state, digest);
- /* write the IDs */
- convertStringToHexString((char *) digest, id, 16);
- pdf_printf("/ID [<%s> <%s>]", id, id);
-}
-
-void printIDalt(integer toks)
-{
- md5_state_t state;
- md5_byte_t digest[16];
- char id[64];
- char *s = makecstring(tokenstostring(toks));
- flushstr(lasttokensstring);
- if (strlen(s) == 0)
- return;
- md5_init(&state);
- md5_append(&state, (const md5_byte_t *) s, strlen(s));
- md5_finish(&state, digest);
- convertStringToHexString((char *) digest, id, 16);
- pdf_printf("/ID [<%s> <%s>]", id, id);
-}
-
-
-/* Print the /CreationDate entry.
-
- PDF Reference, third edition says about the expected date format:
- <blockquote>
- 3.8.2 Dates
-
- PDF defines a standard date format, which closely follows that of
- the international standard ASN.1 (Abstract Syntax Notation One),
- defined in ISO/IEC 8824 (see the Bibliography). A date is a string
- of the form
-
- (D:YYYYMMDDHHmmSSOHH'mm')
-
- where
-
- YYYY is the year
- MM is the month
- DD is the day (01-31)
- HH is the hour (00-23)
- mm is the minute (00-59)
- SS is the second (00-59)
- O is the relationship of local time to Universal Time (UT),
- denoted by one of the characters +, -, or Z (see below)
- HH followed by ' is the absolute value of the offset from UT
- in hours (00-23)
- mm followed by ' is the absolute value of the offset from UT
- in minutes (00-59)
-
- The apostrophe character (') after HH and mm is part of the syntax.
- All fields after the year are optional. (The prefix D:, although also
- optional, is strongly recommended.) The default values for MM and DD
- are both 01; all other numerical fields default to zero values. A plus
- sign (+) as the value of the O field signifies that local time is
- later than UT, a minus sign (-) that local time is earlier than UT,
- and the letter Z that local time is equal to UT. If no UT information
- is specified, the relationship of the specified time to UT is
- considered to be unknown. Whether or not the time zone is known, the
- rest of the date should be specified in local time.
-
- For example, December 23, 1998, at 7:52 PM, U.S. Pacific Standard
- Time, is represented by the string
-
- D:199812231952-08'00'
- </blockquote>
-
- The main difficulty is get the time zone offset. strftime() does this in ISO
- C99 (e.g. newer glibc) with %z, but we have to work with other systems (e.g.
- Solaris 2.5).
-*/
-
-void printcreationdate(void)
-{
- initstarttime();
- pdf_printf("/CreationDate (%s)\n", start_time_str);
-}
-
-void printmoddate(void)
-{
- initstarttime();
- pdf_printf("/ModDate (%s)\n", start_time_str);
-}
-
-
-#define DEFAULT_SUB_MATCH_COUNT 10
-static int sub_match_count = DEFAULT_SUB_MATCH_COUNT;
-static regmatch_t *pmatch = NULL;
-static char *match_string = NULL;
-static int last_match_succeeded = 0;
-
-/* Implements \pdfmatch */
-void
-matchstrings(strnumber s, strnumber t, int subcount, boolean icase)
-{
- regex_t preg;
- int cflags = REG_EXTENDED;
- int eflags = 0;
- int ret;
- char *str;
-
- if (icase) {
- cflags |= REG_ICASE;
- }
-
- if (poolptr + 10 >= poolsize) {
- poolptr = poolsize;
- return;
- }
-
- str = makecstring(s);
- ret = regcomp(&preg, str, cflags);
- if (ret != 0) {
- size_t size = regerror(ret, &preg, NULL, 0);
- str = xtalloc(size, char);
- regerror(ret, &preg, str, size);
- pdftex_warn("%s%s", "\\pdfmatch: ", str);
- xfree(str);
- strpool[poolptr++] = '-';
- strpool[poolptr++] = '1';
- } else {
- str = makecstring(t);
- sub_match_count = ((subcount < 0) ? DEFAULT_SUB_MATCH_COUNT : subcount);
- xfree(pmatch);
- if (sub_match_count > 0) {
- pmatch = xtalloc(sub_match_count, regmatch_t);
- }
- ret = regexec(&preg, str, sub_match_count, pmatch, eflags);
-
- xfree(match_string);
- match_string = xstrdup(str); /* save searched-in string, used below */
- last_match_succeeded = ret == 0; /* save whether match succeeded */
- strpool[poolptr++] = ((ret == 0) ? '1' : '0'); /* in string pool too */
- }
-
- regfree(&preg);
-}
-
-/* Implements \pdflastmatch */
-
-void
-getmatch(int i)
-{
- int size;
- int len = 0; /* avoid spurious uninitialized warning */
-
- boolean found
- = i >= 0 /* should always be so due to pdftex.web */
- && i < sub_match_count /* if >subcount, not found by definition */
- && match_string != NULL /* first call, and just in case */
- && last_match_succeeded /* if no match, not found */
- && pmatch[i].rm_so >= 0 /* if no starting position, not found */
- && pmatch[i].rm_eo >= pmatch[i].rm_so; /* just in case */
-
- if (found) {
- len = pmatch[i].rm_eo - pmatch[i].rm_so;
- size = 20 + len;
- /* 20: place for integer number and '->' */
- } else {
- size = 4;
- }
-
- if (poolptr + size >= poolsize) {
- poolptr = poolsize;
- return;
- }
-
- if (found) {
- int j = snprintf((char *) &strpool[poolptr], 20, "%d",
- (int) pmatch[i].rm_so);
- check_nprintf(j, 20);
- poolptr += j;
- strpool[poolptr++] = '-';
- strpool[poolptr++] = '>';
- memcpy(&strpool[poolptr], &match_string[pmatch[i].rm_so], len);
- poolptr += len;
- return;
- }
-
- strpool[poolptr++] = '-';
- strpool[poolptr++] = '1';
- strpool[poolptr++] = '-';
- strpool[poolptr++] = '>';
-}
-
-
-/* function strips trailing zeros in string with numbers; */
-/* leading zeros are not stripped (as in real life) */
-char *stripzeros(char *a)
-{
- enum { NONUM, DOTNONUM, INT, DOT, LEADDOT, FRAC } s = NONUM, t = NONUM;
- char *p, *q, *r;
- for (p = q = r = a; *p != '\0';) {
- switch (s) {
- case NONUM:
- if (*p >= '0' && *p <= '9')
- s = INT;
- else if (*p == '.')
- s = LEADDOT;
- break;
- case DOTNONUM:
- if (*p != '.' && (*p < '0' || *p > '9'))
- s = NONUM;
- break;
- case INT:
- if (*p == '.')
- s = DOT;
- else if (*p < '0' || *p > '9')
- s = NONUM;
- break;
- case DOT:
- case LEADDOT:
- if (*p >= '0' && *p <= '9')
- s = FRAC;
- else if (*p == '.')
- s = DOTNONUM;
- else
- s = NONUM;
- break;
- case FRAC:
- if (*p == '.')
- s = DOTNONUM;
- else if (*p < '0' || *p > '9')
- s = NONUM;
- break;
- default:;
- }
- switch (s) {
- case DOT:
- r = q;
- break;
- case LEADDOT:
- r = q + 1;
- break;
- case FRAC:
- if (*p > '0')
- r = q + 1;
- break;
- case NONUM:
- if ((t == FRAC || t == DOT) && r != a) {
- q = r--;
- if (*r == '.') /* was a LEADDOT */
- *r = '0';
- r = a;
- }
- break;
- default:;
- }
- *q++ = *p++;
- t = s;
- }
- *q = '\0';
- return a;
-}
-
-void initversionstring(char **versions)
-{
- const_string fmt =
- "Compiled with libpng %s; using libpng %s\n"
- "Compiled with zlib %s; using zlib %s\n"
- "Compiled with %s version %s\n";
- size_t len = strlen(fmt)
- + strlen(PNG_LIBPNG_VER_STRING) + strlen(png_libpng_ver)
- + strlen(ZLIB_VERSION) + strlen(zlib_version)
- + strlen(xpdfString) + strlen(xpdfVersion)
- + 1;
-
- /* len will be more than enough, because of the placeholder chars in fmt
- that get replaced by the arguments. */
- *versions = xmalloc(len);
- sprintf(*versions, fmt,
- PNG_LIBPNG_VER_STRING, png_libpng_ver,
- ZLIB_VERSION, zlib_version, xpdfString, xpdfVersion);
-}
-
-
-/*************************************************/
-/* Color Stack and Matrix Transformation Support */
-/*************************************************/
-
-/*
- In the following array and especially stack data structures are used.
- They have the following properties:
- - They automatically grow dynamically.
- - The size never decreases.
- - The variable with name ending in "size" contains the number how many
- entries the data structure can hold.
- - The variable with name ending in "used" contains the number of
- actually used entries.
- - Memory of strings in stack entries must be allocated and
- freed if the stack is cleared.
-*/
-
-/* Color Stack */
-
-#define STACK_INCREMENT 8
-#define MAX_COLORSTACKS 32768
-/* The colorstack number is stored in two bytes (info field of the node) */
-/* Condition (newcolorstack): MAX_COLORSTACKS mod STACK_INCREMENT = 0 */
-
-#define COLOR_DEFAULT "0 g 0 G"
-/* literal_modes, see pdftex.web */
-#define SET_ORIGIN 0
-#define DIRECT_PAGE 1
-#define DIRECT_ALWAYS 2
-
-/* remember shipout mode: page/form */
-static boolean page_mode;
-
-typedef struct {
- char **page_stack;
- char **form_stack;
- char *page_current;
- char *form_current;
- char *form_init;
- int page_size;
- int form_size;
- int page_used;
- int form_used;
- int literal_mode;
- boolean page_start;
-} colstack_type;
-
-static colstack_type *colstacks = NULL;
-static int colstacks_size = 0;
-static int colstacks_used = 0;
-
-/*
- Initialization is done, if the color stacks are used,
- init_colorstacks() is defined as macro to avoid unnecessary
- procedure calls.
-*/
-#define init_colorstacks() if (colstacks_size == 0) colstacks_first_init();
-static void colstacks_first_init(void)
-{
- colstacks_size = STACK_INCREMENT;
- colstacks = xtalloc(colstacks_size, colstack_type);
- colstacks_used = 1;
- colstacks[0].page_stack = NULL;
- colstacks[0].form_stack = NULL;
- colstacks[0].page_size = 0;
- colstacks[0].form_size = 0;
- colstacks[0].page_used = 0;
- colstacks[0].form_used = 0;
- colstacks[0].page_current = xstrdup(COLOR_DEFAULT);
- colstacks[0].form_current = xstrdup(COLOR_DEFAULT);
- colstacks[0].form_init = xstrdup(COLOR_DEFAULT);
- colstacks[0].literal_mode = DIRECT_ALWAYS;
- colstacks[0].page_start = true;
-}
-
-int colorstackused(void)
-{
- init_colorstacks();
- return colstacks_used;
-}
-
-/*
- newcolorstack()
- A new color stack is setup with the given parameters.
- The stack number is returned or -1 in case of error (no room).
-*/
-int newcolorstack(integer s, integer literal_mode, boolean page_start)
-{
- colstack_type *colstack;
- int colstack_num;
- char *str;
-
- init_colorstacks();
-
- /* make room */
- if (colstacks_used == MAX_COLORSTACKS) {
- return -1;
- }
- if (colstacks_used == colstacks_size) {
- colstacks_size += STACK_INCREMENT;
- /* If (MAX_COLORSTACKS mod STACK_INCREMENT = 0) then we don't
- need to check the case that size overruns MAX_COLORSTACKS. */
- xretalloc(colstacks, colstacks_size, colstack_type);
- }
- /* claim new color stack */
- colstack_num = colstacks_used++;
- colstack = &colstacks[colstack_num];
- /* configure the new color stack */
- colstack->page_stack = NULL;
- colstack->form_stack = NULL;
- colstack->page_size = 0;
- colstack->page_used = 0;
- colstack->form_size = 0;
- colstack->form_used = 0;
- colstack->literal_mode = literal_mode;
- colstack->page_start = page_start;
- str = makecstring(s);
- if (*str == 0) {
- colstack->page_current = NULL;
- colstack->form_current = NULL;
- colstack->form_init = NULL;
- } else {
- colstack->page_current = xstrdup(str);
- colstack->form_current = xstrdup(str);
- colstack->form_init = xstrdup(str);
- }
- return colstack_num;
-}
-
-#define get_colstack(n) (&colstacks[n])
-
-/*
- Puts a string on top of the string pool and updates poolptr.
-*/
-static void put_cstring_on_strpool(poolpointer start, char *str)
-{
- size_t len;
-
- if (str == NULL || *str == 0) {
- return;
- }
-
- len = strlen(str);
- poolptr = start + len;
- if (poolptr >= poolsize) {
- poolptr = poolsize;
- /* error by str_toks that calls str_room(1) */
- return;
- }
- memcpy(&strpool[start], str, len);
-}
-
-integer colorstackset(int colstack_no, integer s)
-{
- colstack_type *colstack = get_colstack(colstack_no);
-
- if (page_mode) {
- xfree(colstack->page_current);
- colstack->page_current = xstrdup(makecstring(s));
- } else {
- xfree(colstack->form_current);
- colstack->form_current = xstrdup(makecstring(s));
- }
- return colstack->literal_mode;
-}
-
-integer colorstackcurrent(int colstack_no)
-{
- colstack_type *colstack = get_colstack(colstack_no);
-
- if (page_mode) {
- put_cstring_on_strpool(poolptr, colstack->page_current);
- } else {
- put_cstring_on_strpool(poolptr, colstack->form_current);
- }
- return colstack->literal_mode;
-}
-
-integer colorstackpush(int colstack_no, integer s)
-{
- colstack_type *colstack = get_colstack(colstack_no);
- char *str;
-
- if (page_mode) {
- if (colstack->page_used == colstack->page_size) {
- colstack->page_size += STACK_INCREMENT;
- xretalloc(colstack->page_stack, colstack->page_size, char *);
- }
- colstack->page_stack[colstack->page_used++] = colstack->page_current;
- str = makecstring(s);
- if (*str == 0) {
- colstack->page_current = NULL;
- } else {
- colstack->page_current = xstrdup(str);
- }
- } else {
- if (colstack->form_used == colstack->form_size) {
- colstack->form_size += STACK_INCREMENT;
- xretalloc(colstack->form_stack, colstack->form_size, char *);
- }
- colstack->form_stack[colstack->form_used++] = colstack->form_current;
- str = makecstring(s);
- if (*str == 0) {
- colstack->form_current = NULL;
- } else {
- colstack->form_current = xstrdup(str);
- }
- }
- return colstack->literal_mode;
-}
-
-integer colorstackpop(int colstack_no)
-{
- colstack_type *colstack = get_colstack(colstack_no);
-
- if (page_mode) {
- if (colstack->page_used == 0) {
- pdftex_warn("pop empty color page stack %u",
- (unsigned int) colstack_no);
- return colstack->literal_mode;
- }
- xfree(colstack->page_current);
- colstack->page_current = colstack->page_stack[--colstack->page_used];
- put_cstring_on_strpool(poolptr, colstack->page_current);
- } else {
- if (colstack->form_used == 0) {
- pdftex_warn("pop empty color form stack %u",
- (unsigned int) colstack_no);
- return colstack->literal_mode;
- }
- xfree(colstack->form_current);
- colstack->form_current = colstack->form_stack[--colstack->form_used];
- put_cstring_on_strpool(poolptr, colstack->form_current);
- }
- return colstack->literal_mode;
-}
-
-static void colorstackpagestart(void)
-{
- int i, j;
- colstack_type *colstack;
-
- if (page_mode) {
- /* see procedure pdf_out_colorstack_startpage */
- return;
- }
-
- for (i = 0; i < colstacks_used; i++) {
- colstack = &colstacks[i];
- for (j = 0; j < colstack->form_used; j++) {
- xfree(colstack->form_stack[j]);
- }
- colstack->form_used = 0;
- xfree(colstack->form_current);
- if (colstack->form_init == NULL) {
- colstack->form_current = NULL;
- } else {
- colstack->form_current = xstrdup(colstack->form_init);
- }
- }
-}
-
-integer colorstackskippagestart(int colstack_no)
-{
- colstack_type *colstack = get_colstack(colstack_no);
-
- if (!colstack->page_start) {
- return 1;
- }
- if (colstack->page_current == NULL) {
- return 0;
- }
- if (strcmp(COLOR_DEFAULT, colstack->page_current) == 0) {
- return 2;
- }
- return 0;
-}
-
-
-/* stack for \pdfsetmatrix */
-
-typedef struct {
- double a;
- double b;
- double c;
- double d;
- double e;
- double f;
-} matrix_entry;
-static matrix_entry *matrix_stack = 0;
-static int matrix_stack_size = 0;
-static int matrix_stack_used = 0;
-
-boolean matrixused(void)
-{
- return matrix_stack_used > 0;
-}
-
-/* stack for positions of \pdfsave */
-typedef struct {
- int pos_h;
- int pos_v;
- int matrix_stack;
-} pos_entry;
-static pos_entry *pos_stack = 0; /* the stack */
-static int pos_stack_size = 0; /* initially empty */
-static int pos_stack_used = 0; /* used entries */
-
-static void matrix_stack_room(void)
-{
- matrix_entry *new_stack;
-
- if (matrix_stack_used >= matrix_stack_size) {
- matrix_stack_size += STACK_INCREMENT;
- new_stack = xtalloc(matrix_stack_size, matrix_entry);
- memcpy((void *) new_stack, (void *) matrix_stack,
- matrix_stack_used * sizeof(matrix_entry));
- xfree(matrix_stack);
- matrix_stack = new_stack;
- }
-}
-
-void checkpdfsave(int cur_h, int cur_v)
-{
- pos_entry *new_stack;
-
- if (pos_stack_used >= pos_stack_size) {
- pos_stack_size += STACK_INCREMENT;
- new_stack = xtalloc(pos_stack_size, pos_entry);
- memcpy((void *) new_stack, (void *) pos_stack,
- pos_stack_used * sizeof(pos_entry));
- xfree(pos_stack);
- pos_stack = new_stack;
- }
- pos_stack[pos_stack_used].pos_h = cur_h;
- pos_stack[pos_stack_used].pos_v = cur_v;
- if (page_mode) {
- pos_stack[pos_stack_used].matrix_stack = matrix_stack_used;
- }
- pos_stack_used++;
-}
-
-void checkpdfrestore(int cur_h, int cur_v)
-{
- int diff_h, diff_v;
- if (pos_stack_used == 0) {
- pdftex_warn("%s", "\\pdfrestore: missing \\pdfsave");
- return;
- }
- pos_stack_used--;
- diff_h = cur_h - pos_stack[pos_stack_used].pos_h;
- diff_v = cur_v - pos_stack[pos_stack_used].pos_v;
- if (diff_h != 0 || diff_v != 0) {
- pdftex_warn("Misplaced \\pdfrestore by (%usp, %usp)", diff_h, diff_v);
- }
- if (page_mode) {
- matrix_stack_used = pos_stack[pos_stack_used].matrix_stack;
- }
-}
-
-void pdfshipoutbegin(boolean shipping_page)
-{
- pos_stack_used = 0; /* start with empty stack */
-
- page_mode = shipping_page;
- if (shipping_page) {
- colorstackpagestart();
- }
-}
-
-void pdfshipoutend(boolean shipping_page)
-{
- if (pos_stack_used > 0) {
- pdftex_fail("%u unmatched \\pdfsave after %s shipout",
- (unsigned int) pos_stack_used,
- ((shipping_page) ? "page" : "form"));
- }
-}
-
-/*
- \pdfsetmatrix{a b c d}
- e := cur_h
- f := cur_v
- M_top: current active matrix at the top of
- the matrix stack
-
- The origin of \pdfsetmatrix is the current point.
- The annotation coordinate system is the original
- page coordinate system. When pdfTeX calculates
- annotation rectangles it does not take into
- account this transformations, it uses the original
- coordinate system. To get the corrected values,
- first we go back to the origin, perform the
- transformation and go back:
-
- ( 1 0 0 ) ( a b 0 ) ( 1 0 0 )
- ( 0 1 0 ) x ( c d 0 ) x ( 0 1 0 ) x M_top
- ( -e -f 1 ) ( 0 0 1 ) ( e f 1 )
-
- ( 1 0 0 ) ( a b 0 )
- = ( 0 1 0 ) x ( c d 0 ) x M_top
- ( e f 1 ) ( -e -f 1 )
-
- ( a b 0 )
- = ( c d 0 ) x M_top
- ( e(1-a)-fc f(1-d)-eb 1 )
-
-*/
-
-integer pdfsetmatrix(poolpointer in, scaled cur_h, scaled cur_v)
-{
- /* Argument of \pdfsetmatrix starts with strpool[in] and ends
- before strpool[poolptr]. */
-
- matrix_entry x, *y, *z;
- char dummy;
-
- if (page_mode) {
- if (sscanf((const char *) &strpool[in], " %lf %lf %lf %lf %c",
- &x.a, &x.b, &x.c, &x.d, &dummy) != 4) {
- return 0; /* failure */
- }
- /* calculate this transformation matrix */
- x.e = (double) cur_h *(1.0 - x.a) - (double) cur_v *x.c;
- x.f = (double) cur_v *(1.0 - x.d) - (double) cur_h *x.b;
- matrix_stack_room();
- z = &matrix_stack[matrix_stack_used];
- if (matrix_stack_used > 0) {
- y = &matrix_stack[matrix_stack_used - 1];
- z->a = x.a * y->a + x.b * y->c;
- z->b = x.a * y->b + x.b * y->d;
- z->c = x.c * y->a + x.d * y->c;
- z->d = x.c * y->b + x.d * y->d;
- z->e = x.e * y->a + x.f * y->c + y->e;
- z->f = x.e * y->b + x.f * y->d + y->f;
- } else {
- z->a = x.a;
- z->b = x.b;
- z->c = x.c;
- z->d = x.d;
- z->e = x.e;
- z->f = x.f;
- }
- matrix_stack_used++;
- }
- return 1; /* success */
-}
-
-/* Apply matrix to point (x,y)
-
- ( a b 0 )
- ( x y 1 ) x ( c d 0 ) = ( xa+yc+e xb+yd+f 1 )
- ( e f 1 )
-
- If \pdfsetmatrix wasn't used, then return the value unchanged.
-*/
-
-/* Return valeus for matrix tranform functions */
-static scaled ret_llx;
-static scaled ret_lly;
-static scaled ret_urx;
-static scaled ret_ury;
-
-scaled getllx(void)
-{
- return ret_llx;
-}
-
-scaled getlly(void)
-{
- return ret_lly;
-}
-
-scaled geturx(void)
-{
- return ret_urx;
-}
-
-scaled getury(void)
-{
- return ret_ury;
-}
-
-static int last_llx;
-static int last_lly;
-static int last_urx;
-static int last_ury;
-
-#define DO_ROUND(x) ((x > 0) ? (x + .5) : (x - .5))
-#define DO_MIN(a, b) ((a < b) ? a : b)
-#define DO_MAX(a, b) ((a > b) ? a : b)
-
-static void do_matrixtransform(scaled x, scaled y, scaled * retx, scaled * rety)
-{
- matrix_entry *m = &matrix_stack[matrix_stack_used - 1];
- double x_old = x;
- double y_old = y;
- double x_new = x_old * m->a + y_old * m->c + m->e;
- double y_new = x_old * m->b + y_old * m->d + m->f;
- *retx = (scaled) DO_ROUND(x_new);
- *rety = (scaled) DO_ROUND(y_new);
-}
-
-void matrixtransformrect(scaled llx, scaled lly, scaled urx, scaled ury)
-{
- scaled x1, x2, x3, x4, y1, y2, y3, y4;
-
- if (page_mode && matrix_stack_used > 0) {
- last_llx = llx;
- last_lly = lly;
- last_urx = urx;
- last_ury = ury;
- do_matrixtransform(llx, lly, &x1, &y1);
- do_matrixtransform(llx, ury, &x2, &y2);
- do_matrixtransform(urx, lly, &x3, &y3);
- do_matrixtransform(urx, ury, &x4, &y4);
- ret_llx = DO_MIN(DO_MIN(x1, x2), DO_MIN(x3, x4));
- ret_lly = DO_MIN(DO_MIN(y1, y2), DO_MIN(y3, y4));
- ret_urx = DO_MAX(DO_MAX(x1, x2), DO_MAX(x3, x4));
- ret_ury = DO_MAX(DO_MAX(y1, y2), DO_MAX(y3, y4));
- } else {
- ret_llx = llx;
- ret_lly = lly;
- ret_urx = urx;
- ret_ury = ury;
- }
-}
-
-void matrixtransformpoint(scaled x, scaled y)
-{
- if (page_mode && matrix_stack_used > 0) {
- do_matrixtransform(x, y, &ret_llx, &ret_lly);
- } else {
- ret_llx = x;
- ret_lly = y;
- }
-}
-
-void matrixrecalculate(scaled urx)
-{
- matrixtransformrect(last_llx, last_lly, urx, last_ury);
-}
-
-void allocvffnts(void)
-{
- if (vf_e_fnts_array == NULL) {
- vf_e_fnts_array = vfefnts;
- vf_e_fnts_limit = fontmax;
- vf_e_fnts_ptr = vf_e_fnts_array;
- vf_i_fnts_array = vfifnts;
- vf_i_fnts_limit = fontmax;
- vf_i_fnts_ptr = vf_i_fnts_array;
- }
- alloc_array(vf_e_fnts, 1, fontmax);
- vf_e_fnts_ptr++;
- alloc_array(vf_i_fnts, 1, fontmax);
- vf_i_fnts_ptr++;
- if (vf_e_fnts_array != vfefnts) {
- vfefnts = vf_e_fnts_array;
- vfifnts = vf_i_fnts_array;
- }
-}
diff --git a/Build/source/texk/web2c/pdftexdir/vfpacket.c b/Build/source/texk/web2c/pdftexdir/vfpacket.c
deleted file mode 100644
index 8d7bd86c3a9..00000000000
--- a/Build/source/texk/web2c/pdftexdir/vfpacket.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/*
-Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-
-typedef struct {
- char *dataptr;
- integer len;
-} packet_entry;
-
-/* define packet_ptr, packet_array & packet_limit */
-define_array(packet);
-
-typedef struct {
- char **data;
- int *len;
- int char_count;
-} vf_entry;
-
-/* define vf_ptr, vf_array & vf_limit */
-define_array(vf);
-
-static char *packet_data_ptr;
-
-integer newvfpacket(internalfontnumber f)
-{
- int i, n = fontec[f] - fontbc[f] + 1;
- alloc_array(vf, 1, SMALL_ARRAY_SIZE);
- vf_ptr->len = xtalloc(n, int);
- vf_ptr->data = xtalloc(n, char *);
- vf_ptr->char_count = n;
- for (i = 0; i < n; i++) {
- vf_ptr->data[i] = NULL;
- vf_ptr->len[i] = 0;
- }
- return vf_ptr++ - vf_array;
-}
-
-void storepacket(internalfontnumber f, integer c, strnumber s)
-{
- int l = strstart[s + 1] - strstart[s];
- vf_array[vfpacketbase[f]].len[c - fontbc[f]] = l;
- vf_array[vfpacketbase[f]].data[c - fontbc[f]] = xtalloc(l, char);
- memcpy((void *) vf_array[vfpacketbase[f]].data[c - fontbc[f]],
- (void *) (strpool + strstart[s]), (unsigned) l);
-}
-
-void startpacket(internalfontnumber f, eightbits c)
-{
- packet_data_ptr = vf_array[vfpacketbase[f]].data[c - fontbc[f]];
- vfpacketlength = vf_array[vfpacketbase[f]].len[c - fontbc[f]];
-}
-
-eightbits packetbyte(void)
-{
- vfpacketlength--;
- return *packet_data_ptr++;
-}
-
-void pushpacketstate(void)
-{
- alloc_array(packet, 1, SMALL_ARRAY_SIZE);
- packet_ptr->dataptr = packet_data_ptr;
- packet_ptr->len = vfpacketlength;
- packet_ptr++;
-}
-
-void poppacketstate(void)
-{
- if (packet_ptr == packet_array)
- pdftex_fail("packet stack empty, impossible to pop");
- packet_ptr--;
- packet_data_ptr = packet_ptr->dataptr;
- vfpacketlength = packet_ptr->len;
-}
-
-void vf_free(void)
-{
- vf_entry *v;
- char **p;
- if (vf_array != NULL) {
- for (v = vf_array; v < vf_ptr; v++) {
- xfree(v->len);
- for (p = v->data; p - v->data < v->char_count; p++)
- xfree(*p);
- xfree(v->data);
- }
- xfree(vf_array);
- }
- xfree(packet_array);
-}
diff --git a/Build/source/texk/web2c/pdftexdir/wprob.test b/Build/source/texk/web2c/pdftexdir/wprob.test
deleted file mode 100755
index 893e65316fc..00000000000
--- a/Build/source/texk/web2c/pdftexdir/wprob.test
+++ /dev/null
@@ -1,19 +0,0 @@
-#! /bin/sh -vx
-# $Id: wprob.test 804 2018-05-17 22:29:15Z karl $
-# Copyright 2017-2018 Karl Berry <tex-live@tug.org>
-# Copyright 2011-2013 Peter Breitenlohner <tex-live@tug.org>
-# You may freely use, modify and/or distribute this file.
-
-rm -rf pwprob.*
-cp "$srcdir/tests/wprob.tex" ./pwprob.tex || exit 1
-
-TEXMFCNF=$srcdir/../kpathsea; export TEXMFCNF
-
-# this command is expected to fail.
-./pdftex --ini --etex --file-line-error --interaction=nonstopmode pwprob.tex \
-&& exit 1
-
-grep '^\./pwprob\.tex:12: Could not open file NoSuchFile\.eps\.$' \
- pwprob.log || exit 1
-
-exit 0
diff --git a/Build/source/texk/web2c/pdftexdir/writeenc.c b/Build/source/texk/web2c/pdftexdir/writeenc.c
deleted file mode 100644
index bd55103f917..00000000000
--- a/Build/source/texk/web2c/pdftexdir/writeenc.c
+++ /dev/null
@@ -1,180 +0,0 @@
-/*
-Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-
-/**********************************************************************/
-/* All encoding entries go into AVL tree for fast search by name. */
-
-struct avl_table *fe_tree = NULL;
-
-/* AVL sort fe_entry into fe_tree by name */
-
-static int comp_fe_entry(const void *pa, const void *pb, void *p)
-{
- return strcmp(((const fe_entry *) pa)->name, ((const fe_entry *) pb)->name);
-}
-
-static fe_entry *new_fe_entry(void)
-{
- fe_entry *fe;
- fe = xtalloc(1, fe_entry);
- fe->name = NULL;
- fe->fe_objnum = 0;
- fe->glyph_names = NULL; /* encoding file not yet read in */
- fe->tx_tree = NULL;
- return fe;
-}
-
-static fe_entry *lookup_fe_entry(char *s)
-{
- fe_entry fe;
- assert(s != NULL);
- fe.name = s;
- if (fe_tree == NULL) {
- fe_tree = avl_create(comp_fe_entry, NULL, &avl_xallocator);
- assert(fe_tree != NULL);
- }
- return (fe_entry *) avl_find(fe_tree, &fe);
-}
-
-static void register_fe_entry(fe_entry * fe)
-{
- void **aa;
- if (fe_tree == NULL) {
- fe_tree = avl_create(comp_fe_entry, NULL, &avl_xallocator);
- assert(fe_tree != NULL);
- }
- assert(fe != NULL);
- assert(fe->name != NULL);
- assert(lookup_fe_entry(fe->name) == NULL); /* encoding not yet registered */
- aa = avl_probe(fe_tree, fe);
- assert(aa != NULL);
-}
-
-fe_entry *get_fe_entry(char *s)
-{
- fe_entry *fe;
- char **gl;
- if ((fe = lookup_fe_entry(s)) == NULL && (gl = load_enc_file(s)) != NULL) {
- fe = new_fe_entry();
- fe->name = s;
- fe->glyph_names = gl;
- register_fe_entry(fe);
- }
- return fe;
-}
-
-/**********************************************************************/
-
-void epdf_write_enc(char **glyph_names, int fe_objnum)
-{
- int i, i_old;
- assert(glyph_names != NULL);
- assert(fe_objnum != 0);
- pdfbegindict(fe_objnum, 1);
- pdf_puts("/Type /Encoding\n");
- pdf_puts("/Differences [");
- for (i = 0, i_old = -2; i < 256; i++)
- if (glyph_names[i] != notdef) {
- if (i == i_old + 1) /* no gap */
- pdf_printf("/%s", glyph_names[i]);
- else {
- if (i_old == -2)
- pdf_printf("%i/%s", i, glyph_names[i]);
- else
- pdf_printf(" %i/%s", i, glyph_names[i]);
- }
- i_old = i;
- }
- pdf_puts("]\n");
- pdfenddict();
-}
-
-static void write_enc(char **glyph_names, struct avl_table *tx_tree, int fe_objnum)
-{
- int i_old, *p;
- struct avl_traverser t;
- assert(glyph_names != NULL);
- assert(tx_tree != NULL);
- assert(fe_objnum != 0);
- pdfbegindict(fe_objnum, 1);
- pdf_puts("/Type /Encoding\n");
- pdf_puts("/Differences [");
- avl_t_init(&t, tx_tree);
- for (i_old = -2, p = (int *) avl_t_first(&t, tx_tree); p != NULL;
- p = (int *) avl_t_next(&t)) {
- if (*p == i_old + 1) /* no gap */
- pdf_printf("/%s", glyph_names[*p]);
- else {
- if (i_old == -2)
- pdf_printf("%i/%s", *p, glyph_names[*p]);
- else
- pdf_printf(" %i/%s", *p, glyph_names[*p]);
- }
- i_old = *p;
- }
- pdf_puts("]\n");
- pdfenddict();
-}
-
-static void write_fontencoding(fe_entry * fe)
-{
- assert(fe != NULL);
- write_enc(fe->glyph_names, fe->tx_tree, fe->fe_objnum);
-}
-
-void write_fontencodings(void)
-{
- fe_entry *fe;
- struct avl_traverser t;
- if (fe_tree == NULL)
- return;
- avl_t_init(&t, fe_tree);
- for (fe = (fe_entry *) avl_t_first(&t, fe_tree); fe != NULL;
- fe = (fe_entry *) avl_t_next(&t))
- if (fe->fe_objnum != 0)
- write_fontencoding(fe);
-}
-
-/**********************************************************************/
-/* cleaning up... */
-
-static void destroy_fe_entry(void *pa, void *pb)
-{
- fe_entry *p;
- int i;
- p = (fe_entry *) pa;
- xfree(p->name);
- if (p->glyph_names != NULL)
- for (i = 0; i < 256; i++)
- if (p->glyph_names[i] != notdef)
- xfree(p->glyph_names[i]);
- xfree(p->glyph_names);
- xfree(p);
-}
-
-void enc_free(void)
-{
- if (fe_tree != NULL)
- avl_destroy(fe_tree, destroy_fe_entry);
- fe_tree = NULL;
-}
-
-/**********************************************************************/
diff --git a/Build/source/texk/web2c/pdftexdir/writefont.c b/Build/source/texk/web2c/pdftexdir/writefont.c
deleted file mode 100644
index ec073e0edff..00000000000
--- a/Build/source/texk/web2c/pdftexdir/writefont.c
+++ /dev/null
@@ -1,720 +0,0 @@
-/* writefont.c: font descriptors and writing Type 1 fonts.
-Copyright 1996-2018 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-
-/**********************************************************************/
-
-struct avl_table *fo_tree = NULL; /* tree of font dictionaries */
-struct avl_table *fd_tree = NULL; /* tree of font descriptor objects */
-
-static int comp_fo_entry(const void *pa, const void *pb, void *p)
-{
- return strcmp(((const fo_entry *) pa)->fm->tfm_name,
- ((const fo_entry *) pb)->fm->tfm_name);
-}
-
-static int comp_fd_entry(const void *pa, const void *pb, void *p)
-{
- int i;
- const fd_entry *p1 = (const fd_entry *) pa, *p2 = (const fd_entry *) pb;
- assert(p1->fm != NULL && is_fontfile(p1->fm) &&
- p2->fm != NULL && is_fontfile(p2->fm));
- if ((i = strcmp(p1->fm->ff_name, p2->fm->ff_name)) != 0)
- return i;
- cmp_return(p1->fm->slant, p2->fm->slant);
- cmp_return(p1->fm->extend, p2->fm->extend);
- return 0;
-}
-
-/**********************************************************************/
-/* initialize data structure for /Type /Font */
-
-static fo_entry *new_fo_entry(void)
-{
- fo_entry *fo;
- fo = xtalloc(1, fo_entry);
- fo->fo_objnum = 0;
- fo->tex_font = 0;
- fo->fm = NULL;
- fo->fd = NULL;
- fo->fe = NULL;
- fo->cw = NULL;
- fo->first_char = 1;
- fo->last_char = 0;
- fo->tounicode_objnum = 0;
- return fo;
-}
-
-/* initialize data structure for /Type /FontDescriptor */
-
-fd_entry *new_fd_entry(void)
-{
- fd_entry *fd;
- int i;
- fd = xtalloc(1, fd_entry);
- fd->fd_objnum = 0;
- fd->fontname = NULL;
- fd->subset_tag = NULL;
- fd->ff_found = false;
- fd->ff_objnum = 0;
- fd->fn_objnum = 0;
- fd->all_glyphs = false;
- fd->write_ttf_glyph_names = false;
- for (i = 0; i < FONT_KEYS_NUM; i++) {
- fd->font_dim[i].val = 0;
- fd->font_dim[i].set = false;
- }
- fd->fe = NULL;
- fd->builtin_glyph_names = NULL;
- fd->fm = NULL;
- fd->tx_tree = NULL;
- fd->gl_tree = NULL;
- return fd;
-}
-
-/* initialize data structure for /Widths array object */
-
-static cw_entry *new_cw_entry(void)
-{
- cw_entry *cw;
- cw = xtalloc(1, cw_entry);
- cw->cw_objnum = 0;
- cw->width = NULL;
- return cw;
-}
-
-/**********************************************************************/
-/*
- * Only fallback values of font metrics are taken from the TFM info
- * of f by preset_fontmetrics(). During reading of the font file,
- * these values are replaced by metrics from the font, if available.
- */
-
-static void preset_fontmetrics(fd_entry * fd, internalfontnumber f)
-{
- int i;
- fd->font_dim[ITALIC_ANGLE_CODE].val =
- dividescaled(-atan(getslant(f) / 65536.0) * (180 / M_PI),
- pdffontsize[f], 3);
- fd->font_dim[ASCENT_CODE].val =
- dividescaled(getcharheight(f, 'h'), pdffontsize[f], 3);
- fd->font_dim[CAPHEIGHT_CODE].val =
- dividescaled(getcharheight(f, 'H'), pdffontsize[f], 3);
- i = -dividescaled(getchardepth(f, 'y'), pdffontsize[f], 3);
- fd->font_dim[DESCENT_CODE].val = i < 0 ? i : 0;
- fd->font_dim[STEMV_CODE].val =
- dividescaled(getcharwidth(f, '.') / 3, pdffontsize[f], 3);
- fd->font_dim[XHEIGHT_CODE].val =
- dividescaled(getxheight(f), pdffontsize[f], 3);
- fd->font_dim[FONTBBOX1_CODE].val = 0;
- fd->font_dim[FONTBBOX2_CODE].val = fd->font_dim[DESCENT_CODE].val;
- fd->font_dim[FONTBBOX3_CODE].val =
- dividescaled(getquad(f), pdffontsize[f], 3);
- fd->font_dim[FONTBBOX4_CODE].val =
- fd->font_dim[CAPHEIGHT_CODE].val > fd->font_dim[ASCENT_CODE].val ?
- fd->font_dim[CAPHEIGHT_CODE].val : fd->font_dim[ASCENT_CODE].val;
- for (i = 0; i < INT_KEYS_NUM; i++)
- fd->font_dim[i].set = true;
-}
-
-static void fix_fontmetrics(fd_entry * fd)
-{
- intparm *p = (intparm *) fd->font_dim;
- if (!p[FONTBBOX1_CODE].set || !p[FONTBBOX2_CODE].set ||
- !p[FONTBBOX3_CODE].set || !p[FONTBBOX4_CODE].set) {
- pdftex_warn("font `%s' doesn't have a BoundingBox", fd->fm->ff_name);
- return;
- }
- if (!p[ASCENT_CODE].set) {
- p[ASCENT_CODE].val = p[FONTBBOX4_CODE].val;
- p[ASCENT_CODE].set = true;
- }
- if (!p[DESCENT_CODE].set) {
- p[DESCENT_CODE].val = p[FONTBBOX2_CODE].val;
- p[DESCENT_CODE].set = true;
- }
- if (!p[CAPHEIGHT_CODE].set) {
- p[CAPHEIGHT_CODE].val = p[FONTBBOX4_CODE].val;
- p[CAPHEIGHT_CODE].set = true;
- }
-}
-
-static void write_fontmetrics(fd_entry * fd)
-{
- int i;
- fix_fontmetrics(fd);
- if (fd->font_dim[FONTBBOX1_CODE].set && fd->font_dim[FONTBBOX2_CODE].set
- && fd->font_dim[FONTBBOX3_CODE].set && fd->font_dim[FONTBBOX4_CODE].set)
- pdf_printf("/%s [%i %i %i %i]\n", font_key[FONTBBOX1_CODE].pdfname,
- (int) fd->font_dim[FONTBBOX1_CODE].val,
- (int) fd->font_dim[FONTBBOX2_CODE].val,
- (int) fd->font_dim[FONTBBOX3_CODE].val,
- (int) fd->font_dim[FONTBBOX4_CODE].val);
- for (i = 0; i < GEN_KEY_NUM; i++)
- if (fd->font_dim[i].set)
- pdf_printf("/%s %i\n", font_key[i].pdfname, fd->font_dim[i].val);
-}
-
-/**********************************************************************/
-
-static void preset_fontname(fo_entry * fo)
-{
- if (fo->fm->ps_name != NULL)
- fo->fd->fontname = xstrdup(fo->fm->ps_name); /* just fallback */
- else
- fo->fd->fontname = xstrdup(fo->fm->tfm_name);
-}
-
-static void write_fontname(fd_entry * fd, const char *key)
-{
- assert(fd->fontname != NULL);
- pdf_puts("/");
- if (key != NULL)
- pdf_printf("%s /", key);
- if (fd->subset_tag != NULL)
- pdf_printf("%s+", fd->subset_tag);
- pdf_printf("%s\n", fd->fontname);
-}
-
-static void write_fontname_object(fd_entry * fd)
-{
- assert(fd->fn_objnum != 0);
- pdfbeginobj(fd->fn_objnum, 1);
- write_fontname(fd, NULL);
- pdfendobj();
-}
-
-/**********************************************************************/
-
-fd_entry *lookup_fd_entry(char *s, integer slant, integer extend)
-{
- fd_entry fd;
- fm_entry fm;
- assert(s != NULL);
- fm.ff_name = s;
- fm.slant = slant;
- fm.extend = extend;
- fd.fm = &fm;
- if (fd_tree == NULL) {
- fd_tree = avl_create(comp_fd_entry, NULL, &avl_xallocator);
- assert(fd_tree != NULL);
- }
- return (fd_entry *) avl_find(fd_tree, &fd);
-}
-
-static fd_entry *lookup_fontdescriptor(fo_entry * fo)
-{
- assert(fo != NULL);
- assert(fo->fm != NULL);
- assert(is_fontfile(fo->fm));
- return lookup_fd_entry(fo->fm->ff_name, fo->fm->slant, fo->fm->extend);
-}
-
-void register_fd_entry(fd_entry * fd)
-{
- void **aa;
- if (fd_tree == NULL) {
- fd_tree = avl_create(comp_fd_entry, NULL, &avl_xallocator);
- assert(fd_tree != NULL);
- }
- assert(fd != NULL && fd->fm != NULL && is_fontfile(fd->fm));
- assert(lookup_fd_entry(fd->fm->ff_name, fd->fm->slant, fd->fm->extend) == NULL); /* font descriptor not yet registered */
- aa = avl_probe(fd_tree, fd);
- assert(aa != NULL);
-}
-
-static void create_fontdescriptor(fo_entry * fo, internalfontnumber f)
-{
- assert(fo != NULL);
- assert(fo->fm != NULL);
- assert(fo->fd == NULL);
- fo->fd = new_fd_entry();
- preset_fontname(fo);
- preset_fontmetrics(fo->fd, f);
- fo->fd->fe = fo->fe; /* encoding needed by TrueType writing */
- fo->fd->fm = fo->fm; /* map entry needed by TrueType writing */
- fo->fd->gl_tree = avl_create(comp_string_entry, NULL, &avl_xallocator);
- assert(fo->fd->gl_tree != NULL);
-}
-
-/**********************************************************************/
-/*
- * For all used characters of TeX font f, get corresponding glyph names
- * from external reencoding (.enc) file and collect these in the glyph
- * tree gl_tree of font descriptor fd referenced by font dictionary fo.
- */
-
-static void mark_reenc_glyphs(fo_entry * fo, internalfontnumber f)
-{
- int i;
- char **g;
- void **aa;
- assert(fo->fe != NULL);
- if (is_subsetted(fo->fm)) {
- assert(is_included(fo->fm));
- /* mark glyphs from TeX (externally reencoded characters) */
- g = fo->fe->glyph_names;
- for (i = fo->first_char; i <= fo->last_char; i++) {
- if (pdfcharmarked(f, i) && g[i] != notdef
- && (char *) avl_find(fo->fd->gl_tree, g[i]) == NULL) {
- aa = avl_probe(fo->fd->gl_tree, xstrdup(g[i]));
- assert(aa != NULL);
- }
- }
- }
-}
-
-/*
- * Function mark_chars() has 2 uses:
- * 1. Mark characters as chars on TeX level.
- * 2. Mark encoding pairs used by TeX to optimize encoding vector.
- */
-
-static struct avl_table *mark_chars(fo_entry * fo, struct avl_table *tx_tree,
- internalfontnumber f)
-{
- int i, *j;
- void **aa;
- if (tx_tree == NULL) {
- tx_tree = avl_create(comp_int_entry, NULL, &avl_xallocator);
- assert(tx_tree != NULL);
- }
- for (i = fo->first_char; i <= fo->last_char; i++) {
- if (pdfcharmarked(f, i) && (int *) avl_find(tx_tree, &i) == NULL) {
- j = xtalloc(1, int);
- *j = i;
- aa = avl_probe(tx_tree, j);
- assert(aa != NULL);
- }
- }
- return tx_tree;
-}
-
-/**********************************************************************/
-
-static void get_char_range(fo_entry * fo, internalfontnumber f)
-{
- int i;
- assert(fo != NULL);
- for (i = fontbc[f]; i <= fontec[f]; i++) /* search for first_char and last_char */
- if (pdfcharmarked(f, i))
- break;
- fo->first_char = i;
- for (i = fontec[f]; i >= fontbc[f]; i--)
- if (pdfcharmarked(f, i))
- break;
- fo->last_char = i;
- if ((fo->first_char > fo->last_char)
- || !pdfcharmarked(f, fo->first_char)) { /* no character used from this font */
- fo->last_char = 0;
- fo->first_char = fo->last_char + 1;
- }
-}
-
-static void create_charwidth_array(fo_entry * fo, internalfontnumber f)
-{
- int i;
- assert(fo != NULL);
- assert(fo->cw == NULL);
- fo->cw = new_cw_entry();
- fo->cw->width = xtalloc(256, integer);
- for (i = 0; i < fo->first_char; i++)
- fo->cw->width[i] = 0;
- for (i = fo->first_char; i <= fo->last_char; i++)
- fo->cw->width[i] = dividescaled(getcharwidth(f, i), pdffontsize[f], 4);
- for (i = fo->last_char + 1; i < 256; i++)
- fo->cw->width[i] = 0;
-}
-
-static void write_charwidth_array(fo_entry * fo)
-{
- int i, j;
- assert(fo->cw != NULL);
- assert(fo->cw->cw_objnum == 0);
- fo->cw->cw_objnum = pdfnewobjnum();
- pdfbeginobj(fo->cw->cw_objnum, 1);
- pdf_puts("[");
- for (i = fo->first_char; i <= fo->last_char; i++) {
- pdf_printf("%i", (int) fo->cw->width[i] / 10); /* see adv_char_width() in pdftex.web */
- if ((j = fo->cw->width[i] % 10) != 0)
- pdf_printf(".%i", j);
- if (i != fo->last_char)
- pdf_puts(" ");
- }
- pdf_puts("]\n");
- pdfendobj();
-}
-
-/**********************************************************************/
-/*
- * Remark: Font objects from embedded PDF files are never registered
- * into fo_tree; they are individually written out.
- */
-
-static fo_entry *lookup_fo_entry(char *s)
-{
- fo_entry fo;
- fm_entry fm;
- assert(s != NULL);
- fm.tfm_name = s;
- fo.fm = &fm;
- if (fo_tree == NULL) {
- fo_tree = avl_create(comp_fo_entry, NULL, &avl_xallocator);
- assert(fo_tree != NULL);
- }
- return (fo_entry *) avl_find(fo_tree, &fo);
-}
-
-static void register_fo_entry(fo_entry * fo)
-{
- void **aa;
- if (fo_tree == NULL) {
- fo_tree = avl_create(comp_fo_entry, NULL, &avl_xallocator);
- assert(fo_tree != NULL);
- }
- assert(fo != NULL);
- assert(fo->fm != NULL);
- assert(fo->fm->tfm_name != NULL);
- assert(lookup_fo_entry(fo->fm->tfm_name) == NULL);
- aa = avl_probe(fo_tree, fo);
- assert(aa != NULL);
-}
-
-/**********************************************************************/
-
-static void write_fontfile(fd_entry * fd)
-{
- assert(is_included(fd->fm));
- if (is_type1(fd->fm))
- writet1(fd);
- else if (is_truetype(fd->fm))
- writettf(fd);
- else if (is_opentype(fd->fm))
- writeotf(fd);
- else
- assert(0);
- if (!fd->ff_found)
- return;
- assert(fd->ff_objnum == 0);
- fd->ff_objnum = pdfnewobjnum();
- pdfbegindict(fd->ff_objnum, 0); /* font file stream */
- if (is_type1(fd->fm))
- pdf_printf("/Length1 %i\n/Length2 %i\n/Length3 %i\n",
- (int) t1_length1, (int) t1_length2, (int) t1_length3);
- else if (is_truetype(fd->fm))
- pdf_printf("/Length1 %i\n", (int) ttf_length);
- else if (is_opentype(fd->fm))
- pdf_puts("/Subtype /Type1C\n");
- else
- assert(0);
- pdfbeginstream();
- fb_flush();
- pdfendstream();
-}
-
-/**********************************************************************/
-
-static void write_fontdescriptor(fd_entry * fd)
-{
- static const int std_flags[] = {
- /* indices for << start with 0, but bits start with 1, so the numbers
- * for << are 1 lower than the bits in table 5.20 */
- /* *INDENT-OFF* */
- 1 + 2 + (1 << 5), /* Courier */
- 1 + 2 + (1 << 5) + (1 << 18),/* Courier-Bold */
- 1 + 2 + (1 << 5) + (1 << 6), /* Courier-Oblique */
- 1 + 2 + (1 << 5) + (1 << 6) + (1 << 18),/* Courier-BoldOblique */
- (1 << 5), /* Helvetica */
- (1 << 5) + (1 << 18),/* Helvetica-Bold */
- (1 << 5) + (1 << 6), /* Helvetica-Oblique */
- (1 << 5) + (1 << 6) + (1 << 18),/* Helvetica-BoldOblique */
- 4, /* Symbol */
- 2 + (1 << 5), /* Times-Roman */
- 2 + (1 << 5) + (1 << 18),/* Times-Bold */
- 2 + (1 << 5) + (1 << 6), /* Times-Italic */
- 2 + (1 << 5) + (1 << 6) + (1 << 18),/* Times-BoldItalic */
- 4 /* ZapfDingbats */
- /* *INDENT-ON* */
- };
- char *glyph;
- struct avl_traverser t;
- int fd_flags;
- assert(fd != NULL && fd->fm != NULL);
-
- if (is_fontfile(fd->fm))
- write_fontfile(fd); /* this will set fd->ff_found if font file is found */
- if (fd->fn_objnum != 0)
- write_fontname_object(fd);
- if (fd->fd_objnum == 0)
- fd->fd_objnum = pdfnewobjnum();
- pdfbegindict(fd->fd_objnum, 1);
- pdf_puts("/Type /FontDescriptor\n");
- write_fontname(fd, "FontName");
- if (fd->fm->fd_flags != FD_FLAGS_NOT_SET_IN_MAPLINE)
- fd_flags = (int) fd->fm->fd_flags;
- else if (fd->ff_found)
- fd_flags = FD_FLAGS_DEFAULT_EMBED;
- else {
- fd_flags = is_std_t1font(fd->fm)
- ? std_flags[check_std_t1font(fd->fm->ps_name)]
- : FD_FLAGS_DEFAULT_NON_EMBED;
- pdftex_warn
- ("No flags specified for non-embedded font `%s' (%s) (I'm using %i): "
- "fix your map entry.",
- fd->fm->ps_name != NULL ? fd->fm->ps_name : "No name given",
- fd->fm->tfm_name, fd_flags);
- }
- pdf_printf("/Flags %i\n", fd_flags);
- write_fontmetrics(fd);
- if (fd->ff_found) {
- if (getpdfomitcharset() == 0 && is_subsetted(fd->fm) && is_type1(fd->fm)) {
- /* We don't get CharSet right. For some PDF standards,
- CharSet is optional, but if it appears, it must be
- correct. Unfortunately, there seems to be no practical
- way we can guarantee correctness with precomposed accent
- characters in our usual fonts (EC, TX, etc.):
- https://mailman.ntg.nl/pipermail/ntg-pdftex/2018-June/004251.html
-
- But for PDF/A-1, apparently it is required, regardless:
- https://mailman.ntg.nl/pipermail/ntg-pdftex/2019-January/004264.html
-
- Whereas for PDF/A-2 and PDF/A-3, it can be omitted:
- https://github.com/veraPDF/veraPDF-validation-profiles/wiki/PDFA-Parts-2-and-3-rules#rule-62114-3
-
- Therefore, whether it is output can be controlled by the
- user at runtime via \pdfincludecharset. */
- assert(fd->gl_tree != NULL);
- avl_t_init(&t, fd->gl_tree);
- /* Names may appear in any order. */
- pdf_puts("/CharSet (");
- for (glyph = (char *) avl_t_first(&t, fd->gl_tree); glyph != NULL;
- glyph = (char *) avl_t_next(&t))
- pdf_printf("/%s", glyph);
- pdf_puts(")\n");
- }
-
- if (is_type1(fd->fm))
- pdf_printf("/FontFile %i 0 R\n", (int) fd->ff_objnum);
- else if (is_truetype(fd->fm))
- pdf_printf("/FontFile2 %i 0 R\n", (int) fd->ff_objnum);
- else if (is_opentype(fd->fm))
- pdf_printf("/FontFile3 %i 0 R\n", (int) fd->ff_objnum);
- else
- assert(0);
- }
- pdfenddict();
-}
-
-static void write_fontdescriptors(void)
-{
- fd_entry *fd;
- struct avl_traverser t;
- if (fd_tree == NULL)
- return;
- avl_t_init(&t, fd_tree);
- for (fd = (fd_entry *) avl_t_first(&t, fd_tree); fd != NULL;
- fd = (fd_entry *) avl_t_next(&t))
- write_fontdescriptor(fd);
-}
-
-/**********************************************************************/
-
-static void write_fontdictionary(fo_entry * fo)
-{
- assert(fo != NULL);
- assert(fo->fm != NULL);
- assert(fo->fo_objnum != 0); /* reserved as pdf_font_num[f] in pdftex.web */
- assert(fo->tex_font != 0);
-
- /* write ToUnicode entry if needed */
- if ((fixedgentounicode > 0 && fo->fd != NULL
- && !pdffontnobuiltintounicode[fo->tex_font])
- || (fo->fd != NULL && fo->fm->tfm_name != NULL
- && strcmp(fo->fm->tfm_name, "dummy-space")) == 0) {
- if (fo->fe != NULL) {
- fo->tounicode_objnum =
- write_tounicode(fo->fe->glyph_names, fo->fm->tfm_name, fo->fe->name);
- } else if (is_type1(fo->fm)) {
- assert(fo->fd->builtin_glyph_names != NULL);
- fo->tounicode_objnum =
- write_tounicode(fo->fd->builtin_glyph_names, fo->fm->tfm_name, NULL);
- }
- }
-
- pdfbegindict(fo->fo_objnum, 1);
- pdf_puts("/Type /Font\n");
- pdf_puts("/Subtype /");
- if (is_type1(fo->fm))
- pdf_printf("%s\n", "Type1");
- else if (is_truetype(fo->fm))
- pdf_printf("%s\n", "TrueType");
- else if (is_opentype(fo->fm))
- pdf_printf("%s\n", "Type1");
- else
- assert(0);
- assert(fo->fd != NULL && fo->fd->fd_objnum != 0);
- write_fontname(fo->fd, "BaseFont");
- pdf_printf("/FontDescriptor %i 0 R\n", (int) fo->fd->fd_objnum);
- assert(fo->cw != NULL);
- pdf_printf("/FirstChar %i\n/LastChar %i\n/Widths %i 0 R\n",
- (int) fo->first_char, (int) fo->last_char,
- (int) fo->cw->cw_objnum);
- if ((is_type1(fo->fm) || is_opentype(fo->fm)) && fo->fe != NULL
- && fo->fe->fe_objnum != 0)
- pdf_printf("/Encoding %i 0 R\n", (int) fo->fe->fe_objnum);
- if (fo->tounicode_objnum != 0)
- pdf_printf("/ToUnicode %i 0 R\n", (int) fo->tounicode_objnum);
- if (pdffontattr[fo->tex_font] != getnullstr()) {
- pdfprint(pdffontattr[fo->tex_font]);
- pdf_puts("\n");
- }
- pdfenddict();
-}
-
-static void write_fontdictionaries(void)
-{
- fo_entry *fo;
- struct avl_traverser t;
- if (fo_tree == NULL)
- return;
- avl_t_init(&t, fo_tree);
- for (fo = (fo_entry *) avl_t_first(&t, fo_tree); fo != NULL;
- fo = (fo_entry *) avl_t_next(&t))
- write_fontdictionary(fo);
-}
-
-/**********************************************************************/
-/*
- * Final flush of all font related stuff by call from
- * @<Output fonts definition@>= in pdftex.web.
- */
-
-void writefontstuff(void)
-{
- write_fontdescriptors();
- write_fontencodings(); /* see writeenc.c */
- write_fontdictionaries();
-}
-
-/**********************************************************************/
-
-static void create_fontdictionary(fm_entry * fm, integer font_objnum,
- internalfontnumber f)
-{
- fo_entry *fo = new_fo_entry();
- get_char_range(fo, f); /* set fo->first_char and fo->last_char from f */
- assert(fo->last_char >= fo->first_char);
- fo->fm = fm;
- fo->fo_objnum = font_objnum;
- fo->tex_font = f;
- if (is_reencoded(fo->fm)) { /* at least the map entry tells so */
- fo->fe = get_fe_entry(fo->fm->encname); /* returns NULL if .enc file couldn't be opened */
- if (fo->fe != NULL && (is_type1(fo->fm) || is_opentype(fo->fm))) {
- if (fo->fe->fe_objnum == 0)
- fo->fe->fe_objnum = pdfnewobjnum(); /* then it will be written out */
- /* mark encoding pairs used by TeX to optimize encoding vector */
- fo->fe->tx_tree = mark_chars(fo, fo->fe->tx_tree, f);
- }
- }
- if (!is_builtin(fo->fm)) {
- if (is_type1(fo->fm)) {
- if ((fo->fd = lookup_fontdescriptor(fo)) == NULL) {
- create_fontdescriptor(fo, f);
- register_fd_entry(fo->fd);
- }
- } else
- create_fontdescriptor(fo, f);
- create_charwidth_array(fo, f);
- write_charwidth_array(fo);
- if (fo->fe != NULL) {
- mark_reenc_glyphs(fo, f);
- if (!is_type1(fo->fm)) {
- /* mark reencoded characters as chars on TeX level */
- assert(fo->fd->tx_tree == NULL);
- fo->fd->tx_tree = mark_chars(fo, fo->fd->tx_tree, f);
- if (is_truetype(fo->fm))
- fo->fd->write_ttf_glyph_names = true;
- }
- } else
- /* mark non-reencoded characters as chars on TeX level */
- fo->fd->tx_tree = mark_chars(fo, fo->fd->tx_tree, f);
- if (!is_type1(fo->fm))
- write_fontdescriptor(fo->fd);
- } else {
- /* builtin fonts still need the /Widths array and /FontDescriptor
- * (to avoid error 'font FOO contains bad /BBox')
- */
- create_charwidth_array(fo, f);
- write_charwidth_array(fo);
- create_fontdescriptor(fo, f);
- write_fontdescriptor(fo->fd);
- if (!is_std_t1font(fo->fm))
- pdftex_warn("font `%s' is not a standard font; "
- "I suppose it is available to your PDF viewer then",
- fo->fm->ps_name);
- }
- if (is_type1(fo->fm))
- register_fo_entry(fo);
- else
- write_fontdictionary(fo);
-}
-
-
-
-/* This is called font_has_subset in luatex, but it returns 1 if any
- characters from the font are used, and 0 if not (using fontbc and
- fontec as the endpoints to check), i.e., whether any characters are
- actually used from the font. */
-
-static int
-font_is_used(internalfontnumber f)
-{
- int i, s;
- /* search for |first_char| and |last_char| */
- for (i = fontbc[f]; i <= fontec[f]; i++)
- if (pdfcharmarked(f, i))
- break;
- s = i;
- for (i = fontec[f]; i >= fontbc[f]; i--)
- if (pdfcharmarked(f, i))
- break;
- if (s > i)
- return 0;
- else
- return 1;
-}
-
-void
-dopdffont(integer font_objnum, internalfontnumber f)
-{
- fm_entry *fm;
- if (!font_is_used(f))
- return; /* avoid failed assertion in create_fontdictionary,
- mailman.ntg.nl/pipermail/ntg-pdftex/2018-January/004209.html */
-
-
- fm = hasfmentry(f) ? (fm_entry *) pdffontmap[f] : NULL;
- if (fm == NULL || is_pk(fm))
- writet3(fm, font_objnum, f);
- else
- create_fontdictionary(fm, font_objnum, f);
-}
-
-// vim: ts=4
diff --git a/Build/source/texk/web2c/pdftexdir/writeimg.c b/Build/source/texk/web2c/pdftexdir/writeimg.c
deleted file mode 100644
index c4d2feda7c3..00000000000
--- a/Build/source/texk/web2c/pdftexdir/writeimg.c
+++ /dev/null
@@ -1,549 +0,0 @@
-/*
-Copyright 1996-2021 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-#include "image.h"
-#include <kpathsea/c-auto.h>
-#include <kpathsea/c-memstr.h>
-
-#define bp2int(p) round(p*(onehundredbp/100.0))
-
-/* define image_ptr, image_array & image_limit */
-/* define_array(image); */
-
-/* avoid use of size_t */
-image_entry *image_ptr, *image_array = NULL;
-integer image_limit;
-
-float epdf_width;
-float epdf_height;
-float epdf_orig_x;
-float epdf_orig_y;
-float epdf_rotate;
-int epdf_selected_page;
-int epdf_num_pages;
-int epdf_page_box;
-void *epdf_doc;
-int epdf_has_page_group;
-
-static integer new_image_entry(void)
-{
- alloc_array(image, 1, SMALL_BUF_SIZE);
- image_ptr->image_type = IMAGE_TYPE_NONE;
- image_ptr->color_type = 0;
- image_ptr->num_pages = 0;
- image_ptr->x_res = 0;
- image_ptr->y_res = 0;
- image_ptr->width = 0;
- image_ptr->height = 0;
- image_ptr->rotate = 0;
- image_ptr->colorspace_ref = 0;
- image_ptr->group_ref = 0;
- return image_ptr++ - image_array;
-}
-
-integer imagecolor(integer img)
-{
- return img_color(img);
-}
-
-integer imagewidth(integer img)
-{
- return img_width(img);
-}
-
-integer imageheight(integer img)
-{
- return img_height(img);
-}
-
-integer imagerotate(integer img)
-{
- return img_rotate(img);
-}
-
-integer imagexres(integer img)
-{
- return img_xres(img);
-}
-
-integer imageyres(integer img)
-{
- return img_yres(img);
-}
-
-boolean ispdfimage(integer img)
-{
- return img_type(img) == IMAGE_TYPE_PDF;
-}
-
-boolean ispngimage(integer img)
-{
- return img_type(img) == IMAGE_TYPE_PNG;
-}
-
-boolean checkimageb(integer procset)
-{
- return procset & IMAGE_COLOR_B;
-}
-
-boolean checkimagec(integer procset)
-{
- return procset & IMAGE_COLOR_C;
-}
-
-boolean checkimagei(integer procset)
-{
- return procset & IMAGE_COLOR_I;
-}
-
-void updateimageprocset(integer img)
-{
- pdfimageprocset |= img_color(img);
-}
-
-integer epdforigx(integer img)
-{
- return pdf_ptr(img)->orig_x;
-}
-
-integer epdforigy(integer img)
-{
- return pdf_ptr(img)->orig_y;
-}
-
-integer imagepages(integer img)
-{
- return img_pages(img);
-}
-
-integer imagecolordepth(integer img)
-{
- switch (img_type(img)) {
- case IMAGE_TYPE_PNG:
- return png_get_bit_depth(png_ptr(img), png_info(img));
- case IMAGE_TYPE_JPG:
- return jpg_ptr(img)->bits_per_component;
- case IMAGE_TYPE_JBIG2:
- return 0;
- case IMAGE_TYPE_PDF:
- return 0;
- default:
- pdftex_fail("unknown type of image");
- return -1; /* to make the compiler happy */
- }
-}
-
-integer getimagegroupref(integer img)
-{
- return img_group_ref(img);
-}
-
-void setimagegroupref(integer img, integer value)
-{
- img_group_ref(img) = value;
-}
-
-/*
- Patch ImageTypeDetection 2003/02/08 by Heiko Oberdiek.
-
- Function "readimage" performs some basic initializations.
- Then it looks at the file extension to determine the
- image type and calls specific code/functions.
- The main disadvantage is that standard file extensions
- have to be used, otherwise pdfTeX is not able to detect
- the correct image type.
-
- The patch now looks at the file header first regardless of
- the file extension. This is implemented in function
- "checktypebyheader". If this check fails, the traditional
- test of standard file extension is tried, done in function
- "checktypebyextension".
-
- Magic headers:
-
- * "PNG (Portable Network Graphics) Specification", Version 1.2
- (http://www.libpng.org/pub/png):
-
- | 3.1. PNG file signature
- |
- | The first eight bytes of a PNG file always contain the following
- | (decimal) values:
- |
- | 137 80 78 71 13 10 26 10
-
- Translation to C: "\x89PNG\r\n\x1A\n"
-
- * "JPEG File Interchange Format", Version 1.02:
-
- | o you can identify a JFIF file by looking for the following
- | sequence: X'FF', SOI X'FF', APP0, <2 bytes to be skipped>,
- | "JFIF", X'00'.
-
- Function "checktypebyheader" only looks at the first two bytes:
- "\xFF\xD8"
-
- * ISO/IEC JTC 1/SC 29/WG 1
- (ITU-T SG8)
- Coding of Still Pictures
- Title: 14492 FCD
- Source: JBIG Committee
- Project: JTC 1.29.10
- Status: Final Committee Draft
-
- | D.4.1, ID string
- |
- | This is an 8-byte sequence containing 0x97 0x4A 0x42 0x32 0x0D 0x0A
- | 0x1A 0x0A.
-
- * "PDF Reference", third edition:
- * The first line should contain "%PDF-1.0" until "%PDF-1.4"
- (section 3.4.1 "File Header").
- * The "implementation notes" say:
-
- | 3.4.1, File Header
- | 12. Acrobat viewers require only that the header appear
- | somewhere within the first 1024 bytes of the file.
- | 13. Acrobat viewers will also accept a header of the form
- | %!PS-Adobe-N.n PDF-M.m
-
- The check in function "checktypebyheader" only implements
- the first issue. The implementation notes are not considered.
- Therefore files with garbage at start of file must have the
- standard extension.
-
- Functions "checktypebyheader" and "checktypebyextension":
- img_type(img) is set to IMAGE_TYPE_NONE by new_image_entry().
- Both functions tries to detect a type and set img_type(img).
- Thus a value other than IMAGE_TYPE_NONE indicates that a
- type is found.
-*/
-
-#define HEADER_JPG "\xFF\xD8"
-#define HEADER_PNG "\x89PNG\r\n\x1A\n"
-#define HEADER_JBIG2 "\x97\x4A\x42\x32\x0D\x0A\x1A\x0A"
-#define HEADER_PDF "%PDF-1."
-#define MAX_HEADER (sizeof(HEADER_PNG)-1)
-static void checktypebyheader(integer img)
-{
- int i;
- FILE *file = NULL;
- char header[MAX_HEADER];
-
- if (img_type(img) != IMAGE_TYPE_NONE) /* nothing to do */
- return;
-
- /* read the header */
- file = xfopen(img_name(img), FOPEN_RBIN_MODE);
- for (i = 0; (unsigned) i < MAX_HEADER; i++) {
- header[i] = xgetc(file);
- if (feof(file))
- pdftex_fail("reading image file failed");
- }
- xfclose(file, img_name(img));
-
- /* tests */
- if (strncmp(header, HEADER_JPG, sizeof(HEADER_JPG) - 1) == 0)
- img_type(img) = IMAGE_TYPE_JPG;
- else if (strncmp(header, HEADER_PNG, sizeof(HEADER_PNG) - 1) == 0)
- img_type(img) = IMAGE_TYPE_PNG;
- else if (strncmp(header, HEADER_JBIG2, sizeof(HEADER_JBIG2) - 1) == 0)
- img_type(img) = IMAGE_TYPE_JBIG2;
- else if (strncmp(header, HEADER_PDF, sizeof(HEADER_PDF) - 1) == 0)
- img_type(img) = IMAGE_TYPE_PDF;
-}
-
-static void checktypebyextension(integer img)
-{
- char *image_suffix;
-
- if (img_type(img) != IMAGE_TYPE_NONE) /* nothing to do */
- return;
- /* tests */
- if ((image_suffix = strrchr(cur_file_name, '.')) == 0)
- img_type(img) = IMAGE_TYPE_NONE;
- else if (strcasecmp(image_suffix, ".png") == 0)
- img_type(img) = IMAGE_TYPE_PNG;
- else if (strcasecmp(image_suffix, ".jpg") == 0 ||
- strcasecmp(image_suffix, ".jpeg") == 0)
- img_type(img) = IMAGE_TYPE_JPG;
- else if (strcasecmp(image_suffix, ".jbig2") == 0 ||
- strcasecmp(image_suffix, ".jb2") == 0)
- img_type(img) = IMAGE_TYPE_JBIG2;
- else if (strcasecmp(image_suffix, ".pdf") == 0)
- img_type(img) = IMAGE_TYPE_PDF;
-}
-
-integer readimage(strnumber s, integer page_num, strnumber page_name,
- integer colorspace, integer pagebox,
- integer pdfmajorversion, integer pdfminorversion, integer pdfinclusionerrorlevel)
-{
- char *dest = NULL;
- integer img = new_image_entry();
- img_colorspace_ref(img) = colorspace;
-
- /* need to allocate new string as makecstring's buffer is
- already used by cur_file_name */
- if (page_name != 0)
- dest = xstrdup(makecstring(page_name));
- cur_file_name = find_input_file(s);
- img_name(img) = cur_file_name;
- if (img_name(img) == NULL)
- pdftex_fail("cannot find image file %s", makecstring(s));
- recorder_record_input(cur_file_name);
- /* type checks */
- checktypebyheader(img);
- checktypebyextension(img);
- /* read image */
- switch (img_type(img)) {
- case IMAGE_TYPE_PDF:
- pdf_ptr(img) = xtalloc(1, pdf_image_struct);
- pdf_ptr(img)->page_box = pagebox;
- page_num = read_pdf_info(img_name(img), dest, page_num, pagebox,
- pdfmajorversion, pdfminorversion, pdfinclusionerrorlevel);
- img_width(img) = bp2int(epdf_width);
- img_height(img) = bp2int(epdf_height);
- img_rotate(img) = epdf_rotate;
- img_pages(img) = epdf_num_pages;
- pdf_ptr(img)->orig_x = bp2int(epdf_orig_x);
- pdf_ptr(img)->orig_y = bp2int(epdf_orig_y);
- pdf_ptr(img)->selected_page = page_num;
- pdf_ptr(img)->doc = epdf_doc;
- if (epdf_has_page_group == 1)
- img_group_ref(img) = -1; // page group present, but new object
- // number not set yet
- else
- img_group_ref(img) = 0; // no page group present
- break;
- case IMAGE_TYPE_PNG:
- img_pages(img) = 1;
- read_png_info(img);
- break;
- case IMAGE_TYPE_JPG:
- jpg_ptr(img) = xtalloc(1, JPG_IMAGE_INFO);
- img_pages(img) = 1;
- read_jpg_info(img);
- break;
- case IMAGE_TYPE_JBIG2:
- if (pdfmajorversion == 1 && pdfminorversion < 4) {
- pdftex_fail
- ("JBIG2 images only possible with at least PDF 1.4; you are generating PDF 1.%i",
- (int) pdfminorversion);
- }
- jbig2_ptr(img) = xtalloc(1, JBIG2_IMAGE_INFO);
- img_type(img) = IMAGE_TYPE_JBIG2;
- jbig2_ptr(img)->selected_page = page_num;
- read_jbig2_info(img);
- break;
- default:
- pdftex_fail("unknown type of image");
- }
- xfree(dest);
- cur_file_name = NULL;
- return img;
-}
-
-void writeimage(integer img)
-{
- cur_file_name = img_name(img);
- tex_printf(" <%s", img_name(img));
- switch (img_type(img)) {
- case IMAGE_TYPE_PNG:
- write_png(img);
- break;
- case IMAGE_TYPE_JPG:
- write_jpg(img);
- break;
- case IMAGE_TYPE_JBIG2:
- write_jbig2(img);
- break;
- case IMAGE_TYPE_PDF:
- epdf_doc = pdf_ptr(img)->doc;
- epdf_selected_page = pdf_ptr(img)->selected_page;
- epdf_page_box = pdf_ptr(img)->page_box;
- write_epdf();
- break;
- default:
- pdftex_fail("unknown type of image");
- }
-
- tex_printf(">");
- cur_file_name = NULL;
-}
-
-void deleteimage(integer img)
-{
- if (iniversion)
- return; // The image may be \dump{}ed to a format
- switch (img_type(img)) {
- case IMAGE_TYPE_PDF:
- epdf_doc = pdf_ptr(img)->doc;
- epdf_delete();
- break;
- case IMAGE_TYPE_PNG:
- xfclose((FILE *) png_get_io_ptr(png_ptr(img)), cur_file_name);
- png_destroy_read_struct(&(png_ptr(img)), &(png_info(img)), NULL);
- break;
- case IMAGE_TYPE_JPG:
- xfclose(jpg_ptr(img)->file, cur_file_name);
- break;
- case IMAGE_TYPE_JBIG2:
- break;
- default:
- pdftex_fail("unknown type of image");
- }
- xfree(img_name(img));
- return;
-}
-
-void img_free(void)
-{
- xfree(image_array);
-}
-
-
-/* To allow the use of \pdfrefximage inside saved boxes in -ini mode,
- * the information in the array has to be (un)dumped with the format.
- * The next two routines take care of that.
- *
- * Most of the work involved in setting up the images is simply
- * executed again. This solves the many possible errors resulting from
- * the split in two separate runs.
-
- * There was only one problem remaining: The pdfversion and
- * pdfinclusionerrorlevel can have changed inbetween the call to
- * readimage() and dump time. That is why they are passed as arguments
- * to undumpimagemeta once more.
- */
-
-/* some of the dumped values are really type int, not integer,
- * but since the macro falls back to generic_dump anyway, that
- * does not matter.
- */
-
-/* #define dumpsizet generic_dump */
-#define dumpinteger generic_dump
-
-/* #define undumpsizet generic_undump */
-#define undumpinteger generic_undump
-
-void dumpimagemeta(void)
-{
- int cur_image, img;
-
- dumpinteger(image_limit);
- cur_image = (image_ptr - image_array);
- dumpinteger(cur_image);
-
- for (img = 0; img < cur_image; img++) {
-
- dumpcharptr(img_name(img));
- dumpinteger(img_type(img));
- dumpinteger(img_color(img));
- dumpinteger(img_width(img));
- dumpinteger(img_height(img));
- dumpinteger(img_xres(img));
- dumpinteger(img_yres(img));
- dumpinteger(img_pages(img));
- dumpinteger(img_colorspace_ref(img));
- dumpinteger(img_group_ref(img));
-
- /* the image_struct is not dumped at all, except for a few
- variables that are needed to restore the contents */
-
- if (img_type(img) == IMAGE_TYPE_PDF) {
- dumpinteger(pdf_ptr(img)->page_box);
- dumpinteger(pdf_ptr(img)->selected_page);
- } else if (img_type(img) == IMAGE_TYPE_JBIG2) {
- dumpinteger(jbig2_ptr(img)->selected_page);
- }
-
- }
-}
-
-void undumpimagemeta(integer pdfmajorversion, integer pdfminorversion, integer pdfinclusionerrorlevel)
-{
- int cur_image, img;
-
- undumpinteger(image_limit);
-
- image_array = xtalloc(image_limit, image_entry);
- undumpinteger(cur_image);
- image_ptr = image_array + cur_image;
-
- for (img = 0; img < cur_image; img++) {
- undumpcharptr(img_name(img));
- undumpinteger(img_type(img));
- undumpinteger(img_color(img));
- undumpinteger(img_width(img));
- undumpinteger(img_height(img));
- undumpinteger(img_xres(img));
- undumpinteger(img_yres(img));
- undumpinteger(img_pages(img));
- undumpinteger(img_colorspace_ref(img));
- undumpinteger(img_group_ref(img));
-
- /* if img_name(img)==NULL -- which it shouldn't be -- the next line
- will trigger an assertion failure. */
- if (kpse_find_file(img_name(img), kpse_tex_format, true) == NULL)
- pdftex_fail("cannot find image file %s", img_name(img));
-
- switch (img_type(img)) {
- case IMAGE_TYPE_PDF:
- pdf_ptr(img) = xtalloc(1, pdf_image_struct);
-
- undumpinteger(pdf_ptr(img)->page_box);
- undumpinteger(pdf_ptr(img)->selected_page);
-
- read_pdf_info(img_name(img), NULL, pdf_ptr(img)->selected_page,
- pdf_ptr(img)->page_box, pdfmajorversion, pdfminorversion,
- pdfinclusionerrorlevel);
-
- img_width(img) = bp2int(epdf_width);
- img_height(img) = bp2int(epdf_height);
- img_pages(img) = epdf_num_pages;
- pdf_ptr(img)->orig_x = bp2int(epdf_orig_x);
- pdf_ptr(img)->orig_y = bp2int(epdf_orig_y);
- pdf_ptr(img)->doc = epdf_doc;
- break;
- case IMAGE_TYPE_PNG:
- img_pages(img) = 1;
- read_png_info(img);
- break;
- case IMAGE_TYPE_JPG:
- jpg_ptr(img) = xtalloc(1, JPG_IMAGE_INFO);
- img_pages(img) = 1;
- read_jpg_info(img);
- break;
- case IMAGE_TYPE_JBIG2:
- if (pdfmajorversion == 1 && pdfminorversion < 4) {
- pdftex_fail
- ("JBIG2 images only possible with at least PDF 1.4; you are generating PDF 1.%i",
- (int) pdfminorversion);
- }
- jbig2_ptr(img) = xtalloc(1, JBIG2_IMAGE_INFO);
- img_type(img) = IMAGE_TYPE_JBIG2;
- undumpinteger(jbig2_ptr(img)->selected_page);
- read_jbig2_info(img);
- break;
- default:
- pdftex_fail("unknown type of image");
- }
- }
-}
diff --git a/Build/source/texk/web2c/pdftexdir/writejbig2.c b/Build/source/texk/web2c/pdftexdir/writejbig2.c
deleted file mode 100644
index 0bfa995d996..00000000000
--- a/Build/source/texk/web2c/pdftexdir/writejbig2.c
+++ /dev/null
@@ -1,834 +0,0 @@
-/*
-Copyright 2002-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify it under
-the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2 of the License, or (at your option)
-any later version.
-
-pdfTeX is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-
-This is experimental JBIG2 image support to pdfTeX. JBIG2 image decoding
-is part of Adobe PDF-1.4, and requires Acroread 5.0 or later.
-
-References
-==========
-
-* 14492 FCD: Information technology -- coded representation of picture
-and audio information -- lossy/lossless coding of bi-level images /
-JBIG committee, 1999 July 16. This JBIG2 Working Draft is available from
-http://www.jpeg.org/public/fcd14492.pdf. The references in the C-code
-correspond to the sections of this document.
-
-* PDF Reference, 5th edition, version 1.6, 1985--2005 Adobe Systems
-Incorporated. Available online:
-
-http://partners.adobe.com/public/developer/en/pdf/PDFReference16.pdf
-
-News
-====
-
-31 May 2006: no need to wait for endoffileflag in sequential access
-organization.
-
-10 May 2006: ygetc() for some catching of broken JBIG2 files; modify to
-accept Example 3.4 from PDFRef 5th ed. with short end-of-file segment.
-
-09 May 2006: pages_maketree() and segments_maketree() by AVL tree,
-some cleaning up.
-
-06 May 2006: File list replaced by AVL tree; new_fileinfo(),
-new_pageinfo().
-
-04 May 2006: Updated for pdftex-1.40-beta-20060213.
-
-08 Jan. 2003: Added flushjbig2page0objects() function. Now at the end
-of the pdfTeX run all pending page0 objects are written out.
-
-08 Jan. 2003: Release on private webpage.
-
-04 Jan. 2003: Completely rewritten. Now with some data structures.
-Rudimentary local file and image bookkeeping. Multiple image inclusion
-from one JBIG2 file. Only required page0 segments are marked for
-inclusion.
-
-13 Nov. 2002: pdfcrypting removed.
-
-08 Dec. 2002: bug in page 0 stream writing repaired.
-Strategy for multiple page inclusion from same JBIG2 file: When writing
-1st image, create fresh PDF object for page 0, and include any page
-0 segments from complete file (even if these segments are not needed
-for image). When writing next image, check by filename comparison if
-PDF object for page 0 of this JBIG2 file has already been written. This
-can only remember the file name for the direct predecessor JBIG2 image
-(but images of other types might come inbetween). If such page 0 PDF
-object exists, reference it. Else create fresh one.
-
-09 Dec. 2002: JBIG2 seg. page numbers > 0 are now set to 1, see PDF Ref.
-
-***********************************************************************/
-
-#include "ptexlib.h"
-#include <stdlib.h>
-#include <stdio.h>
-#include <assert.h>
-#include "ptexmac.h"
-#include "image.h"
-
-/* 7.3 Segment types */
-#define M_SymbolDictionary 0
-#define M_IntermediateTextRegion 4
-#define M_ImmediateTextRegion 6
-#define M_ImmediateLosslessTextRegion 7
-#define M_PatternDictionary 16
-#define M_IntermediateHalftoneRegion 20
-#define M_ImmediateHalftoneRegion 22
-#define M_ImmediateLosslessHalftoneRegion 23
-#define M_IntermediateGenericRegion 36
-#define M_ImmediateGenericRegion 38
-#define M_ImmediateLosslessGenericRegion 39
-#define M_IntermediateGenericRefinementRegion 40
-#define M_ImmediateGenericRefinementRegion 42
-#define M_ImmediateLosslessGenericRefinementRegion 43
-#define M_PageInformation 48
-#define M_EndOfPage 49
-#define M_EndOfStripe 50
-#define M_EndOfFile 51
-#define M_Profiles 52
-#define M_Tables 53
-#define M_Extension 62
-
-/**********************************************************************/
-
-typedef enum { INITIAL, HAVEINFO, WRITEPDF } PHASE;
-
-typedef struct _LITEM {
- struct _LITEM *prev;
- struct _LITEM *next;
- void *d; /* data */
-} LITEM;
-
-typedef struct _LIST {
- LITEM *first;
- LITEM *last;
- struct avl_table *tree;
-} LIST;
-
-typedef struct _SEGINFO {
- unsigned long segnum;
- boolean isrefered;
- boolean refers;
- unsigned int seghdrflags; /* set by readseghdr() */
- boolean pageassocsizeflag; /* set by readseghdr() */
- unsigned int reftosegcount; /* set by readseghdr() */
- unsigned int countofrefered; /* set by readseghdr() */
- unsigned int fieldlen; /* set by readseghdr() */
- unsigned int segnumwidth; /* set by readseghdr() */
- long segpage; /* set by readseghdr() */
- unsigned long segdatalen; /* set by readseghdr() */
- off_t hdrstart; /* set by readseghdr() */
- off_t hdrend; /* set by readseghdr() */
- off_t datastart;
- off_t dataend;
- boolean endofstripeflag; /* set by checkseghdrflags() */
- boolean endofpageflag; /* set by checkseghdrflags() */
- boolean pageinfoflag; /* set by checkseghdrflags() */
- boolean endoffileflag; /* set by checkseghdrflags() */
-} SEGINFO;
-
-typedef struct _PAGEINFO {
- LIST segments; /* segments associated with page */
- unsigned long pagenum;
- unsigned int width;
- unsigned int height;
- unsigned int xres;
- unsigned int yres;
- unsigned int pagesegmentflags;
- unsigned int stripinginfo;
- unsigned int stripedheight;
-} PAGEINFO;
-
-typedef struct _FILEINFO {
- FILE *file;
- char *filename;
- off_t filesize;
- LIST pages; /* not including page0 */
- LIST page0;
- unsigned int filehdrflags; /* set by readfilehdr() */
- boolean sequentialaccess; /* set by readfilehdr() */
- unsigned long numofpages; /* set by readfilehdr() */
- off_t streamstart; /* set by get_jbig2_info() */
- unsigned long pdfpage0objnum;
- PHASE phase;
-} FILEINFO;
-
-/**********************************************************************/
-
-static void initlinkedlist(LIST * lp);
-static void checkseghdrflags(SEGINFO * sip);
-static void markpage0seg(FILEINFO * fip, unsigned long referedseg);
-
-/**********************************************************************/
-
-struct avl_table *file_tree = NULL;
-
-static int comp_file_entry(const void *pa, const void *pb, void *p)
-{
- return strcmp(((const FILEINFO *) pa)->filename,
- ((const FILEINFO *) pb)->filename);
-}
-
-static int comp_page_entry(const void *pa, const void *pb, void *p)
-{
- return ((const PAGEINFO *) pa)->pagenum - ((const PAGEINFO *) pb)->pagenum;
-}
-
-static int comp_segment_entry(const void *pa, const void *pb, void *p)
-{
- return ((const SEGINFO *) pa)->segnum - ((const SEGINFO *) pb)->segnum;
-}
-
-/**********************************************************************/
-
-static int ygetc(FILE * stream)
-{
- int c = getc(stream);
- if (c < 0) {
- if (c == EOF)
- pdftex_fail("getc() failed; premature end of JBIG2 image file");
- else
- pdftex_fail("getc() failed (can't happen)");
- }
- return c;
-}
-
-/**********************************************************************/
-
-static FILEINFO *new_fileinfo(void)
-{
- FILEINFO *fip;
- fip = xtalloc(1, FILEINFO);
- fip->file = NULL;
- fip->filename = NULL;
- fip->filesize = 0;
- initlinkedlist(&(fip->pages));
- initlinkedlist(&(fip->page0));
- fip->filehdrflags = 0;
- fip->sequentialaccess = false;
- fip->numofpages = 0;
- fip->streamstart = 0;
- fip->pdfpage0objnum = 0;
- fip->phase = INITIAL;
- return fip;
-}
-
-static PAGEINFO *new_pageinfo(void)
-{
- PAGEINFO *pip;
- pip = xtalloc(1, PAGEINFO);
- initlinkedlist(&(pip->segments));
- pip->pagenum = 0;
- pip->width = 0;
- pip->height = 0;
- pip->xres = 0;
- pip->yres = 0;
- pip->pagesegmentflags = 0;
- pip->stripinginfo = 0;
- pip->stripedheight = 0;
- return pip;
-}
-
-static void init_seginfo(SEGINFO * sip)
-{
- sip->segnum = 0;
- sip->isrefered = false;
- sip->refers = false;
- sip->seghdrflags = 0;
- sip->pageassocsizeflag = false;
- sip->reftosegcount = 0;
- sip->countofrefered = 0;
- sip->fieldlen = 0;
- sip->segnumwidth = 0;
- sip->segpage = 0;
- sip->segdatalen = 0;
- sip->hdrstart = 0;
- sip->hdrend = 0;
- sip->datastart = 0;
- sip->dataend = 0;
- sip->endofstripeflag = false;
- sip->endofpageflag = false;
- sip->pageinfoflag = false;
- sip->endoffileflag = false;
-}
-
-/**********************************************************************/
-
-static void initlinkedlist(LIST * lp)
-{
- lp->first = NULL;
- lp->last = NULL;
- lp->tree = NULL;
-}
-
-static LIST *litem_append(LIST * lp)
-{
- LITEM *ip;
- ip = xtalloc(1, LITEM);
- if (lp->first == NULL) {
- lp->first = ip;
- ip->prev = NULL;
- } else {
- lp->last->next = ip;
- ip->prev = lp->last;
- }
- lp->last = ip;
- ip->next = NULL;
- ip->d = NULL;
- return lp;
-}
-
-/**********************************************************************/
-
-static void pages_maketree(LIST * plp)
-{
- LITEM *ip;
- void **aa;
- assert(plp->tree == NULL);
- plp->tree = avl_create(comp_page_entry, NULL, &avl_xallocator);
- assert(plp->tree != NULL);
- for (ip = plp->first; ip != NULL; ip = ip->next) {
- aa = avl_probe(plp->tree, (PAGEINFO *) ip->d);
- assert(aa != NULL);
- }
-}
-
-static void segments_maketree(LIST * slp)
-{
- LITEM *ip;
- void **aa;
- assert(slp->tree == NULL);
- slp->tree = avl_create(comp_segment_entry, NULL, &avl_xallocator);
- assert(slp->tree != NULL);
- for (ip = slp->first; ip != NULL; ip = ip->next) {
- aa = avl_probe(slp->tree, (SEGINFO *) ip->d);
- assert(aa != NULL);
- }
-}
-
-/**********************************************************************/
-
-static PAGEINFO *find_pageinfo(LIST * plp, unsigned long pagenum)
-{
- PAGEINFO tmp;
- tmp.pagenum = pagenum;
- assert(plp->tree != NULL);
- return (PAGEINFO *) avl_find(plp->tree, &tmp);
-}
-
-static SEGINFO *find_seginfo(LIST * slp, unsigned long segnum)
-{
- SEGINFO tmp;
- tmp.segnum = segnum;
- assert(slp->tree != NULL);
- return (SEGINFO *) avl_find(slp->tree, &tmp);
-}
-
-/**********************************************************************/
-
-static unsigned int read2bytes(FILE * f)
-{
- unsigned int c = ygetc(f);
- return (c << 8) + ygetc(f);
-}
-
-static unsigned long read4bytes(FILE * f)
-{
- unsigned int l = read2bytes(f);
- return (l << 16) + read2bytes(f);
-}
-
-/**********************************************************************/
-
-static off_t getstreamlen(LITEM * slip, boolean refer)
-{
- SEGINFO *sip;
- off_t len = 0;
- for (; slip != NULL; slip = slip->next) {
- sip = slip->d;
- if (refer || sip->isrefered)
- len += (sip->hdrend - sip->hdrstart) + (sip->dataend - sip->datastart);
- }
- return len;
-}
-
-/**********************************************************************/
-
-static void readfilehdr(FILEINFO * fip)
-{
- unsigned int i;
- /* Annex D.4 File header syntax */
- /* Annex D.4.1 ID string */
- unsigned char jbig2_id[] = { 0x97, 'J', 'B', '2', 0x0d, 0x0a, 0x1a, 0x0a };
- xfseeko(fip->file, (off_t)0, SEEK_SET, fip->filename);
- for (i = 0; i < 8; i++)
- if (ygetc(fip->file) != jbig2_id[i])
- pdftex_fail
- ("readfilehdr(): reading JBIG2 image file failed: ID string missing");
- /* Annex D.4.2 File header flags */
- fip->filehdrflags = ygetc(fip->file);
- fip->sequentialaccess = (fip->filehdrflags & 0x01) ? true : false;
- if (fip->sequentialaccess) { /* Annex D.1 vs. Annex D.2 */
- xfseeko(fip->file, (off_t)0, SEEK_END, fip->filename);
- fip->filesize = xftello(fip->file, fip->filename);
- xfseeko(fip->file, (off_t)9, SEEK_SET, fip->filename);
- }
- /* Annex D.4.3 Number of pages */
- if (!(fip->filehdrflags >> 1) & 0x01) /* known number of pages */
- fip->numofpages = read4bytes(fip->file);
- /* --- at end of file header --- */
-}
-
-/**********************************************************************/
-/* for first reading of file; return value tells if header been read */
-
-static boolean readseghdr(FILEINFO * fip, SEGINFO * sip)
-{
- unsigned int i;
- sip->hdrstart = xftello(fip->file, fip->filename);
- if (fip->sequentialaccess && sip->hdrstart == fip->filesize)
- return false; /* no endoffileflag is ok for sequentialaccess */
- /* 7.2.2 Segment number */
- sip->segnum = read4bytes(fip->file);
- /* 7.2.3 Segment header flags */
- sip->seghdrflags = ygetc(fip->file);
- checkseghdrflags(sip);
- if (fip->sequentialaccess && sip->endoffileflag) /* accept shorter segment, */
- return true; /* makes it compliant with Example 3.4 of PDFRef. 5th ed. */
- sip->pageassocsizeflag = ((sip->seghdrflags >> 6) & 0x01) ? true : false;
- /* 7.2.4 Referred-to segment count and retention flags */
- sip->reftosegcount = (unsigned int) ygetc(fip->file);
- sip->countofrefered = sip->reftosegcount >> 5;
- if (sip->countofrefered < 5)
- sip->fieldlen = 1;
- else {
- sip->fieldlen = 5 + sip->countofrefered / 8;
- xfseeko(fip->file, (off_t) sip->fieldlen - 1, SEEK_CUR, fip->filename);
- }
- /* 7.2.5 Referred-to segment numbers */
- if (sip->segnum <= 256)
- sip->segnumwidth = 1;
- else if (sip->segnum <= 65536)
- sip->segnumwidth = 2;
- else
- sip->segnumwidth = 4;
- for (i = 0; i < sip->countofrefered; i++) {
- switch (sip->segnumwidth) {
- case 1:
- (void) ygetc(fip->file);
- break;
- case 2:
- (void) read2bytes(fip->file);
- break;
- case 4:
- (void) read4bytes(fip->file);
- break;
- }
- }
- /* 7.2.6 Segment page association */
- if (sip->pageassocsizeflag)
- sip->segpage = read4bytes(fip->file);
- else
- sip->segpage = ygetc(fip->file);
- /* 7.2.7 Segment data length */
- sip->segdatalen = read4bytes(fip->file);
- sip->hdrend = xftello(fip->file, fip->filename);
- /* ---- at end of segment header ---- */
- return true;
-}
-
-/**********************************************************************/
-/* for writing, marks refered page0 segments, sets segpage > 0 to 1 */
-
-static void writeseghdr(FILEINFO * fip, SEGINFO * sip)
-{
- unsigned int i;
- unsigned long referedseg = 0;
- /* 7.2.2 Segment number */
- /* 7.2.3 Segment header flags */
- /* 7.2.4 Referred-to segment count and retention flags */
- for (i = 0; i < 5 + sip->fieldlen; i++)
- pdfout(ygetc(fip->file));
- /* 7.2.5 Referred-to segment numbers */
- for (i = 0; i < sip->countofrefered; i++) {
- switch (sip->segnumwidth) {
- case 1:
- referedseg = ygetc(fip->file);
- pdfout(referedseg);
- break;
- case 2:
- referedseg = read2bytes(fip->file);
- pdfout((referedseg >> 8) & 0xff);
- pdfout(referedseg & 0xff);
- break;
- case 4:
- referedseg = read4bytes(fip->file);
- pdfout((referedseg >> 24) & 0xff);
- pdfout((referedseg >> 16) & 0xff);
- pdfout((referedseg >> 8) & 0xff);
- pdfout(referedseg & 0xff);
- break;
- }
- if (fip->page0.last != NULL && !sip->refers)
- markpage0seg(fip, referedseg);
- }
- if (sip->countofrefered > 0)
- sip->refers = true;
- /* 7.2.6 Segment page association */
- if (sip->pageassocsizeflag)
- for (i = 0; i < 3; i++) {
- (void) ygetc(fip->file);
- pdfout(0);
- }
- (void) ygetc(fip->file);
- pdfout((sip->segpage > 0) ? 1 : 0);
- /* 7.2.7 Segment data length */
- for (i = 0; i < 4; i++)
- pdfout(ygetc(fip->file));
- /* ---- at end of segment header ---- */
-}
-
-/**********************************************************************/
-/* for recursive marking of refered page0 segments */
-
-static void checkseghdr(FILEINFO * fip, SEGINFO * sip)
-{
- unsigned int i;
- unsigned long referedseg = 0;
- /* 7.2.2 Segment number */
- /* 7.2.3 Segment header flags */
- /* 7.2.4 Referred-to segment count and retention flags */
- xfseeko(fip->file, (off_t) sip->fieldlen + 5, SEEK_CUR, fip->filename);
- /* 7.2.5 Referred-to segment numbers */
- for (i = 0; i < sip->countofrefered; i++) {
- switch (sip->segnumwidth) {
- case 1:
- referedseg = ygetc(fip->file);
- break;
- case 2:
- referedseg = read2bytes(fip->file);
- break;
- case 4:
- referedseg = read4bytes(fip->file);
- break;
- }
- if (!sip->refers)
- markpage0seg(fip, referedseg);
- }
- if (sip->countofrefered > 0)
- sip->refers = true;
- /* 7.2.6 Segment page association */
- /* 7.2.7 Segment data length */
- if (sip->pageassocsizeflag)
- xfseeko(fip->file, 8, SEEK_CUR, fip->filename);
- else
- xfseeko(fip->file, 5, SEEK_CUR, fip->filename);
- /* ---- at end of segment header ---- */
-}
-
-/**********************************************************************/
-
-static void checkseghdrflags(SEGINFO * sip)
-{
- sip->endofstripeflag = false;
- sip->endofpageflag = false;
- sip->pageinfoflag = false;
- sip->endoffileflag = false;
- /* 7.3 Segment types */
- switch (sip->seghdrflags & 0x3f) {
- case M_SymbolDictionary:
- case M_IntermediateTextRegion:
- case M_ImmediateTextRegion:
- case M_ImmediateLosslessTextRegion:
- case M_PatternDictionary:
- case M_IntermediateHalftoneRegion:
- case M_ImmediateHalftoneRegion:
- case M_ImmediateLosslessHalftoneRegion:
- case M_IntermediateGenericRegion:
- case M_ImmediateGenericRegion:
- case M_ImmediateLosslessGenericRegion:
- case M_IntermediateGenericRefinementRegion:
- case M_ImmediateGenericRefinementRegion:
- case M_ImmediateLosslessGenericRefinementRegion:
- break;
- case M_PageInformation:
- sip->pageinfoflag = true;
- break;
- case M_EndOfPage:
- sip->endofpageflag = true;
- break;
- case M_EndOfStripe:
- sip->endofstripeflag = true;
- break;
- case M_EndOfFile:
- sip->endoffileflag = true;
- break;
- case M_Profiles:
- case M_Tables:
- case M_Extension:
- break;
- default:
- pdftex_fail
- ("checkseghdrflags(): unknown segment type in JBIG2 image file");
- break;
- }
-}
-
-/**********************************************************************/
-
-static void markpage0seg(FILEINFO * fip, unsigned long referedseg)
-{
- PAGEINFO *pip;
- SEGINFO *sip;
- pip = fip->page0.first->d;
- sip = find_seginfo(&(pip->segments), referedseg);
- if (sip != NULL) {
- if (!sip->refers && sip->countofrefered > 0)
- checkseghdr(fip, sip);
- sip->isrefered = true;
- }
-}
-
-/**********************************************************************/
-
-static off_t findstreamstart(FILEINFO * fip)
-{
- SEGINFO tmp;
- assert(!fip->sequentialaccess); /* D.2 Random-access organisation */
- do /* find random-access stream start */
- (void) readseghdr(fip, &tmp);
- while (!tmp.endoffileflag);
- fip->streamstart = tmp.hdrend;
- readfilehdr(fip);
- return fip->streamstart;
-}
-
-/**********************************************************************/
-
-static void rd_jbig2_info(FILEINFO * fip)
-{
- off_t seekdist = 0; /* for sequential-access only */
- off_t streampos = 0; /* for random-access only */
- unsigned long currentpage = 0;
- boolean sipavail = false;
- PAGEINFO *pip;
- SEGINFO *sip = NULL;
- LIST *plp, *slp;
- fip->file = xfopen(fip->filename, FOPEN_RBIN_MODE);
- readfilehdr(fip);
- if (!fip->sequentialaccess) /* D.2 Random-access organisation */
- streampos = findstreamstart(fip);
- while (true) { /* loop over segments */
- if (!sipavail) {
- sip = xtalloc(1, SEGINFO);
- sipavail = true;
- }
- init_seginfo(sip);
- if (!readseghdr(fip, sip) || sip->endoffileflag)
- break;
- if (sip->segpage > 0) {
- if (sip->segpage > currentpage) {
- plp = litem_append(&(fip->pages));
- plp->last->d = new_pageinfo();
- currentpage = sip->segpage;
- }
- pip = fip->pages.last->d;
- } else {
- if (fip->page0.last == NULL) {
- plp = litem_append(&(fip->page0));
- plp->last->d = new_pageinfo();
- }
- pip = fip->page0.last->d;
- }
- if (!sip->endofpageflag) {
- slp = litem_append(&(pip->segments));
- slp->last->d = sip;
- sipavail = false;
- }
- if (!fip->sequentialaccess)
- sip->datastart = streampos;
- else
- sip->datastart = sip->hdrend;
- sip->dataend = sip->datastart + sip->segdatalen;
- if (!fip->sequentialaccess
- && (sip->pageinfoflag || sip->endofstripeflag))
- xfseeko(fip->file, sip->datastart, SEEK_SET, fip->filename);
- seekdist = (off_t) sip->segdatalen;
- /* 7.4.8 Page information segment syntax */
- if (sip->pageinfoflag) {
- pip->pagenum = sip->segpage;
- pip->width = read4bytes(fip->file);
- pip->height = read4bytes(fip->file);
- pip->xres = read4bytes(fip->file);
- pip->yres = read4bytes(fip->file);
- pip->pagesegmentflags = ygetc(fip->file);
- /* 7.4.8.6 Page striping information */
- pip->stripinginfo = read2bytes(fip->file);
- seekdist -= 19;
- }
- if (sip->endofstripeflag) {
- pip->stripedheight = read4bytes(fip->file);
- seekdist -= 4;
- }
- if (!fip->sequentialaccess
- && (sip->pageinfoflag || sip->endofstripeflag))
- xfseeko(fip->file, sip->hdrend, SEEK_SET, fip->filename);
- if (!fip->sequentialaccess)
- streampos += sip->segdatalen;
- if (fip->sequentialaccess)
- xfseeko(fip->file, seekdist, SEEK_CUR, fip->filename);
- if (sip->endofpageflag && currentpage && (pip->stripinginfo >> 15))
- pip->height = pip->stripedheight;
- }
- fip->phase = HAVEINFO;
- if (sipavail)
- xfree(sip);
- xfclose(fip->file, fip->filename);
-}
-
-/**********************************************************************/
-
-static void wr_jbig2(FILEINFO * fip, unsigned long page)
-{
- LITEM *slip;
- PAGEINFO *pip;
- SEGINFO *sip;
- off_t i;
- if (page > 0) {
- pip = find_pageinfo(&(fip->pages), page);
- assert(pip != NULL);
- pdf_puts("/Type /XObject\n");
- pdf_puts("/Subtype /Image\n");
- pdf_printf("/Width %i\n", pip->width);
- pdf_printf("/Height %i\n", pip->height);
- pdf_puts("/ColorSpace /DeviceGray\n");
- pdf_puts("/BitsPerComponent 1\n");
- pdf_printf("/Length %" LONGINTEGER_PRI "d\n",
- (LONGINTEGER_TYPE) getstreamlen(pip->segments.first, true));
- pdf_puts("/Filter [/JBIG2Decode]\n");
- if (fip->page0.last != NULL) {
- if (fip->pdfpage0objnum == 0) {
- pdfcreateobj(0, 0);
- fip->pdfpage0objnum = objptr;
- }
- pdf_printf("/DecodeParms [<< /JBIG2Globals %lu 0 R >>]\n",
- fip->pdfpage0objnum);
- }
- } else {
- pip = find_pageinfo(&(fip->page0), page);
- assert(pip != NULL);
- pdfbegindict(fip->pdfpage0objnum, 0);
- pdf_printf("/Length %" LONGINTEGER_PRI "d\n",
- (LONGINTEGER_TYPE) getstreamlen(pip->segments.first, false));
- }
- pdf_puts(">>\n");
- pdf_puts("stream\n");
- fip->file = xfopen(fip->filename, FOPEN_RBIN_MODE);
- for (slip = pip->segments.first; slip != NULL; slip = slip->next) { /* loop over page segments */
- sip = slip->d;
- if (sip->isrefered || page > 0) {
- xfseeko(fip->file, sip->hdrstart, SEEK_SET, fip->filename);
- /* mark refered-to page 0 segments, change segpages > 1 to 1 */
- writeseghdr(fip, sip);
- xfseeko(fip->file, sip->datastart, SEEK_SET, fip->filename);
- for (i = sip->datastart; i < sip->dataend; i++)
- pdfout(ygetc(fip->file));
- }
- }
- pdfendstream();
- xfclose(fip->file, fip->filename);
-}
-
-/**********************************************************************/
-
-void read_jbig2_info(integer img)
-{
- FILEINFO *fip, tmp;
- PAGEINFO *pip;
- void **aa;
- if (jbig2_ptr(img)->selected_page < 1)
- pdftex_fail
- ("read_jbig2_info(): page %d not in JBIG2 image file; page must be > 0",
- (int) jbig2_ptr(img)->selected_page);
- if (file_tree == NULL) {
- file_tree = avl_create(comp_file_entry, NULL, &avl_xallocator);
- assert(file_tree != NULL);
- }
- tmp.filename = img_name(img);
- fip = (FILEINFO *) avl_find(file_tree, &tmp);
- if (fip == NULL) {
- fip = new_fileinfo();
- fip->filename = xstrdup(img_name(img));
- aa = avl_probe(file_tree, fip);
- assert(aa != NULL);
- }
- if (fip->phase == INITIAL) {
- rd_jbig2_info(fip);
- pages_maketree(&(fip->pages));
- if (fip->page0.last != NULL) {
- pages_maketree(&(fip->page0));
- pip = fip->page0.first->d;
- segments_maketree(&(pip->segments));
- }
- }
- pip = find_pageinfo(&(fip->pages), jbig2_ptr(img)->selected_page);
- if (pip == NULL)
- pdftex_fail("read_jbig2_info(): page %d not found in JBIG2 image file",
- (int) jbig2_ptr(img)->selected_page);
- img_pages(img) = fip->numofpages;
- img_width(img) = pip->width;
- img_height(img) = pip->height;
- img_xres(img) = (int) (pip->xres * 0.0254 + 0.5);
- img_yres(img) = (int) (pip->yres * 0.0254 + 0.5);
-}
-
-/**********************************************************************/
-
-void write_jbig2(integer img)
-{
- FILEINFO *fip, tmp;
- PAGEINFO *pip;
- assert(file_tree != NULL);
- tmp.filename = img_name(img);
- fip = (FILEINFO *) avl_find(file_tree, &tmp);
- assert(fip != NULL);
- assert(fip->phase == HAVEINFO); /* don't write before rd_jbig2_info() call */
- pip = find_pageinfo(&(fip->pages), jbig2_ptr(img)->selected_page);
- assert(pip != NULL);
- wr_jbig2(fip, pip->pagenum);
-}
-
-/**********************************************************************/
-
-void flushjbig2page0objects(void)
-{
- FILEINFO *fip;
- struct avl_traverser t;
- if (file_tree != NULL) {
- avl_t_init(&t, file_tree);
- for (fip = avl_t_first(&t, file_tree); fip != NULL;
- fip = avl_t_next(&t)) {
- if (fip->page0.last != NULL)
- wr_jbig2(fip, 0);
- }
- }
-}
-
-/**********************************************************************/
diff --git a/Build/source/texk/web2c/pdftexdir/writejpg.c b/Build/source/texk/web2c/pdftexdir/writejpg.c
deleted file mode 100644
index a0267238fe2..00000000000
--- a/Build/source/texk/web2c/pdftexdir/writejpg.c
+++ /dev/null
@@ -1,404 +0,0 @@
-/*
-Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-#include "image.h"
-
-#define JPG_GRAY 1 /* Gray color space, use /DeviceGray */
-#define JPG_RGB 3 /* RGB color space, use /DeviceRGB */
-#define JPG_CMYK 4 /* CMYK color space, use /DeviceCMYK */
-
-typedef enum { /* JPEG marker codes */
- M_SOF0 = 0xc0, /* baseline DCT */
- M_SOF1 = 0xc1, /* extended sequential DCT */
- M_SOF2 = 0xc2, /* progressive DCT */
- M_SOF3 = 0xc3, /* lossless (sequential) */
-
- M_SOF5 = 0xc5, /* differential sequential DCT */
- M_SOF6 = 0xc6, /* differential progressive DCT */
- M_SOF7 = 0xc7, /* differential lossless */
-
- M_JPG = 0xc8, /* JPEG extensions */
- M_SOF9 = 0xc9, /* extended sequential DCT */
- M_SOF10 = 0xca, /* progressive DCT */
- M_SOF11 = 0xcb, /* lossless (sequential) */
-
- M_SOF13 = 0xcd, /* differential sequential DCT */
- M_SOF14 = 0xce, /* differential progressive DCT */
- M_SOF15 = 0xcf, /* differential lossless */
-
- M_DHT = 0xc4, /* define Huffman tables */
-
- M_DAC = 0xcc, /* define arithmetic conditioning table */
-
- M_RST0 = 0xd0, /* restart */
- M_RST1 = 0xd1, /* restart */
- M_RST2 = 0xd2, /* restart */
- M_RST3 = 0xd3, /* restart */
- M_RST4 = 0xd4, /* restart */
- M_RST5 = 0xd5, /* restart */
- M_RST6 = 0xd6, /* restart */
- M_RST7 = 0xd7, /* restart */
-
- M_SOI = 0xd8, /* start of image */
- M_EOI = 0xd9, /* end of image */
- M_SOS = 0xda, /* start of scan */
- M_DQT = 0xdb, /* define quantization tables */
- M_DNL = 0xdc, /* define number of lines */
- M_DRI = 0xdd, /* define restart interval */
- M_DHP = 0xde, /* define hierarchical progression */
- M_EXP = 0xdf, /* expand reference image(s) */
-
- M_APP0 = 0xe0, /* application marker, used for JFIF */
- M_APP1 = 0xe1, /* application marker */
- M_APP2 = 0xe2, /* application marker */
- M_APP3 = 0xe3, /* application marker */
- M_APP4 = 0xe4, /* application marker */
- M_APP5 = 0xe5, /* application marker */
- M_APP6 = 0xe6, /* application marker */
- M_APP7 = 0xe7, /* application marker */
- M_APP8 = 0xe8, /* application marker */
- M_APP9 = 0xe9, /* application marker */
- M_APP10 = 0xea, /* application marker */
- M_APP11 = 0xeb, /* application marker */
- M_APP12 = 0xec, /* application marker */
- M_APP13 = 0xed, /* application marker */
- M_APP14 = 0xee, /* application marker, used by Adobe */
- M_APP15 = 0xef, /* application marker */
-
- M_JPG0 = 0xf0, /* reserved for JPEG extensions */
- M_JPG13 = 0xfd, /* reserved for JPEG extensions */
- M_COM = 0xfe, /* comment */
-
- M_TEM = 0x01, /* temporary use */
-
- M_ERROR = 0x100 /* dummy marker, internal use only */
-} JPEG_MARKER;
-
-static JPG_UINT16 read2bytes(FILE * f)
-{
- int c = xgetc(f);
- return (c << 8) + xgetc(f);
-}
-
-static unsigned char
-get_unsigned_byte (FILE *file)
-{
- int ch;
- ch = fgetc (file);
- return (unsigned char) ch;
-}
-
-static unsigned short
-get_unsigned_pair (FILE *file)
-{
- unsigned short pair = get_unsigned_byte(file);
- pair = (pair << 8) | get_unsigned_byte(file);
- return pair;
-}
-
-static unsigned int
-read_exif_bytes(unsigned char **p, int n, int b)
-{
- unsigned int rval = 0;
- unsigned char *pp = *p;
- if (b) {
- switch (n) {
- case 4:
- rval += *pp++; rval <<= 8;
- rval += *pp++; rval <<= 8;
- case 2:
- rval += *pp++; rval <<= 8;
- rval += *pp;
- break;
- }
- } else {
- pp += n;
- switch (n) {
- case 4:
- rval += *--pp; rval <<= 8;
- rval += *--pp; rval <<= 8;
- case 2:
- rval += *--pp; rval <<= 8;
- rval += *--pp;
- break;
- }
- }
- *p += n;
- return rval;
-}
-
-#define NEW(n, t) (t*)xmalloc(n * sizeof(t))
-
-static void
-read_APP1_Exif (FILE *fp, unsigned short length, int *xx, int *yy)
-{
- /* this doesn't save the data, just reads the tags we need */
- /* based on info from http://www.exif.org/Exif2-2.PDF */
- unsigned char *buffer = NEW(length, unsigned char);
- unsigned char *p, *rp;
- unsigned char *tiff_header;
- char bigendian;
- int i;
- int num_fields, tag, type;
- int value = 0, num = 0, den = 0; /* silence uninitialized warnings */
- double xres = 72.0;
- double yres = 72.0;
- double res_unit = 1.0;
- fread(buffer, length, 1, fp);
- p = buffer;
- while ((p < buffer + length) && (*p == 0))
- ++p;
- tiff_header = p;
- if ((*p == 'M') && (*(p+1) == 'M'))
- bigendian = 1;
- else if ((*p == 'I') && (*(p+1) == 'I'))
- bigendian = 0;
- else
- goto err;
- p += 2;
- i = read_exif_bytes(&p, 2, bigendian);
- if (i != 42)
- goto err;
- i = read_exif_bytes(&p, 4, bigendian);
- p = tiff_header + i;
- num_fields = read_exif_bytes(&p, 2, bigendian);
- while (num_fields-- > 0) {
- tag = read_exif_bytes(&p, 2, bigendian);
- type = read_exif_bytes(&p, 2, bigendian);
- read_exif_bytes(&p, 4, bigendian);
- switch (type) {
- case 1: /* byte */
- value = *p++;
- p += 3;
- break;
- case 3: /* short */
- value = read_exif_bytes(&p, 2, bigendian);
- p += 2;
- break;
- case 4: /* long */
- case 9: /* slong */
- value = read_exif_bytes(&p, 4, bigendian);
- break;
- case 5: /* rational */
- case 10: /* srational */
- value = read_exif_bytes(&p, 4, bigendian);
- rp = tiff_header + value;
- num = read_exif_bytes(&rp, 4, bigendian);
- den = read_exif_bytes(&rp, 4, bigendian);
- break;
- case 7: /* undefined */
- value = *p++;
- p += 3;
- break;
- case 2: /* ascii */
- default:
- p += 4;
- break;
- }
- switch (tag) {
- case 282: /* x res */
- if (den != 0)
- xres = num / den;
- break;
- case 283: /* y res */
- if (den != 0)
- yres = num / den;
- break;
- case 296: /* res unit */
- switch (value) {
- case 2:
- res_unit = 1.0;
- break;
- case 3:
- res_unit = 2.54;
- break;
- }
- }
- }
-
- *xx = (int)(xres * res_unit);
- *yy = (int)(yres * res_unit);
-
-err:
- free(buffer);
- return;
-}
-
-void read_jpg_info(integer img)
-{
- int i, units = 0;
- unsigned short appmk, length;
- unsigned char jpg_id[] = "JFIF";
- img_xres(img) = img_yres(img) = 0;
- jpg_ptr(img)->file = xfopen(img_name(img), FOPEN_RBIN_MODE);
- /* no LFS needed, as JPEG is limited to <4GiB */
- xfseek(jpg_ptr(img)->file, 0, SEEK_END, cur_file_name);
- jpg_ptr(img)->length = xftell(jpg_ptr(img)->file, cur_file_name);
- xfseek(jpg_ptr(img)->file, 0, SEEK_SET, cur_file_name);
- if (read2bytes(jpg_ptr(img)->file) != 0xFFD8)
- pdftex_fail("reading JPEG image failed (no JPEG header found)");
- /* currently JFIF and Exif files allow extracting img_xres and img_yres */
- appmk = read2bytes(jpg_ptr(img)->file);
- if (appmk == 0xFFE0) { /* check for JFIF */
- (void) read2bytes(jpg_ptr(img)->file);
- for (i = 0; i < 5; i++) {
- if (xgetc(jpg_ptr(img)->file) != jpg_id[i])
- break;
- }
- if (i == 5) { /* it's JFIF */
- read2bytes(jpg_ptr(img)->file);
- units = xgetc(jpg_ptr(img)->file);
- img_xres(img) = read2bytes(jpg_ptr(img)->file);
- img_yres(img) = read2bytes(jpg_ptr(img)->file);
- switch (units) {
- case 1:
- break; /* pixels per inch */
- case 2:
- img_xres(img) *= 2.54;
- img_yres(img) *= 2.54;
- break; /* pixels per cm */
- default:
- img_xres(img) = img_yres(img) = 0;
- break;
- }
- }
- /* if either xres or yres is 0 but the other isn't,
- set it to the value of the other */
- if ((img_xres(img) == 0) && (img_yres(img) != 0)) {
- img_xres(img) = img_yres(img);
- }
- if ((img_yres(img) == 0) && (img_xres(img) != 0)) {
- img_yres(img) = img_xres(img);
- }
- } else if (appmk == 0xFFE1) { /* check for Exif */
- FILE *fp = jpg_ptr(img)->file;
- int xxres = 0;
- int yyres = 0;
- char app_sig[32];
- length = get_unsigned_pair(fp) - 2;
- if (length > 5) {
- if (fread(app_sig, sizeof(char), 5, fp) != 5)
- return;
- length -= 5;
- if (!memcmp(app_sig, "Exif\000", 5)) {
- read_APP1_Exif(fp, length, &xxres, &yyres);
- }
- }
- img_xres(img) = xxres;
- img_yres(img) = yyres;
- }
- xfseek(jpg_ptr(img)->file, 0, SEEK_SET, cur_file_name);
- while (1) {
- if (feof(jpg_ptr(img)->file))
- pdftex_fail("reading JPEG image failed (premature file end)");
- if (fgetc(jpg_ptr(img)->file) != 0xFF)
- pdftex_fail("reading JPEG image failed (no marker found)");
- switch (xgetc(jpg_ptr(img)->file)) {
- case M_SOF5:
- case M_SOF6:
- case M_SOF7:
- case M_SOF9:
- case M_SOF10:
- case M_SOF11:
- case M_SOF13:
- case M_SOF14:
- case M_SOF15:
- pdftex_fail("unsupported type of compression");
- case M_SOF2:
- if (fixedpdfminorversion <= 2)
- pdftex_fail("cannot use progressive DCT with PDF-1.2");
- case M_SOF0:
- case M_SOF1:
- case M_SOF3:
- (void) read2bytes(jpg_ptr(img)->file); /* read segment length */
- jpg_ptr(img)->bits_per_component = xgetc(jpg_ptr(img)->file);
- img_height(img) = read2bytes(jpg_ptr(img)->file);
- img_width(img) = read2bytes(jpg_ptr(img)->file);
- jpg_ptr(img)->color_space = xgetc(jpg_ptr(img)->file);
- xfseek(jpg_ptr(img)->file, 0, SEEK_SET, cur_file_name);
- switch (jpg_ptr(img)->color_space) {
- case JPG_GRAY:
- img_color(img) = IMAGE_COLOR_B;
- break;
- case JPG_RGB:
- img_color(img) = IMAGE_COLOR_C;
- break;
- case JPG_CMYK:
- img_color(img) = IMAGE_COLOR_C;
- break;
- default:
- pdftex_fail("Unsupported color space %i",
- (int) jpg_ptr(img)->color_space);
- }
- return;
- case M_SOI: /* ignore markers without parameters */
- case M_EOI:
- case M_TEM:
- case M_RST0:
- case M_RST1:
- case M_RST2:
- case M_RST3:
- case M_RST4:
- case M_RST5:
- case M_RST6:
- case M_RST7:
- break;
- default: /* skip variable length markers */
- xfseek(jpg_ptr(img)->file, read2bytes(jpg_ptr(img)->file) - 2,
- SEEK_CUR, cur_file_name);
- break;
- }
- }
-}
-
-void write_jpg(integer img)
-{
- long unsigned l;
- FILE *f;
- pdf_puts("/Type /XObject\n/Subtype /Image\n");
- pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n/Length %i\n",
- (int) img_width(img),
- (int) img_height(img),
- (int) jpg_ptr(img)->bits_per_component,
- (int) jpg_ptr(img)->length);
- pdf_puts("/ColorSpace ");
- if (img_colorspace_ref(img) != 0) {
- pdf_printf("%i 0 R\n", (int) img_colorspace_ref(img));
- } else {
- switch (jpg_ptr(img)->color_space) {
- case JPG_GRAY:
- pdf_puts("/DeviceGray\n");
- break;
- case JPG_RGB:
- pdf_puts("/DeviceRGB\n");
- break;
- case JPG_CMYK:
- pdf_puts("/DeviceCMYK\n/Decode [1 0 1 0 1 0 1 0]\n");
- break;
- default:
- pdftex_fail("Unsupported color space %i",
- (int) jpg_ptr(img)->color_space);
- }
- }
- pdf_puts("/Filter /DCTDecode\n>>\nstream\n");
- for (l = jpg_ptr(img)->length, f = jpg_ptr(img)->file; l > 0; l--)
- pdfout(xgetc(f));
- pdfendstream();
-}
diff --git a/Build/source/texk/web2c/pdftexdir/writepng.c b/Build/source/texk/web2c/pdftexdir/writepng.c
deleted file mode 100644
index 5079fc3f3d3..00000000000
--- a/Build/source/texk/web2c/pdftexdir/writepng.c
+++ /dev/null
@@ -1,675 +0,0 @@
-/*
-Copyright 1996-2017 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-#include "image.h"
-
-static int transparent_page_group = 0;
-
-static void warn(png_structp png_ptr, png_const_charp msg)
-{
- (void)png_ptr; (void)msg; /* Make compiler happy */
-}
-
-void read_png_info(integer img)
-{
- FILE *png_file = xfopen(img_name(img), FOPEN_RBIN_MODE);
-
- if ((png_ptr(img) = png_create_read_struct(PNG_LIBPNG_VER_STRING,
- NULL, NULL, warn)) == NULL)
- pdftex_fail("libpng: png_create_read_struct() failed");
- if ((png_info(img) = png_create_info_struct(png_ptr(img))) == NULL)
- pdftex_fail("libpng: png_create_info_struct() failed");
- if (setjmp(png_jmpbuf(png_ptr(img))))
- pdftex_fail("libpng: internal error");
-#if PNG_LIBPNG_VER >= 10603
- /* ignore possibly incorrect CMF bytes */
- png_set_option(png_ptr(img), PNG_MAXIMUM_INFLATE_WINDOW, PNG_OPTION_ON);
-#endif
- png_init_io(png_ptr(img), png_file);
- png_read_info(png_ptr(img), png_info(img));
- /* resolution support */
- img_width(img) = png_get_image_width(png_ptr(img), png_info(img));
- img_height(img) = png_get_image_height(png_ptr(img), png_info(img));
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_pHYs)) {
- img_xres(img) =
- round(0.0254 *
- png_get_x_pixels_per_meter(png_ptr(img), png_info(img)));
- img_yres(img) =
- round(0.0254 *
- png_get_y_pixels_per_meter(png_ptr(img), png_info(img)));
- }
- switch (png_get_color_type(png_ptr(img), png_info(img))) {
- case PNG_COLOR_TYPE_PALETTE:
- img_color(img) = IMAGE_COLOR_C | IMAGE_COLOR_I;
- break;
- case PNG_COLOR_TYPE_GRAY:
- case PNG_COLOR_TYPE_GRAY_ALPHA:
- img_color(img) = IMAGE_COLOR_B;
- break;
- case PNG_COLOR_TYPE_RGB:
- case PNG_COLOR_TYPE_RGB_ALPHA:
- img_color(img) = IMAGE_COLOR_C;
- break;
- default:
- pdftex_fail("unsupported type of color_type <%i>",
- png_get_color_type(png_ptr(img), png_info(img)));
- }
- if ((fixedpdfmajorversion > 1 || fixedpdfminorversion >= 4)
- && (png_get_color_type(png_ptr(img), png_info(img)) == PNG_COLOR_TYPE_GRAY_ALPHA
- || png_get_color_type(png_ptr(img), png_info(img)) == PNG_COLOR_TYPE_RGB_ALPHA)) {
- /* png with alpha channel in device colours; we have to add a Page
- * Group to make Adobe happy, so we have to create a dummy group object
- */
- if (transparent_page_group == 0) {
- transparent_page_group = pdfnewobjnum();
- }
- if (pdfpagegroupval == 0) {
- pdfpagegroupval = transparent_page_group;
- }
- img_group_ref(img) = pdfpagegroupval;
- }
-}
-
-
-#define write_gray_pixel_16(r) \
- if (j % 4 == 0||j % 4 == 1) pdfbuf[pdfptr++] = *r++; \
- else smask[smask_ptr++] = *r++
-
-#define write_gray_pixel_8(r) \
- if (j % 2 == 0) pdfbuf[pdfptr++] = *r++; \
- else smask[smask_ptr++] = *r++
-
-
-#define write_rgb_pixel_16(r) \
- if (!(j % 8 == 6||j % 8 == 7)) pdfbuf[pdfptr++] = *r++; \
- else smask[smask_ptr++] = *r++
-
-#define write_rgb_pixel_8(r) \
- if (j % 4 != 3) pdfbuf[pdfptr++] = *r++; \
- else smask[smask_ptr++] = *r++
-
-#define write_simple_pixel(r) pdfbuf[pdfptr++] = *r++
-
-
-#define write_noninterlaced(outmac) \
- for (i = 0; i < (int)png_get_image_height(png_ptr(img), png_info(img)); i++) { \
- png_read_row(png_ptr(img), row, NULL); \
- r = row; \
- k = png_get_rowbytes(png_ptr(img), png_info(img)); \
- while(k > 0) { \
- l = (k > pdfbufsize)? pdfbufsize : k; \
- pdfroom(l); \
- for (j = 0; j < l; j++) { \
- outmac; \
- } \
- k -= l; \
- } \
- }
-
-#define write_interlaced(outmac) \
- for (i = 0; i < (int)png_get_image_height(png_ptr(img), png_info(img)); i++) { \
- row = rows[i]; \
- k = png_get_rowbytes(png_ptr(img), png_info(img)); \
- while(k > 0) { \
- l = (k > pdfbufsize)? pdfbufsize : k; \
- pdfroom(l); \
- for (j = 0; j < l; j++) { \
- outmac; \
- } \
- k -= l; \
- } \
- xfree(rows[i]); \
- }
-
-
-static void write_png_palette(integer img)
-{
- int i, j, k, l;
- png_bytep row, r, *rows;
- integer palette_objnum = 0;
- png_colorp palette;
- int num_palette;
-
- png_get_PLTE(png_ptr(img), png_info(img), &palette, &num_palette);
-
- pdfcreateobj(0, 0);
- palette_objnum = objptr;
- if (img_colorspace_ref(img) != 0) {
- pdf_printf("%i 0 R\n", (int) img_colorspace_ref(img));
- } else {
- pdf_printf("[/Indexed /DeviceRGB %i %i 0 R]\n",
- num_palette -1, (int) palette_objnum);
- }
- pdfbeginstream();
- if (png_get_interlace_type(png_ptr(img), png_info(img)) == PNG_INTERLACE_NONE) {
- row = xtalloc(png_get_rowbytes(png_ptr(img), png_info(img)), png_byte);
- write_noninterlaced(write_simple_pixel(r));
- xfree(row);
- } else {
- if (png_get_image_height(png_ptr(img), png_info(img))
- * png_get_rowbytes(png_ptr(img), png_info(img)) >= 10240000L)
- pdftex_warn
- ("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
- rows = xtalloc(png_get_image_height(png_ptr(img), png_info(img)), png_bytep);
- for (i = 0; (unsigned) i < png_get_image_height(png_ptr(img), png_info(img)); i++)
- rows[i] = xtalloc(png_get_rowbytes(png_ptr(img), png_info(img)), png_byte);
- png_read_image(png_ptr(img), rows);
- write_interlaced(write_simple_pixel(row));
- xfree(rows);
- }
- pdfendstream();
- if (palette_objnum > 0) {
- pdfbegindict(palette_objnum, 0);
- pdfbeginstream();
- for (i = 0; (unsigned) i < num_palette; i++) {
- pdfroom(3);
- pdfbuf[pdfptr++] = palette[i].red;
- pdfbuf[pdfptr++] = palette[i].green;
- pdfbuf[pdfptr++] = palette[i].blue;
- }
- pdfendstream();
- }
-}
-
-static void write_png_gray(integer img)
-{
- int i, j, k, l;
- png_bytep row, r, *rows;
- if (img_colorspace_ref(img) != 0) {
- pdf_printf("%i 0 R\n", (int) img_colorspace_ref(img));
- } else {
- pdf_puts("/DeviceGray\n");
- }
- pdfbeginstream();
- if (png_get_interlace_type(png_ptr(img), png_info(img)) == PNG_INTERLACE_NONE) {
- row = xtalloc(png_get_rowbytes(png_ptr(img), png_info(img)), png_byte);
- write_noninterlaced(write_simple_pixel(r));
- xfree(row);
- } else {
- if (png_get_image_height(png_ptr(img), png_info(img))
- * png_get_rowbytes(png_ptr(img), png_info(img)) >= 10240000L)
- pdftex_warn
- ("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
- rows = xtalloc(png_get_image_height(png_ptr(img), png_info(img)), png_bytep);
- for (i = 0; (unsigned) i < png_get_image_height(png_ptr(img), png_info(img)); i++)
- rows[i] = xtalloc(png_get_rowbytes(png_ptr(img), png_info(img)), png_byte);
- png_read_image(png_ptr(img), rows);
- write_interlaced(write_simple_pixel(row));
- xfree(rows);
- }
- pdfendstream();
-}
-
-
-
-static void write_png_gray_alpha(integer img)
-{
- int i, j, k, l;
- png_bytep row, r, *rows;
- integer smask_objnum = 0;
- png_bytep smask;
- integer smask_ptr = 0;
- integer smask_size = 0;
- int bitdepth;
- if (img_colorspace_ref(img) != 0) {
- pdf_printf("%i 0 R\n", (int) img_colorspace_ref(img));
- } else {
- pdf_puts("/DeviceGray\n");
- }
- pdfcreateobj(0, 0);
- smask_objnum = objptr;
- pdf_printf("/SMask %i 0 R\n", (int) smask_objnum);
- smask_size = (png_get_rowbytes(png_ptr(img), png_info(img)) / 2)
- * png_get_image_height(png_ptr(img), png_info(img));
- smask = xtalloc(smask_size, png_byte);
- pdfbeginstream();
- if (png_get_interlace_type(png_ptr(img), png_info(img)) == PNG_INTERLACE_NONE) {
- row = xtalloc(png_get_rowbytes(png_ptr(img), png_info(img)), png_byte);
- if ((png_get_bit_depth(png_ptr(img), png_info(img)) == 16) && fixedimagehicolor) {
- write_noninterlaced(write_gray_pixel_16(r));
- } else {
- write_noninterlaced(write_gray_pixel_8(r));
- }
- xfree(row);
- } else {
- if (png_get_image_height(png_ptr(img), png_info(img))
- * png_get_rowbytes(png_ptr(img), png_info(img)) >= 10240000L)
- pdftex_warn
- ("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
- rows = xtalloc(png_get_image_height(png_ptr(img), png_info(img)), png_bytep);
- for (i = 0; (unsigned) i < png_get_image_height(png_ptr(img), png_info(img)); i++)
- rows[i] = xtalloc(png_get_rowbytes(png_ptr(img), png_info(img)), png_byte);
- png_read_image(png_ptr(img), rows);
- if ((png_get_bit_depth(png_ptr(img), png_info(img)) == 16) && fixedimagehicolor) {
- write_interlaced(write_gray_pixel_16(row));
- } else {
- write_interlaced(write_gray_pixel_8(row));
- }
- xfree(rows);
- }
- pdfendstream();
- pdfflush();
- /* now write the Smask object */
- if (smask_objnum > 0) {
- bitdepth = (int) png_get_bit_depth(png_ptr(img), png_info(img));
- pdfbegindict(smask_objnum, 0);
- pdf_puts("/Type /XObject\n/Subtype /Image\n");
- pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n",
- (int) png_get_image_width(png_ptr(img), png_info(img)),
- (int) png_get_image_height(png_ptr(img), png_info(img)),
- (bitdepth == 16 ? 8 : bitdepth));
- pdf_puts("/ColorSpace /DeviceGray\n");
- pdfbeginstream();
- for (i = 0; i < smask_size; i++) {
- if (i % 8 == 0)
- pdfroom(8);
- pdfbuf[pdfptr++] = smask[i];
- if (bitdepth == 16)
- i++;
- }
- xfree(smask);
- pdfendstream();
- }
-}
-
-static void write_png_rgb(integer img)
-{
- int i, j, k, l;
- png_bytep row, r, *rows;
- if (img_colorspace_ref(img) != 0) {
- pdf_printf("%i 0 R\n", (int) img_colorspace_ref(img));
- } else {
- pdf_puts("/DeviceRGB\n");
- }
- pdfbeginstream();
- if (png_get_interlace_type(png_ptr(img), png_info(img)) == PNG_INTERLACE_NONE) {
- row = xtalloc(png_get_rowbytes(png_ptr(img), png_info(img)), png_byte);
- write_noninterlaced(write_simple_pixel(r));
- xfree(row);
- } else {
- if (png_get_image_height(png_ptr(img), png_info(img))
- * png_get_rowbytes(png_ptr(img), png_info(img)) >= 10240000L)
- pdftex_warn
- ("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
- rows = xtalloc(png_get_image_height(png_ptr(img), png_info(img)), png_bytep);
- for (i = 0; (unsigned) i < png_get_image_height(png_ptr(img), png_info(img)); i++)
- rows[i] = xtalloc(png_get_rowbytes(png_ptr(img), png_info(img)), png_byte);
- png_read_image(png_ptr(img), rows);
- write_interlaced(write_simple_pixel(row));
- xfree(rows);
- }
- pdfendstream();
-}
-
-static void write_png_rgb_alpha(integer img)
-{
- int i, j, k, l;
- png_bytep row, r, *rows;
- integer smask_objnum = 0;
- png_bytep smask;
- integer smask_ptr = 0;
- integer smask_size = 0;
- int bitdepth;
- if (img_colorspace_ref(img) != 0) {
- pdf_printf("%i 0 R\n", (int) img_colorspace_ref(img));
- } else {
- pdf_puts("/DeviceRGB\n");
- }
- pdfcreateobj(0, 0);
- smask_objnum = objptr;
- pdf_printf("/SMask %i 0 R\n", (int) smask_objnum);
- smask_size = (png_get_rowbytes(png_ptr(img), png_info(img)) / 4)
- * png_get_image_height(png_ptr(img), png_info(img));
- smask = xtalloc(smask_size, png_byte);
- pdfbeginstream();
- if (png_get_interlace_type(png_ptr(img), png_info(img)) == PNG_INTERLACE_NONE) {
- row = xtalloc(png_get_rowbytes(png_ptr(img), png_info(img)), png_byte);
- if ((png_get_bit_depth(png_ptr(img), png_info(img)) == 16) && fixedimagehicolor) {
- write_noninterlaced(write_rgb_pixel_16(r));
- } else {
- write_noninterlaced(write_rgb_pixel_8(r));
- }
- xfree(row);
- } else {
- if (png_get_image_height(png_ptr(img), png_info(img))
- * png_get_rowbytes(png_ptr(img), png_info(img)) >= 10240000L)
- pdftex_warn
- ("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
- rows = xtalloc(png_get_image_height(png_ptr(img), png_info(img)), png_bytep);
- for (i = 0; (unsigned) i < png_get_image_height(png_ptr(img), png_info(img)); i++)
- rows[i] = xtalloc(png_get_rowbytes(png_ptr(img), png_info(img)), png_byte);
- png_read_image(png_ptr(img), rows);
- if ((png_get_bit_depth(png_ptr(img), png_info(img)) == 16) && fixedimagehicolor) {
- write_interlaced(write_rgb_pixel_16(row));
- } else {
- write_interlaced(write_rgb_pixel_8(row));
- }
- xfree(rows);
- }
- pdfendstream();
- pdfflush();
- /* now write the Smask object */
- if (smask_objnum > 0) {
- bitdepth = (int) png_get_bit_depth(png_ptr(img), png_info(img));
- pdfbegindict(smask_objnum, 0);
- pdf_puts("/Type /XObject\n/Subtype /Image\n");
- pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n",
- (int) png_get_image_width(png_ptr(img), png_info(img)),
- (int) png_get_image_height(png_ptr(img), png_info(img)),
- (bitdepth == 16 ? 8 : bitdepth));
- pdf_puts("/ColorSpace /DeviceGray\n");
- pdfbeginstream();
- for (i = 0; i < smask_size; i++) {
- if (i % 8 == 0)
- pdfroom(8);
- pdfbuf[pdfptr++] = smask[i];
- if (bitdepth == 16)
- i++;
- }
- xfree(smask);
- pdfendstream();
- }
-}
-
-
-/**********************************************************************/
-/*
- *
- * The |copy_png| function is from Hartmut Henkel. The goal is to use
- * pdf's native FlateDecode support if that is possible.
- *
- * Only a subset of the png files allows this, but when possible it
- * greatly improves inclusion speed.
- *
- */
-
-/* Code cheerfully gleaned from Thomas Merz' PDFlib, file p_png.c "SPNG - Simple PNG" */
-
-static int spng_getint(FILE * fp)
-{
- unsigned char buf[4];
- if (fread(buf, 1, 4, fp) != 4)
- pdftex_fail("writepng: reading chunk type failed");
- return ((((((int) buf[0] << 8) + buf[1]) << 8) + buf[2]) << 8) + buf[3];
-}
-
-#define SPNG_CHUNK_IDAT 0x49444154
-#define SPNG_CHUNK_IEND 0x49454E44
-
-static void copy_png(integer img)
-{
- FILE *fp = (FILE *) png_get_io_ptr(png_ptr(img));
- int i, len, type, streamlength = 0;
- boolean endflag = false;
- int idat = 0; /* flag to check continuous IDAT chunks sequence */
- /* 1st pass to find overall stream /Length */
- if (fseek(fp, 8, SEEK_SET) != 0)
- pdftex_fail("writepng: fseek in PNG file failed");
- do {
- len = spng_getint(fp);
- type = spng_getint(fp);
- switch (type) {
- case SPNG_CHUNK_IEND:
- endflag = true;
- break;
- case SPNG_CHUNK_IDAT:
- streamlength += len;
- default:
- if (fseek(fp, len + 4, SEEK_CUR) != 0)
- pdftex_fail("writepng: fseek in PNG file failed");
- }
- } while (endflag == false);
- pdf_printf("/Length %d\n"
- "/Filter/FlateDecode\n"
- "/DecodeParms<<"
- "/Colors %d"
- "/Columns %d"
- "/BitsPerComponent %i"
- "/Predictor 10>>\n>>\nstream\n", streamlength,
- png_get_color_type(png_ptr(img), png_info(img)) == 2 ? 3 : 1,
- (int) png_get_image_width(png_ptr(img), png_info(img)),
- (int) png_get_bit_depth(png_ptr(img), png_info(img)));
- /* 2nd pass to copy data */
- endflag = false;
- if (fseek(fp, 8, SEEK_SET) != 0)
- pdftex_fail("writepng: fseek in PNG file failed");
- do {
- len = spng_getint(fp);
- type = spng_getint(fp);
- switch (type) {
- case SPNG_CHUNK_IDAT: /* do copy */
- if (idat == 2)
- pdftex_fail("writepng: IDAT chunk sequence broken");
- idat = 1;
- while (len > 0) {
- i = (len > pdfbufsize) ? pdfbufsize : len;
- pdfroom(i);
- fread(&pdfbuf[pdfptr], 1, i, fp);
- pdfptr += i;
- len -= i;
- }
- if (fseek(fp, 4, SEEK_CUR) != 0)
- pdftex_fail("writepng: fseek in PNG file failed");
- break;
- case SPNG_CHUNK_IEND: /* done */
- pdfendstream();
- endflag = true;
- break;
- default:
- if (idat == 1)
- idat = 2;
- if (fseek(fp, len + 4, SEEK_CUR) != 0)
- pdftex_fail("writepng: fseek in PNG file failed");
- }
- } while (endflag == false);
-}
-
-static boolean last_png_needs_page_group;
-static boolean transparent_page_group_was_written = false;
-
-/* Called after the xobject generated by write_png has been finished; used to
- * write out additional objects */
-static void write_additional_png_objects(void)
-{
- if (last_png_needs_page_group) {
- if (!transparent_page_group_was_written && transparent_page_group > 0) {
- // create new group object
- transparent_page_group_was_written = true;
- pdfbeginobj(transparent_page_group, 2);
- if (getpdfcompresslevel() == 0) {
- pdf_puts("%PTEX Group needed for transparent pngs\n");
- }
- pdf_puts("<</Type/Group /S/Transparency /CS/DeviceRGB /I true>>\n");
- pdfendobj();
- }
- }
-}
-
-void write_png(integer img)
-{
-
- boolean png_copy = true;
- double gamma = 0.0;
- png_fixed_point int_file_gamma = 0;
-#ifndef PNG_FP_1
- /* for libpng < 1.5.0 */
-#define PNG_FP_1 100000
-#endif
- int i;
- integer palette_objnum = 0;
- png_colorp palette;
- int num_palette;
- last_png_needs_page_group = false;
-
- png_get_PLTE(png_ptr(img), png_info(img), &palette, &num_palette);
-
- if (fixedpdfmajorversion == 1 && fixedpdfminorversion < 5)
- fixedimagehicolor = 0;
-
- pdf_puts("/Type /XObject\n/Subtype /Image\n");
- /* simple transparency support */
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_tRNS)) {
- png_set_tRNS_to_alpha(png_ptr(img));
- png_copy = false;
- }
- /* alpha channel support */
- if (fixedpdfmajorversion == 1 && fixedpdfminorversion < 4
- && png_get_color_type(png_ptr(img), png_info(img)) | PNG_COLOR_MASK_ALPHA) {
- png_set_strip_alpha(png_ptr(img));
- png_copy = false;
- }
- /* 16 bit depth support */
- if (fixedpdfmajorversion == 1 && fixedpdfminorversion < 5)
- fixedimagehicolor = 0;
- if ((png_get_bit_depth(png_ptr(img), png_info(img)) == 16) && (fixedimagehicolor == 0)) {
- png_set_strip_16(png_ptr(img));
- png_copy = false;
- }
- /* gamma support */
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_gAMA)) {
- png_get_gAMA(png_ptr(img), png_info(img), &gamma);
- png_get_gAMA_fixed(png_ptr(img), png_info(img), &int_file_gamma);
- }
- if (fixedimageapplygamma) {
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_gAMA))
- png_set_gamma(png_ptr(img), fixedgamma / 1000.0, gamma);
- else
- png_set_gamma(png_ptr(img), fixedgamma / 1000.0,
- 1000.0 / fixedimagegamma);
- png_copy = false;
- }
- /* reset structure */
- (void) png_set_interlace_handling(png_ptr(img));
- png_read_update_info(png_ptr(img), png_info(img));
-
- pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n",
- (int) png_get_image_width(png_ptr(img), png_info(img)),
- (int) png_get_image_height(png_ptr(img), png_info(img)),
- (int) png_get_bit_depth(png_ptr(img), png_info(img)));
- pdf_puts("/ColorSpace ");
- if (png_copy && (fixedpdfmajorversion > 1 || fixedpdfminorversion > 1)
- && png_get_interlace_type(png_ptr(img), png_info(img)) == PNG_INTERLACE_NONE
- && (png_get_color_type(png_ptr(img), png_info(img)) == PNG_COLOR_TYPE_GRAY
- || png_get_color_type(png_ptr(img), png_info(img)) == PNG_COLOR_TYPE_RGB)
- && !fixedimageapplygamma
- && (!png_get_valid(png_ptr(img), png_info(img), PNG_INFO_gAMA)
- || int_file_gamma == PNG_FP_1)
- && !png_get_valid(png_ptr(img), png_info(img),
- PNG_INFO_cHRM | PNG_INFO_iCCP | PNG_INFO_sBIT | PNG_INFO_sRGB
- | PNG_INFO_bKGD | PNG_INFO_hIST | PNG_INFO_tRNS | PNG_INFO_sPLT)
- ) {
- /* Copy PNG */
- if (img_colorspace_ref(img) != 0) {
- pdf_printf("%i 0 R\n", (int) img_colorspace_ref(img));
- } else {
- switch (png_get_color_type(png_ptr(img), png_info(img))) {
- case PNG_COLOR_TYPE_PALETTE:
- pdfcreateobj(0, 0);
- palette_objnum = objptr;
- pdf_printf("[/Indexed /DeviceRGB %i %i 0 R]\n",
- num_palette - 1, (int) palette_objnum);
- break;
- case PNG_COLOR_TYPE_GRAY:
- pdf_puts("/DeviceGray\n");
- break;
- default: /* RGB */
- pdf_puts("/DeviceRGB\n");
- };
- }
- tex_printf(" (PNG copy)");
- copy_png(img);
- if (palette_objnum > 0) {
- pdfbegindict(palette_objnum, 0);
- pdfbeginstream();
- for (i = 0; i < num_palette; i++) {
- pdfroom(3);
- pdfbuf[pdfptr++] = palette[i].red;
- pdfbuf[pdfptr++] = palette[i].green;
- pdfbuf[pdfptr++] = palette[i].blue;
- }
- pdfendstream();
- }
- } else {
- if (0) {
- tex_printf(" *** PNG copy skipped because:");
- if (!png_copy)
- tex_printf(" !png_copy");
- if (fixedpdfmajorversion == 1 && fixedpdfminorversion <= 1)
- tex_printf(" minorversion=%d (and majorversion=1)",
- (int) fixedpdfminorversion);
- if (png_get_interlace_type(png_ptr(img), png_info(img)) != PNG_INTERLACE_NONE)
- tex_printf(" interlaced");
- if (!((png_get_color_type(png_ptr(img), png_info(img)) == PNG_COLOR_TYPE_GRAY)
- || (png_get_color_type(png_ptr(img), png_info(img)) == PNG_COLOR_TYPE_RGB)))
- tex_printf(" colortype");
- if (fixedimageapplygamma)
- tex_printf(" apply gamma");
- if (!(!png_get_valid(png_ptr(img), png_info(img), PNG_INFO_gAMA)
- || int_file_gamma == PNG_FP_1))
- tex_printf(" gamma");
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_cHRM))
- tex_printf(" cHRM");
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_iCCP))
- tex_printf(" iCCP");
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_sBIT))
- tex_printf(" sBIT");
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_sRGB))
- tex_printf(" sRGB");
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_bKGD))
- tex_printf(" bKGD");
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_hIST))
- tex_printf(" hIST");
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_tRNS))
- tex_printf(" tRNS");
- if (png_get_valid(png_ptr(img), png_info(img), PNG_INFO_sPLT))
- tex_printf(" sPLT");
- }
- switch (png_get_color_type(png_ptr(img), png_info(img))) {
- case PNG_COLOR_TYPE_PALETTE:
- write_png_palette(img);
- break;
- case PNG_COLOR_TYPE_GRAY:
- write_png_gray(img);
- break;
- case PNG_COLOR_TYPE_GRAY_ALPHA:
- if (fixedpdfminorversion >= 4 || fixedpdfmajorversion > 1) {
- write_png_gray_alpha(img);
- last_png_needs_page_group = true;
- } else
- write_png_gray(img);
- break;
- case PNG_COLOR_TYPE_RGB:
- write_png_rgb(img);
- break;
- case PNG_COLOR_TYPE_RGB_ALPHA:
- if (fixedpdfminorversion >= 4 || fixedpdfmajorversion > 1) {
- write_png_rgb_alpha(img);
- last_png_needs_page_group = true;
- } else
- write_png_rgb(img);
- break;
- default:
- pdftex_fail("unsupported type of color_type <%i>",
- png_get_color_type(png_ptr(img), png_info(img)));
- }
- }
- pdfflush();
- write_additional_png_objects();
-}
diff --git a/Build/source/texk/web2c/pdftexdir/writet1.c b/Build/source/texk/web2c/pdftexdir/writet1.c
deleted file mode 100644
index 079ac369d7d..00000000000
--- a/Build/source/texk/web2c/pdftexdir/writet1.c
+++ /dev/null
@@ -1,1711 +0,0 @@
-/*
-Copyright 1996-2018 Han The Thanh <thanh@pdftex.org>
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>. */
-
-#include "ptexlib.h"
-#include <stdarg.h>
-#include <string.h>
-
-#define t1_log(str) tex_printf("%s",str)
-#define get_length1() t1_length1 = t1_offset() - t1_save_offset
-#define get_length2() t1_length2 = t1_offset() - t1_save_offset
-#define get_length3() t1_length3 = fixedcontent? t1_offset() - t1_save_offset : 0
-#define save_offset() t1_save_offset = t1_offset()
-
-#define t1_open() open_input(&t1_file, kpse_type1_format, FOPEN_RBIN_MODE)
-#define t1_close() xfclose(t1_file, cur_file_name)
-#define t1_getchar() getc(t1_file)
-#define t1_putchar fb_putchar
-#define t1_offset fb_offset
-#define t1_ungetchar(c) ungetc(c, t1_file)
-#define t1_eof() feof(t1_file)
-
-#define t1_prefix(s) str_prefix(t1_line_array, s)
-#define t1_buf_prefix(s) str_prefix(t1_buf_array, s)
-#define t1_suffix(s) str_suffix(t1_line_array, t1_line_ptr, s)
-#define t1_buf_suffix(s) str_suffix(t1_buf_array, t1_buf_ptr, s)
-#define t1_charstrings() strstr(t1_line_array, charstringname)
-#define t1_subrs() t1_prefix("/Subrs")
-#define t1_end_eexec() t1_suffix("mark currentfile closefile")
-#define t1_cleartomark() t1_prefix("cleartomark")
-
-#define enc_open() open_input(&enc_file, kpse_enc_format, FOPEN_RBIN_MODE)
-#define enc_close() xfclose(enc_file, cur_file_name)
-#define enc_getchar() getc(enc_file)
-#define enc_eof() feof(enc_file)
-
-#define valid_code(c) (c >= 0 && c < 256)
-#define fixedcontent false /* false for pdfTeX, true for dvips */
-
-static const char *standard_glyph_names[256] = {
- /* 0x00 */
- notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
- notdef, notdef, notdef, notdef, notdef, notdef, notdef,
- /* 0x10 */
- notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
- notdef, notdef, notdef, notdef, notdef, notdef, notdef,
- /* 0x20 */
- "space", "exclam", "quotedbl", "numbersign", "dollar", "percent",
- "ampersand", "quoteright", "parenleft", "parenright", "asterisk",
- "plus", "comma", "hyphen", "period", "slash",
- /* 0x30 */
- "zero", "one", "two", "three", "four", "five", "six", "seven", "eight",
- "nine", "colon", "semicolon", "less", "equal", "greater", "question",
- /* 0x40 */
- "at", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N",
- "O",
- /* 0x50 */
- "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "bracketleft",
- "backslash", "bracketright", "asciicircum", "underscore",
- /* 0x60 */
- "quoteleft", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l",
- "m", "n", "o",
- /* 0x70 */
- "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "braceleft", "bar",
- "braceright", "asciitilde", notdef,
- /* 0x80 */
- notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
- notdef, notdef, notdef, notdef, notdef, notdef, notdef,
- /* 0x90 */
- notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
- notdef, notdef, notdef, notdef, notdef, notdef, notdef,
- /* 0xa0 */
- notdef, "exclamdown", "cent", "sterling", "fraction", "yen", "florin",
- "section", "currency", "quotesingle", "quotedblleft", "guillemotleft",
- "guilsinglleft", "guilsinglright", "fi", "fl",
- /* 0xb0 */
- notdef, "endash", "dagger", "daggerdbl", "periodcentered", notdef,
- "paragraph", "bullet", "quotesinglbase", "quotedblbase",
- "quotedblright", "guillemotright", "ellipsis", "perthousand", notdef,
- "questiondown",
- /* 0xc0 */
- notdef, "grave", "acute", "circumflex", "tilde", "macron", "breve",
- "dotaccent", "dieresis", notdef,
- "ring", "cedilla", notdef, "hungarumlaut", "ogonek", "caron",
- /* 0xd0 */
- "emdash", notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
- notdef, notdef, notdef, notdef, notdef, notdef, notdef,
- /* 0xe0 */
- notdef, "AE", notdef, "ordfeminine", notdef, notdef, notdef, notdef,
- "Lslash", "Oslash", "OE", "ordmasculine", notdef, notdef, notdef,
- notdef,
- /* 0xf0 */
- notdef, "ae", notdef, notdef, notdef, "dotlessi", notdef, notdef, "lslash",
- "oslash", "oe", "germandbls", notdef, notdef, notdef, notdef
-};
-
-integer t1_length1, t1_length2, t1_length3;
-static integer t1_save_offset;
-static integer t1_fontname_offset;
-static fd_entry *fd_cur;
-
-static char charstringname[] = "/CharStrings";
-
-enum { ENC_STANDARD, ENC_BUILTIN } t1_encoding;
-
-#define T1_BUF_SIZE 0x10
-#define ENC_BUF_SIZE 0x1000
-
-#define CS_HSTEM 1
-#define CS_VSTEM 3
-#define CS_VMOVETO 4
-#define CS_RLINETO 5
-#define CS_HLINETO 6
-#define CS_VLINETO 7
-#define CS_RRCURVETO 8
-#define CS_CLOSEPATH 9
-#define CS_CALLSUBR 10
-#define CS_RETURN 11
-#define CS_ESCAPE 12
-#define CS_HSBW 13
-#define CS_ENDCHAR 14
-#define CS_RMOVETO 21
-#define CS_HMOVETO 22
-#define CS_VHCURVETO 30
-#define CS_HVCURVETO 31
-#define CS_1BYTE_MAX (CS_HVCURVETO + 1)
-
-#define CS_DOTSECTION CS_1BYTE_MAX + 0
-#define CS_VSTEM3 CS_1BYTE_MAX + 1
-#define CS_HSTEM3 CS_1BYTE_MAX + 2
-#define CS_SEAC CS_1BYTE_MAX + 6
-#define CS_SBW CS_1BYTE_MAX + 7
-#define CS_DIV CS_1BYTE_MAX + 12
-#define CS_CALLOTHERSUBR CS_1BYTE_MAX + 16
-#define CS_POP CS_1BYTE_MAX + 17
-#define CS_SETCURRENTPOINT CS_1BYTE_MAX + 33
-#define CS_2BYTE_MAX (CS_SETCURRENTPOINT + 1)
-#define CS_MAX CS_2BYTE_MAX
-
-typedef unsigned char byte;
-
-typedef struct {
- byte nargs; /* number of arguments */
- boolean bottom; /* take arguments from bottom of stack? */
- boolean clear; /* clear stack? */
- boolean valid;
-} cc_entry; /* CharString Command */
-
-typedef struct {
- char *name; /* glyph name (or notdef for Subrs entry) */
- byte *data;
- unsigned short len; /* length of the whole string */
- unsigned short cslen; /* length of the encoded part of the string */
- boolean used;
- boolean valid;
-} cs_entry;
-
-static unsigned short t1_dr, t1_er;
-static const unsigned short t1_c1 = 52845, t1_c2 = 22719;
-static unsigned short t1_cslen;
-static short t1_lenIV;
-static char enc_line[ENC_BUF_SIZE];
-
-/* define t1_line_ptr, t1_line_array & t1_line_limit */
-typedef char t1_line_entry;
-define_array(t1_line);
-
-/* define t1_buf_ptr, t1_buf_array & t1_buf_limit */
-typedef char t1_buf_entry;
-define_array(t1_buf);
-
-static int cs_start;
-
-static cs_entry *cs_tab, *cs_ptr, *cs_notdef;
-static char *cs_dict_start, *cs_dict_end;
-static int cs_count, cs_size, cs_size_pos;
-
-static cs_entry *subr_tab;
-static char *subr_array_start, *subr_array_end;
-static int subr_max, subr_size, subr_size_pos;
-
-/* This list contains the begin/end tokens commonly used in the */
-/* /Subrs array of a Type 1 font. */
-
-static const char *cs_token_pairs_list[][2] = {
- {" RD", "NP"},
- {" -|", "|"},
- {" RD", "noaccess put"},
- {" -|", "noaccess put"},
- {NULL, NULL}
-};
-static const char **cs_token_pair;
-
-static boolean t1_pfa, t1_cs, t1_scan, t1_eexec_encrypt, t1_synthetic;
-static int t1_in_eexec; /* 0 before eexec-encrypted, 1 during, 2 after */
-static long t1_block_length;
-static int last_hexbyte;
-static FILE *t1_file;
-static FILE *enc_file;
-
-static void enc_getline(void)
-{
- char *p;
- int c;
- restart:
- if (enc_eof())
- pdftex_fail("unexpected end of file");
- p = enc_line;
- do {
- c = enc_getchar();
- append_char_to_buf(c, p, enc_line, ENC_BUF_SIZE);
- } while (c != 10);
- append_eol(p, enc_line, ENC_BUF_SIZE);
- if (p - enc_line < 2 || *enc_line == '%')
- goto restart;
-}
-
-/* read encoding from .enc file, return glyph_names array, or pdffail() */
-
-char **load_enc_file(char *enc_name)
-{
- char buf[ENC_BUF_SIZE], *p, *r;
- int i, names_count;
- char **glyph_names;
- set_cur_file_name(enc_name);
- if (!enc_open()) {
- pdftex_fail("cannot open encoding file for reading");
- }
- glyph_names = xtalloc(256, char *);
- for (i = 0; i < 256; i++)
- glyph_names[i] = notdef;
- t1_log("{");
- t1_log(cur_file_name = (char *) nameoffile + 1);
- enc_getline();
- if (*enc_line != '/' || (r = strchr(enc_line, '[')) == NULL) {
- remove_eol(r, enc_line);
- pdftex_fail
- ("invalid encoding vector (a name or `[' missing): `%s'", enc_line);
- }
- names_count = 0;
- r++; /* skip '[' */
- skip(r, ' ');
- for (;;) {
- while (*r == '/') {
- for (p = buf, r++;
- *r != ' ' && *r != 10 && *r != ']' && *r != '/'; *p++ = *r++);
- *p = 0;
- skip(r, ' ');
- if (names_count > 255)
- pdftex_fail("encoding vector contains more than 256 names");
- if (strcmp(buf, notdef) != 0)
- glyph_names[names_count] = xstrdup(buf);
- names_count++;
- }
- if (*r != 10 && *r != '%') {
- if (str_prefix(r, "] def"))
- goto done;
- else {
- remove_eol(r, enc_line);
- pdftex_fail
- ("invalid encoding vector: a name or `] def' expected: `%s'", enc_line);
- }
- }
- enc_getline();
- r = enc_line;
- }
- done:
- enc_close();
- t1_log("}");
- cur_file_name = NULL;
- return glyph_names;
-}
-
-static void t1_check_pfa(void)
-{
- const int c = t1_getchar();
- t1_pfa = (c != 128) ? true : false;
- t1_ungetchar(c);
-}
-
-static int t1_getbyte(void)
-{
- int c = t1_getchar();
- if (t1_pfa)
- return c;
- if (t1_block_length == 0) {
- if (c != 128)
- pdftex_fail("invalid marker");
- c = t1_getchar();
- if (c == 3) {
- while (!t1_eof())
- t1_getchar();
- return EOF;
- }
- t1_block_length = t1_getchar() & 0xff;
- t1_block_length |= (t1_getchar() & 0xff) << 8;
- t1_block_length |= (t1_getchar() & 0xff) << 16;
- t1_block_length |= (t1_getchar() & 0xff) << 24;
- c = t1_getchar();
- }
- t1_block_length--;
- return c;
-}
-
-static int hexval(int c)
-{
- if (c >= 'A' && c <= 'F')
- return c - 'A' + 10;
- else if (c >= 'a' && c <= 'f')
- return c - 'a' + 10;
- else if (c >= '0' && c <= '9')
- return c - '0';
- else
- return -1;
-}
-
-static byte edecrypt(byte cipher)
-{
- byte plain;
- if (t1_pfa) {
- while (cipher == 10 || cipher == 13)
- cipher = t1_getbyte();
- last_hexbyte = cipher = (hexval(cipher) << 4) + hexval(t1_getbyte());
- }
- plain = (cipher ^ (t1_dr >> 8));
- t1_dr = (cipher + t1_dr) * t1_c1 + t1_c2;
- return plain;
-}
-
-static byte cdecrypt(byte cipher, unsigned short *cr)
-{
- const byte plain = (cipher ^ (*cr >> 8));
- *cr = (cipher + *cr) * t1_c1 + t1_c2;
- return plain;
-}
-
-static byte eencrypt(byte plain)
-{
- const byte cipher = (plain ^ (t1_er >> 8));
- t1_er = (cipher + t1_er) * t1_c1 + t1_c2;
- return cipher;
-}
-
-static byte cencrypt(byte plain, unsigned short *cr)
-{
- const byte cipher = (plain ^ (*cr >> 8));
- *cr = (cipher + *cr) * t1_c1 + t1_c2;
- return cipher;
-}
-
-static char *eol(char *s)
-{
- char *p = strend(s);
- if (p - s > 1 && p[-1] != 10) {
- *p++ = 10;
- *p = 0;
- }
- return p;
-}
-
-static float t1_scan_num(char *p, char **r)
-{
- float f;
- skip(p, ' ');
- if (sscanf(p, "%g", &f) != 1) {
- remove_eol(p, t1_line_array);
- pdftex_fail("a number expected: `%s'", t1_line_array);
- }
- if (r != NULL) {
- for (; isdigit((unsigned char)*p) || *p == '.' ||
- *p == 'e' || *p == 'E' || *p == '+' || *p == '-'; p++);
- *r = p;
- }
- return f;
-}
-
-static boolean str_suffix(const char *begin_buf, const char *end_buf,
- const char *s)
-{
- const char *s1 = end_buf - 1, *s2 = strend(s) - 1;
- if (*s1 == 10)
- s1--;
- while (s1 >= begin_buf && s2 >= s) {
- if (*s1-- != *s2--)
- return false;
- }
- return s2 < s;
-}
-
-static void t1_getline(void)
-{
- int c, l, eexec_scan;
- char *p;
- static const char eexec_str[] = "currentfile eexec";
- static int eexec_len = 17; /* strlen(eexec_str) */
- restart:
- if (t1_eof())
- pdftex_fail("unexpected end of file");
- t1_line_ptr = t1_line_array;
- alloc_array(t1_line, 1, T1_BUF_SIZE);
- t1_cslen = 0;
- eexec_scan = 0;
- c = t1_getbyte();
- if (c == EOF)
- goto exit;
- while (!t1_eof()) {
- if (t1_in_eexec == 1)
- c = edecrypt((byte)c);
- alloc_array(t1_line, 1, T1_BUF_SIZE);
- append_char_to_buf(c, t1_line_ptr, t1_line_array, t1_line_limit);
- if (t1_in_eexec == 0 && eexec_scan >= 0 && eexec_scan < eexec_len) {
- if (t1_line_array[eexec_scan] == eexec_str[eexec_scan])
- eexec_scan++;
- else
- eexec_scan = -1;
- }
- if (c == 10 || (t1_pfa && eexec_scan == eexec_len && c == 32))
- break;
- if (t1_cs && t1_cslen == 0 && (t1_line_ptr - t1_line_array > 4) &&
- (t1_suffix(" RD ") || t1_suffix(" -| "))) {
- p = t1_line_ptr - 5;
- while (*p != ' ')
- p--;
- t1_cslen = l = t1_scan_num(p + 1, 0);
- cs_start = t1_line_ptr - t1_line_array; /* cs_start is an index now */
- alloc_array(t1_line, l, T1_BUF_SIZE);
- while (l-- > 0)
- *t1_line_ptr++ = edecrypt((byte)t1_getbyte());
- }
- c = t1_getbyte();
- }
- alloc_array(t1_line, 2, T1_BUF_SIZE); /* append_eol can append 2 chars */
- append_eol(t1_line_ptr, t1_line_array, t1_line_limit);
- if (t1_line_ptr - t1_line_array < 2)
- goto restart;
- if (eexec_scan == eexec_len)
- t1_in_eexec = 1;
- exit:
- /* ensure that t1_buf_array has as much room as t1_line_array */
- t1_buf_ptr = t1_buf_array;
- alloc_array(t1_buf, t1_line_limit, t1_line_limit);
-}
-
-static void t1_putline(void)
-{
- char *p = t1_line_array;
- if (t1_line_ptr - t1_line_array <= 1)
- return;
- if (t1_eexec_encrypt) {
- while (p < t1_line_ptr)
- t1_putchar(eencrypt(*p++));
- } else
- while (p < t1_line_ptr)
- t1_putchar(*p++);
-}
-
-static void t1_puts(const char *s)
-{
- if (s != t1_line_array)
- strcpy(t1_line_array, s);
- t1_line_ptr = strend(t1_line_array);
- t1_putline();
-}
-
-__attribute__ ((format(printf, 1, 2)))
-static void t1_printf(const char *fmt, ...)
-{
- va_list args;
- va_start(args, fmt);
- vsprintf(t1_line_array, fmt, args);
- t1_puts(t1_line_array);
- va_end(args);
-}
-
-static void t1_init_params(const char *open_name_prefix)
-{
- t1_log(open_name_prefix);
- t1_log(cur_file_name);
- t1_lenIV = 4;
- t1_dr = 55665;
- t1_er = 55665;
- t1_in_eexec = 0;
- t1_cs = false;
- t1_scan = true;
- t1_synthetic = false;
- t1_eexec_encrypt = false;
- t1_block_length = 0;
- t1_check_pfa();
-}
-
-static void t1_close_font_file(const char *close_name_suffix)
-{
- t1_log(close_name_suffix);
- t1_close();
- cur_file_name = NULL;
-}
-
-static void t1_check_block_len(boolean decrypt)
-{
- int l, c;
- if (t1_block_length == 0)
- return;
- c = t1_getbyte();
- if (decrypt)
- c = edecrypt((byte)c);
- l = t1_block_length;
- if (!(l == 0 && (c == 10 || c == 13))) {
- pdftex_fail("%i bytes more than expected", l + 1);
- }
-}
-
-static void t1_start_eexec(void)
-{
- int i;
- assert(is_included(fd_cur->fm));
- get_length1();
- save_offset();
- if (!t1_pfa)
- t1_check_block_len(false);
- for (t1_line_ptr = t1_line_array, i = 0; i < 4; i++) {
- edecrypt((byte)t1_getbyte());
- *t1_line_ptr++ = 0;
- }
- t1_eexec_encrypt = true;
- t1_putline(); /* to put the first four bytes */
-}
-
-static void t1_stop_eexec(void)
-{
- int c;
- assert(is_included(fd_cur->fm));
- get_length2();
- save_offset();
- t1_eexec_encrypt = false;
- if (!t1_pfa)
- t1_check_block_len(true);
- else {
- c = edecrypt((byte)t1_getbyte());
- if (!(c == 10 || c == 13)) {
- if (last_hexbyte == 0)
- t1_puts("00");
- else
- pdftex_fail("unexpected data after eexec");
- }
- }
- t1_cs = false;
- t1_in_eexec = 2;
-}
-
-/* macros for various transforms; currently only slant and extend are used */
-
-#define do_xshift(x,a) {x[4]+=a;}
-#define do_yshift(x,a) {x[5]+=a;}
-#define do_xscale(x,a) {x[0]*=a; x[2]*=a; x[4]*=a;}
-#define do_yscale(x,a) {x[1]*=a; x[3]*=a; x[5]*=a;}
-#define do_extend(x,a) {do_xscale(x,a);}
-#define do_scale(x,a) {do_xscale(x,a); do_yscale(x,a);}
-#define do_slant(x,a) {x[0]+=x[1]*(a); x[2]+=x[3]*(a); x[4]+=x[5]*(a);}
-#define do_shear(x,a) {x[1]+=x[0]*(a); x[3]+=x[2]*(a); x[5]+=x[4]*(a);}
-#define do_rotate(x,a) \
- {float t, u=cos(a), v=sin(a); \
- t =x[0]*u+x[1]*-v; \
- x[1] =x[0]*v+x[1]* u; x[0]=t; \
- t =x[2]*u+x[3]*-v; \
- x[3] =x[2]*v+x[3]* u; x[2]=t; \
- t =x[4]*u+x[5]*-v; \
- x[5] =x[4]*v+x[5]* u; x[4]=t;}
-
-static void t1_modify_fm(void)
-{
- /*
- * font matrix is given as six numbers a0..a5, which stands for the matrix
- *
- * a0 a1 0
- * M = a2 a3 0
- * a4 a5 1
- *
- * ExtendFont is given as
- *
- * e 0 0
- * E = 0 1 0
- * 0 0 1
- *
- * SlantFont is given as
- *
- * 1 0 0
- * S = s 1 0
- * 0 0 1
- *
- * The slant transform must be done _before_ the extend transform
- * for compatibility!
- */
- float a[6];
- int i, c;
- char *p, *q, *r;
- if ((p = strchr(t1_line_array, '[')) == 0)
- if ((p = strchr(t1_line_array, '{')) == 0) {
- remove_eol(p, t1_line_array);
- pdftex_fail("FontMatrix: an array expected: `%s'", t1_line_array);
- }
- c = *p++; /* save the character '[' resp. '{' */
- strncpy(t1_buf_array, t1_line_array, (size_t) (p - t1_line_array));
- r = t1_buf_array + (p - t1_line_array);
- for (i = 0; i < 6; i++) {
- a[i] = t1_scan_num(p, &q);
- p = q;
- }
- if (fm_slant(fd_cur->fm) != 0)
- do_slant(a, fm_slant(fd_cur->fm) * 1E-3);
- if (fm_extend(fd_cur->fm) != 0)
- do_extend(a, fm_extend(fd_cur->fm) * 1E-3);
- for (i = 0; i < 6; i++) {
- sprintf(r, "%g ", a[i]);
- r = strend(r);
- }
- if (c == '[') {
- while (*p != ']' && *p != 0)
- p++;
- } else {
- while (*p != '}' && *p != 0)
- p++;
- }
- if (*p == 0) {
- remove_eol(p, t1_line_array);
- pdftex_fail
- ("FontMatrix: cannot find the corresponding character to '%c': `%s'",
- c, t1_line_array);
- }
- strcpy(r, p);
- strcpy(t1_line_array, t1_buf_array);
- t1_line_ptr = eol(t1_line_array);
-}
-
-static void t1_modify_italic(void)
-{
- float a;
- char *p, *r;
- if (fm_slant(fd_cur->fm) == 0)
- return;
- p = strchr(t1_line_array, ' ');
- strncpy(t1_buf_array, t1_line_array, (size_t) (p - t1_line_array + 1));
- a = t1_scan_num(p + 1, &r);
- a -= atan(fm_slant(fd_cur->fm) * 1E-3) * (180 / M_PI);
- sprintf(t1_buf_array + (p - t1_line_array + 1), "%g", a);
- strcpy(strend(t1_buf_array), r);
- strcpy(t1_line_array, t1_buf_array);
- t1_line_ptr = eol(t1_line_array);
- fd_cur->font_dim[ITALIC_ANGLE_CODE].val = round(a);
- fd_cur->font_dim[ITALIC_ANGLE_CODE].set = true;
-}
-
-static void t1_scan_keys(void)
-{
- int i, k;
- char *p, *q, *r;
- const key_entry *key;
- if (fm_extend(fd_cur->fm) != 0 || fm_slant(fd_cur->fm) != 0) {
- if (t1_prefix("/FontMatrix")) {
- t1_modify_fm();
- return;
- }
- if (t1_prefix("/ItalicAngle")) {
- t1_modify_italic();
- return;
- }
- }
- if (t1_prefix("/FontType")) {
- p = t1_line_array + strlen("FontType") + 1;
- if ((i = t1_scan_num(p, 0)) != 1)
- pdftex_fail("Type%d fonts unsupported by pdfTeX", i);
- return;
- }
- for (key = font_key; key - font_key < FONT_KEYS_NUM; key++) {
- if (key->t1name[0] != '\0' &&
- str_prefix(t1_line_array + 1, key->t1name))
- break;
- }
- if (key - font_key == FONT_KEYS_NUM)
- return;
- p = t1_line_array + strlen(key->t1name) + 1;
- skip(p, ' ');
- if ((k = key - font_key) == FONTNAME_CODE) {
- if (*p != '/') {
- remove_eol(p, t1_line_array);
- pdftex_fail("a name expected: `%s'", t1_line_array);
- }
- r = ++p; /* skip the slash */
- for (q = t1_buf_array; *p != ' ' && *p != 10; *q++ = *p++);
- *q = 0;
- if (fm_slant(fd_cur->fm) != 0) {
- sprintf(q, "-Slant_%i", (int) fm_slant(fd_cur->fm));
- q = strend(q);
- }
- if (fm_extend(fd_cur->fm) != 0) {
- sprintf(q, "-Extend_%i", (int) fm_extend(fd_cur->fm));
- }
- xfree(fd_cur->fontname);
- fd_cur->fontname = xstrdup(t1_buf_array);
- /* at this moment we cannot call make_subset_tag() yet, as the encoding
- * is not read; thus we mark the offset of the subset tag and write it
- * later */
- if (is_subsetted(fd_cur->fm)) {
- assert(is_included(fd_cur->fm));
- t1_fontname_offset = t1_offset() + (r - t1_line_array);
- strcpy(t1_buf_array, p);
- sprintf(r, "ABCDEF+%s%s", fd_cur->fontname, t1_buf_array);
- t1_line_ptr = eol(r);
- }
- return;
- }
- if ((k == STEMV_CODE || k == FONTBBOX1_CODE)
- && (*p == '[' || *p == '{'))
- p++;
- if (k == FONTBBOX1_CODE) {
- for (i = 0; i < 4; i++, k++) {
- fd_cur->font_dim[k].val = t1_scan_num(p, &r);
- fd_cur->font_dim[k].set = true;
- p = r;
- }
- return;
- }
- fd_cur->font_dim[k].val = t1_scan_num(p, 0);
- fd_cur->font_dim[k].set = true;
-}
-
-static void t1_scan_param(void)
-{
- static const char *lenIV = "/lenIV";
- if (!t1_scan || *t1_line_array != '/')
- return;
- if (t1_prefix(lenIV)) {
- t1_lenIV = t1_scan_num(t1_line_array + strlen(lenIV), 0);
- if (t1_lenIV < 0)
- pdftex_fail("negative value of lenIV is not supported");
- return;
- }
- t1_scan_keys();
-}
-
-static void copy_glyph_names(char **glyph_names, int a, int b)
-{
- if (glyph_names[b] != notdef) {
- xfree(glyph_names[b]);
- glyph_names[b] = notdef;
- }
- if (glyph_names[a] != notdef) {
- glyph_names[b] = xstrdup(glyph_names[a]);
- }
-}
-
-/* read encoding from Type1 font file, return glyph_names array, or pdffail() */
-
-static char **t1_builtin_enc(void)
-{
- int i, a, b, c, counter = 0;
- char *r, *p, **glyph_names;
- /* At this moment "/Encoding" is the prefix of t1_line_array */
- glyph_names = xtalloc(256, char *);
- for (i = 0; i < 256; i++)
- glyph_names[i] = notdef;
- if (t1_suffix("def")) { /* predefined encoding */
- if (sscanf(t1_line_array + strlen("/Encoding"), "%255s", t1_buf_array) == 1
- && strcmp(t1_buf_array, "StandardEncoding") == 0) {
- t1_encoding = ENC_STANDARD;
- for (i = 0; i < 256; i++) {
- if (standard_glyph_names[i] != notdef)
- glyph_names[i] = xstrdup(standard_glyph_names[i]);
- }
- return glyph_names;
- }
- pdftex_fail("cannot subset font (unknown predefined encoding `%s')",
- t1_buf_array);
- }
- /* At this moment "/Encoding" is the prefix of t1_line_array, and the encoding is
- * not a predefined encoding.
- *
- * We have two possible forms of Encoding vector. The first case is
- *
- * /Encoding [/a /b /c...] readonly def
- *
- * and the second case can look like
- *
- * /Encoding 256 array 0 1 255 {1 index exch /.notdef put} for
- * dup 0 /x put
- * dup 1 /y put
- * ...
- * readonly def
- */
- t1_encoding = ENC_BUILTIN;
- if (t1_prefix("/Encoding [") || t1_prefix("/Encoding[")) { /* the first case */
- r = strchr(t1_line_array, '[') + 1;
- skip(r, ' ');
- for (;;) {
- while (*r == '/') {
- for (p = t1_buf_array, r++;
- *r != 32 && *r != 10 && *r != ']' && *r != '/';
- *p++ = *r++);
- *p = 0;
- skip(r, ' ');
- if (counter > 255)
- pdftex_fail("encoding vector contains more than 256 names");
- if (strcmp(t1_buf_array, notdef) != 0)
- glyph_names[counter] = xstrdup(t1_buf_array);
- counter++;
- }
- if (*r != 10 && *r != '%') {
- if (str_prefix(r, "] def") || str_prefix(r, "] readonly def"))
- break;
- else {
- remove_eol(r, t1_line_array);
- pdftex_fail
- ("a name or `] def' or `] readonly def' expected: `%s'", t1_line_array);
- }
- }
- t1_getline();
- r = t1_line_array;
- }
- } else { /* the second case */
- p = strchr(t1_line_array, 10);
- for (;;) {
- if (*p == 10) {
- t1_getline();
- p = t1_line_array;
- }
- /*
- check for `dup <index> <glyph> put'
- */
- if (sscanf(p, "dup %i%255s put", &i, t1_buf_array) == 2 &&
- *t1_buf_array == '/' && valid_code(i)) {
- if (strcmp(t1_buf_array + 1, notdef) != 0)
- glyph_names[i] = xstrdup(t1_buf_array + 1);
- p = strstr(p, " put") + strlen(" put");
- skip(p, ' ');
- }
- /*
- check for `dup dup <to> exch <from> get put'
- */
- else if (sscanf(p, "dup dup %i exch %i get put", &b, &a) == 2
- && valid_code(a) && valid_code(b)) {
- copy_glyph_names(glyph_names, a, b);
- p = strstr(p, " get put") + strlen(" get put");
- skip(p, ' ');
- }
- /*
- check for `dup dup <from> <size> getinterval <to> exch putinterval'
- */
- else if (sscanf(p, "dup dup %i %i getinterval %i exch putinterval",
- &a, &c, &b) == 3
- && valid_code(a) && valid_code(b) && valid_code(c)) {
- for (i = 0; i < c; i++)
- copy_glyph_names(glyph_names, a + i, b + i);
- p = strstr(p, " putinterval") + strlen(" putinterval");
- skip(p, ' ');
- }
- /*
- check for `def' or `readonly def'
- */
- else if ((p == t1_line_array || (p > t1_line_array && p[-1] == ' '))
- && strcmp(p, "def\n") == 0)
- return glyph_names;
- /*
- skip an unrecognizable word
- */
- else {
- while (*p != ' ' && *p != 10)
- p++;
- skip(p, ' ');
- }
- }
- }
- return glyph_names;
-}
-
-static void t1_check_end(void)
-{
- if (t1_eof())
- return;
- t1_getline();
- if (t1_prefix("{restore}"))
- t1_putline();
-}
-
-static boolean t1_open_fontfile(const char *open_name_prefix)
-{
- ff_entry *ff;
- ff = check_ff_exist(fd_cur->fm->ff_name, is_truetype(fd_cur->fm));
- if (ff->ff_path != NULL) {
- t1_file = xfopen(cur_file_name = ff->ff_path, FOPEN_RBIN_MODE);
- recorder_record_input(ff->ff_path);
- } else {
- set_cur_file_name(fd_cur->fm->ff_name);
- pdftex_fail("cannot open Type 1 font file for reading");
- }
- t1_init_params(open_name_prefix);
- return true; /* font file found */
-}
-
-static void t1_include(void)
-{
- do {
- t1_getline();
- t1_scan_param();
- t1_putline();
- } while (t1_in_eexec == 0);
- t1_start_eexec();
- do {
- t1_getline();
- t1_scan_param();
- t1_putline();
- } while (!(t1_charstrings() || t1_subrs()));
- t1_cs = true;
- do {
- t1_getline();
- t1_putline();
- } while (!t1_end_eexec());
- t1_stop_eexec();
- if (fixedcontent) { /* copy 512 zeros (not needed for PDF) */
- do {
- t1_getline();
- t1_putline();
- } while (!t1_cleartomark());
- t1_check_end(); /* write "{restore}if" if found */
- }
- get_length3();
-}
-
-#define check_subr(subr) \
- if (subr >= subr_size || subr < 0) \
- pdftex_fail("Subrs array: entry index out of range (%i)", subr);
-
-static const char **check_cs_token_pair(void)
-{
- const char **p = (const char **) cs_token_pairs_list;
- for (; p[0] != NULL; ++p)
- if (t1_buf_prefix(p[0]) && t1_buf_suffix(p[1]))
- return p;
- return NULL;
-}
-
-static void cs_store(boolean is_subr)
-{
- char *p;
- cs_entry *ptr;
- int subr;
- for (p = t1_line_array, t1_buf_ptr = t1_buf_array; *p != ' ';
- *t1_buf_ptr++ = *p++);
- *t1_buf_ptr = 0;
- if (is_subr) {
- subr = t1_scan_num(p + 1, 0);
- check_subr(subr);
- ptr = subr_tab + subr;
- } else {
- ptr = cs_ptr++;
- if (cs_ptr - cs_tab > cs_size)
- pdftex_fail
- ("CharStrings dict: more entries than dict size (%i)", cs_size);
- if (strcmp(t1_buf_array + 1, notdef) == 0) /* skip the slash */
- ptr->name = notdef;
- else
- ptr->name = xstrdup(t1_buf_array + 1);
- }
- /* copy " RD " + cs data to t1_buf_array */
- memcpy(t1_buf_array, t1_line_array + cs_start - 4,
- (unsigned) (t1_cslen + 4));
- /* copy the end of cs data to t1_buf_array */
- for (p = t1_line_array + cs_start + t1_cslen,
- t1_buf_ptr = t1_buf_array + t1_cslen + 4;
- *p != 10; *t1_buf_ptr++ = *p++);
- *t1_buf_ptr++ = 10;
- if (is_subr && cs_token_pair == NULL)
- cs_token_pair = check_cs_token_pair();
- ptr->len = t1_buf_ptr - t1_buf_array;
- ptr->cslen = t1_cslen;
- ptr->data = xtalloc(ptr->len, byte);
- memcpy(ptr->data, t1_buf_array, ptr->len);
- ptr->valid = true;
-}
-
-#define store_subr() cs_store(true)
-#define store_cs() cs_store(false)
-
-#define CC_STACK_SIZE 24
-
-static integer cc_stack[CC_STACK_SIZE], *stack_ptr = cc_stack;
-static cc_entry cc_tab[CS_MAX];
-static boolean is_cc_init = false;
-
-#define cc_pop(N) \
- if (stack_ptr - cc_stack < (N)) \
- stack_error(N); \
- stack_ptr -= N
-
-#define stack_error(N) { \
- pdftex_fail("CharString: invalid access (%i) to stack (%i entries)", \
- (int) N, (int)(stack_ptr - cc_stack)); \
- goto cs_error; \
-}
-
-/*
-static integer cc_get(integer index)
-{
- if (index < 0) {
- if (stack_ptr + index < cc_stack )
- stack_error(stack_ptr - cc_stack + index);
- return *(stack_ptr + index);
- }
- else {
- if (cc_stack + index >= stack_ptr)
- stack_error(index);
- return cc_stack[index];
- }
-}
-*/
-
-#define cc_get(N) ((N) < 0 ? *(stack_ptr + (N)) : *(cc_stack + (N)))
-#define cc_push(V) *stack_ptr++ = V
-#define cc_clear() stack_ptr = cc_stack
-#define set_cc(N, B, A, C) \
- cc_tab[N].nargs = A; \
- cc_tab[N].bottom = B; \
- cc_tab[N].clear = C; \
- cc_tab[N].valid = true
-
-static void cc_init(void)
-{
- int i;
- if (is_cc_init)
- return;
- for (i = 0; i < CS_MAX; i++)
- cc_tab[i].valid = false;
- set_cc(CS_HSTEM, true, 2, true);
- set_cc(CS_VSTEM, true, 2, true);
- set_cc(CS_VMOVETO, true, 1, true);
- set_cc(CS_RLINETO, true, 2, true);
- set_cc(CS_HLINETO, true, 1, true);
- set_cc(CS_VLINETO, true, 1, true);
- set_cc(CS_RRCURVETO, true, 6, true);
- set_cc(CS_CLOSEPATH, false, 0, true);
- set_cc(CS_CALLSUBR, false, 1, false);
- set_cc(CS_RETURN, false, 0, false);
- /*
- set_cc(CS_ESCAPE, false, 0, false);
- */
- set_cc(CS_HSBW, true, 2, true);
- set_cc(CS_ENDCHAR, false, 0, true);
- set_cc(CS_RMOVETO, true, 2, true);
- set_cc(CS_HMOVETO, true, 1, true);
- set_cc(CS_VHCURVETO, true, 4, true);
- set_cc(CS_HVCURVETO, true, 4, true);
- set_cc(CS_DOTSECTION, false, 0, true);
- set_cc(CS_VSTEM3, true, 6, true);
- set_cc(CS_HSTEM3, true, 6, true);
- set_cc(CS_SEAC, true, 5, true);
- set_cc(CS_SBW, true, 4, true);
- set_cc(CS_DIV, false, 2, false);
- set_cc(CS_CALLOTHERSUBR, false, 0, false);
- set_cc(CS_POP, false, 0, false);
- set_cc(CS_SETCURRENTPOINT, true, 2, true);
- is_cc_init = true;
-}
-
-#define cs_getchar() cdecrypt(*data++, &cr)
-
-#define mark_subr(n) cs_mark(0, n)
-#define mark_cs(s) cs_mark(s, 0)
-
-__attribute__ ((format(printf, 3, 4)))
-static void cs_fail(const char *cs_name, int subr, const char *fmt, ...)
-{
- char buf[SMALL_BUF_SIZE];
- va_list args;
- va_start(args, fmt);
- vsprintf(buf, fmt, args);
- va_end(args);
- if (cs_name == NULL)
- pdftex_fail("Subr (%i): %s", (int) subr, buf);
- else
- pdftex_fail("CharString (/%s): %s", cs_name, buf);
-}
-
-/* fix a return-less subr by appending CS_RETURN */
-static void append_cs_return(cs_entry *ptr)
-{
- unsigned short cr;
- int i;
- byte *p, *q, *data, *new_data;
- assert(ptr != NULL && ptr->valid && ptr->used);
-
- /* decrypt the cs data to t1_buf_array, append CS_RETURN */
- p = (byte *) t1_buf_array;
- data = ptr->data + 4;
- cr = 4330;
- for (i = 0; i < ptr->cslen; i++)
- *p++ = cs_getchar();
- *p = CS_RETURN;
-
- /* encrypt the new cs data to new_data */
- new_data = xtalloc(ptr->len + 1, byte);
- memcpy(new_data, ptr->data, 4);
- p = new_data + 4;
- q = (byte *) t1_buf_array;
- cr = 4330;
- for (i = 0; i < ptr->cslen + 1; i++)
- *p++ = cencrypt(*q++, &cr);
- memcpy(p, ptr->data + 4 + ptr->cslen, ptr->len - ptr->cslen - 4);
-
- /* update *ptr */
- xfree(ptr->data);
- ptr->data = new_data;
- ptr->len++;
- ptr->cslen++;
-}
-
-static void cs_mark(const char *cs_name, int subr)
-{
- byte *data;
- int i, b, cs_len;
- int last_cmd = 0;
- integer a, a1, a2;
- unsigned short cr;
- static integer lastargOtherSubr3 = 3; /* the argument of last call to
- OtherSubrs[3] */
- cs_entry *ptr;
- cc_entry *cc;
- if (cs_name == NULL) {
- check_subr(subr);
- ptr = subr_tab + subr;
- if (!ptr->valid)
- return;
- } else {
- if (cs_notdef != NULL &&
- (cs_name == notdef || strcmp(cs_name, notdef) == 0))
- ptr = cs_notdef;
- else {
- for (ptr = cs_tab; ptr < cs_ptr; ptr++)
- if (strcmp(ptr->name, cs_name) == 0)
- break;
- if (ptr == cs_ptr) {
- pdftex_warn("glyph `%s' undefined", cs_name);
- return;
- }
- if (ptr->name == notdef)
- cs_notdef = ptr;
- }
- }
- /* only marked CharString entries and invalid entries can be skipped;
- valid marked subrs must be parsed to keep the stack in sync */
- if (!ptr->valid || (ptr->used && cs_name != NULL))
- return;
- ptr->used = true;
- cr = 4330;
- cs_len = ptr->cslen;
- data = ptr->data + 4;
- for (i = 0; i < t1_lenIV; i++, cs_len--)
- cs_getchar();
- while (cs_len > 0) {
- --cs_len;
- b = cs_getchar();
- if (b >= 32) {
- if (b <= 246)
- a = b - 139;
- else if (b <= 250) {
- --cs_len;
- a = ((b - 247) << 8) + 108 + cs_getchar();
- } else if (b <= 254) {
- --cs_len;
- a = -((b - 251) << 8) - 108 - cs_getchar();
- } else {
- cs_len -= 4;
- a = (cs_getchar() & 0xff) << 24;
- a |= (cs_getchar() & 0xff) << 16;
- a |= (cs_getchar() & 0xff) << 8;
- a |= (cs_getchar() & 0xff) << 0;
- if (sizeof(integer) > 4 && (a & 0x80000000))
- a |= ~0x7FFFFFFF;
- }
- cc_push(a);
- } else {
- if (b == CS_ESCAPE) {
- b = cs_getchar() + CS_1BYTE_MAX;
- cs_len--;
- }
- if (b >= CS_MAX) {
- cs_fail(cs_name, subr, "command value out of range: %i",
- (int) b);
- goto cs_error;
- }
- cc = cc_tab + b;
- if (!cc->valid) {
- cs_fail(cs_name, subr, "command not valid: %i", (int) b);
- goto cs_error;
- }
- if (cc->bottom) {
- if (stack_ptr - cc_stack < cc->nargs)
- cs_fail(cs_name, subr,
- "less arguments on stack (%i) than required (%i)",
- (int) (stack_ptr - cc_stack), (int) cc->nargs);
- else if (stack_ptr - cc_stack > cc->nargs)
- cs_fail(cs_name, subr,
- "more arguments on stack (%i) than required (%i)",
- (int) (stack_ptr - cc_stack), (int) cc->nargs);
- }
- last_cmd = b;
- switch (cc - cc_tab) {
- case CS_CALLSUBR:
- a1 = cc_get(-1);
- cc_pop(1);
- mark_subr(a1);
- if (!subr_tab[a1].valid) {
- cs_fail(cs_name, subr, "cannot call subr (%i)", (int) a1);
- goto cs_error;
- }
- break;
- case CS_DIV:
- cc_pop(2);
- cc_push(0);
- break;
- case CS_CALLOTHERSUBR:
- if (cc_get(-1) == 3)
- lastargOtherSubr3 = cc_get(-3);
- a1 = cc_get(-2) + 2;
- cc_pop(a1);
- break;
- case CS_POP:
- cc_push(lastargOtherSubr3);
- /* the only case when we care about the value being pushed onto
- stack is when POP follows CALLOTHERSUBR (changing hints by
- OtherSubrs[3])
- */
- break;
- case CS_SEAC:
- a1 = cc_get(3);
- a2 = cc_get(4);
- cc_clear();
- mark_cs(standard_glyph_names[a1]);
- mark_cs(standard_glyph_names[a2]);
- break;
- default:
- if (cc->clear)
- cc_clear();
- }
- }
- }
- if (cs_name == NULL && last_cmd != CS_RETURN) {
- pdftex_warn("last command in subr `%i' is not a RETURN; "
- "I will add it now but please consider fixing the font",
- (int) subr);
- append_cs_return(ptr);
- }
- return;
- cs_error: /* an error occured during parsing */
- cc_clear();
- ptr->valid = false;
- ptr->used = false;
-}
-
-/**********************************************************************/
-/* AVL search tree for glyph code by glyph name */
-
-static int comp_t1_glyphs(const void *pa, const void *pb, void *p)
-{
- return strcmp(*((const char * const *) pa), *((const char * const *) pb));
-}
-
-static struct avl_table *create_t1_glyph_tree(char **glyph_names)
-{
- int i;
- void **aa;
- static struct avl_table *gl_tree;
- gl_tree = avl_create(comp_t1_glyphs, NULL, &avl_xallocator);
- assert(gl_tree != NULL);
- for (i = 0; i < 256; i++) {
- if (glyph_names[i] != notdef &&
- (char **) avl_find(gl_tree, &glyph_names[i]) == NULL) {
- /* no strdup here, just point to the glyph_names array members */
- aa = avl_probe(gl_tree, &glyph_names[i]);
- assert(aa != NULL);
- }
- }
- return gl_tree;
-}
-
-static void destroy_t1_glyph_tree(struct avl_table *gl_tree)
-{
- assert(gl_tree != NULL);
- avl_destroy(gl_tree, NULL);
-}
-
-/**********************************************************************/
-
-static void t1_subset_ascii_part(void)
-{
- int j, *p;
- char *glyph, **gg, **glyph_names;
- struct avl_table *gl_tree;
- struct avl_traverser t;
- void **aa;
- assert(fd_cur != NULL);
- assert(fd_cur->gl_tree != NULL);
- t1_getline();
- while (!t1_prefix("/Encoding")) {
- t1_scan_param();
- if (!(t1_prefix("/UniqueID")
- && !strncmp(t1_line_array + strlen(t1_line_array) -4, "def", 3)))
- t1_putline();
- t1_getline();
- }
- glyph_names = t1_builtin_enc();
- fd_cur->builtin_glyph_names = glyph_names;
- if (is_subsetted(fd_cur->fm)) {
- assert(is_included(fd_cur->fm));
- if (fd_cur->tx_tree != NULL) {
- /* take over collected non-reencoded characters from TeX */
- avl_t_init(&t, fd_cur->tx_tree);
- for (p = (int *) avl_t_first(&t, fd_cur->tx_tree); p != NULL;
- p = (int *) avl_t_next(&t)) {
- if ((char *) avl_find(fd_cur->gl_tree, glyph_names[*p]) == NULL) {
- glyph = xstrdup(glyph_names[*p]);
- aa = avl_probe(fd_cur->gl_tree, glyph);
- assert(aa != NULL);
- }
- }
- }
- make_subset_tag(fd_cur);
- assert(t1_fontname_offset != 0);
- strncpy(fb_array + t1_fontname_offset, fd_cur->subset_tag, 6);
- }
- /* now really all glyphs needed from this font are in the fd_cur->gl_tree */
- if (t1_encoding == ENC_STANDARD)
- t1_puts("/Encoding StandardEncoding def\n");
- else {
- t1_puts
- ("/Encoding 256 array\n0 1 255 {1 index exch /.notdef put} for\n");
- gl_tree = create_t1_glyph_tree(glyph_names);
- avl_t_init(&t, fd_cur->gl_tree);
- j = 0;
- for (glyph = (char *) avl_t_first(&t, fd_cur->gl_tree); glyph != NULL;
- glyph = (char *) avl_t_next(&t)) {
- if ((gg = (char **) avl_find(gl_tree, &glyph)) != NULL) {
- t1_printf("dup %i /%s put\n", (int) (gg - glyph_names), *gg);
- j++;
- }
- }
- destroy_t1_glyph_tree(gl_tree);
- if (j == 0)
- /* We didn't mark anything for the Encoding array. */
- /* We add "dup 0 /.notdef put" for compatibility */
- /* with Acrobat 5.0. */
- t1_puts("dup 0 /.notdef put\n");
- t1_puts("readonly def\n");
- }
- do {
- t1_getline();
- t1_scan_param();
- if (!t1_prefix("/UniqueID")) /* ignore UniqueID for subsetted fonts */
- t1_putline();
- } while (t1_in_eexec == 0);
-}
-
-static void cs_init(void)
-{
- cs_ptr = cs_tab = NULL;
- cs_dict_start = cs_dict_end = NULL;
- cs_count = cs_size = cs_size_pos = 0;
- cs_token_pair = NULL;
- subr_tab = NULL;
- subr_array_start = subr_array_end = NULL;
- subr_max = subr_size = subr_size_pos = 0;
-}
-
-static void init_cs_entry(cs_entry *cs)
-{
- cs->data = NULL;
- cs->name = NULL;
- cs->len = 0;
- cs->cslen = 0;
- cs->used = false;
- cs->valid = false;
-}
-
-static void t1_read_subrs(void)
-{
- int i, s;
- cs_entry *ptr;
- t1_getline();
- while (!(t1_charstrings() || t1_subrs())) {
- t1_scan_param();
- if (!t1_prefix("/UniqueID")) /* ignore UniqueID for subsetted fonts */
- t1_putline();
- t1_getline();
- }
- found:
- t1_cs = true;
- t1_scan = false;
- if (!t1_subrs())
- return;
- subr_size_pos = strlen("/Subrs") + 1;
- /* subr_size_pos points to the number indicating dict size after "/Subrs" */
- subr_size = t1_scan_num(t1_line_array + subr_size_pos, 0);
- if (subr_size == 0) {
- while (!t1_charstrings())
- t1_getline();
- return;
- }
- subr_tab = xtalloc(subr_size, cs_entry);
- for (ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
- init_cs_entry(ptr);
- subr_array_start = xstrdup(t1_line_array);
- t1_getline();
- while (t1_cslen) {
- store_subr();
- t1_getline();
- }
- /* mark the first four entries without parsing */
- for (i = 0; i < subr_size && i < 4; i++)
- subr_tab[i].used = true;
- /* the end of the Subrs array might have more than one line so we need to
- concatnate them to subr_array_end. Unfortunately some fonts don't have
- the Subrs array followed by the CharStrings dict immediately (synthetic
- fonts). If we cannot find CharStrings in next POST_SUBRS_SCAN lines then
- we will treat the font as synthetic and ignore everything until next
- Subrs is found
- */
-
-#define POST_SUBRS_SCAN 5
-
- s = 0;
- *t1_buf_array = 0;
- for (i = 0; i < POST_SUBRS_SCAN; i++) {
- if (t1_charstrings())
- break;
- s += t1_line_ptr - t1_line_array;
- alloc_array(t1_buf, s, T1_BUF_SIZE);
- strcat(t1_buf_array, t1_line_array);
- t1_getline();
- }
- subr_array_end = xstrdup(t1_buf_array);
- if (i == POST_SUBRS_SCAN) { /* CharStrings not found;
- suppose synthetic font */
- for (ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
- if (ptr->valid)
- xfree(ptr->data);
- xfree(subr_tab);
- xfree(subr_array_start);
- xfree(subr_array_end);
- cs_init();
- t1_cs = false;
- t1_synthetic = true;
- while (!(t1_charstrings() || t1_subrs()))
- t1_getline();
- goto found;
- }
-}
-
-#define t1_subr_flush() t1_flush_cs(true)
-#define t1_cs_flush() t1_flush_cs(false)
-
-static void t1_flush_cs(boolean is_subr)
-{
- char *p;
- byte *r, *return_cs = NULL;
- cs_entry *tab, *end_tab, *ptr;
- char *start_line, *line_end;
- int count, size_pos;
- unsigned short cr, cs_len = 0; /* to avoid warning about uninitialized use of cs_len */
- if (is_subr) {
- start_line = subr_array_start;
- line_end = subr_array_end;
- size_pos = subr_size_pos;
- tab = subr_tab;
- count = subr_max + 1;
- end_tab = subr_tab + count;
- } else {
- start_line = cs_dict_start;
- line_end = cs_dict_end;
- size_pos = cs_size_pos;
- tab = cs_tab;
- end_tab = cs_ptr;
- count = cs_count;
- }
- t1_line_ptr = t1_line_array;
- for (p = start_line; p - start_line < size_pos;)
- *t1_line_ptr++ = *p++;
- while (isdigit((unsigned char)*p))
- p++;
- sprintf(t1_line_ptr, "%u", count);
- strcat(t1_line_ptr, p);
- t1_line_ptr = eol(t1_line_array);
- t1_putline();
-
- /* create return_cs to replace unused subr's */
- if (is_subr) {
- cr = 4330;
- cs_len = 0;
- /* at this point we have t1_lenIV >= 0;
- * a negative value would be caught in t1_scan_param() */
- return_cs = xtalloc(t1_lenIV + 1, byte);
- for (cs_len = 0, r = return_cs; cs_len < t1_lenIV; cs_len++, r++)
- *r = cencrypt(0x00, &cr);
- *r = cencrypt(CS_RETURN, &cr);
- cs_len++;
- }
-
- for (ptr = tab; ptr < end_tab; ptr++) {
- if (ptr->used) {
- if (is_subr)
- sprintf(t1_line_array, "dup %lu %u",
- (unsigned long) (ptr - tab), ptr->cslen);
- else
- sprintf(t1_line_array, "/%s %u", ptr->name, ptr->cslen);
- p = strend(t1_line_array);
- memcpy(p, ptr->data, ptr->len);
- t1_line_ptr = p + ptr->len;
- t1_putline();
- } else {
- /* replace unsused subr's by return_cs */
- if (is_subr) {
- sprintf(t1_line_array, "dup %lu %u%s ",
- (unsigned long) (ptr - tab), cs_len, cs_token_pair[0]);
- p = strend(t1_line_array);
- memcpy(p, return_cs, cs_len);
- t1_line_ptr = p + cs_len;
- t1_putline();
- sprintf(t1_line_array, " %s", cs_token_pair[1]);
- t1_line_ptr = eol(t1_line_array);
- t1_putline();
- }
- }
- xfree(ptr->data);
- if (ptr->name != notdef)
- xfree(ptr->name);
- }
- sprintf(t1_line_array, "%s", line_end);
- t1_line_ptr = eol(t1_line_array);
- t1_putline();
- if (is_subr)
- xfree(return_cs);
- xfree(tab);
- xfree(start_line);
- xfree(line_end);
-}
-
-static void t1_mark_glyphs(void)
-{
- char *glyph;
- struct avl_traverser t;
- cs_entry *ptr;
- if (t1_synthetic || fd_cur->all_glyphs) { /* mark everything */
- if (cs_tab != NULL)
- for (ptr = cs_tab; ptr < cs_ptr; ptr++)
- if (ptr->valid)
- ptr->used = true;
- if (subr_tab != NULL) {
- for (ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
- if (ptr->valid)
- ptr->used = true;
- subr_max = subr_size - 1;
- }
- return;
- }
- mark_cs(notdef);
- avl_t_init(&t, fd_cur->gl_tree);
- for (glyph = (char *) avl_t_first(&t, fd_cur->gl_tree); glyph != NULL;
- glyph = (char *) avl_t_next(&t)) {
- mark_cs(glyph);
- }
- if (subr_tab != NULL)
- for (subr_max = -1, ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
- if (ptr->used && ptr - subr_tab > subr_max)
- subr_max = ptr - subr_tab;
-}
-
-static void t1_check_unusual_charstring(void)
-{
- char *p = strstr(t1_line_array, charstringname) + strlen(charstringname);
- int i;
- /* if no number follows "/CharStrings", let's read the next line */
- if (sscanf(p, "%i", &i) != 1) {
- /* pdftex_warn("no number found after `%s', I assume it's on the next line",
- charstringname); */
- strcpy(t1_buf_array, t1_line_array);
-
- /* t1_getline always appends EOL to t1_line_array; let's change it to
- * space before appending the next line
- */
- *(strend(t1_buf_array) - 1) = ' ';
-
- t1_getline();
- alloc_array(t1_buf, strlen(t1_line_array)
- + (t1_buf_array ? strlen(t1_buf_array) + 1 : 0),
- T1_BUF_SIZE);
- strcat(t1_buf_array, t1_line_array);
- alloc_array(t1_line, strlen(t1_buf_array) + 1, T1_BUF_SIZE);
- strcpy(t1_line_array, t1_buf_array);
- t1_line_ptr = eol(t1_line_array);
- }
-}
-
-static void t1_subset_charstrings(void)
-{
- cs_entry *ptr;
-
- /* at this point t1_line_array contains "/CharStrings".
- when we hit a case like this:
- dup/CharStrings
- 229 dict dup begin
- we read the next line and concatenate to t1_line_array before moving on
- */
- t1_check_unusual_charstring();
-
- cs_size_pos = strstr(t1_line_array, charstringname)
- + strlen(charstringname) - t1_line_array + 1;
- /* cs_size_pos points to the number indicating
- dict size after "/CharStrings" */
- cs_size = t1_scan_num(t1_line_array + cs_size_pos, 0);
- cs_ptr = cs_tab = xtalloc(cs_size, cs_entry);
- for (ptr = cs_tab; ptr - cs_tab < cs_size; ptr++)
- init_cs_entry(ptr);
- cs_notdef = NULL;
- cs_dict_start = xstrdup(t1_line_array);
- t1_getline();
- while (t1_cslen) {
- store_cs();
- t1_getline();
- }
- cs_dict_end = xstrdup(t1_line_array);
- t1_mark_glyphs();
- if (subr_tab != NULL) {
- if (cs_token_pair == NULL)
- pdftex_fail
- ("This Type 1 font uses mismatched subroutine begin/end token pairs.");
- t1_subr_flush();
- }
- for (cs_count = 0, ptr = cs_tab; ptr < cs_ptr; ptr++)
- if (ptr->used)
- cs_count++;
- t1_cs_flush();
-}
-
-static void t1_subset_end(void)
-{
- if (t1_synthetic) { /* copy to "dup /FontName get exch definefont pop" */
- while (!strstr(t1_line_array, "definefont")) {
- t1_getline();
- t1_putline();
- }
- while (!t1_end_eexec())
- t1_getline(); /* ignore the rest */
- t1_putline(); /* write "mark currentfile closefile" */
- } else
- while (!t1_end_eexec()) { /* copy to "mark currentfile closefile" */
- t1_getline();
- t1_putline();
- }
- t1_stop_eexec();
- if (fixedcontent) { /* copy 512 zeros (not needed for PDF) */
- while (!t1_cleartomark()) {
- t1_getline();
- t1_putline();
- }
- if (!t1_synthetic) /* don't check "{restore}if" for synthetic fonts */
- t1_check_end(); /* write "{restore}if" if found */
- }
- get_length3();
-}
-
-void writet1(fd_entry *fd)
-{
- fd_cur = fd; /* fd_cur is global inside writet1.c */
- assert(fd_cur->fm != NULL);
- assert(is_type1(fd->fm));
- assert(is_included(fd->fm));
-
- t1_save_offset = 0;
- if (!is_subsetted(fd_cur->fm)) { /* include entire font */
- if (!(fd->ff_found = t1_open_fontfile("<<")))
- return;
- t1_include();
- t1_close_font_file(">>");
- return;
- }
- /* partial downloading */
- if (!(fd->ff_found = t1_open_fontfile("<")))
- return;
- t1_subset_ascii_part();
- t1_start_eexec();
- cc_init();
- cs_init();
- t1_read_subrs();
- t1_subset_charstrings();
- t1_subset_end();
- t1_close_font_file(">");
-}
-
-void t1_free(void)
-{
- xfree(t1_line_array);
- xfree(t1_buf_array);
-}
diff --git a/Build/source/texk/web2c/pdftexdir/writet3.c b/Build/source/texk/web2c/pdftexdir/writet3.c
deleted file mode 100644
index 5d5eb47729f..00000000000
--- a/Build/source/texk/web2c/pdftexdir/writet3.c
+++ /dev/null
@@ -1,429 +0,0 @@
-/* writet3.c: write a Type 3 (bitmap PK) font.
-Copyright 1996-2019 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-#include <kpathsea/tex-glyph.h>
-#include <kpathsea/magstep.h>
-#include <string.h>
-
-#define T3_BUF_SIZE 1024
-
-typedef char t3_line_entry;
-define_array(t3_line);
-
-FILE *t3_file;
-static boolean t3_image_used;
-
-static integer t3_char_procs[256];
-static float t3_char_widths[256];
-static int t3_glyph_num;
-static float t3_font_scale;
-static integer t3_b0, t3_b1, t3_b2, t3_b3;
-static boolean is_pk_font;
-
-#define t3_open() \
- open_input(&t3_file, kpse_miscfonts_format, FOPEN_RBIN_MODE)
-#define t3_close() xfclose(t3_file, cur_file_name)
-#define t3_getchar() xgetc(t3_file)
-#define t3_eof() feof(t3_file)
-#define t3_prefix(s) str_prefix(t3_line_array, s)
-#define t3_putchar(c) pdfout(c)
-
-#define t3_check_eof() \
- if (t3_eof()) \
- pdftex_fail("unexpected end of file");
-
-static void t3_getline(void)
-{
- int c;
- restart:
- t3_line_ptr = t3_line_array;
- c = t3_getchar();
- while (!t3_eof()) {
- alloc_array(t3_line, 1, T3_BUF_SIZE);
- append_char_to_buf(c, t3_line_ptr, t3_line_array, t3_line_limit);
- if (c == 10)
- break;
- c = t3_getchar();
- }
- alloc_array(t3_line, 2, T3_BUF_SIZE);
- append_eol(t3_line_ptr, t3_line_array, T3_BUF_SIZE);
- if (t3_line_ptr - t3_line_array < 2 || *t3_line_array == '%') {
- if (!t3_eof())
- goto restart;
- }
-}
-
-static void t3_putline(void)
-{
- char *p = t3_line_array;
- while (p < t3_line_ptr)
- t3_putchar(*p++);
-}
-
-static void update_bbox(integer llx, integer lly, integer urx, integer ury,
- boolean is_first_glyph)
-{
- if (is_first_glyph) {
- t3_b0 = llx;
- t3_b1 = lly;
- t3_b2 = urx;
- t3_b3 = ury;
- } else {
- if (llx < t3_b0)
- t3_b0 = llx;
- if (lly < t3_b1)
- t3_b1 = lly;
- if (urx > t3_b2)
- t3_b2 = urx;
- if (ury > t3_b3)
- t3_b3 = ury;
- }
-}
-
-static void t3_write_glyph(internalfontnumber f)
-{
- static char t3_begin_glyph_str[] = "\\pdfglyph";
- static char t3_end_glyph_str[] = "\\endglyph";
- int glyph_index;
- int width, height, depth, llx, lly, urx, ury;
- char *p;
- t3_getline();
- if (t3_prefix(t3_begin_glyph_str)) {
- if (sscanf(t3_line_array + strlen(t3_begin_glyph_str) + 1,
- "%i %i %i %i %i %i %i %i =", &glyph_index,
- &width, &height, &depth, &llx, &lly, &urx, &ury) != 8) {
- remove_eol(p, t3_line_array);
- pdftex_fail("invalid glyph preamble: `%s'", t3_line_array);
- }
- if (glyph_index < fontbc[f] || glyph_index > fontec[f])
- return;
- } else
- return;
- if (!pdfcharmarked(f, glyph_index)) {
- while (!t3_prefix(t3_end_glyph_str)) {
- t3_check_eof();
- t3_getline();
- }
- return;
- }
- update_bbox(llx, lly, urx, ury, t3_glyph_num == 0);
- t3_glyph_num++;
- pdfnewdict(0, 0, 0);
- t3_char_procs[glyph_index] = objptr;
- if (width == 0)
- t3_char_widths[glyph_index] =
- (getcharwidth(f, glyph_index) / t3_font_scale) / pdffontsize[f];
- else
- t3_char_widths[glyph_index] = width;
- pdfbeginstream();
- t3_getline();
- pdf_printf("%i 0 %i %i %i %i d1\nq\n",
- (int) t3_char_widths[glyph_index], (int) llx,
- (int) lly, (int) urx, (int) ury);
- while (!t3_prefix(t3_end_glyph_str)) {
- t3_check_eof();
- if (t3_prefix("BI"))
- t3_image_used = true;
- t3_putline();
- t3_getline();
- }
- pdf_puts("Q\n");
- pdfendstream();
-}
-
-static integer get_pk_font_scale(internalfontnumber f)
-{
- return
- dividescaled(pkscalefactor,
- dividescaled(pdffontsize[f], onehundredbp,
- fixeddecimaldigits + 2), 0);
-}
-
-static integer pk_char_width(internalfontnumber f, scaled w)
-{
- return
- dividescaled(dividescaled(w, pdffontsize[f], 7),
- get_pk_font_scale(f), 0);
-}
-
-scaled getpkcharwidth(internalfontnumber f, scaled w)
-{
- return (get_pk_font_scale(f) / 100000.0) *
- (pk_char_width(f, w) / 100.0) * pdffontsize[f];
-}
-
-static boolean writepk(internalfontnumber f)
-{
- kpse_glyph_file_type font_ret;
- integer llx, lly, urx, ury;
- integer cw, rw, i, j;
- halfword *row;
- char *name;
- chardesc cd;
- boolean is_null_glyph, check_preamble;
- integer dpi;
- dpi =
- kpse_magstep_fix(round
- (fixedpkresolution *
- (((float) pdffontsize[f]) / fontdsize[f])),
- fixedpkresolution, NULL);
- cur_file_name = makecstring(fontname[f]);
- name = kpse_find_pk(cur_file_name, (unsigned) dpi, &font_ret);
- if (name == NULL ||
- !FILESTRCASEEQ(cur_file_name, font_ret.name) ||
- !kpse_bitmap_tolerance((float) font_ret.dpi, (float) dpi)) {
- pdftex_fail("Font %s at %i not found", cur_file_name, (int) dpi);
- }
- t3_file = xfopen(name, FOPEN_RBIN_MODE);
- recorder_record_input(name);
- t3_image_used = true;
- is_pk_font = true;
- tex_printf(" <%s", (char *) name);
- cd.rastersize = 256;
- cd.raster = xtalloc(cd.rastersize, halfword);
- check_preamble = true;
- while (readchar(check_preamble, &cd) != 0) {
- check_preamble = false;
- if (!pdfcharmarked(f, cd.charcode))
- continue;
- t3_char_widths[cd.charcode] =
- pk_char_width(f, getcharwidth(f, cd.charcode));
- if (cd.cwidth < 1 || cd.cheight < 1) {
- cd.xescape = cd.cwidth = round(t3_char_widths[cd.charcode] / 100.0);
- cd.cheight = 1;
- cd.xoff = 0;
- cd.yoff = 0;
- is_null_glyph = true;
- } else
- is_null_glyph = false;
- llx = -cd.xoff;
- lly = cd.yoff - cd.cheight + 1;
- urx = cd.cwidth + llx + 1;
- ury = cd.cheight + lly;
- update_bbox(llx, lly, urx, ury, t3_glyph_num == 0);
- t3_glyph_num++;
- pdfnewdict(0, 0, 0);
- t3_char_procs[cd.charcode] = objptr;
- pdfbeginstream();
- pdfprintreal(t3_char_widths[cd.charcode], 2);
- pdf_printf(" 0 %i %i %i %i d1\n",
- (int) llx, (int) lly, (int) urx, (int) ury);
- if (is_null_glyph)
- goto end_stream;
- pdf_printf("q\n%i 0 0 %i %i %i cm\nBI\n", (int) cd.cwidth,
- (int) cd.cheight, (int) llx, (int) lly);
- pdf_printf("/W %i\n/H %i\n", (int) cd.cwidth, (int) cd.cheight);
- pdf_puts("/IM true\n/BPC 1\n/D [1 0]\nID ");
- cw = (cd.cwidth + 7) / 8;
- rw = (cd.cwidth + 15) / 16;
- row = cd.raster;
- for (i = 0; i < cd.cheight; i++) {
- for (j = 0; j < rw - 1; j++) {
- pdfout(*row / 256);
- pdfout(*row % 256);
- row++;
- }
- pdfout(*row / 256);
- if (2 * rw == cw)
- pdfout(*row % 256);
- row++;
- }
- pdf_puts("\nEI\nQ\n");
- end_stream:
- pdfendstream();
- }
- xfree(cd.raster);
- cur_file_name = NULL;
- return true;
-}
-
-/* We must remove duplicate glyph names since the duplicates render the
- output invalid. We give a warning, since this should only happen with
- ill-defined .enc files that should get fixed. */
-static void remove_duplicate_glyph_names(char **g, const char *encname)
-{
- struct avl_table *gl_tree;
- char *aa;
- int i;
- gl_tree = avl_create(comp_string_entry, NULL, &avl_xallocator);
- assert(gl_tree != NULL);
- for (i = 0; i < 256; i++) {
- if (g[i] == notdef)
- continue;
- aa = (char *) avl_find(gl_tree, g[i]);
- if (aa == NULL) {
- aa = (char *) avl_probe(gl_tree, g[i]);
- assert(aa != NULL);
- } else {
- pdftex_warn("%s: duplicate glyph name at position %d: %s",
- encname, i, g[i]);
- xfree(g[i]);
- g[i] = (char *) notdef;
- }
- }
- avl_destroy(gl_tree, NULL);
-}
-
-void writet3(fm_entry * fm, int objnum, internalfontnumber f)
-{
- static char t3_font_scale_str[] = "\\pdffontscale";
- int i;
- integer wptr, eptr, cptr;
- int first_char, last_char;
- integer pk_font_scale;
- boolean is_notdef;
- fe_entry *fe;
- char **glyph_names;
- integer tounicode_objnum;
- t3_glyph_num = 0;
- t3_image_used = false;
- for (i = 0; i < 256; i++) {
- t3_char_procs[i] = 0;
- t3_char_widths[i] = 0;
- }
- fe = fm && fm->encname ? get_fe_entry(fm->encname) : NULL;
- glyph_names = fe ? fe->glyph_names : NULL;
- if (glyph_names)
- remove_duplicate_glyph_names(glyph_names, fm->encname);
- packfilename(fontname[f], getnullstr(), maketexstring(".pgc"));
- cur_file_name = makecstring(makenamestring());
- is_pk_font = false;
- if (!t3_open()) {
- if (writepk(f))
- goto write_font_dict;
- else {
- cur_file_name = NULL;
- return;
- }
- }
- tex_printf("<%s", nameoffile + 1);
- t3_getline();
- if (!t3_prefix(t3_font_scale_str) ||
- sscanf(t3_line_array + strlen(t3_font_scale_str) + 1, "%g",
- &t3_font_scale) < 1 || t3_font_scale <= 0
- || t3_font_scale > 1000) {
- pdftex_fail("missing or invalid font scale");
- }
- while (!t3_eof())
- t3_write_glyph(f);
- write_font_dict:
- for (i = fontbc[f]; i <= fontec[f]; i++)
- if (pdfcharmarked(f, i))
- break;
- first_char = i;
- for (i = fontec[f]; i > first_char; i--)
- if (pdfcharmarked(f, i))
- break;
- last_char = i;
- /* write ToUnicode entry if we can */
- if (fixedgentounicode > 0 && !pdffontnobuiltintounicode[f] && fe != NULL)
- tounicode_objnum = write_tounicode(glyph_names, fm->tfm_name, fe->name);
- else
- tounicode_objnum = 0;
- pdfbegindict(objnum, 1); /* Type 3 font dictionary */
- pdf_puts("/Type /Font\n/Subtype /Type3\n");
- pdf_printf("/Name /F%i\n", (int) f);
- if (pdffontattr[f] != getnullstr()) {
- pdfprint(pdffontattr[f]);
- pdf_puts("\n");
- }
- if (is_pk_font) {
- pk_font_scale = get_pk_font_scale(f);
- pdf_puts("/FontMatrix [");
- pdfprintreal(pk_font_scale, 5);
- pdf_puts(" 0 0 ");
- pdfprintreal(pk_font_scale, 5);
- pdf_puts(" 0 0]\n");
- } else
- pdf_printf("/FontMatrix [%g 0 0 %g 0 0]\n",
- (double) t3_font_scale, (double) t3_font_scale);
- pdf_printf("/%s [ %i %i %i %i ]\n",
- font_key[FONTBBOX1_CODE].pdfname,
- (int) t3_b0, (int) t3_b1, (int) t3_b2, (int) t3_b3);
- pdf_printf("/Resources << /ProcSet [ /PDF %s] >>\n",
- t3_image_used ? "/ImageB " : "");
- pdf_printf("/FirstChar %i\n/LastChar %i\n", first_char, last_char);
- wptr = pdfnewobjnum();
- eptr = pdfnewobjnum();
- cptr = pdfnewobjnum();
- pdf_printf("/Widths %i 0 R\n/Encoding %i 0 R\n/CharProcs %i 0 R\n",
- (int) wptr, (int) eptr, (int) cptr);
- if (tounicode_objnum != 0)
- pdf_printf("/ToUnicode %i 0 R\n", (int) tounicode_objnum);
- pdfenddict();
- pdfbeginobj(wptr, 1); /* chars width array */
- pdf_puts("[");
- if (is_pk_font)
- for (i = first_char; i <= last_char; i++) {
- pdfprintreal(t3_char_widths[i], 2);
- pdf_puts(" ");
- } else
- for (i = first_char; i <= last_char; i++)
- pdf_printf("%i ", (int) t3_char_widths[i]);
- pdf_puts("]\n");
- pdfendobj();
- pdfbegindict(eptr, 1); /* encoding dictionary */
- pdf_printf("/Type /Encoding\n/Differences [%i", first_char);
- if (t3_char_procs[first_char] == 0) {
- pdf_printf("/%s", notdef);
- is_notdef = true;
- } else {
- if (glyph_names
- && glyph_names[first_char]
- && glyph_names[first_char] != notdef)
- pdf_printf("/%s", glyph_names[first_char]);
- else
- pdf_printf("/a%i", first_char);
- is_notdef = false;
- }
- for (i = first_char + 1; i <= last_char; i++) {
- if (t3_char_procs[i] == 0) {
- if (!is_notdef) {
- pdf_printf(" %i/%s", i, notdef);
- is_notdef = true;
- }
- } else {
- if (is_notdef) {
- pdf_printf(" %i", i);
- is_notdef = false;
- }
- if (glyph_names && glyph_names[i] && glyph_names[i] != notdef)
- pdf_printf("/%s", glyph_names[i]);
- else
- pdf_printf("/a%i", i);
- }
- }
- pdf_puts("]\n");
- pdfenddict();
- pdfbegindict(cptr, 1); /* CharProcs dictionary */
- for (i = first_char; i <= last_char; i++)
- if (t3_char_procs[i] != 0) {
- if (glyph_names && glyph_names[i] && glyph_names[i] != notdef)
- pdf_printf("/%s %i 0 R\n", glyph_names[i],
- (int) t3_char_procs[i]);
- else
- pdf_printf("/a%i %i 0 R\n", (int) i,
- (int) t3_char_procs[i]);
- }
- pdfenddict();
- t3_close();
- tex_printf(">");
- cur_file_name = NULL;
-}
diff --git a/Build/source/texk/web2c/pdftexdir/writettf.c b/Build/source/texk/web2c/pdftexdir/writettf.c
deleted file mode 100644
index 4ae5092e6b9..00000000000
--- a/Build/source/texk/web2c/pdftexdir/writettf.c
+++ /dev/null
@@ -1,1463 +0,0 @@
-/*
-Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-#include "writettf.h"
-#include <string.h>
-
-#define DEFAULT_NTABS 14
-#define NEW_CMAP_SIZE 2
-
-#define ttf_putchar fb_putchar
-#define ttf_offset fb_offset
-#define ttf_seek_outbuf fb_seek
-
-#define INFILE ttf_file
-
-#define ttf_open() \
- open_input(&ttf_file, kpse_truetype_format, FOPEN_RBIN_MODE)
-#define ttf_close() xfclose(ttf_file, cur_file_name)
-#define ttf_getchar() xgetc(ttf_file)
-#define ttf_eof() feof(ttf_file)
-
-typedef struct {
- TTF_LONG offset;
- TTF_LONG newoffset;
- TTF_UFWORD advWidth;
- TTF_FWORD lsb;
- const char *name; /* name of glyph */
- TTF_SHORT newindex; /* new index of glyph in output file */
- TTF_USHORT name_index; /* index of name as read from font file */
-} glyph_entry;
-
-typedef struct {
- const char *name; /* name of glyph */
- long code; /* charcode in case of subfonts */
- long newindex; /* new index of glyph in output file */
-} ttfenc_entry;
-
-typedef struct {
- TTF_USHORT platform_id;
- TTF_USHORT encoding_id;
- TTF_USHORT language_id;
- TTF_USHORT name_id;
- TTF_USHORT length;
- TTF_USHORT offset;
- TTF_USHORT new_offset;
- TTF_USHORT new_length;
-} name_record;
-
-typedef struct {
- char *ttf_name;
- TTF_USHORT pid;
- TTF_USHORT eid;
- long *table;
-} ttf_cmap_entry;
-
-static TTF_USHORT ntabs;
-static TTF_USHORT upem;
-static TTF_FIXED post_format;
-static TTF_SHORT loca_format;
-static TTF_ULONG last_glyf_offset;
-static TTF_USHORT glyphs_count;
-static TTF_USHORT new_glyphs_count;
-static TTF_USHORT nhmtxs;
-static TTF_USHORT new_ntabs;
-
-static glyph_entry *glyph_tab;
-static long *glyph_index;
-static cmap_entry *cmap_tab, new_cmap_tab[NEW_CMAP_SIZE];
-static name_record *name_tab;
-static int name_record_num;
-static char *name_buf;
-static int name_buf_size;
-static dirtab_entry *dir_tab;
-static char *glyph_name_buf;
-static TTF_ULONG checksum;
-static TTF_ULONG tab_length;
-static TTF_ULONG tmp_ulong;
-static TTF_ULONG checkSumAdjustment_offset;
-static FILE *ttf_file;
-static ttfenc_entry ttfenc_tab[256];
-
-static fd_entry *fd_cur; /* pointer to the current font descriptor */
-
-static struct avl_table *ttf_cmap_tree = NULL;
-
-integer ttf_length;
-
-#include "macnames.c"
-
-static const char *newtabnames[] = {
- "OS/2",
- "PCLT",
- "cmap",
- "cvt ",
- "fpgm",
- "glyf",
- "head",
- "hhea",
- "hmtx",
- "loca",
- "maxp",
- "name",
- "post",
- "prep"
-};
-
-static ttf_cmap_entry *new_ttf_cmap_entry(void)
-{
- ttf_cmap_entry *e;
- e = xtalloc(1, ttf_cmap_entry);
- e->ttf_name = NULL;
- e->table = NULL;
- return e;
-}
-
-static void destroy_ttf_cmap_entry(void *pa, void *pb)
-{
- ttf_cmap_entry *p;
- p = (ttf_cmap_entry *) pa;
- xfree(p->ttf_name);
- xfree(p->table);
- xfree(p);
-}
-
-void ttf_free(void)
-{
- if (ttf_cmap_tree != NULL)
- avl_destroy(ttf_cmap_tree, destroy_ttf_cmap_entry);
-}
-
-static int comp_ttf_cmap_entry(const void *pa, const void *pb, void *p)
-{
- const ttf_cmap_entry *p1 = (const ttf_cmap_entry *) pa,
- *p2 = (const ttf_cmap_entry *) pb;
- int i;
- assert(p1->ttf_name != NULL && p2->ttf_name != NULL);
- if ((i = strcmp(p1->ttf_name, p2->ttf_name)) != 0)
- return i;
- cmp_return(p1->pid, p2->pid);
- cmp_return(p1->eid, p2->eid);
- return 0;
-}
-
-static unsigned char ttf_addchksm(unsigned char b)
-{
- tmp_ulong = (tmp_ulong << 8) + b;
- tab_length++;
- if (tab_length % 4 == 0) {
- checksum += tmp_ulong;
- tmp_ulong = 0;
- }
- return b;
-}
-
-static TTF_ULONG ttf_getchksm(void)
-{
- while (tab_length % 4 != 0)
- ttf_putchar(ttf_addchksm(0)); /* ttf_addchksm updates tab_length */
- return checksum;
-}
-
-static long ttf_putnum(int s, long n)
-{
- long i = n;
- char buf[TTF_LONG_SIZE + 1], *p = buf;
- while (s-- > 0) {
- *p++ = i & 0xFF;
- i >>= 8;
- }
- p--;
- while (p >= buf)
- ttf_putchar(ttf_addchksm(*p--));
- return n;
-}
-
-static long ttf_getnum(int s)
-{
- long i = 0;
- int c;
- while (s > 0) {
- if ((c = ttf_getchar()) < 0)
- pdftex_fail("unexpected EOF");
- i = (i << 8) + c;
- s--;
- }
- return i;
-}
-
-static long ttf_funit(long n)
-{
- if (n < 0)
- return -((-n / upem) * 1000 + ((-n % upem) * 1000) / upem);
- else
- return (n / upem) * 1000 + ((n % upem) * 1000) / upem;
-}
-
-static void ttf_ncopy(int n)
-{
- while (n-- > 0)
- copy_byte();
-}
-
-static dirtab_entry *ttf_name_lookup(const char *s, boolean required)
-{
- dirtab_entry *tab;
- for (tab = dir_tab; tab - dir_tab < ntabs; tab++)
- if (strncmp(tab->tag, s, 4) == 0)
- break;
- if (tab - dir_tab == ntabs) {
- if (required)
- pdftex_fail("can't find table `%s'", s);
- else
- tab = NULL;
- }
- return tab;
-}
-
-static dirtab_entry *ttf_seek_tab(const char *name, TTF_LONG offset)
-{
- dirtab_entry *tab = ttf_name_lookup(name, true);
- xfseek(INFILE, tab->offset + offset, SEEK_SET, cur_file_name);
- return tab;
-}
-
-static void ttf_seek_off(TTF_LONG offset)
-{
- xfseek(INFILE, offset, SEEK_SET, cur_file_name);
-}
-
-static void ttf_copy_encoding(void)
-{
- int i, *q;
- void **aa;
- char **glyph_names;
- long *charcodes;
- static char buf[SMALL_BUF_SIZE];
- struct avl_traverser t;
- ttfenc_entry *e = ttfenc_tab;
-
- assert(fd_cur->tx_tree != NULL); /* this must be set in create_fontdictionary */
-
- if (fd_cur->fe != NULL) {
- glyph_names = fd_cur->fe->glyph_names;
- assert(glyph_names != NULL);
-
- for (i = 0; i < 256; i++)
- ttfenc_tab[i].name = notdef;
-
- /* a workaround for a bug of AcroReader 4.0 */
- if (strcmp(glyph_names[97], "a") == 0) {
- q = xtalloc(1, int);
- *q = 'a';
- aa = avl_probe(fd_cur->tx_tree, q);
- assert(aa != NULL);
- }
- /* end of workaround */
-
- /* take over collected characters from TeX, reencode them */
- avl_t_init(&t, fd_cur->tx_tree);
- for (q = (int *) avl_t_first(&t, fd_cur->tx_tree); q != NULL;
- q = (int *) avl_t_next(&t)) {
- assert(*q >= 0 && *q < 256);
- ttfenc_tab[*q].name = glyph_names[*q];
- }
- make_subset_tag(fd_cur);
- } else if (is_subfont(fd_cur->fm)) {
- charcodes = fd_cur->fm->subfont->charcodes;
- assert(charcodes != NULL);
-
- for (i = 0; i < 256; i++)
- ttfenc_tab[i].code = -1;
-
- /* take over collected characters from TeX */
- avl_t_init(&t, fd_cur->tx_tree);
- for (q = (int *) avl_t_first(&t, fd_cur->tx_tree); q != NULL;
- q = (int *) avl_t_next(&t)) {
- assert(*q >= 0 && *q < 256);
- e = ttfenc_tab + *q;
- e->code = charcodes[*q];
- if (e->code == -1)
- pdftex_warn
- ("character %i in subfont %s is not mapped to any charcode",
- *q, fd_cur->fm->tfm_name);
- else {
- assert(e->code < 0x10000);
- sprintf(buf, "/c%4.4X", (int) e->code);
- aa = avl_probe(fd_cur->gl_tree, xstrdup(buf));
- assert(aa != NULL);
- }
- }
- make_subset_tag(fd_cur);
- } else
- assert(0);
-}
-
-#define ttf_append_byte(B)\
-do {\
- if (name_tab[i].platform_id == 3)\
- *q++ = 0;\
- *q++ = B;\
-} while (0)
-
-static char *strip_spaces_and_delims(char *s, int l)
-{
- static char buf[SMALL_BUF_SIZE];
- char *p = buf;
- int i;
-
- assert(l >= 0 && l < (int) sizeof(buf));
-
- for (i = 0; i < l; s++, i++) {
- if (*s == '(' || *s == ')' || *s == '<' || *s == '>' ||
- *s == '[' || *s == ']' || *s == '{' || *s == '}' ||
- *s == '/' || *s == '%' || isspace((unsigned char)*s))
- continue;
- *p++ = *s;
- }
- *p = 0;
- return buf;
-}
-
-static void ttf_read_name(void)
-{
- int i, j;
- dirtab_entry *tab = ttf_seek_tab("name", TTF_USHORT_SIZE);
- char *p, buf[SMALL_BUF_SIZE];
- name_record_num = get_ushort();
- name_tab = xtalloc(name_record_num, name_record);
- name_buf_size = tab->length -
- (3 * TTF_USHORT_SIZE + name_record_num * 6 * TTF_USHORT_SIZE);
- name_buf = xtalloc(name_buf_size, char);
- ttf_skip(TTF_USHORT_SIZE);
- for (i = 0; i < name_record_num; i++) {
- name_tab[i].platform_id = get_ushort();
- name_tab[i].encoding_id = get_ushort();
- name_tab[i].language_id = get_ushort();
- name_tab[i].name_id = get_ushort();
- name_tab[i].length = get_ushort();
- name_tab[i].offset = get_ushort();
- }
- for (p = name_buf; p - name_buf < name_buf_size; p++)
- *p = get_char();
- /* look for PS font name */
- for (i = 0; i < name_record_num; i++) {
- if (name_tab[i].platform_id == 1 &&
- name_tab[i].encoding_id == 0 && name_tab[i].name_id == 6) {
- xfree(fd_cur->fontname);
- fd_cur->fontname =
- xstrdup(strip_spaces_and_delims(name_buf + name_tab[i].offset,
- name_tab[i].length));
- fd_cur->font_dim[FONTNAME_CODE].set = true;
- break;
- }
- }
- if (!fd_cur->font_dim[FONTNAME_CODE].set) {
- for (i = 0; i < name_record_num; i++) {
- if (name_tab[i].platform_id == 3 &&
- (name_tab[i].encoding_id == 0 || name_tab[i].encoding_id == 1) &&
- name_tab[i].name_id == 6) {
- xfree(fd_cur->fontname);
- assert(name_tab[i].length < sizeof(buf));
- for (j = 0, p = buf; j < name_tab[i].length; j += 2)
- *p++ = name_buf[name_tab[i].offset + j + 1];
- *p = 0;
- fd_cur->fontname = xstrdup(strip_spaces_and_delims(buf, strlen(buf)));
- fd_cur->font_dim[FONTNAME_CODE].set = true;
- break;
- }
- }
- }
-}
-
-static void ttf_read_mapx(void)
-{
- glyph_entry *glyph;
- ttf_seek_tab("maxp", TTF_FIXED_SIZE);
- glyph_tab = xtalloc(1 + (glyphs_count = get_ushort()), glyph_entry);
- for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count; glyph++) {
- glyph->newindex = -1;
- glyph->newoffset = 0;
- glyph->name_index = 0;
- glyph->name = notdef;
- }
- glyph_index = xtalloc(glyphs_count + 1, long);
- glyph_index[0] = 0; /* index of ".notdef" glyph */
- glyph_index[1] = 1; /* index of ".null" glyph */
-}
-
-static void ttf_read_head(void)
-{
- ttf_seek_tab("head",
- 2 * TTF_FIXED_SIZE + 2 * TTF_ULONG_SIZE + TTF_USHORT_SIZE);
- upem = get_ushort();
- ttf_skip(16);
- fd_cur->font_dim[FONTBBOX1_CODE].val = ttf_funit(get_fword());
- fd_cur->font_dim[FONTBBOX2_CODE].val = ttf_funit(get_fword());
- fd_cur->font_dim[FONTBBOX3_CODE].val = ttf_funit(get_fword());
- fd_cur->font_dim[FONTBBOX4_CODE].val = ttf_funit(get_fword());
- fd_cur->font_dim[FONTBBOX1_CODE].set = true;
- fd_cur->font_dim[FONTBBOX2_CODE].set = true;
- fd_cur->font_dim[FONTBBOX3_CODE].set = true;
- fd_cur->font_dim[FONTBBOX4_CODE].set = true;
- ttf_skip(2 * TTF_USHORT_SIZE + TTF_SHORT_SIZE);
- loca_format = get_short();
-}
-
-static void ttf_read_hhea(void)
-{
- ttf_seek_tab("hhea", TTF_FIXED_SIZE);
- fd_cur->font_dim[ASCENT_CODE].val = ttf_funit(get_fword());
- fd_cur->font_dim[DESCENT_CODE].val = ttf_funit(get_fword());
- fd_cur->font_dim[ASCENT_CODE].set = true;
- fd_cur->font_dim[DESCENT_CODE].set = true;
- ttf_skip(TTF_FWORD_SIZE + TTF_UFWORD_SIZE + 3 * TTF_FWORD_SIZE +
- 8 * TTF_SHORT_SIZE);
- nhmtxs = get_ushort();
-}
-
-static void ttf_read_pclt(void)
-{
- if (ttf_name_lookup("PCLT", false) == NULL)
- return;
- ttf_seek_tab("PCLT", TTF_FIXED_SIZE + TTF_ULONG_SIZE + TTF_USHORT_SIZE);
- fd_cur->font_dim[XHEIGHT_CODE].val = ttf_funit(get_ushort());
- ttf_skip(2 * TTF_USHORT_SIZE);
- fd_cur->font_dim[CAPHEIGHT_CODE].val = ttf_funit(get_ushort());
- fd_cur->font_dim[XHEIGHT_CODE].set = true;
- fd_cur->font_dim[CAPHEIGHT_CODE].set = true;
-}
-
-static void ttf_read_hmtx(void)
-{
- glyph_entry *glyph;
- TTF_UFWORD last_advWidth;
- ttf_seek_tab("hmtx", 0);
- for (glyph = glyph_tab; glyph - glyph_tab < nhmtxs; glyph++) {
- glyph->advWidth = get_ufword();
- glyph->lsb = get_ufword();
- }
- if (nhmtxs < glyphs_count) {
- last_advWidth = glyph[-1].advWidth;
- for (; glyph - glyph_tab < glyphs_count; glyph++) {
- glyph->advWidth = last_advWidth;
- glyph->lsb = get_ufword();
- }
- }
-}
-
-static void ttf_read_post(void)
-{
- int k, nnames;
- long length;
- long int_part, frac_part;
- int sign = 1;
- TTF_FIXED italic_angle;
- char *p;
- glyph_entry *glyph;
- const dirtab_entry *tab = ttf_seek_tab("post", 0);
- post_format = get_fixed();
- italic_angle = get_fixed();
- int_part = italic_angle >> 16;
- if (int_part > 0x7FFF) { /* a negative number */
- int_part = 0x10000 - int_part;
- sign = -1;
- }
- frac_part = italic_angle % 0x10000;
- fd_cur->font_dim[ITALIC_ANGLE_CODE].val =
- sign * (int_part + frac_part * 1.0 / 0x10000);
- fd_cur->font_dim[ITALIC_ANGLE_CODE].set = true;
- if (glyph_tab == NULL)
- return; /* being called from writeotf() */
- ttf_skip(2 * TTF_FWORD_SIZE + 5 * TTF_ULONG_SIZE);
- switch (post_format) {
- case 0x10000:
- for (glyph = glyph_tab; glyph - glyph_tab < NMACGLYPHS; glyph++) {
- glyph->name = mac_glyph_names[glyph - glyph_tab];
- glyph->name_index = glyph - glyph_tab;
- }
- break;
- case 0x20000:
- nnames = get_ushort(); /* some fonts have this value different from nglyphs */
- for (glyph = glyph_tab; glyph - glyph_tab < nnames; glyph++)
- glyph->name_index = get_ushort();
- length = tab->length - (xftell(INFILE, cur_file_name) - tab->offset);
- glyph_name_buf = xtalloc(length, char);
- for (p = glyph_name_buf; p - glyph_name_buf < length;) {
- for (k = get_byte(); k > 0; k--)
- *p++ = get_char();
- *p++ = 0;
- }
- for (glyph = glyph_tab; glyph - glyph_tab < nnames; glyph++) {
- if (glyph->name_index < NMACGLYPHS)
- glyph->name = mac_glyph_names[glyph->name_index];
- else {
- p = glyph_name_buf;
- k = glyph->name_index - NMACGLYPHS;
- for (; k > 0; k--)
- p = strend(p) + 1;
- glyph->name = p;
- }
- }
- break;
- default:
- pdftex_warn("unsupported format (%.8X) of `post' table, assuming 3.0",
- (unsigned int) post_format);
- case 0x00030000:
- for (glyph = glyph_tab; glyph - glyph_tab < NMACGLYPHS; glyph++) {
- glyph->name_index = glyph - glyph_tab;
- }
- }
-}
-
-static void ttf_read_loca(void)
-{
- glyph_entry *glyph;
- ttf_seek_tab("loca", 0);
- if (loca_format != 0)
- for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count + 1; glyph++)
- glyph->offset = get_ulong();
- else
- for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count + 1; glyph++)
- glyph->offset = get_ushort() << 1;
-}
-
-static void ttf_read_tabdir(void)
-{
- int i;
- dirtab_entry *tab;
- ttf_skip(TTF_FIXED_SIZE); /* ignore the sfnt number */
- dir_tab = xtalloc(ntabs = get_ushort(), dirtab_entry);
- ttf_skip(3 * TTF_USHORT_SIZE);
- for (tab = dir_tab; tab - dir_tab < ntabs; tab++) {
- for (i = 0; i < 4; i++)
- tab->tag[i] = get_char();
- tab->checksum = get_ulong();
- tab->offset = get_ulong();
- tab->length = get_ulong();
- }
-}
-
-static ttf_cmap_entry *ttf_read_cmap(char *ttf_name, int pid, int eid,
- boolean warn)
-{
- seg_entry *seg_tab, *s;
- TTF_USHORT *glyphId, format, segCount;
- TTF_USHORT ncmapsubtabs, tmp_pid, tmp_eid;
- TTF_ULONG cmap_offset, tmp_offset;
- long n, i, k, length, index;
- ttf_cmap_entry tmp_e, *p;
- void **aa;
-
- /* loop up in ttf_cmap_tree first, return if found */
- tmp_e.ttf_name = ttf_name;
- tmp_e.pid = pid;
- tmp_e.eid = eid;
- if (ttf_cmap_tree == NULL) {
- ttf_cmap_tree = avl_create(comp_ttf_cmap_entry, NULL, &avl_xallocator);
- assert(ttf_cmap_tree != NULL);
- }
- p = (ttf_cmap_entry *) avl_find(ttf_cmap_tree, &tmp_e);
- if (p != NULL)
- return p;
-
- /* not found, have to read it */
- ttf_seek_tab("cmap", TTF_USHORT_SIZE); /* skip the table version number (=0) */
- ncmapsubtabs = get_ushort();
- cmap_offset = xftell(INFILE, cur_file_name) - 2 * TTF_USHORT_SIZE;
- cmap_tab = xtalloc(ncmapsubtabs, cmap_entry);
- for (i = 0; i < ncmapsubtabs; ++i) {
- tmp_pid = get_ushort();
- tmp_eid = get_ushort();
- tmp_offset = get_ulong();
- if (tmp_pid == pid && tmp_eid == eid) {
- ttf_seek_off(cmap_offset + tmp_offset);
- format = get_ushort();
- if (format == 4)
- goto read_cmap_format_4;
- else {
- if (warn)
- pdftex_warn("cmap format %i unsupported", format);
- return NULL;
- }
- }
- }
- if (warn)
- pdftex_warn("cannot find cmap subtable for (pid,eid) = (%i, %i)",
- pid, eid);
- return NULL;
- read_cmap_format_4:
- /* initialize the new entry */
- p = new_ttf_cmap_entry();
- p->ttf_name = xstrdup(ttf_name);
- p->pid = pid;
- p->eid = eid;
- p->table = xtalloc(0x10000, long);
- for (i = 0; i < 0x10000; ++i)
- p->table[i] = -1; /* unassigned yet */
-
- /* read the subtable */
- length = get_ushort(); /* length of subtable */
- (void) get_ushort(); /* skip the version number */
- segCount = get_ushort() / 2;
- (void) get_ushort(); /* skip searchRange */
- (void) get_ushort(); /* skip entrySelector */
- (void) get_ushort(); /* skip rangeShift */
- seg_tab = xtalloc(segCount, seg_entry);
- for (s = seg_tab; s - seg_tab < segCount; s++)
- s->endCode = get_ushort();
- (void) get_ushort(); /* skip reversedPad */
- for (s = seg_tab; s - seg_tab < segCount; s++)
- s->startCode = get_ushort();
- for (s = seg_tab; s - seg_tab < segCount; s++)
- s->idDelta = get_ushort();
- for (s = seg_tab; s - seg_tab < segCount; s++)
- s->idRangeOffset = get_ushort();
- length -= 8 * TTF_USHORT_SIZE + 4 * segCount * TTF_USHORT_SIZE;
- n = length / TTF_USHORT_SIZE; /* number of glyphID's */
- glyphId = xtalloc(n, TTF_USHORT);
- for (i = 0; i < n; i++)
- glyphId[i] = get_ushort();
- for (s = seg_tab; s - seg_tab < segCount; s++) {
- for (i = s->startCode; i <= s->endCode; i++) {
- if (i == 0xFFFF)
- break;
- if (s->idRangeOffset != 0xFFFF) {
- if (s->idRangeOffset == 0)
- index = (s->idDelta + i) & 0xFFFF;
- else {
- k = (i - s->startCode) + s->idRangeOffset / 2 +
- (s - seg_tab) - segCount;
- assert(k >= 0 && k < n);
- index = glyphId[k];
- if (index != 0)
- index = (index + s->idDelta) & 0xFFFF;
- }
- if (index >= glyphs_count)
- pdftex_fail("cmap: glyph index %li out of range [0..%i)",
- index, glyphs_count);
- if (p->table[i] != -1)
- pdftex_warn
- ("cmap: multiple glyphs are mapped to unicode %.4lX, "
- "only %li will be used (glyph %li being ignored)", i,
- p->table[i], index);
- else
- p->table[i] = index;
- }
- }
- }
- xfree(seg_tab);
- xfree(glyphId);
- aa = avl_probe(ttf_cmap_tree, p);
- assert(aa != NULL);
- return p;
-}
-
-static void ttf_read_font(void)
-{
- ttf_read_tabdir();
- if (ttf_name_lookup("PCLT", false) == NULL)
- new_ntabs--;
- if (ttf_name_lookup("fpgm", false) == NULL)
- new_ntabs--;
- if (ttf_name_lookup("cvt ", false) == NULL)
- new_ntabs--;
- if (ttf_name_lookup("prep", false) == NULL)
- new_ntabs--;
- ttf_read_mapx();
- ttf_read_head();
- ttf_read_hhea();
- ttf_read_pclt();
- ttf_read_hmtx();
- ttf_read_post();
- ttf_read_loca();
- ttf_read_name();
-}
-
-static void ttf_reset_chksm(dirtab_entry * tab)
-{
- checksum = 0;
- tab_length = 0;
- tmp_ulong = 0;
- tab->offset = ttf_offset();
- if (tab->offset % 4 != 0)
- pdftex_warn("offset of `%4.4s' is not a multiple of 4", tab->tag);
-}
-
-
-static void ttf_set_chksm(dirtab_entry * tab)
-{
- tab->length = ttf_offset() - tab->offset;
- tab->checksum = ttf_getchksm();
-}
-
-static void ttf_copytab(const char *name)
-{
- long i;
- dirtab_entry *tab = ttf_seek_tab(name, 0);
- ttf_reset_chksm(tab);
- for (i = tab->length; i > 0; i--)
- copy_char();
- ttf_set_chksm(tab);
-}
-
-#define BYTE_ENCODING_LENGTH \
- ((256)*TTF_BYTE_SIZE + 3*TTF_USHORT_SIZE)
-
-static void ttf_byte_encoding(void)
-{
- ttfenc_entry *e;
- (void) put_ushort(0); /* format number (0: byte encoding table) */
- (void) put_ushort(BYTE_ENCODING_LENGTH); /* length of table */
- (void) put_ushort(0); /* version number */
- for (e = ttfenc_tab; e - ttfenc_tab < 256; e++)
- if (e->newindex < 256) {
- put_byte(e->newindex);
- } else {
- if (e->name != notdef)
- pdftex_warn
- ("glyph `%s' has been mapped to `%s' in `ttf_byte_encoding' cmap table",
- e->name, notdef);
- put_byte(0); /* notdef */
- }
-}
-
-#define TRIMMED_TABLE_MAP_LENGTH (TTF_USHORT_SIZE*(5 + (256)))
-
-static void ttf_trimmed_table_map(void)
-{
- ttfenc_entry *e;
- (void) put_ushort(6); /* format number (6): trimmed table mapping */
- (void) put_ushort(TRIMMED_TABLE_MAP_LENGTH);
- (void) put_ushort(0); /* version number (0) */
- (void) put_ushort(0); /* first character code */
- (void) put_ushort(256); /* number of character code in table */
- for (e = ttfenc_tab; e - ttfenc_tab < 256; e++)
- (void) put_ushort(e->newindex);
-}
-
-#define SEG_MAP_DELTA_LENGTH ((16 + (256))*TTF_USHORT_SIZE)
-
-static void ttf_seg_map_delta(void)
-{
- ttfenc_entry *e;
- (void) put_ushort(4); /* format number (4: segment mapping to delta values) */
- (void) put_ushort(SEG_MAP_DELTA_LENGTH);
- (void) put_ushort(0); /* version number */
- (void) put_ushort(4); /* 2*segCount */
- (void) put_ushort(4); /* searchRange */
- (void) put_ushort(1); /* entrySelector */
- (void) put_ushort(0); /* rangeShift */
- (void) put_ushort(0xF0FF); /* endCount[0] */
- (void) put_ushort(0xFFFF); /* endCount[1] */
- (void) put_ushort(0); /* reversedPad */
- (void) put_ushort(0xF000); /* startCount[0] */
- (void) put_ushort(0xFFFF); /* startCount[1] */
- (void) put_ushort(0); /* idDelta[0] */
- (void) put_ushort(1); /* idDelta[1] */
- (void) put_ushort(2 * TTF_USHORT_SIZE); /* idRangeOffset[0] */
- (void) put_ushort(0); /* idRangeOffset[1] */
- for (e = ttfenc_tab; e - ttfenc_tab < 256; e++)
- (void) put_ushort(e->newindex);
-}
-
-#define CMAP_ENTRY_LENGTH (2*TTF_USHORT_SIZE + TTF_ULONG_SIZE)
-
-static void ttf_select_cmap(void)
-{
- assert(sizeof(new_cmap_tab) <= NEW_CMAP_SIZE * sizeof(cmap_entry));
- new_cmap_tab[0].platform_id = 1; /* Macintosh */
- new_cmap_tab[0].encoding_id = 0; /* Symbol; ignore code page */
- new_cmap_tab[0].format = new_glyphs_count < 256 ? 0 /* byte encoding */
- : 6; /* trimmed table mapping */
- new_cmap_tab[1].platform_id = 3; /* Microsoft */
- new_cmap_tab[1].encoding_id = 0; /* Symbol; ignore code page */
- new_cmap_tab[1].format = 4; /* segment mapping to delta */
-}
-
-static void ttf_write_cmap(void)
-{
- cmap_entry *ce;
- long offset;
- dirtab_entry *tab = ttf_name_lookup("cmap", true);
- ttf_select_cmap();
- ttf_reset_chksm(tab);
- (void) put_ushort(0); /* table version number (0) */
- (void) put_ushort(NEW_CMAP_SIZE); /* number of encoding tables */
- offset = 2 * TTF_USHORT_SIZE + NEW_CMAP_SIZE * CMAP_ENTRY_LENGTH;
- for (ce = new_cmap_tab; ce - new_cmap_tab < NEW_CMAP_SIZE; ce++) {
- ce->offset = offset;
- switch (ce->format) {
- case 0:
- offset += BYTE_ENCODING_LENGTH;
- break;
- case 4:
- offset += SEG_MAP_DELTA_LENGTH;
- break;
- case 6:
- offset += TRIMMED_TABLE_MAP_LENGTH;
- break;
- default:
- pdftex_fail("invalid format (it should not have happened)");
- }
- (void) put_ushort(ce->platform_id);
- (void) put_ushort(ce->encoding_id);
- put_ulong(ce->offset);
- }
- for (ce = new_cmap_tab; ce - new_cmap_tab < NEW_CMAP_SIZE; ce++) {
- switch (ce->format) {
- case 0:
- ttf_byte_encoding();
- break;
- case 4:
- ttf_seg_map_delta();
- break;
- case 6:
- ttf_trimmed_table_map();
- break;
- }
- }
- ttf_set_chksm(tab);
-}
-
-static int prepend_subset_tags(int index, char *p)
-{
- boolean is_unicode;
- int i;
- assert(index >= 0 && index < name_record_num && fd_cur->subset_tag != NULL);
- is_unicode = (name_tab[index].platform_id == 3);
- if (is_unicode) {
- for (i = 0; i < 6; ++i) {
- *p++ = 0;
- *p++ = fd_cur->subset_tag[i];
- }
- *p++ = 0;
- *p++ = '+';
- return 14;
- } else {
- strncpy(p, fd_cur->subset_tag, 6);
- p += 6;
- *p++ = '+';
- return 7;
- }
-}
-
-
-static void ttf_write_name(void)
-{
- int i, l;
- char *p;
- int new_name_buf_size;
- char *new_name_buf;
- name_record *n;
- dirtab_entry *tab = ttf_name_lookup("name", true);
- if (is_subsetted(fd_cur->fm)) {
- l = 0;
- for (i = 0; i < name_record_num; i++)
- l += name_tab[i].length + 14; /* maximum lengh of new stogare area */
- new_name_buf = xtalloc(l, char);
- /* additional space for subset tags */
- p = new_name_buf;
- for (i = 0; i < name_record_num; i++) {
- n = name_tab + i;
- n->new_offset = p - new_name_buf;
- if ((n->name_id == 1 || n->name_id == 3 ||
- n->name_id == 4 || n->name_id == 6) &&
- ((n->platform_id == 1 && n->encoding_id == 0) ||
- (n->platform_id == 3 && n->encoding_id == 0) ||
- (n->platform_id == 3 && n->encoding_id == 1))) {
- l = prepend_subset_tags(i, p);
- p += l;
- } else
- l = 0;
- memcpy(p, name_buf + n->offset, n->length);
- p += n->length;
- n->new_length = n->length + l;
- }
- new_name_buf_size = p - new_name_buf;
- } else {
- new_name_buf = name_buf;
- new_name_buf_size = name_buf_size;
- }
- ttf_reset_chksm(tab);
- (void) put_ushort(0); /* Format selector */
- (void) put_ushort(name_record_num);
- (void) put_ushort(3 * TTF_USHORT_SIZE +
- name_record_num * 6 * TTF_USHORT_SIZE);
- for (i = 0; i < name_record_num; i++) {
- (void) put_ushort(name_tab[i].platform_id);
- (void) put_ushort(name_tab[i].encoding_id);
- (void) put_ushort(name_tab[i].language_id);
- (void) put_ushort(name_tab[i].name_id);
- (void) put_ushort(name_tab[i].new_length);
- (void) put_ushort(name_tab[i].new_offset);
- }
- for (p = new_name_buf; p - new_name_buf < new_name_buf_size; p++)
- put_char(*p);
- ttf_set_chksm(tab);
- if (new_name_buf != name_buf)
- xfree(new_name_buf);
-}
-
-static void ttf_write_dirtab(void)
-{
- dirtab_entry *tab;
- TTF_ULONG i, k;
- char *p;
- const uint32_t save_offset = ttf_offset();
- ttf_seek_outbuf(TABDIR_OFF);
- if (is_subsetted(fd_cur->fm)) {
- for (i = 0; i < DEFAULT_NTABS; i++) {
- tab = ttf_name_lookup(newtabnames[i], false);
- if (tab == NULL)
- continue;
- for (k = 0; k < 4; k++)
- put_char(tab->tag[k]);
- put_ulong(tab->checksum);
- put_ulong(tab->offset);
- put_ulong(tab->length);
- }
- } else {
- for (tab = dir_tab; tab - dir_tab < ntabs; tab++) {
- for (k = 0; k < 4; k++)
- put_char(tab->tag[k]);
- put_ulong(tab->checksum);
- put_ulong(tab->offset);
- put_ulong(tab->length);
- }
- }
- /* adjust checkSumAdjustment */
- tmp_ulong = 0;
- checksum = 0;
- for (p = fb_array, i = 0; i < save_offset;) {
- tmp_ulong = (tmp_ulong << 8) + *p++;
- i++;
- if (i % 4 == 0) {
- checksum += tmp_ulong;
- tmp_ulong = 0;
- }
- }
- if (i % 4 != 0) {
- pdftex_warn("font length is not a multiple of 4 (%d)", i);
- checksum <<= 8 * (4 - i % 4);
- }
- k = 0xB1B0AFBA - checksum;
- ttf_seek_outbuf(checkSumAdjustment_offset);
- put_ulong(k);
- ttf_seek_outbuf(save_offset);
-}
-
-static void ttf_write_glyf(void)
-{
- long *id, k;
- TTF_USHORT idx;
- TTF_USHORT flags;
- dirtab_entry *tab = ttf_name_lookup("glyf", true);
- const long glyf_offset = tab->offset;
- const long new_glyf_offset = ttf_offset();
- ttf_reset_chksm(tab);
- for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
- glyph_tab[*id].newoffset = ttf_offset() - new_glyf_offset;
- if (glyph_tab[*id].offset != glyph_tab[*id + 1].offset) {
- ttf_seek_off(glyf_offset + glyph_tab[*id].offset);
- k = copy_short();
- ttf_ncopy(4 * TTF_FWORD_SIZE);
- if (k < 0) {
- do {
- flags = copy_ushort();
- idx = get_ushort();
- if (glyph_tab[idx].newindex < 0) {
- glyph_tab[idx].newindex = new_glyphs_count;
- glyph_index[new_glyphs_count++] = idx;
- /*
- N.B.: Here we change `new_glyphs_count',
- which appears in the condition of the `for' loop
- */
- }
- (void) put_ushort(glyph_tab[idx].newindex);
- if (flags & ARG_1_AND_2_ARE_WORDS)
- ttf_ncopy(2 * TTF_SHORT_SIZE);
- else
- ttf_ncopy(TTF_USHORT_SIZE);
- if (flags & WE_HAVE_A_SCALE)
- ttf_ncopy(TTF_F2DOT14_SIZE);
- else if (flags & WE_HAVE_AN_X_AND_Y_SCALE)
- ttf_ncopy(2 * TTF_F2DOT14_SIZE);
- else if (flags & WE_HAVE_A_TWO_BY_TWO)
- ttf_ncopy(4 * TTF_F2DOT14_SIZE);
- } while (flags & MORE_COMPONENTS);
- if (flags & WE_HAVE_INSTRUCTIONS)
- ttf_ncopy(copy_ushort());
- } else
- ttf_ncopy(glyph_tab[*id + 1].offset - glyph_tab[*id].offset -
- TTF_USHORT_SIZE - 4 * TTF_FWORD_SIZE);
- }
- }
- last_glyf_offset = ttf_offset() - new_glyf_offset;
- ttf_set_chksm(tab);
-}
-
-static void ttf_reindex_glyphs(void)
-{
- ttfenc_entry *e;
- glyph_entry *glyph;
- int index;
- int n;
- long *t;
- ttf_cmap_entry *cmap = NULL;
- boolean cmap_not_found = false;
-
- /*
- * reindexing glyphs: we append index of used glyphs to `glyph_index'
- * while going through `ttfenc_tab'. After appending a new entry to
- * `glyph_index' we set field `newindex' of corresponding entries in both
- * `glyph_tab' and `ttfenc_tab' to the newly created index
- */
- for (e = ttfenc_tab; e - ttfenc_tab < 256; e++) {
- e->newindex = 0; /* index of ".notdef" glyph */
-
- /* handle case of subfonts first */
- if (is_subfont(fd_cur->fm)) {
- if (e->code == -1)
- continue;
- assert(fd_cur->fm->pid != -1 && fd_cur->fm->eid != -1);
- if (cmap == NULL && !cmap_not_found) {
- cmap =
- ttf_read_cmap(fd_cur->fm->ff_name, fd_cur->fm->pid,
- fd_cur->fm->eid, true);
- if (cmap == NULL)
- cmap_not_found = true;
- }
- if (cmap == NULL)
- continue;
- t = cmap->table;
- assert(t != NULL && e->code < 0x10000);
- if (t[e->code] < 0) {
- pdftex_warn
- ("subfont %s: wrong mapping: character %li --> 0x%4.4lX --> .notdef",
- fd_cur->fm->tfm_name, (long) (e - ttfenc_tab), e->code);
- continue;
- }
- assert(t[e->code] >= 0 && t[e->code] < glyphs_count); /* t has been read from ttf */
- glyph = glyph_tab + t[e->code];
- goto append_new_glyph;
- }
-
- /* handle case of reencoded fonts */
- if (e->name == notdef)
- continue;
-
- /* look up by name first */
- for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count; glyph++)
- if (glyph->name != notdef && strcmp(glyph->name, e->name) == 0)
- goto append_new_glyph;
-
- /* scan form `uniABCD' */
- n = -1;
- sscanf(e->name, GLYPH_PREFIX_UNICODE "%X%n", &index, &n);
- if (n == strlen(e->name)) {
- if (cmap == NULL && !cmap_not_found) {
- /* need to read the unicode mapping, ie (pid,eid) = (3,1) or (0,3) */
- cmap = ttf_read_cmap(fd_cur->fm->ff_name, 3, 1, false);
- if (cmap == NULL)
- cmap = ttf_read_cmap(fd_cur->fm->ff_name, 0, 3, false);
- if (cmap == NULL) {
- pdftex_warn
- ("no unicode mapping found, all `uniXXXX' names will be ignored");
- cmap_not_found = true; /* once only */
- }
- }
- if (cmap == NULL)
- continue;
- t = cmap->table;
- assert(t != NULL);
- if (t[index] != -1) {
- if (t[index] >= glyphs_count) {
- pdftex_warn
- ("`%s' is mapped to index %li which is out of valid range [0..%i)",
- e->name, t[index], glyphs_count);
- continue;
- }
- glyph = glyph_tab + t[index];
- goto append_new_glyph;
- } else {
- pdftex_warn("`unicode %s%.4X' is not mapped to any glyph",
- GLYPH_PREFIX_UNICODE, index);
- continue;
- }
- }
-
- /* scan form `index123' */
- n = -1;
- sscanf(e->name, GLYPH_PREFIX_INDEX "%i%n", &index, &n);
- if (n == strlen(e->name)) {
- if (index >= glyphs_count) {
- pdftex_warn("`%s' out of valid range [0..%i)",
- e->name, glyphs_count);
- continue;
- }
- glyph = glyph_tab + index;
- goto append_new_glyph;
- }
-
- /* not found */
- pdftex_warn("glyph `%s' not found", e->name);
- continue;
-
- append_new_glyph:
- assert(glyph > glyph_tab && glyph - glyph_tab < glyphs_count);
- if (glyph->newindex < 0) {
- glyph_index[new_glyphs_count] = glyph - glyph_tab;
- glyph->newindex = new_glyphs_count;
- new_glyphs_count++;
- }
- e->newindex = glyph->newindex;
- }
-}
-
-static void ttf_write_head(void)
-{
- dirtab_entry *tab;
- tab = ttf_seek_tab("head", 0);
- ttf_reset_chksm(tab);
- ttf_ncopy(2 * TTF_FIXED_SIZE);
- checkSumAdjustment_offset = ttf_offset();
- put_ulong(0);
- ttf_skip(TTF_ULONG_SIZE); /* skip checkSumAdjustment */
- ttf_ncopy(TTF_ULONG_SIZE + 2 * TTF_USHORT_SIZE + 16 +
- 4 * TTF_FWORD_SIZE + 2 * TTF_USHORT_SIZE + TTF_SHORT_SIZE);
- if (is_subsetted(fd_cur->fm)) {
- (void) put_short(loca_format);
- (void) put_short(0);
- } else
- ttf_ncopy(2 * TTF_SHORT_SIZE);
- ttf_set_chksm(tab);
-}
-
-static void ttf_write_hhea(void)
-{
- dirtab_entry *tab;
- tab = ttf_seek_tab("hhea", 0);
- ttf_reset_chksm(tab);
- ttf_ncopy(TTF_FIXED_SIZE + 3 * TTF_FWORD_SIZE + TTF_UFWORD_SIZE +
- 3 * TTF_FWORD_SIZE + 8 * TTF_SHORT_SIZE);
- (void) put_ushort(new_glyphs_count);
- ttf_set_chksm(tab);
-}
-
-static void ttf_write_htmx(void)
-{
- long *id;
- dirtab_entry *tab = ttf_seek_tab("hmtx", 0);
- ttf_reset_chksm(tab);
- for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
- put_ufword(glyph_tab[*id].advWidth);
- put_ufword(glyph_tab[*id].lsb);
- }
- ttf_set_chksm(tab);
-}
-
-static void ttf_write_loca(void)
-{
- long *id;
- dirtab_entry *tab = ttf_seek_tab("loca", 0);
- ttf_reset_chksm(tab);
- loca_format = 0;
- if (last_glyf_offset >= 0x00020000 || (last_glyf_offset & 1))
- loca_format = 1;
- else
- for (id = glyph_index; id - glyph_index < new_glyphs_count; id++)
- if (glyph_tab[*id].newoffset & 1) {
- loca_format = 1;
- break;
- }
- if (loca_format != 0) {
- for (id = glyph_index; id - glyph_index < new_glyphs_count; id++)
- put_ulong(glyph_tab[*id].newoffset);
- put_ulong(last_glyf_offset);
- } else {
- for (id = glyph_index; id - glyph_index < new_glyphs_count; id++)
- (void) put_ushort(glyph_tab[*id].newoffset / 2);
- (void) put_ushort(last_glyf_offset / 2);
- }
- ttf_set_chksm(tab);
-}
-
-static void ttf_write_mapx(void)
-{
- dirtab_entry *tab = ttf_seek_tab("maxp", TTF_FIXED_SIZE + TTF_USHORT_SIZE);
- ttf_reset_chksm(tab);
- put_fixed(0x00010000);
- (void) put_ushort(new_glyphs_count);
- ttf_ncopy(13 * TTF_USHORT_SIZE);
- ttf_set_chksm(tab);
-}
-
-static void ttf_write_OS2(void)
-{
- dirtab_entry *tab = ttf_seek_tab("OS/2", 0);
- TTF_USHORT version;
- ttf_reset_chksm(tab);
- version = get_ushort();
- if (version > 3)
- pdftex_fail("unknown version of OS/2 table (%.4X)", version);
- (void) put_ushort(0x0001); /* fix version to 1 */
- ttf_ncopy(2 * TTF_USHORT_SIZE + 13 * TTF_SHORT_SIZE + 10 * TTF_BYTE_SIZE);
- ttf_skip(4 * TTF_ULONG_SIZE); /* ulUnicodeRange 1--4 */
- put_ulong(0x00000003); /* Basic Latin + Latin-1 Supplement (0x0000--0x00FF) */
- put_ulong(0x10000000); /* Private Use (0xE000--0xF8FF) */
- put_ulong(0x00000000);
- put_ulong(0x00000000);
- ttf_ncopy(4 * TTF_CHAR_SIZE + TTF_USHORT_SIZE); /* achVendID + fsSelection */
- ttf_skip(2 * TTF_USHORT_SIZE);
- (void) put_ushort(0x0000); /* usFirstCharIndex */
- (void) put_ushort(0xF0FF); /* usLastCharIndex */
- ttf_ncopy(5 * TTF_USHORT_SIZE);
- /* for version 0 the OS/2 table ends here, the rest is for version 1 */
- put_ulong(0x80000000); /* Symbol Character Set---don't use any code page */
- put_ulong(0x00000000);
- ttf_set_chksm(tab);
-}
-
-static boolean unsafe_name(const char *s)
-{
- const char **p;
- for (p = ambiguous_names; *p != NULL; p++)
- if (strcmp(s, *p) == 0)
- return true;
- return false;
-}
-
-static void ttf_write_post(void)
-{
- dirtab_entry *tab = ttf_seek_tab("post", TTF_FIXED_SIZE);
- glyph_entry *glyph;
- const char *s;
- long *id;
- int l;
- ttf_reset_chksm(tab);
- if (!fd_cur->write_ttf_glyph_names || post_format == 0x00030000) {
- put_fixed(0x00030000);
- ttf_ncopy(TTF_FIXED_SIZE + 2 * TTF_FWORD_SIZE + 5 * TTF_ULONG_SIZE);
- } else {
- put_fixed(0x00020000);
- ttf_ncopy(TTF_FIXED_SIZE + 2 * TTF_FWORD_SIZE + 5 * TTF_ULONG_SIZE);
- (void) put_ushort(new_glyphs_count);
- k = 0;
- for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
- glyph = glyph_tab + *id;
- if (glyph->name_index >= NMACGLYPHS || unsafe_name(glyph->name))
- glyph->name_index = NMACGLYPHS + k++;
- (void) put_ushort(glyph->name_index);
- }
- for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
- glyph = glyph_tab + *id;
- if (glyph->name_index >= NMACGLYPHS) {
- s = glyph->name;
- l = strlen(s);
- put_byte(l);
- while (l-- > 0)
- put_char(*s++);
- }
- }
- }
- ttf_set_chksm(tab);
-}
-
-static void ttf_init_font(int n)
-{
- int i, k;
- for (i = 1, k = 0; i <= n; i <<= 1, k++);
- put_fixed(0x00010000); /* font version */
- (void) put_ushort(n); /* number of tables */
- (void) put_ushort(i << 3); /* search range */
- (void) put_ushort(k - 1); /* entry selector */
- (void) put_ushort((n << 4) - (i << 3)); /* range shift */
- ttf_seek_outbuf(TABDIR_OFF + n * 4 * TTF_ULONG_SIZE);
-}
-
-static void ttf_subset_font(void)
-{
- ttf_init_font(new_ntabs);
- if (ttf_name_lookup("PCLT", false) != NULL)
- ttf_copytab("PCLT");
- if (ttf_name_lookup("fpgm", false) != NULL)
- ttf_copytab("fpgm");
- if (ttf_name_lookup("cvt ", false) != NULL)
- ttf_copytab("cvt ");
- if (ttf_name_lookup("prep", false) != NULL)
- ttf_copytab("prep");
- ttf_reindex_glyphs();
- ttf_write_glyf();
- ttf_write_loca();
- ttf_write_OS2();
- ttf_write_head();
- ttf_write_hhea();
- ttf_write_htmx();
- ttf_write_mapx();
- ttf_write_name();
- ttf_write_post();
- ttf_write_cmap();
- ttf_write_dirtab();
-}
-
-static void ttf_copy_font(void)
-{
- dirtab_entry *tab;
- ttf_init_font(ntabs);
- for (tab = dir_tab; tab - dir_tab < ntabs; tab++) {
- if (strncmp(tab->tag, "head", 4) == 0)
- ttf_write_head();
- else
- ttf_copytab(tab->tag);
- }
- ttf_write_dirtab();
-}
-
-void writettf(fd_entry * fd)
-{
- fd_cur = fd; /* fd_cur is global inside writettf.c */
- assert(fd_cur->fm != NULL);
- assert(is_truetype(fd_cur->fm));
- assert(is_included(fd_cur->fm));
-
- set_cur_file_name(fd_cur->fm->ff_name);
- if (is_subsetted(fd_cur->fm) && (fd_cur->fe == NULL)
- && !is_subfont(fd_cur->fm)) {
- pdftex_fail("Subset TrueType must be a reencoded or a subfont");
- }
- if (!ttf_open()) {
- pdftex_fail("cannot open TrueType font file for reading");
- }
- cur_file_name = (char *) nameoffile + 1;
-
- /* skip ttc header, prepare for reading first font */
- if (strcasecmp(strchr(cur_file_name, 0) - 4, ".ttc") == 0) {
- if (get_ulong() != 0x74746366 /* ttcf */) {
- xfseek(INFILE, 0, SEEK_SET, cur_file_name);
- } else {
- ttf_skip(TTF_FIXED_SIZE); /* ignore the version */
- ttf_skip(TTF_ULONG_SIZE); /* ignore the numFonts */
-
- /* goto first font */
- xfseek(INFILE, get_ulong(), SEEK_SET, cur_file_name);
- }
- }
-
- if (is_subsetted(fd_cur->fm))
- tex_printf("<%s", cur_file_name);
- else
- tex_printf("<<%s", cur_file_name);
- fd_cur->ff_found = true;
- new_glyphs_count = 2;
- new_ntabs = DEFAULT_NTABS;
- dir_tab = NULL;
- glyph_tab = NULL;
- glyph_index = NULL;
- glyph_name_buf = NULL;
- name_tab = NULL;
- name_buf = NULL;
- ttf_read_font();
-
- pdfsaveoffset = pdfoffset();
- pdfflush();
- if (is_subsetted(fd_cur->fm)) {
- ttf_copy_encoding();
- ttf_subset_font();
- } else
- ttf_copy_font();
- ttf_length = ttf_offset();
-
- xfree(dir_tab);
- xfree(glyph_tab);
- xfree(glyph_index);
- xfree(glyph_name_buf);
- xfree(name_tab);
- xfree(name_buf);
- ttf_close();
- if (is_subsetted(fd_cur->fm))
- tex_printf(">");
- else
- tex_printf(">>");
- cur_file_name = NULL;
-}
-
-void writeotf(fd_entry * fd)
-{
- dirtab_entry *tab;
- long i;
-
- fd_cur = fd; /* fd_cur is global inside writettf.c */
- assert(fd_cur->fm != NULL);
- assert(is_opentype(fd_cur->fm));
- assert(is_included(fd_cur->fm));
-
- set_cur_file_name(fd_cur->fm->ff_name);
- if (is_subsetted(fd_cur->fm))
- pdftex_fail("OTF fonts must be included entirely");
- if (!open_input(&ttf_file, kpse_opentype_format, FOPEN_RBIN_MODE)) {
- pdftex_fail("cannot open OpenType font file for reading");
- }
- cur_file_name = (char *) nameoffile + 1;
- tex_printf("<<%s", cur_file_name);
- fd_cur->ff_found = true;
- dir_tab = NULL;
- glyph_tab = NULL;
- ttf_read_tabdir();
- /* read font parameters */
- if (ttf_name_lookup("head", false) != NULL)
- ttf_read_head();
- if (ttf_name_lookup("hhea", false) != NULL)
- ttf_read_hhea();
- if (ttf_name_lookup("PCLT", false) != NULL)
- ttf_read_pclt();
- if (ttf_name_lookup("post", false) != NULL)
- ttf_read_post();
- /* copy font file */
- tab = ttf_seek_tab("CFF ", 0);
- for (i = tab->length; i > 0; i--)
- copy_char();
- xfree(dir_tab);
- ttf_close();
- tex_printf(">>");
- cur_file_name = NULL;
-}
-
-/*
- To calculate the checkSum for the 'head' table which itself includes the
- checkSumAdjustment entry for the entire font, do the following:
-
- * Set the checkSumAdjustment to 0.
- * Calculate the checksum for all the tables including the 'head' table
- and enter that value into the table directory.
- * Calculate the checksum for the entire font.
- * Subtract that value from the hex value B1B0AFBA.
- * Store the result in checkSumAdjustment.
-
- The checkSum for the 'head table which includes the checkSumAdjustment
- entry for the entire font is now incorrect. That is not a problem. Do not
- change it. An application attempting to verify that the 'head' table has
- not changed should calculate the checkSum for that table by not including
- the checkSumAdjustment value, and compare the result with the entry in the
- table directory.
-
- The table directory also includes the offset of the associated tagged
- table from the beginning of the font file and the length of that table.
- */
diff --git a/Build/source/texk/web2c/pdftexdir/writettf.h b/Build/source/texk/web2c/pdftexdir/writettf.h
deleted file mode 100644
index dc951f2ab83..00000000000
--- a/Build/source/texk/web2c/pdftexdir/writettf.h
+++ /dev/null
@@ -1,125 +0,0 @@
-/*
-Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-typedef signed char TTF_CHAR;
-typedef unsigned char TTF_BYTE;
-typedef signed short TTF_SHORT;
-typedef unsigned short TTF_USHORT;
-typedef int32_t TTF_LONG;
-typedef uint32_t TTF_ULONG;
-typedef uint32_t TTF_FIXED;
-typedef unsigned short TTF_FUNIT;
-typedef signed short TTF_FWORD;
-typedef unsigned short TTF_UFWORD;
-typedef unsigned short TTF_F2DOT14;
-
-#define TTF_CHAR_SIZE 1
-#define TTF_BYTE_SIZE 1
-#define TTF_SHORT_SIZE 2
-#define TTF_USHORT_SIZE 2
-#define TTF_LONG_SIZE 4
-#define TTF_ULONG_SIZE 4
-#define TTF_FIXED_SIZE 4
-#define TTF_FWORD_SIZE 2
-#define TTF_UFWORD_SIZE 2
-#define TTF_F2DOT14_SIZE 2
-
-#define ARG_1_AND_2_ARE_WORDS (1<<0)
-#define ARGS_ARE_XY_VALUES (1<<1)
-#define ROUND_XY_TO_GRID (1<<2)
-#define WE_HAVE_A_SCALE (1<<3)
-#define RESERVED (1<<4)
-#define MORE_COMPONENTS (1<<5)
-#define WE_HAVE_AN_X_AND_Y_SCALE (1<<6)
-#define WE_HAVE_A_TWO_BY_TWO (1<<7)
-#define WE_HAVE_INSTRUCTIONS (1<<8)
-#define USE_MY_METRICS (1<<9)
-
-#define get_type(t) ((t)ttf_getnum(t##_SIZE))
-#define ttf_skip(n) ttf_getnum(n)
-
-#define get_byte() get_type(TTF_BYTE)
-#define get_char() get_type(TTF_CHAR)
-#define get_ushort() get_type(TTF_USHORT)
-#define get_short() get_type(TTF_SHORT)
-#define get_ulong() get_type(TTF_ULONG)
-#define get_long() get_type(TTF_LONG)
-#define get_fixed() get_type(TTF_FIXED)
-#define get_funit() get_type(TTF_FUNIT)
-#define get_fword() get_type(TTF_FWORD)
-#define get_ufword() get_type(TTF_UFWORD)
-#define get_f2dot14() get_type(TTF_F2DOT14)
-
-#define put_num(t,n) ((t)ttf_putnum(t##_SIZE, n))
-
-#define put_char(n) (void)put_num(TTF_CHAR, n)
-#define put_byte(n) (void)put_num(TTF_BYTE, n)
-#define put_short(n) put_num(TTF_SHORT, n)
-#define put_ushort(n) put_num(TTF_USHORT, n)
-#define put_long(n) put_num(TTF_LONG, n)
-#define put_ulong(n) (void)put_num(TTF_ULONG, n)
-#define put_fixed(n) (void)put_num(TTF_FIXED, n)
-#define put_funit(n) put_num(TTF_FUNIT, n)
-#define put_fword(n) put_num(TTF_FWORD, n)
-#define put_ufword(n) (void)put_num(TTF_UFWORD, n)
-#define put_f2dot14(n) put_num(TTF_F2DOT14, n)
-
-#define copy_byte() put_byte(get_byte())
-#define copy_char() put_char(get_char())
-#define copy_ushort() put_ushort(get_ushort())
-#define copy_short() put_short(get_short())
-#define copy_ulong() put_ulong(get_ulong())
-#define copy_long() put_long(get_long())
-#define copy_fixed() put_fixed(get_fixed())
-#define copy_funit() put_funit(get_funit())
-#define copy_fword() put_fword(get_fword())
-#define copy_ufword() put_ufword(get_ufword())
-#define copy_f2dot14() put_f2dot14(get_f2dot14())
-
-#define is_unicode_mapping(e) \
- (e->platform_id == 0 || (e->platform_id == 3 || e->encoding_id == 1))
-
-
-#define NMACGLYPHS 258
-#define TABDIR_OFF 12
-#define ENC_BUF_SIZE 1024
-
-#define GLYPH_PREFIX_INDEX "index"
-#define GLYPH_PREFIX_UNICODE "uni"
-
-typedef struct {
- char tag[4];
- TTF_ULONG checksum;
- TTF_ULONG offset;
- TTF_ULONG length;
-} dirtab_entry;
-
-typedef struct {
- TTF_USHORT platform_id;
- TTF_USHORT encoding_id;
- TTF_ULONG offset;
- TTF_USHORT format;
-} cmap_entry;
-
-typedef struct {
- TTF_USHORT endCode;
- TTF_USHORT startCode;
- TTF_USHORT idDelta;
- TTF_USHORT idRangeOffset;
-} seg_entry;
diff --git a/Build/source/texk/web2c/pdftexdir/writezip.c b/Build/source/texk/web2c/pdftexdir/writezip.c
deleted file mode 100644
index f0e62358db3..00000000000
--- a/Build/source/texk/web2c/pdftexdir/writezip.c
+++ /dev/null
@@ -1,95 +0,0 @@
-/*
-Copyright 1996-2014 Han The Thanh, <thanh@pdftex.org>
-
-This file is part of pdfTeX.
-
-pdfTeX is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-pdfTeX is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along
-with this program. If not, see <http://www.gnu.org/licenses/>.
-*/
-
-#include "ptexlib.h"
-#include "zlib.h"
-#include <assert.h>
-
-#define ZIP_BUF_SIZE 32768
-
-#define check_err(f, fn) \
- if (f != Z_OK) \
- pdftex_fail("zlib: %s() failed (error code %d)", fn, f)
-
-static char *zipbuf = NULL;
-static z_stream c_stream; /* compression stream */
-
-void writezip(boolean finish)
-{
- int err;
- static int level_old = 0;
- int level = getpdfcompresslevel();
- assert(level > 0);
- cur_file_name = NULL;
- if (pdfstreamlength == 0) {
- if (zipbuf == NULL) {
- zipbuf = xtalloc(ZIP_BUF_SIZE, char);
- c_stream.zalloc = (alloc_func) 0;
- c_stream.zfree = (free_func) 0;
- c_stream.opaque = (voidpf) 0;
- check_err(deflateInit(&c_stream, level), "deflateInit");
- } else {
- if (level != level_old) { /* \pdfcompresslevel change in mid document */
- check_err(deflateEnd(&c_stream), "deflateEnd");
- c_stream.zalloc = (alloc_func) 0; /* these 3 lines no need, just to be safe */
- c_stream.zfree = (free_func) 0;
- c_stream.opaque = (voidpf) 0;
- check_err(deflateInit(&c_stream, level), "deflateInit");
- } else
- check_err(deflateReset(&c_stream), "deflateReset");
- }
- level_old = level;
- c_stream.next_out = (Bytef *) zipbuf;
- c_stream.avail_out = ZIP_BUF_SIZE;
- }
- assert(zipbuf != NULL);
- c_stream.next_in = pdfbuf;
- c_stream.avail_in = pdfptr;
- for (;;) {
- if (c_stream.avail_out == 0) {
- pdfgone += xfwrite(zipbuf, 1, ZIP_BUF_SIZE, pdffile);
- pdflastbyte = zipbuf[ZIP_BUF_SIZE - 1]; /* not needed */
- c_stream.next_out = (Bytef *) zipbuf;
- c_stream.avail_out = ZIP_BUF_SIZE;
- }
- err = deflate(&c_stream, finish ? Z_FINISH : Z_NO_FLUSH);
- if (finish && err == Z_STREAM_END)
- break;
- check_err(err, "deflate");
- if (!finish && c_stream.avail_in == 0)
- break;
- }
- if (finish) {
- if (c_stream.avail_out < ZIP_BUF_SIZE) { /* at least one byte has been output */
- pdfgone +=
- xfwrite(zipbuf, 1, ZIP_BUF_SIZE - c_stream.avail_out, pdffile);
- pdflastbyte = zipbuf[ZIP_BUF_SIZE - c_stream.avail_out - 1];
- }
- xfflush(pdffile);
- }
- pdfstreamlength = c_stream.total_out;
-}
-
-void zip_free(void)
-{
- if (zipbuf != NULL) {
- check_err(deflateEnd(&c_stream), "deflateEnd");
- free(zipbuf);
- }
-}