diff options
author | Denis Bitouzé <dbitouze@wanadoo.fr> | 2021-02-25 18:23:07 +0000 |
---|---|---|
committer | Denis Bitouzé <dbitouze@wanadoo.fr> | 2021-02-25 18:23:07 +0000 |
commit | c6101f91d071883b48b1b4b51e5eba0f36d9a78d (patch) | |
tree | 1bf7f5a881d7a4f5c5bf59d0b2821943dd822372 /Build/source/texk/web2c/pdftexdir | |
parent | 07ee7222e389b0777456b427a55c22d0e6ffd267 (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')
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 (®exp, 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 (®exp); - 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 (®exp, 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 (®exp); - - 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 (¤t_token, regexp, syntax | RE_CARET_ANCHORS_HERE); - tree = parse_reg_exp (regexp, preg, ¤t_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 Binary files differdeleted file mode 100644 index 95e09e4eb9f..00000000000 --- a/Build/source/texk/web2c/pdftexdir/tests/postV3.ttf +++ /dev/null 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 Binary files differdeleted file mode 100644 index 7f298cfd037..00000000000 --- a/Build/source/texk/web2c/pdftexdir/tests/postV7.ttf +++ /dev/null diff --git a/Build/source/texk/web2c/pdftexdir/tests/test-13.pdf b/Build/source/texk/web2c/pdftexdir/tests/test-13.pdf Binary files differdeleted file mode 100644 index 8255d131c61..00000000000 --- a/Build/source/texk/web2c/pdftexdir/tests/test-13.pdf +++ /dev/null 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 Binary files differdeleted file mode 100644 index e5d1feb715a..00000000000 --- a/Build/source/texk/web2c/pdftexdir/tests/test-15.pdf +++ /dev/null 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, >ab[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); - } -} |