From eba910adcf713a6905cb891a0eacb93d03f467c4 Mon Sep 17 00:00:00 2001 From: Peter Breitenlohner Date: Fri, 4 Jan 2013 08:13:00 +0000 Subject: various cleanups for the new XeTeX git-svn-id: svn://tug.org/texlive/trunk@28724 c570f23f-e606-0410-a88d-b1316a301751 --- Build/source/texk/web2c/Makefile.in | 121 +- Build/source/texk/web2c/aclocal.m4 | 107 - Build/source/texk/web2c/c-auto.in | 3 + Build/source/texk/web2c/configure | 96 +- Build/source/texk/web2c/xetex-hz.ch | 1035 --- Build/source/texk/web2c/xetex-latex3.ch | 974 --- Build/source/texk/web2c/xetex-orig.ch | 8705 -------------------------- Build/source/texk/web2c/xetexdir/am/xetex.am | 53 +- Build/source/texk/web2c/xetexdir/tex.mod | 87 - 9 files changed, 102 insertions(+), 11079 deletions(-) delete mode 100644 Build/source/texk/web2c/xetex-hz.ch delete mode 100644 Build/source/texk/web2c/xetex-latex3.ch delete mode 100644 Build/source/texk/web2c/xetex-orig.ch delete mode 100644 Build/source/texk/web2c/xetexdir/tex.mod (limited to 'Build/source/texk/web2c') diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in index b64385a05c2..9d11ff75629 100644 --- a/Build/source/texk/web2c/Makefile.in +++ b/Build/source/texk/web2c/Makefile.in @@ -1472,7 +1472,6 @@ nodist_man_MANS = EXTRA_LIBRARIES = libmf.a libmplib.a libkanji.a libukanji.a \ libpdftex.a liblua51.a libluasocket.a libluamisc.a libff.a \ libluatex.a libxetex.a libmd5.a -# EXTRA_DIST = PROJECTS cftests cpascal.h help.h w2c/config.h \ triptrap-sh tangle.web tangle.ch tangleboot.pin cwebdir \ ctangleboot.cin cwebboot.cin cwebboot.hin tangle.test \ @@ -1657,42 +1656,42 @@ EXTRA_DIST = PROJECTS cftests cpascal.h help.h w2c/config.h \ luatexdir/luafontloader/fontforge/inc/config.h.in \ luatexdir/luafontloader/fontforge/plugins/Makefile.in \ $(libluatex_web) luatexdir/ChangeLog luatexdir/NEWS \ - luatexdir/font/subfont.txt $(Xold_web_srcs) $(xetex_web_srcs) \ - $(xetex_ch_srcs) xetexdir/xetex.defines \ - xetexdir/unicode-char-prep.pl xetexdir/appleGlyphNames.c \ - xetexdir/ChangeLog $(xetex_tests) xetexdir/COPYING \ - omegaware/README omegaware/ChangeLog $(odvicopy_sources) \ - $(odvitype_sources) $(ofm2opl_sources) $(opl2ofm_sources) \ - $(otangle_sources) omegaware/ovf2ovp.web omegaware/ovf2ovp.up \ - omegaware/ovf2ovp.ch omegaware/ovp2ovf.web \ - omegaware/ovp2ovf.up omegaware/ovp2ovf.ch $(OTANGLE_tests) \ - $(OMFONTS_tests) omegaware/tests/level1.opl \ - omegaware/tests/ofontd1.dvi omegaware/tests/ofontd1.typ \ - omegaware/tests/ofontd2.dvi omegaware/tests/ofontd2.typ \ - omegaware/tests/ofontd3.dvi omegaware/tests/ofontd3.typ \ - omegaware/tests/ofontr1.vf omegaware/tests/ofontr2.ovf \ - omegaware/tests/ofontr3.ovf omegaware/tests/ofontv4.vf \ - omegaware/tests/ofontv5.ovf omegaware/tests/ofontv6.ovf \ - omegaware/tests/ofontd0.dtl omegaware/tests/ofontd0.dvi \ - omegaware/tests/ofontd0.typ omegaware/tests/ofontr0.tfm \ - omegaware/tests/ofontr1.tfm omegaware/tests/ofontr2.ofm \ - omegaware/tests/ofontr3.ofm omegaware/tests/ofontv4.tfm \ - omegaware/tests/ofontv5.ofm omegaware/tests/ofontv6.ofm \ - omegaware/tests/ofontr0.pl omegaware/tests/ofontr1.pl \ - omegaware/tests/ofontr1.vpl omegaware/tests/ofontr2.opl \ - omegaware/tests/ofontr2.ovp omegaware/tests/ofontr3.opl \ - omegaware/tests/ofontr3.ovp omegaware/tests/ofontv4.pl \ - omegaware/tests/ofontv4.vpl omegaware/tests/ofontv5.opl \ - omegaware/tests/ofontv5.ovp omegaware/tests/ofontv6.opl \ - omegaware/tests/ofontv6.ovp omegaware/tests/Cherokee.pl \ - omegaware/tests/OCherokee.ovp omegaware/tests/realnum.opl \ - omegaware/tests/realnum.out omegaware/tests/repeat.opl \ - omegaware/tests/repeated.opl omegaware/tests/sample.out \ - omegaware/tests/sample.ovp omegaware/tests/sample0-h.opl \ - omegaware/tests/specialhex.ovp $(aleph_web_srcs) \ - $(aleph_ch_srcs) alephdir/ChangeLog alephdir/aleph.defines \ - alephdir/aleph.version $(aleph_tests) synctexdir/ChangeLog \ - synctexdir/README.txt synctexdir/synctex_parser_readme.txt \ + luatexdir/font/subfont.txt $(xetex_web_srcs) $(xetex_ch_srcs) \ + xetexdir/xetex.defines xetexdir/unicode-char-prep.pl \ + xetexdir/appleGlyphNames.c xetexdir/ChangeLog $(xetex_tests) \ + xetexdir/COPYING omegaware/README omegaware/ChangeLog \ + $(odvicopy_sources) $(odvitype_sources) $(ofm2opl_sources) \ + $(opl2ofm_sources) $(otangle_sources) omegaware/ovf2ovp.web \ + omegaware/ovf2ovp.up omegaware/ovf2ovp.ch \ + omegaware/ovp2ovf.web omegaware/ovp2ovf.up \ + omegaware/ovp2ovf.ch $(OTANGLE_tests) $(OMFONTS_tests) \ + omegaware/tests/level1.opl omegaware/tests/ofontd1.dvi \ + omegaware/tests/ofontd1.typ omegaware/tests/ofontd2.dvi \ + omegaware/tests/ofontd2.typ omegaware/tests/ofontd3.dvi \ + omegaware/tests/ofontd3.typ omegaware/tests/ofontr1.vf \ + omegaware/tests/ofontr2.ovf omegaware/tests/ofontr3.ovf \ + omegaware/tests/ofontv4.vf omegaware/tests/ofontv5.ovf \ + omegaware/tests/ofontv6.ovf omegaware/tests/ofontd0.dtl \ + omegaware/tests/ofontd0.dvi omegaware/tests/ofontd0.typ \ + omegaware/tests/ofontr0.tfm omegaware/tests/ofontr1.tfm \ + omegaware/tests/ofontr2.ofm omegaware/tests/ofontr3.ofm \ + omegaware/tests/ofontv4.tfm omegaware/tests/ofontv5.ofm \ + omegaware/tests/ofontv6.ofm omegaware/tests/ofontr0.pl \ + omegaware/tests/ofontr1.pl omegaware/tests/ofontr1.vpl \ + omegaware/tests/ofontr2.opl omegaware/tests/ofontr2.ovp \ + omegaware/tests/ofontr3.opl omegaware/tests/ofontr3.ovp \ + omegaware/tests/ofontv4.pl omegaware/tests/ofontv4.vpl \ + omegaware/tests/ofontv5.opl omegaware/tests/ofontv5.ovp \ + omegaware/tests/ofontv6.opl omegaware/tests/ofontv6.ovp \ + omegaware/tests/Cherokee.pl omegaware/tests/OCherokee.ovp \ + omegaware/tests/realnum.opl omegaware/tests/realnum.out \ + omegaware/tests/repeat.opl omegaware/tests/repeated.opl \ + omegaware/tests/sample.out omegaware/tests/sample.ovp \ + omegaware/tests/sample0-h.opl omegaware/tests/specialhex.ovp \ + $(aleph_web_srcs) $(aleph_ch_srcs) alephdir/ChangeLog \ + alephdir/aleph.defines alephdir/aleph.version $(aleph_tests) \ + synctexdir/ChangeLog synctexdir/README.txt \ + synctexdir/synctex_parser_readme.txt \ synctexdir/synctex_parser_version.txt synctexdir/tests \ synctexdir/synctex-common.h synctexdir/synctex.c \ synctexdir/synctex.defines synctexdir/synctex.h \ @@ -1752,7 +1751,7 @@ DISTCLEANFILES = $(EXTRA_LIBRARIES) CXXLD.sh tangle.c tangle.h \ $(nodist_pdftex_SOURCES) pdftex.ch pdftex-web2c pdftex.p \ pdftex.pool pdftex-tangle wprob.log wprob.tex test-13.pdf \ test-13.xref test-15.pdf test-15.xref \ - $(nodist_libluatex_a_SOURCES) txt2zlib.c X* \ + $(nodist_libluatex_a_SOURCES) txt2zlib.c \ $(nodist_xetex_SOURCES) xetex.web xetex.ch xetex-web2c xetex.p \ xetex.pool xetex-tangle $(omegaware_programs:=.c) \ $(omegaware_programs:=.h) $(omegaware_programs:=.p) \ @@ -2699,33 +2698,6 @@ xetex_ch_srcs = \ $(xetex_post_ch_synctex) \ tex-binpool.ch -@XETEX_SYNCTEX_TRUE@Xold_ch_synctex = \ -@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-mem.ch0 \ -@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-mem.ch0 \ -@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-mem.ch1 \ -@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-mem.ch2 \ -@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-rec.ch0 \ -@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-rec.ch0 \ -@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-rec.ch2 - -@XETEX_SYNCTEX_TRUE@Xold_post_ch_synctex = \ -@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-rec.ch3 - -Xold_web_srcs = \ - tex.web \ - etexdir/etex.ch \ - etexdir/tex.ch0 \ - tex.ch \ - xetexdir/tex.mod \ - etexdir/tex.ch1 \ - etexdir/tex.ech \ - tex-binpool.ch \ - $(Xold_ch_synctex) \ - xetex-orig.ch \ - xetex-latex3.ch \ - xetex-hz.ch \ - $(Xold_post_ch_synctex) - libxetex_a_CPPFLAGS = $(xetex_cppflags) libxetex_a_CFLAGS = # $(WARNING_CFLAGS) libxetex_a_CXXFLAGS = # $(WARNING_CXXFLAGS) @@ -10277,25 +10249,6 @@ xetexdir/xetex_version.h: xetexdir/xetex.ch xetex.ch: tie$(EXEEXT) $(xetex_ch_srcs) $(tie) -c xetex.ch $(xetex_ch_srcs) - -Xold.p Xold.pool: Xold-tangle - @$(xe_tangle) Xold -Xold-tangle: otangle$(EXEEXT) Xold.web tangle-sh - @$(xe_tangle) Xold -Xold.web: tie$(EXEEXT) $(Xold_web_srcs) - $(tie) -m Xold.web $(Xold_web_srcs) -# -Xnew.web: tie$(EXEEXT) xetexdir/xetex.web xetex.ch - $(tie) -m Xnew.web xetexdir/xetex.web xetex.ch -# -Xweb.diff: Xold.web Xnew.web - diff -u Xold.web Xnew.web >Xweb.diff; : -Xp.diff: Xold.p xetex.p - diff -u Xold.p xetex.p >Xp.diff; : -Xpool.diff: Xold.pool xetex.pool - diff -u Xold.pool xetex.pool >Xpool.diff; : -X.diff: Xweb.diff Xp.diff Xpool.diff - cat Xweb.diff Xp.diff Xpool.diff >X.diff $(libxetex_a_OBJECTS): $(libxetex_prereq) odvicopy.c odvicopy.h: odvicopy-web2c @$(web2c) odvicopy diff --git a/Build/source/texk/web2c/aclocal.m4 b/Build/source/texk/web2c/aclocal.m4 index 9a9abb3029d..8d18c4b84ec 100644 --- a/Build/source/texk/web2c/aclocal.m4 +++ b/Build/source/texk/web2c/aclocal.m4 @@ -20,113 +20,6 @@ You have another version of autoconf. It may work, but is not guaranteed to. If you have problems, you may need to regenerate the build system entirely. To do so, use the procedure documented by the package, typically 'autoreconf'.])]) -# longlong.m4 serial 14 -dnl Copyright (C) 1999-2007, 2009-2010 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -dnl From Paul Eggert. - -# Define HAVE_LONG_LONG_INT if 'long long int' works. -# This fixes a bug in Autoconf 2.61, but can be removed once we -# assume 2.62 everywhere. - -# Note: If the type 'long long int' exists but is only 32 bits large -# (as on some very old compilers), HAVE_LONG_LONG_INT will not be -# defined. In this case you can treat 'long long int' like 'long int'. - -AC_DEFUN([AC_TYPE_LONG_LONG_INT], -[ - AC_CACHE_CHECK([for long long int], [ac_cv_type_long_long_int], - [AC_LINK_IFELSE( - [_AC_TYPE_LONG_LONG_SNIPPET], - [dnl This catches a bug in Tandem NonStop Kernel (OSS) cc -O circa 2004. - dnl If cross compiling, assume the bug isn't important, since - dnl nobody cross compiles for this platform as far as we know. - AC_RUN_IFELSE( - [AC_LANG_PROGRAM( - [[@%:@include - @%:@ifndef LLONG_MAX - @%:@ define HALF \ - (1LL << (sizeof (long long int) * CHAR_BIT - 2)) - @%:@ define LLONG_MAX (HALF - 1 + HALF) - @%:@endif]], - [[long long int n = 1; - int i; - for (i = 0; ; i++) - { - long long int m = n << i; - if (m >> i != n) - return 1; - if (LLONG_MAX / 2 < m) - break; - } - return 0;]])], - [ac_cv_type_long_long_int=yes], - [ac_cv_type_long_long_int=no], - [ac_cv_type_long_long_int=yes])], - [ac_cv_type_long_long_int=no])]) - if test $ac_cv_type_long_long_int = yes; then - AC_DEFINE([HAVE_LONG_LONG_INT], [1], - [Define to 1 if the system has the type `long long int'.]) - fi -]) - -# Define HAVE_UNSIGNED_LONG_LONG_INT if 'unsigned long long int' works. -# This fixes a bug in Autoconf 2.61, but can be removed once we -# assume 2.62 everywhere. - -# Note: If the type 'unsigned long long int' exists but is only 32 bits -# large (as on some very old compilers), AC_TYPE_UNSIGNED_LONG_LONG_INT -# will not be defined. In this case you can treat 'unsigned long long int' -# like 'unsigned long int'. - -AC_DEFUN([AC_TYPE_UNSIGNED_LONG_LONG_INT], -[ - AC_CACHE_CHECK([for unsigned long long int], - [ac_cv_type_unsigned_long_long_int], - [AC_LINK_IFELSE( - [_AC_TYPE_LONG_LONG_SNIPPET], - [ac_cv_type_unsigned_long_long_int=yes], - [ac_cv_type_unsigned_long_long_int=no])]) - if test $ac_cv_type_unsigned_long_long_int = yes; then - AC_DEFINE([HAVE_UNSIGNED_LONG_LONG_INT], [1], - [Define to 1 if the system has the type `unsigned long long int'.]) - fi -]) - -# Expands to a C program that can be used to test for simultaneous support -# of 'long long' and 'unsigned long long'. We don't want to say that -# 'long long' is available if 'unsigned long long' is not, or vice versa, -# because too many programs rely on the symmetry between signed and unsigned -# integer types (excluding 'bool'). -AC_DEFUN([_AC_TYPE_LONG_LONG_SNIPPET], -[ - AC_LANG_PROGRAM( - [[/* For now, do not test the preprocessor; as of 2007 there are too many - implementations with broken preprocessors. Perhaps this can - be revisited in 2012. In the meantime, code should not expect - #if to work with literals wider than 32 bits. */ - /* Test literals. */ - long long int ll = 9223372036854775807ll; - long long int nll = -9223372036854775807LL; - unsigned long long int ull = 18446744073709551615ULL; - /* Test constant expressions. */ - typedef int a[((-9223372036854775807LL < 0 && 0 < 9223372036854775807ll) - ? 1 : -1)]; - typedef int b[(18446744073709551615ULL <= (unsigned long long int) -1 - ? 1 : -1)]; - int i = 63;]], - [[/* Test availability of runtime routines for shift and division. */ - long long int llmax = 9223372036854775807ll; - unsigned long long int ullmax = 18446744073709551615ull; - return ((ll << 63) | (ll >> 63) | (ll < i) | (ll > i) - | (llmax / ll) | (llmax % ll) - | (ull << 63) | (ull >> 63) | (ull << i) | (ull >> i) - | (ullmax / ull) | (ullmax % ull));]]) -]) - # Copyright (C) 2002-2012 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation diff --git a/Build/source/texk/web2c/c-auto.in b/Build/source/texk/web2c/c-auto.in index d8ee4e1053a..119083937fb 100644 --- a/Build/source/texk/web2c/c-auto.in +++ b/Build/source/texk/web2c/c-auto.in @@ -229,6 +229,9 @@ /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H +/* Define to 1 if the system has the type `unsigned long long int'. */ +#undef HAVE_UNSIGNED_LONG_LONG_INT + /* metafont: Define to include HP 2627 window support. */ #undef HP2627WIN diff --git a/Build/source/texk/web2c/configure b/Build/source/texk/web2c/configure index aea23a2a17a..313171905cb 100755 --- a/Build/source/texk/web2c/configure +++ b/Build/source/texk/web2c/configure @@ -1749,7 +1749,7 @@ Optional Packages: --with-teckit-libdir=DIR teckit library installed in DIR --with-system-icu use installed ICU headers and libraries (requires - icu-config, not for XeTeX) + icu-config) --with-system-graphite2 use installed graphite2 headers and library (requires pkg-config) --with-system-harfbuzz use installed harfbuzz headers and library (requires @@ -20543,27 +20543,29 @@ $as_echo "#define HAVE_LONG_DOUBLE 1" >>confdefs.h fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for long long int" >&5 -$as_echo_n "checking for long long int... " >&6; } -if ${ac_cv_type_long_long_int+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for unsigned long long int" >&5 +$as_echo_n "checking for unsigned long long int... " >&6; } +if ${ac_cv_type_unsigned_long_long_int+:} false; then : $as_echo_n "(cached) " >&6 else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + ac_cv_type_unsigned_long_long_int=yes + if test "x${ac_cv_prog_cc_c99-no}" = xno; then + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* For now, do not test the preprocessor; as of 2007 there are too many - implementations with broken preprocessors. Perhaps this can - be revisited in 2012. In the meantime, code should not expect - #if to work with literals wider than 32 bits. */ + implementations with broken preprocessors. Perhaps this can + be revisited in 2012. In the meantime, code should not expect + #if to work with literals wider than 32 bits. */ /* Test literals. */ long long int ll = 9223372036854775807ll; long long int nll = -9223372036854775807LL; unsigned long long int ull = 18446744073709551615ULL; /* Test constant expressions. */ typedef int a[((-9223372036854775807LL < 0 && 0 < 9223372036854775807ll) - ? 1 : -1)]; + ? 1 : -1)]; typedef int b[(18446744073709551615ULL <= (unsigned long long int) -1 - ? 1 : -1)]; + ? 1 : -1)]; int i = 63; int main () @@ -20572,46 +20574,73 @@ main () long long int llmax = 9223372036854775807ll; unsigned long long int ullmax = 18446744073709551615ull; return ((ll << 63) | (ll >> 63) | (ll < i) | (ll > i) - | (llmax / ll) | (llmax % ll) - | (ull << 63) | (ull >> 63) | (ull << i) | (ull >> i) - | (ullmax / ull) | (ullmax % ull)); + | (llmax / ll) | (llmax % ll) + | (ull << 63) | (ull >> 63) | (ull << i) | (ull >> i) + | (ullmax / ull) | (ullmax % ull)); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO"; then : - if test "$cross_compiling" = yes; then : + +else + ac_cv_type_unsigned_long_long_int=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_unsigned_long_long_int" >&5 +$as_echo "$ac_cv_type_unsigned_long_long_int" >&6; } + if test $ac_cv_type_unsigned_long_long_int = yes; then + +$as_echo "#define HAVE_UNSIGNED_LONG_LONG_INT 1" >>confdefs.h + + fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for long long int" >&5 +$as_echo_n "checking for long long int... " >&6; } +if ${ac_cv_type_long_long_int+:} false; then : + $as_echo_n "(cached) " >&6 +else ac_cv_type_long_long_int=yes + if test "x${ac_cv_prog_cc_c99-no}" = xno; then + ac_cv_type_long_long_int=$ac_cv_type_unsigned_long_long_int + if test $ac_cv_type_long_long_int = yes; then + if test "$cross_compiling" = yes; then : + : else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include - #ifndef LLONG_MAX - # define HALF \ - (1LL << (sizeof (long long int) * CHAR_BIT - 2)) - # define LLONG_MAX (HALF - 1 + HALF) - #endif + #ifndef LLONG_MAX + # define HALF \ + (1LL << (sizeof (long long int) * CHAR_BIT - 2)) + # define LLONG_MAX (HALF - 1 + HALF) + #endif int main () { long long int n = 1; - int i; - for (i = 0; ; i++) - { - long long int m = n << i; - if (m >> i != n) - return 1; - if (LLONG_MAX / 2 < m) - break; - } - return 0; + int i; + for (i = 0; ; i++) + { + long long int m = n << i; + if (m >> i != n) + return 1; + if (LLONG_MAX / 2 < m) + break; + } + return 0; ; return 0; } _ACEOF if ac_fn_c_try_run "$LINENO"; then : - ac_cv_type_long_long_int=yes + else ac_cv_type_long_long_int=no fi @@ -20619,11 +20648,8 @@ rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ conftest.$ac_objext conftest.beam conftest.$ac_ext fi -else - ac_cv_type_long_long_int=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext + fi + fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_long_long_int" >&5 $as_echo "$ac_cv_type_long_long_int" >&6; } diff --git a/Build/source/texk/web2c/xetex-hz.ch b/Build/source/texk/web2c/xetex-hz.ch deleted file mode 100644 index a6c6414f442..00000000000 --- a/Build/source/texk/web2c/xetex-hz.ch +++ /dev/null @@ -1,1035 +0,0 @@ -/****************************************************************************\ - Part of the XeTeX typesetting system - copyright (c) 1994-2008 by SIL International - copyright (c) 2009-2012 by Jonathan Kew - copyright (c) 2012 by Khaled Hosny - - Written by Han The Thanh - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the -"Software"), to deal in the Software without restriction, including -without limitation the rights to use, copy, modify, merge, publish, -distribute, sublicense, and/or sell copies of the Software, and to -permit persons to whom the Software is furnished to do so, subject to -the following conditions: - -The above copyright notice and this permission notice shall be -included in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE -FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF -CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION -WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - -Except as contained in this notice, the name of the copyright holders -shall not be used in advertising or otherwise to promote the sale, -use or other dealings in this Software without prior written -authorization from the copyright holders. -\****************************************************************************/ - -@x -new_kern:=p; -end; -@y -new_kern:=p; -end; - -@ Some stuff for character protrusion. -@# {memory structure for marginal kerns} -@d margin_kern_node = 40 -@d margin_kern_node_size = 3 -@d margin_char(#) == info(# + 2) {unused for now; relevant for font expansion} - -@# {|subtype| of marginal kerns} -@d left_side == 0 -@d right_side == 1 - -@# {base for lp/rp codes starts from 2: - 0 for |hyphen_char|, - 1 for |skew_char|} -@d lp_code_base == 2 -@d rp_code_base == 3 - -@d max_hlist_stack = 512 {maximum fill level for |hlist_stack|} -{maybe good if larger than |2 * max_quarterword|, so that box nesting level would overflow first} - -@= -@!last_leftmost_char: pointer; -@!last_rightmost_char: pointer; -@!hlist_stack:array[0..max_hlist_stack] of pointer; {stack for |find_protchar_left()| and |find_protchar_right()|} -@!hlist_stack_level:0..max_hlist_stack; {fill level for |hlist_stack|} -@!first_p: pointer; {to access the first node of the paragraph} -@!global_prev_p: pointer; {to access |prev_p| in |line_break|; should be kept in sync with |prev_p| by |update_prev_p|} -@z - -@x -@; -end; -gubed -@y -@; -end; -gubed - -@ Some stuff for character protrusion. - -@d pdf_debug_on == true {change to |false| to suppress debugging info} -@p -procedure pdf_error(t, p: str_number); -begin - normalize_selector; - print_err("Error"); - if t <> 0 then begin - print(" ("); - print(t); - print(")"); - end; - print(": "); print(p); - succumb; -end; - -procedure pdf_DEBUG(s: str_number); -begin - if not pdf_debug_on then - return; - print_ln; print("DEBUG: "); print(s); -end; - -procedure pdf_DEBUG_int(s: str_number; i: integer); -begin - if not pdf_debug_on then - return; - print_ln; print("DEBUG: "); print(s); print_int(i); -end; - -procedure pdf_DEBUG_str(s, s2: str_number); -begin - if not pdf_debug_on then - return; - print_ln; print("DEBUG: "); print(s); print(s2); -end; - -function prev_rightmost(s, e: pointer): pointer; -{finds the node preceding the rightmost node |e|; |s| is some node -before |e|} -var p: pointer; -begin - prev_rightmost := null; - p := s; - if p = null then - return; - while link(p) <> e do begin - p := link(p); - if p = null then - return; - end; - prev_rightmost := p; -end; - -function round_xn_over_d(@!x:scaled; @!n,@!d:integer):scaled; -var positive:boolean; {was |x>=0|?} -@!t,@!u,@!v:nonnegative_integer; {intermediate quantities} -begin if x>=0 then positive:=true -else begin negate(x); positive:=false; - end; -t:=(x mod @'100000)*n; -u:=(x div @'100000)*n+(t div @'100000); -v:=(u mod d)*@'100000 + (t mod @'100000); -if u div d>=@'100000 then arith_error:=true -else u:=@'100000*(u div d) + (v div d); -v := v mod d; -if 2*v >= d then - incr(u); -if positive then - round_xn_over_d := u -else - round_xn_over_d := -u; -end; -@z - -@x - kern_node: @; -@y - kern_node: @; - 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; -@z - -@x -show_node_list(p); {the show starts at |p|} -print_ln; -end; -@y -show_node_list(p); {the show starts at |p|} -print_ln; -end; - -procedure short_display_n(@!p, m:integer); {prints highlights of list |p|} -begin - breadth_max := m; - depth_threshold:=pool_size-pool_ptr-1; - show_node_list(p); {the show starts at |p|} -end; -@z - -@x - kern_node,math_node,penalty_node:begin - free_node(p, medium_node_size); - goto done; - end; -@y - kern_node,math_node,penalty_node:begin - free_node(p, medium_node_size); - goto done; - end; - margin_kern_node: begin -{ free_avail(margin_char(p)); } - free_node(p, margin_kern_node_size); - goto done; - end; -@z - -@x - words:=medium_node_size; - end; -@y - words:=medium_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 := margin_kern_node_size; - end; -@z - -@x -@d XeTeX_linebreak_penalty_code=etex_int_base+11 {penalty to use at locale-dependent linebreak locations} -@d eTeX_state_code=etex_int_base+12 {\eTeX\ state variables} -@y -@d XeTeX_linebreak_penalty_code=etex_int_base+11 {penalty to use at locale-dependent linebreak locations} -@d XeTeX_protrude_chars_code=etex_int_base+12 {protrude chars at left/right edge of paragraphs} -@d eTeX_state_code=etex_int_base+13 {\eTeX\ state variables} -@z - -@x -@d XeTeX_linebreak_penalty==int_par(XeTeX_linebreak_penalty_code) -@y -@d XeTeX_linebreak_penalty==int_par(XeTeX_linebreak_penalty_code) -@d XeTeX_protrude_chars==int_par(XeTeX_protrude_chars_code) -@z - -@x -XeTeX_linebreak_penalty_code:print_esc("XeTeXlinebreakpenalty"); -@y -XeTeX_linebreak_penalty_code:print_esc("XeTeXlinebreakpenalty"); -XeTeX_protrude_chars_code:print_esc("XeTeXprotrudechars"); -@z - -@x -primitive("XeTeXlinebreakpenalty",assign_int,int_base+XeTeX_linebreak_penalty_code);@/ -@y -primitive("XeTeXlinebreakpenalty",assign_int,int_base+XeTeX_linebreak_penalty_code);@/ -primitive("XeTeXprotrudechars",assign_int,int_base+XeTeX_protrude_chars_code);@/ -@!@:XeTeX_protrude_chars_}{\.{\\XeTeXprotrudechars} primitive@> -@z - -@x -if m=0 then scanned_result(hyphen_char[cur_val])(int_val) -else scanned_result(skew_char[cur_val])(int_val); -@y -if m=0 then scanned_result(hyphen_char[cur_val])(int_val) -else if m=1 then scanned_result(skew_char[cur_val])(int_val) -else begin - n := cur_val; - if is_native_font(n) then scan_glyph_number(n) - else scan_char_num; - k := cur_val; - case m of - lp_code_base: scanned_result(get_cp_code(n, k, left_side))(int_val); - rp_code_base: scanned_result(get_cp_code(n, k, right_side))(int_val); - end; -end; -@z - -@x -|scan_something_internal|. - -@ @= -@y -|scan_something_internal|. - -@ @= - -procedure scan_glyph_number(f: internal_font_number); -{ scan a glyph ID for native font |f|, identified by Unicode value or name or glyph number } -begin - if scan_keyword("/") then {set cp value by glyph name} - begin - scan_and_pack_name; {result is in |nameoffile|} - scanned_result(map_glyph_to_index(f))(int_val); - end else if scan_keyword("u") then {set cp value by unicode} - begin - scan_char_num; - scanned_result(map_char_to_glyph(f,cur_val))(int_val); - end else - scan_int; -end; - -@z - -@x -@d XeTeX_glyph_name_code=10 - -@d etex_convert_codes=XeTeX_glyph_name_code+1 {end of \eTeX's command codes} -@d job_name_code=etex_convert_codes {command code for \.{\\jobname}} - -@= -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("jobname",convert,job_name_code);@/ -@!@:job_name_}{\.{\\jobname} primitive@> - -@ @= -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"); - pdf_strcmp_code: print_esc("strcmp"); -@y -@d XeTeX_glyph_name_code=10 - -@d left_margin_kern_code=11 -@d right_margin_kern_code=12 - -@d etex_convert_codes=right_margin_kern_code+1 {end of \eTeX's command codes} -@d job_name_code=etex_convert_codes {command code for \.{\\jobname}} - -@= -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("jobname",convert,job_name_code);@/ -@!@:job_name_}{\.{\\jobname} 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@> - -@ @= -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"); - pdf_strcmp_code: print_esc("strcmp"); - left_margin_kern_code: print_esc("leftmarginkern"); - right_margin_kern_code: print_esc("rightmarginkern"); -@z - -@x -@!i:small_number; -@!quote_char:UTF16_code; -@y -@!i:small_number; -@!quote_char:UTF16_code; -p, q: pointer; -@z - -@x -glue_node: @; -@y -glue_node: @; -margin_kern_node: begin -{ if subtype(p) = right_side then } -{ pdf_DEBUG_int("right margin kern:", width(p)) } -{ else } -{ pdf_DEBUG_int("left margin kern:", width(p)); } - cur_h:=cur_h+width(p); -end; -@z - -@x -@ @=adjust_tail:=null; last_badness:=0; -@y -@ @=adjust_tail:=null; last_badness:=0; - -@ Some stuff for character protrusion. - -@d left_pw(#) == char_pw(#, left_side) -@d right_pw(#) == char_pw(#, right_side) - -@p -function char_pw(p: pointer; side: small_number): scaled; -var f: internal_font_number; - c: integer; -begin - char_pw := 0; - if side = left_side then - last_leftmost_char := null - else - last_rightmost_char := null; - if p = null then - return; - - { native word } - if is_native_word_node(p) then begin - if native_glyph_info_ptr(p) <> null_ptr then begin - f := native_font(p); - char_pw := round_xn_over_d(quad(f), get_native_word_cp(p, side), 1000); - end; - return; - end; - - { glyph node } - if is_glyph_node(p) then begin - f := native_font(p); - char_pw := round_xn_over_d(quad(f), get_cp_code(f, native_glyph(p), side), 1000); - return; - end; - - { char node or ligature; same like pdftex } - if not is_char_node(p) then begin - if type(p) = ligature_node then - p := lig_char(p) - else - return; - end; - f := font(p); - c := get_cp_code(f, character(p), side); - case side of - left_side: - last_leftmost_char := p; - right_side: - last_rightmost_char := p; - endcases; - if c = 0 then - return; - char_pw := - round_xn_over_d(quad(f), c, 1000); -end; - -function new_margin_kern(w: scaled; p: pointer; side: small_number): pointer; -var k: pointer; -begin - k := get_node(margin_kern_node_size); - type(k) := margin_kern_node; - subtype(k) := side; - width(k) := w; -{ 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; -@z - -@x - kern_node: x:=x+width(p); -@y - kern_node: x:=x+width(p); - margin_kern_node: x:=x+width(p); -@z - -@x -@d deactivate=60 {go here when node |r| should be deactivated} - -@= -@y -@d deactivate=60 {go here when node |r| should be deactivated} - -@d cp_skipable(#) == {skipable nodes at the margins during character protrusion} -( - not is_char_node(#) and - ( - (type(#) = ins_node) - or (type(#) = mark_node) - or (type(#) = adjust_node) - or (type(#) = penalty_node) - or ((type(#) = disc_node) and - (pre_break(#) = null) and - (post_break(#) = null) and - (replace_count(#) = 0)) {an empty |disc_node|} - or ((type(#) = math_node) and (width(#) = 0)) - or ((type(#) = kern_node) and - ((width(#) = 0) or (subtype(#) = normal))) - or ((type(#) = glue_node) and (glue_ptr(#) = zero_glue)) - or ((type(#) = hlist_node) and (width(#) = 0) and (height(#) = 0) and - (depth(#) = 0) and (list_ptr(#) = null)) - ) -) - -@= -procedure push_node(p: pointer); -begin - if hlist_stack_level > max_hlist_stack then - pdf_error("push_node", "stack overflow"); - hlist_stack[hlist_stack_level] := p; - hlist_stack_level := hlist_stack_level + 1; -end; - -function pop_node: pointer; -begin - hlist_stack_level := hlist_stack_level - 1; - if hlist_stack_level < 0 then {would point to some bug} - pdf_error("pop_node", "stack underflow (internal error)"); - pop_node := hlist_stack[hlist_stack_level]; -end; - -function find_protchar_left(l: pointer; d: boolean): pointer; -{searches left to right from list head |l|, returns 1st non-skipable item} -var t: pointer; - run: boolean; -begin - if (link(l) <> null) and (type(l) = hlist_node) and (width(l) = 0) - and (height(l) = 0) and (depth(l) = 0) and (list_ptr(l) = null) then - l := link(l) {for paragraph start with \.{\\parindent = 0pt}} - else if d then - while (link(l) <> null) and (not (is_char_node(l) or non_discardable(l))) do - l := link(l); {std.\ discardables at line break, \TeX book, p 95} - hlist_stack_level := 0; - run := true; - repeat - t := l; - while run and (type(l) = hlist_node) and (list_ptr(l) <> null) do begin - push_node(l); - l := list_ptr(l); - end; - while run and cp_skipable(l) do begin - while (link(l) = null) and (hlist_stack_level > 0) do begin - l := pop_node; {don't visit this node again} - end; - if link(l) <> null then - l := link(l) - else if hlist_stack_level = 0 then run := false - end; - until t = l; - find_protchar_left := l; -end; - -function find_protchar_right(l, r: pointer): pointer; -{searches right to left from list tail |r| to head |l|, returns 1st non-skipable item} -var t: pointer; - run: boolean; -begin - find_protchar_right := null; - if r = null then return; - hlist_stack_level := 0; - run := true; - repeat - t := r; - while run and (type(r) = hlist_node) and (list_ptr(r) <> null) do begin - push_node(l); - push_node(r); - l := list_ptr(r); - r := l; - while link(r) <> null do - r := link(r); - end; - while run and cp_skipable(r) do begin - while (r = l) and (hlist_stack_level > 0) do begin - r := pop_node; {don't visit this node again} - l := pop_node; - end; - if (r <> l) and (r <> null) then - r := prev_rightmost(l, r) - else if (r = l) and (hlist_stack_level = 0) then run := false - end; - until t = r; - find_protchar_right := r; -end; - -function total_pw(q, p: pointer): scaled; -{returns the total width of character protrusion of a line; -|cur_break(break_node(q))| and |p| is the leftmost resp. rightmost node in the -horizontal list representing the actual line} -var l, r: pointer; - n: integer; -begin - if break_node(q) = null then - l := first_p - else - l := cur_break(break_node(q)); - r := prev_rightmost(global_prev_p, p); {get |link(r)=p|} - {let's look at the right margin first} - if (p <> null) and (type(p) = disc_node) and (pre_break(p) <> null) then - {a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break|} - begin - r := pre_break(p); - while link(r) <> null do - r := link(r); - end else r := find_protchar_right(l, r); - {now the left margin} - if (l <> null) and (type(l) = disc_node) then begin - if post_break(l) <> null then begin - l := post_break(l); {protrude the first char} - goto done; - end else {discard |replace_count(l)| nodes} - begin - n := replace_count(l); - l := link(l); - while n > 0 do begin - if link(l) <> null then - l := link(l); - decr(n); - end; - end; - end; - l := find_protchar_left(l, true); -done: - total_pw := left_pw(l) + right_pw(r); -end; -@z - -@x -shortfall:=line_width-cur_active_width[1]; {we're this much too short} -@y -shortfall:=line_width-cur_active_width[1]; {we're this much too short} -if XeTeX_protrude_chars > 1 then - shortfall := shortfall + total_pw(r, cur_p); -@z - -@x -entire paragraph. - -@= -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 @; - @; - cur_p:=link(temp_head); auto_breaking:=true;@/ - prev_p:=cur_p; {glue at beginning is not a legal breakpoint} -@y -entire paragraph. - -@d update_prev_p == begin - prev_p := cur_p; - global_prev_p := cur_p; -end - -@= -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 @; - @; - cur_p:=link(temp_head); auto_breaking:=true;@/ - update_prev_p; {glue at beginning is not a legal breakpoint} - first_p := cur_p; {to access the first node of paragraph as the first active - node has |break_node=null|} -@z - -@x -@: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@> - -@= -begin prev_p:=cur_p; -@y -@:this can't happen paragraph}{\quad paragraph@> -endcases;@/ -update_prev_p; cur_p:=link(cur_p); -done5:end - -@ The code that passes over the characters of words in a paragraph is -part of \TeX's inner loop, so it has been streamlined for speed. We use -the fact that `\.{\\parfillskip}' glue appears at the end of each paragraph; -it is therefore unnecessary to check if |link(cur_p)=null| when |cur_p| is a -character node. -@^inner loop@> - -@= -begin update_prev_p; -@z - -@x - decr(r); s:=link(s); - end; -prev_p:=cur_p; cur_p:=s; goto done5; -@y - decr(r); s:=link(s); - end; -update_prev_p; cur_p:=s; goto done5; -@z - -@x -var q,@!r,@!s:pointer; {temporary registers for list manipulation} -@y -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; -@z - -@x -q:=cur_break(cur_p); disc_break:=false; post_disc_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); - goto done; - end - else begin if type(q)=disc_node then - @ - 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 @; - end; - end -else begin q:=temp_head; - while link(q)<>null do q:=link(q); - end; -@; -done: -@y -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 - @ - 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 @; - end; - end -else begin q:=temp_head; - while link(q)<>null do q:=link(q); - end; -done: -{at this point |q| is the rightmost breakpoint; the only exception is the case -of a discretionary break with non-empty |pre_break|, then |q| has been changed -to the last node of the |pre_break| list} -if XeTeX_protrude_chars > 0 then begin -{ short_display_n(q, 5); } - 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, 5); } - w := right_pw(p); - if w <> 0 then {we have found a marginal kern, append it after |ptmp|} - begin -{ pdf_DEBUG_int("right margin:", w); } - 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 - @; -end; -@z - -@x -r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r; -@y -r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r; -{at this point |q| is the leftmost node; all discardable nodes have been discarded} -if XeTeX_protrude_chars > 0 then begin - p := q; - p := find_protchar_left(p, false); {no more discardables} - w := left_pw(p); - if w <> 0 then begin - k := new_margin_kern(-w, last_leftmost_char, left_side); - link(k) := q; - q := k; - end; -end; -@z - -@x -var p:pointer; {the box} -@!c:box_code..copy_code; {should we copy?} -begin if cur_chr>copy_code then @; -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 tail:=link(tail); -@y -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 @; -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; -@z - -@x -kern_node: d:=width(p); -@y -kern_node: d:=width(p); -margin_kern_node: d:=width(p); -@z - -@x -assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val; - scan_optional_equals; scan_int; - if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val; - end; - -@ @= -primitive("hyphenchar",assign_font_int,0); -@!@:hyphen_char_}{\.{\\hyphenchar} primitive@> -primitive("skewchar",assign_font_int,1); -@!@:skew_char_}{\.{\\skewchar} primitive@> - -@ @= -assign_font_int: if chr_code=0 then print_esc("hyphenchar") - else print_esc("skewchar"); -@y -assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val; - if n < lp_code_base then begin - scan_optional_equals; scan_int; - if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val; - end else begin - if is_native_font(f) then - scan_glyph_number(f) {for native fonts, the value is a glyph id} - else scan_char_num; {for |tfm| fonts it's the same like pdftex} - p := cur_val; - scan_optional_equals; scan_int; - case n of - lp_code_base: set_cp_code(f, p, left_side, cur_val); - rp_code_base: set_cp_code(f, p, right_side, cur_val); - endcases; - end; -end; - -@ @= -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@> - -@ @= -assign_font_int: case chr_code of -0: print_esc("hyphenchar"); -1: print_esc("skewchar"); -lp_code_base: print_esc("lpcode"); -rp_code_base: print_esc("rpcode"); -endcases; -@z - -@x - flush_string; -end; - -procedure pdf_error(t, p: str_number); -begin - normalize_selector; - print_err("Error"); - if t <> 0 then begin - print(" ("); - print(t); - print(")"); - end; - print(": "); print(p); - succumb; -end; -@y - flush_string; -end; -@z - -@x - not_native_font_error(convert, c, fnt); - end; - -@ @= -eTeX_revision_code: print(eTeX_revision); -pdf_strcmp_code: print_int(cur_val); -XeTeX_revision_code: print(XeTeX_revision); - -XeTeX_variation_name_code: - if is_atsu_font(fnt) then - atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2); - -XeTeX_feature_name_code, -XeTeX_selector_name_code: - if is_atsu_font(fnt) then - atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2) - else if is_gr_font(fnt) then - gr_print_font_name(c, font_layout_engine[fnt], arg1, arg2); - -XeTeX_glyph_name_code: - if is_native_font(fnt) then print_glyph_name(fnt, arg1); -@y - not_native_font_error(convert, c, fnt); - 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; - -@ @= -eTeX_revision_code: print(eTeX_revision); -pdf_strcmp_code: print_int(cur_val); -XeTeX_revision_code: print(XeTeX_revision); - -XeTeX_variation_name_code: - if is_atsu_font(fnt) then - atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2); - -XeTeX_feature_name_code, -XeTeX_selector_name_code: - if is_atsu_font(fnt) then - atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2) - else if is_gr_font(fnt) then - gr_print_font_name(c, font_layout_engine[fnt], arg1, arg2); - -XeTeX_glyph_name_code: - if is_native_font(fnt) then print_glyph_name(fnt, arg1); - -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; -@z - diff --git a/Build/source/texk/web2c/xetex-latex3.ch b/Build/source/texk/web2c/xetex-latex3.ch deleted file mode 100644 index 42463cc342a..00000000000 --- a/Build/source/texk/web2c/xetex-latex3.ch +++ /dev/null @@ -1,974 +0,0 @@ -/****************************************************************************\ - Part of the XeTeX typesetting system - copyright (c) 1994-2008 by SIL International - copyright (c) 2009, 2011 by Jonathan Kew - - Written by Jonathan Kew - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the -"Software"), to deal in the Software without restriction, including -without limitation the rights to use, copy, modify, merge, publish, -distribute, sublicense, and/or sell copies of the Software, and to -permit persons to whom the Software is furnished to do so, subject to -the following conditions: - -The above copyright notice and this permission notice shall be -included in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE -FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF -CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION -WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - -Except as contained in this notice, the name of the copyright holders -shall not be used in advertising or otherwise to promote the sale, -use or other dealings in this Software without prior written -authorization from the copyright holders. -\****************************************************************************/ - -% When updating code here, also increment version number/string in xetex.ch - -% \vadjust -@x l.3142 -@d adjust_node=5 {|type| of an adjust node} -@y -@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 -@z - -% \vadjust -@x l.3581 -@d backup_head==mem_top-13 {head of token list built by |scan_keyword|} -@d hi_mem_stat_min==mem_top-13 {smallest statically allocated word in - the one-word |mem|} -@d hi_mem_stat_usage=14 {the number of one-word nodes always present} -@y -@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} -@z - -% \vadjust -@x l.4145 -begin print_esc("vadjust"); node_list_display(adjust_ptr(p)); {recursive call} -@y -begin print_esc("vadjust"); if adjust_pre(p) <> 0 then print(" pre "); -node_list_display(adjust_ptr(p)); {recursive call} -@z - -% \primitive -@x l.4868 -@d frozen_null_font=frozen_control_sequence+11 - {permanent `\.{\\nullfont}'} -@y -@d frozen_primitive=frozen_control_sequence+11 - {permanent `\.{\\primitive}'} -@d frozen_null_font=frozen_control_sequence+12 - {permanent `\.{\\nullfont}'} -@z - -% \primitive -% \ifprimitive -@x l.5942 -@!cs_count:integer; {total number of known identifiers} - -@ @= -no_new_control_sequence:=true; {new identifiers are usually forbidden} - -@ @= -hash_used:=frozen_control_sequence; {nothing is used} -hash_high:=0; -cs_count:=0; -eq_type(frozen_dont_expand):=dont_expand; -text(frozen_dont_expand):="notexpanded:"; -@.notexpanded:@> -@y -@!cs_count:integer; {total number of known identifiers} - -@ Primitive support needs a few extra variables and definitions - -@d prim_size=480 {maximum number of primitives } -@d prim_prime=409 {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} -@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(prim_eqtb[#]) {level of definition} -@d prim_eq_type(#)==prim_eq_type_field(prim_eqtb[#]) {command code for equivalent} -@d prim_equiv(#)==prim_equiv_field(prim_eqtb[#]) {equivalent value} -@d undefined_primitive=0 - -@= -@!prim: array [0..prim_size] of two_halves; {the primitives table} -@!prim_used:pointer; {allocation pointer for |prim|} -@!prim_eqtb:array[0..prim_size] of memory_word; - -@ @= -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]; -prim_eq_level(0) := level_zero; -prim_eq_type(0) := undefined_cs; -prim_equiv(0) := null; -for k:=1 to prim_size do prim_eqtb[k]:=prim_eqtb[0]; - -@ @= -prim_used:=prim_size; {nothing is used} -hash_used:=frozen_control_sequence; {nothing is used} -hash_high:=0; -cs_count:=0; -eq_type(frozen_dont_expand):=dont_expand; -text(frozen_dont_expand):="notexpanded:"; -@.notexpanded:@> - -eq_type(frozen_primitive):=ignore_spaces; -equiv(frozen_primitive):=1; -eq_level(frozen_primitive):=level_one; -text(frozen_primitive):="primitive"; -@z - -% \primitive -% \ifprimitive -@x l.6029 -@ Single-character control sequences do not need to be looked up in a hash -@y -@ 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<256 then begin - p := s; - if (p<0) or (prim_eq_level(p)<>level_one) then - p := undefined_primitive; -end -else begin - j:=str_start_macro(s); - if s = str_ptr then l := cur_length else l := length(s); - @; - p:=h+prim_base; {we start searching here; note that |0<=h0 then if length(prim_text(p))=l then - if str_eq_str(prim_text(p),s) then goto found; - if prim_next(p)=0 then - begin if no_new_control_sequence then - p:=undefined_primitive - else @; - goto found; - end; - p:=prim_next(p); - end; - end; -found: prim_lookup:=p; -end; - -@ @= -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; -end - -@ The value of |prim_prime| should be roughly 85\pct! of -|prim_size|, and it should be a prime number. - -@= -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 -@z - -% \primitive -@x -@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} -begin if s<256 then cur_val:=s+single_base -else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k; - {we will move |s| into the (possibly non-empty) |buffer|} - if first+l>buf_size+1 then - overflow("buffer size",buf_size); -@:TeX capacity exceeded buffer size}{\quad buffer size@> - for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]); - cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|} - flush_string; text(cur_val):=s; {we don't want to have the string twice} - end; -eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o; -end; -@y -@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:=s; -end -else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k; - {we will move |s| into the (possibly non-empty) |buffer|} - if first+l>buf_size+1 then - overflow("buffer size",buf_size); -@:TeX capacity exceeded buffer size}{\quad buffer size@> - for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]); - cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|} - flush_string; text(cur_val):=s; {we don't want to have the string twice} - prim_val:=prim_lookup(s); - end; -eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o; -prim_eq_level(prim_val):=level_one; -prim_eq_type(prim_val):=c; -prim_equiv(prim_val):=o; -end; -@z - -% \primitive -@x l.6163 -@!@:no_expand_}{\.{\\noexpand} primitive@> -@y -@!@:no_expand_}{\.{\\noexpand} primitive@> -primitive("primitive",no_expand,1);@/ -@!@:primitive_}{\.{\\primitive} primitive@> -@z - -% \primitive -@x l.6224 -ignore_spaces: print_esc("ignorespaces"); -@y -ignore_spaces: if chr_code=0 then print_esc("ignorespaces") else print_esc("primitive"); -@z - -% \primitive -@x l.6239 -no_expand: print_esc("noexpand"); -@y -no_expand: if chr_code=0 then print_esc("noexpand") - else print_esc("primitive"); -@z - -% \ifincsname -@x -var t:halfword; {token that is being ``expanded after''} -@y -var t:halfword; {token that is being ``expanded after''} -@!b:boolean; {keep track of nested csnames} -@z - -% \ifincsname -@x l.8348 -@ @= -@y -@ @= -@!is_in_csname: boolean; - -@ @= -is_in_csname := false; - -@ @= -@z - -% \primitive -@x l.8354 -no_expand:@; -@y -no_expand: if cur_chr=0 then @ - else @; -@z - -% \primitive -@x l.8391 -@ @= -@y -@ The \.{\\primitive} handling. If the primitive meaning of the next -token is an expandable command, it suffices to replace the current -token with the primitive one and restart |expand|/ - -Otherwise, the token we just read has to be pushed back, as well -as a token matching the internal form of \.{\\primitive}, that is -sneaked in as an alternate form of |ignore_spaces|. -@!@:primitive_}{\.{\\primitive} primitive (internalized)@> - -Simply pushing back a token that matches the correct internal command -does not work, because approach would not survive roundtripping to a -temporary file. - -@= -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-257) -else - cur_cs := prim_lookup(text(cur_cs)); -if cur_cs<>undefined_primitive then begin - t := prim_eq_type(cur_cs); - if t>max_command then begin - cur_cmd := t; - cur_chr := prim_equiv(cur_cs); - cur_tok := (cur_cmd*max_char_val)+cur_chr; - cur_cs := 0; - goto reswitch; - end - else begin - back_input; { now |loc| and |start| point to a one-item list } - p:=get_avail; info(p):=cs_token_flag+frozen_primitive; - link(p):=loc; loc:=p; start:=p; - end; - end; -end - -@ @= -@z - -% \ifincsname -@x -begin r:=get_avail; p:=r; {head of the list of characters} -@y -begin r:=get_avail; p:=r; {head of the list of characters} -b := is_in_csname; is_in_csname := true; -@z - -% \ifincsname -@x -if cur_cmd<>end_cs_name then @; -@y -if cur_cmd<>end_cs_name then @; -is_in_csname := b; -@z - -% \strcmp -% \shellescape -@x l.29172 -@d pdf_last_x_pos_code = XeTeX_int+27 -@d pdf_last_y_pos_code = XeTeX_int+28 - -@d XeTeX_pdf_page_count_code = XeTeX_int+29 - -@# -@d XeTeX_dim=XeTeX_int+30 {first of \XeTeX\ codes for dimensions} -@y -@d pdf_last_x_pos_code = XeTeX_int+27 -@d pdf_last_y_pos_code = XeTeX_int+28 -@d pdf_strcmp_code = XeTeX_int+29 -@d pdf_shell_escape_code = XeTeX_int+30 - -@d XeTeX_pdf_page_count_code = XeTeX_int+31 - -@# -@d XeTeX_dim=XeTeX_int+32 {first of \XeTeX\ codes for dimensions} -@z - -% \shellescape -@x l.9244 - input_line_no_code: print_esc("inputlineno"); -@y - input_line_no_code: print_esc("inputlineno"); - pdf_shell_escape_code: print_esc("shellescape"); -@z - -@x l.9322 - badness_code: cur_val:=last_badness; -@y - badness_code: cur_val:=last_badness; - 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; -@z - -% \strcmp -@x l.10165 - font_name_code: print_esc("fontname"); -@y - font_name_code: print_esc("fontname"); - pdf_strcmp_code: print_esc("strcmp"); -@z - -% \strcmp -@x l.10174 -@p procedure conv_toks; -var old_setting:0..max_selector; {holds |selector| setting} -@y -The extra temp string |u| is needed because |pdf_scan_ext_toks| incorporates -any pending string in its output. In order to save such a pending string, -we have to create a temporary string that is destroyed immediately after. - -@d save_cur_string==if str_start_macro(str_ptr)0 then decr(str_ptr) - -@p procedure conv_toks; -var old_setting:0..max_selector; {holds |selector| setting} -@!save_warning_index, @!save_def_ref:pointer; -@!u: str_number; -@z - -% \ifprimitive -@x l.10483 -@d if_case_code=16 { `\.{\\ifcase}' } -@y -@d if_case_code=16 { `\.{\\ifcase}' } -@d if_primitive_code=21 { `\.{\\ifprimitive}' } -@z - -% \ifprimitive -@x l.10519 -@!@:if_case_}{\.{\\ifcase} primitive@> -@y -@!@:if_case_}{\.{\\ifcase} primitive@> -primitive("ifprimitive",if_test,if_primitive_code); -@!@:if_primitive_}{\.{\\ifprimitive} primitive@> -@z - -% \ifprimitive -@x l.10539 - if_case_code:print_esc("ifcase"); -@y - if_case_code:print_esc("ifcase"); - if_primitive_code:print_esc("ifprimitive"); -@z - -% \ifincsname -@x -var b:boolean; {is the condition true?} -@y -var b:boolean; {is the condition true?} -@!e:boolean; {keep track of nested csnames} -@z - -% \ifprimitive -@x l.10723 -if_case_code: @; -if_primitive_code: begin - save_scanner_status:=scanner_status; - scanner_status:=normal; - get_next; - scanner_status:=save_scanner_status; - if cur_cs < hash_base then - m := prim_lookup(cur_cs-257) - 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; -@z - -% \vadjust -@x l.14527 -if adjust_tail<>null then link(adjust_tail):=null; -@y -if adjust_tail<>null then link(adjust_tail):=null; -if pre_adjust_tail<>null then link(pre_adjust_tail):=null; -@z - -% \vadjust -@x - ins_node,mark_node,adjust_node: if adjust_tail<>null then -@y - ins_node,mark_node,adjust_node: if (adjust_tail<>null) or (pre_adjust_tail<> null) then -@z - - -% \vadjust -@x l.14607 -@= -begin while link(q)<>p do q:=link(q); -if type(p)=adjust_node then - begin link(adjust_tail):=adjust_ptr(p); - while link(adjust_tail)<>null do adjust_tail:=link(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 -@y -@= -@!pre_adjust_tail: pointer; - -@ @= -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 - -@= -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 -@z - -% \vadjust -@x l.17583 -@d align_stack_node_size=5 {number of |mem| words to save alignment states} -@y -@d align_stack_node_size=6 {number of |mem| words to save alignment states} -@z - -% \vadjust -@x l.17590 -@!cur_head,@!cur_tail:pointer; {adjustment list pointers} -@y -@!cur_head,@!cur_tail:pointer; {adjustment list pointers} -@!cur_pre_head,@!cur_pre_tail:pointer; {pre-adjustment list pointers} -@z - -% \vadjust -@x l.17596 -cur_head:=null; cur_tail:=null; -@y -cur_head:=null; cur_tail:=null; -cur_pre_head:=null; cur_pre_tail:=null; -@z - -% \vadjust -@x l.17607 -info(p+4):=cur_head; link(p+4):=cur_tail; -align_ptr:=p; -cur_head:=get_avail; -@y -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; -@z - -% \vadjust -@x l.17616 -begin free_avail(cur_head); -p:=align_ptr; -cur_tail:=link(p+4); cur_head:=info(p+4); -@y -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); -@z - -% \vadjust -@x -cur_align:=link(preamble); cur_tail:=cur_head; init_span(cur_align); -@y -cur_align:=link(preamble); cur_tail:=cur_head; cur_pre_tail:=cur_pre_head; -init_span(cur_align); -@z - -% \vadjust -@x l.17690 - begin adjust_tail:=cur_tail; u:=hpack(link(head),natural); w:=width(u); - cur_tail:=adjust_tail; adjust_tail:=null; - end -@y - 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 -@z - -% \vadjust -@x - pop_nest; append_to_vlist(p); - if cur_head<>cur_tail then - begin link(tail):=link(cur_head); tail:=cur_tail; - end; - end -@y - 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 -@z - -% \vadjust -@x l.19508 -append_to_vlist(just_box); -if adjust_head<>adjust_tail then - begin link(tail):=link(adjust_head); tail:=adjust_tail; - end; -@y -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); -@z - -% \vadjust -@x 19529 -adjust_tail:=adjust_head; just_box:=hpack(q,cur_width,exactly); -@y -adjust_tail:=adjust_head; -pre_adjust_tail := pre_adjust_head; -just_box:=hpack(q,cur_width,exactly); -@z - -% \primitive -@x -any_mode(ignore_spaces): begin @; - goto reswitch; - end; -@y -any_mode(ignore_spaces): begin - if cur_chr = 0 then begin - @; - 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-257) - 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); - goto reswitch; - end; - end; - end; -@z - -% \vadjust -@x l.23545 - begin append_to_vlist(cur_box); - if adjust_tail<>null then - begin if adjust_head<>adjust_tail then - begin link(tail):=link(adjust_head); tail:=adjust_tail; - end; -@y - 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); -@z - -% \vadjust -@x l.23716 -adjusted_hbox_group: begin adjust_tail:=adjust_head; package(0); -@y -adjusted_hbox_group: begin adjust_tail:=adjust_head; - pre_adjust_tail:=pre_adjust_head; package(0); -@z - -% \vadjust -@x l.23870 - help1("I'm changing to \insert0; box 255 is special."); - error; cur_val:=0; - end; - end; -saved(0):=cur_val; incr(save_ptr); -new_save_level(insert_group); scan_left_brace; normal_paragraph; -push_nest; mode:=-vmode; prev_depth:=ignore_depth; -end; -@y - help1("I'm changing to \insert0; box 255 is special."); - error; cur_val:=0; - end; - end; -saved(0) := cur_val; -if (cur_cmd = vadjust) and scan_keyword("pre") then - saved(1) := 1 -else - saved(1) := 0; -save_ptr := save_ptr + 2; -new_save_level(insert_group); scan_left_brace; normal_paragraph; -push_nest; mode:=-vmode; prev_depth:=ignore_depth; -end; -@z - -% \vadjust -@x - d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr); -@y - d:=split_max_depth; f:=floating_penalty; unsave; save_ptr:=save_ptr-2; -@z - -% \vadjust -@x l.23892 - subtype(tail):=0; {the |subtype| is not used} -@y - adjust_pre(tail) := saved(1); {the |subtype| is used for |adjust_pre|} -@z - -% \vadjust -@x -@!t:pointer; {tail of adjustment list} -@y -@!t:pointer; {tail of adjustment list} -@!pre_t:pointer; {tail of pre-adjustment list} -@z - -% \vadjust -@x l.25339 -adjust_tail:=adjust_head; b:=hpack(p,natural); p:=list_ptr(b); -t:=adjust_tail; adjust_tail:=null;@/ -@y -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;@/ -@z - -% \vadjust -@x l.25448 -tail_append(new_penalty(post_display_penalty)); -@y -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)); -@z - -% \primitive -@x -@= -@y -@= -for p:=0 to prim_size do dump_hh(prim[p]); -for p:=0 to prim_size do dump_wd(prim_eqtb[p]); -@z - -% \primitive -@x -@ @= -@y -@ @= -for p:=0 to prim_size do undump_hh(prim[p]); -for p:=0 to prim_size do undump_wd(prim_eqtb[p]); -@z - -% \strcmp -@x l.28174 -@ Each new type of node that appears in our data structure must be capable -@y -@ @d call_func(#) == begin if # <> 0 then do_nothing end -@d flushable(#) == (# = str_ptr - 1) - -@p procedure flush_str(s: str_number); {flush a string if possible} -begin - if flushable(s) then - flush_string; -end; - -procedure pdf_error(t, p: str_number); -begin - normalize_selector; - print_err("Error"); - if t <> 0 then begin - print(" ("); - print(t); - print(")"); - end; - print(": "); print(p); - succumb; -end; - -function 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; -} - tokens_to_string := make_string; -end; - -procedure compare_strings; {to implement \.{\\strcmp}} -label done; -var s1, s2: str_number; - i1, i2, j1, j2: pool_pointer; -begin - call_func(scan_toks(false, true)); - s1 := tokens_to_string(def_ref); - delete_token_ref(def_ref); - call_func(scan_toks(false, true)); - s2 := tokens_to_string(def_ref); - delete_token_ref(def_ref); - i1 := str_start_macro(s1); - j1 := str_start_macro(s1 + 1); - i2 := str_start_macro(s2); - j2 := str_start_macro(s2 + 1); - while (i1 < j1) and (i2 < j2) do begin - if str_pool[i1] < str_pool[i2] then begin - cur_val := -1; - goto done; - end; - if str_pool[i1] > str_pool[i2] then begin - cur_val := 1; - goto done; - end; - incr(i1); - incr(i2); - end; - if (i1 = j1) and (i2 = j2) then - cur_val := 0 - else if i1 < j1 then - cur_val := 1 - else - cur_val := -1; -done: - flush_str(s2); - flush_str(s1); - cur_val_level := int_val; -end; - -@ Each new type of node that appears in our data structure must be capable -@z - -% \strcmp -% \shellescape -@x l.29232 -primitive("pdflastypos",last_item,pdf_last_y_pos_code); -@y -primitive("pdflastypos",last_item,pdf_last_y_pos_code); -primitive("strcmp",convert,pdf_strcmp_code); -primitive("shellescape",last_item,pdf_shell_escape_code); -@z - -% \strcmp -@x -eTeX_revision_code: do_nothing; -@y -eTeX_revision_code: do_nothing; -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; -@z - -% \strcmp -@x -eTeX_revision_code: print(eTeX_revision); -@y -eTeX_revision_code: print(eTeX_revision); -pdf_strcmp_code: print_int(cur_val); -@z - -% \ifincsname -@x l.31105 -@d if_font_char_code=19 { `\.{\\iffontchar}' } -@y -@d if_font_char_code=19 { `\.{\\iffontchar}' } -@d if_in_csname_code=20 { `\.{\\ifincsname}' } -@z - -% \ifincsname -@x l.31115 -@!@:if_font_char_}{\.{\\iffontchar} primitive@> -@y -@!@:if_font_char_}{\.{\\iffontchar} primitive@> -primitive("ifincsname",if_test,if_in_csname_code); -@!@:if_in_csname_}{\.{\\ifincsname} primitive@> -@z - -% \ifincsname -@x l.31123 -if_font_char_code:print_esc("iffontchar"); -@y -if_font_char_code:print_esc("iffontchar"); -if_in_csname_code:print_esc("ifincsname"); -@z - -% \ifincsname -@x -if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters} -@y -if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters} - e := is_in_csname; is_in_csname := true; -@z - -% \ifincsname -@x - b:=(eq_type(cur_cs)<>undefined_cs); -@y - b:=(eq_type(cur_cs)<>undefined_cs); - is_in_csname := e; -@z - -% \ifincsname -@x l.31189 -if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num; -@y -if_in_csname_code: b := is_in_csname; -if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num; -@z - diff --git a/Build/source/texk/web2c/xetex-orig.ch b/Build/source/texk/web2c/xetex-orig.ch deleted file mode 100644 index 16cc05c8650..00000000000 --- a/Build/source/texk/web2c/xetex-orig.ch +++ /dev/null @@ -1,8705 +0,0 @@ -/****************************************************************************\ - Part of the XeTeX typesetting system - copyright (c) 1994-2008 by SIL International - copyright (c) 2009-2012 by Jonathan Kew - copyright (c) 2012 by Khaled Hosny - - Written by Jonathan Kew - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the -"Software"), to deal in the Software without restriction, including -without limitation the rights to use, copy, modify, merge, publish, -distribute, sublicense, and/or sell copies of the Software, and to -permit persons to whom the Software is furnished to do so, subject to -the following conditions: - -The above copyright notice and this permission notice shall be -included in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE -FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF -CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION -WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - -Except as contained in this notice, the name of the copyright holders -shall not be used in advertising or otherwise to promote the sale, -use or other dealings in this Software without prior written -authorization from the copyright holders. -\****************************************************************************/ - -@x -\def\section{\mathhexbox278} -@y -\def\section{\mathhexbox278} -\def\XeTeX{Xe\TeX} -@z - -@x -\def\title{\eTeX} -@y -\def\title{\XeTeX} -@z - -@x -\let\maybe=\iffalse % print only changed modules -@y -@z - -@x -\let\maybe=\iffalse -@y -\let\maybe=\iftrue -@z - -@x -@* \[1] Introduction. -@y -@* \[1] Introduction. -@z - -@x -@d TeX_banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts} -@y -@d TeX_banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts} -@# -@d XeTeX_version=0 -@d XeTeX_revision==".9999" -@d XeTeX_version_string=='-0.9999' {current \XeTeX\ version} -@# -@d XeTeX_banner=='This is XeTeX, Version 3.1415926',eTeX_version_string,XeTeX_version_string - {printed when \XeTeX\ starts} -@d XeTeX_banner_k==XeTeX_banner -@z - -@x -@d banner==eTeX_banner -@d banner_k==eTeX_banner_k -@y -@d banner==XeTeX_banner -@d banner_k==XeTeX_banner_k -@z - -@x -@d TEX==ETEX {change program name into |ETEX|} -@y -@d TEX==XETEX {change program name into |XETEX|} -@z - -@x -@d TeXXeT_code=0 {the \TeXXeT\ feature is optional} -@# -@d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|} -@y -@d TeXXeT_code=0 {the \TeXXeT\ feature is optional} -@# -@d XeTeX_dash_break_code = 1 {non-zero to enable breaks after en- and em-dashes} -@# -@d XeTeX_upwards_code = 2 {non-zero if the main vertical list is being built upwards} -@d XeTeX_use_glyph_metrics_code = 3 {non-zero to use exact glyph height/depth} -@d XeTeX_inter_char_tokens_code = 4 {non-zero to enable \\XeTeXinterchartokens insertion} -@# -@d XeTeX_input_normalization_code = 5 {normalization mode: 1 = NFC, 2 = NFD, else none} -@# -@d XeTeX_default_input_mode_code = 6 {input mode for newly opened files} -@d XeTeX_input_mode_auto = 0 -@d XeTeX_input_mode_utf8 = 1 -@d XeTeX_input_mode_utf16be = 2 -@d XeTeX_input_mode_utf16le = 3 -@d XeTeX_input_mode_raw = 4 -@d XeTeX_input_mode_icu_mapping = 5 -@# -@d XeTeX_default_input_encoding_code = 7 {|str_number| of encoding name if mode = ICU} -@# -@d XeTeX_tracing_fonts_code = 8 {non-zero to log native fonts used} -@d eTeX_states=9 {number of \eTeX\ state variables in |eqtb|} -@z - -@x -@d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions; - if you change this, you should also change |iinf_hyphen_size|.} -@y -@d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions; - if you change this, you should also change |iinf_hyphen_size|.} - -{NB: |biggest_char| here refers to UTF16 codepoints that we store in strings, etc; - actual character codes can exceed this range, up to |biggest_usv|.} -@d biggest_char=65535 {the largest allowed character number; - must be |<=max_quarterword|} -@d biggest_usv=@"10FFFF {the largest Unicode Scalar Value} -@d too_big_char=65536 {|biggest_char+1|} -@d special_char=65537 {|biggest_char+2|} -@d number_chars=65536 {|biggest_char+1|} -@d too_big_usv=@"110000 -@d number_usvs=@"110000 -@d biggest_reg=255 {the largest allowed register number; - must be |<=max_quarterword|} -@d number_regs=256 {|biggest_reg+1|} -@d font_biggest=255 {the real biggest font} -@d number_fonts=font_biggest-font_base+2 -@d number_math_families=256 -@d number_math_fonts=number_math_families+number_math_families+number_math_families -@d math_font_biggest=number_math_fonts-1 -@d text_size=0 {size code for the largest size in a family} -@d script_size=number_math_families {size code for the medium size in a family} -@d script_script_size=number_math_families+number_math_families {size code for the smallest size in a family} -@d biggest_lang=255 -@d too_big_lang=256 -@z - -@x -@* \[2] The character set. -@y -@* \[2] The character set. -@z - -@x -@ 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. - -@= -@!ASCII_code=0..255; {eight-bit numbers} -@y -@ Characters of text that have been converted to \TeX's internal form -are said to be of type |ASCII_code|, which is a subrange of the integers. -For xetex, we rename |ASCII_code| as |UTF16_code|. But we also have a -new type |UTF8_code|, used when we construct filenames to pass to the -system libraries. - -@d ASCII_code==UTF16_code -@d packed_ASCII_code==packed_UTF16_code - -@= -@!ASCII_code=0..biggest_char; {16-bit numbers} -@!UTF8_code=0..255; {8-bit numbers} -@!UnicodeScalar=0..@"10FFFF; {Unicode scalars} -@z - -@x -@d last_text_char=255 {ordinal number of the largest element of |text_char|} -@y -@d last_text_char=biggest_char {ordinal number of the largest element of |text_char|} -@z - -@x -@!xord: array [text_char] of ASCII_code; - {specifies conversion of input characters} -xchr: array [ASCII_code] of text_char; - { specifies conversion of output characters } -xprn: array [ASCII_code] of ASCII_code; - { non zero iff character is printable } -@y -@!xchr: ^text_char; - {dummy variable so tangle doesn't complain; not actually used} -@z - -@x -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]:='~';@/ -@y -{ don't need to set up xchr here } -@z - -@x -{Initialize |xchr| to the identity mapping.} -for i:=0 to @'37 do xchr[i]:=i; -for i:=@'177 to @'377 do xchr[i]:=i; -@y -@z - -@x -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; -{Set |xprn| for printable ASCII, unless |eight_bit_p| is set.} -for i:=0 to 255 do xprn[i]:=(eight_bit_p or ((i>=" ")and(i<="~"))); - -{The idea for this dynamic translation comes from the patch by - Libor Skarvada \.{} - and Petr Sojka \.{}. I didn't use any of the - actual code, though, preferring a more general approach.} - -{This updates the |xchr|, |xord|, and |xprn| arrays from the provided - |translate_filename|. See the function definition in \.{texmfmp.c} for - more comments.} -if translate_filename then read_tcx_file; -@y -@z - -@x -@* \[3] Input and output. -@y -@* \[3] Input and output. -@z - -@x -@!name_of_file:^text_char; -@!name_length:0..file_name_size;@/{this many characters are actually - relevant in |name_of_file| (the rest are blank)} -@y -@!name_of_file:^UTF8_code; {we build filenames in utf8 to pass to the OS} -@!name_of_file16:^UTF16_code; {but sometimes we need a utf16 version of the name} -@!name_length:0..file_name_size;@/{this many characters are actually - relevant in |name_of_file| (the rest are blank)} -@!name_length16:0..file_name_size; -@z - -@x -@!buffer:^ASCII_code; {lines of characters being read} -@y -@!buffer:^UnicodeScalar; {lines of characters being read} -@z - -@x -@d term_in==stdin {the terminal as an input file} -@y -@z - -@x -@!bound_default:integer; {temporary for setup} -@y -@!term_in:unicode_file; -@# -@!bound_default:integer; {temporary for setup} -@z - -@x -@* \[4] String handling. -@y -@* \[4] String handling. -@z - -@x -|str_start[s]<=j=@"10000) then length:=str_start_macro(s+1)-str_start_macro(s) -else if (s>=@"20) and (s<@"7F) then length:=1 -else if (s<=@"7F) then length:=3 -else if (s<@"100) then length:=4 -else length:=8 -end; -@z - -@x -@d cur_length == (pool_ptr - str_start[str_ptr]) -@y -@d cur_length == (pool_ptr - str_start_macro(str_ptr)) -@z - -@x -incr(str_ptr); str_start[str_ptr]:=pool_ptr; -@y -incr(str_ptr); str_start_macro(str_ptr):=pool_ptr; -@z - -@x -@d flush_string==begin decr(str_ptr); pool_ptr:=str_start[str_ptr]; - end -@y -@d flush_string==begin decr(str_ptr); pool_ptr:=str_start_macro(str_ptr); - end - -@p procedure append_str(@!s:str_number); { append an existing string to the current string } -var i: integer; - j: pool_pointer; -begin - i:=length(s); - str_room(i); - j:=str_start_macro(s); - while (i > 0) do begin - append_char(str_pool[j]); - incr(j); decr(i); - end; -end; -@z - -@x -begin j:=str_start[s]; -while jbuffer[k] then -@y -begin j:=str_start_macro(s); -while j=@"10000 then - if so(str_pool[j])<>@"D800+(buffer[k]-@"10000)div@"400 then - begin result:=false; goto not_found; - end - else if so(str_pool[j+1])<>@"DC00+(buffer[k]-@"10000)mod@"400 then - begin result:=false; goto not_found; - end - else incr(j) - else if so(str_pool[j])<>buffer[k] then -@z - -@x -j:=str_start[s]; k:=str_start[t]; -while jstr_pool[k] then goto not_found; - incr(j); incr(k); -@y -if (length(s)=1) then begin - if s<65536 then begin - if t<65536 then begin - if s<>t then goto not_found; - end - else begin - if s<>str_pool[str_start_macro(t)] then goto not_found; - end; - end - else begin - if t<65536 then begin - if str_pool[str_start_macro(s)]<>t then goto not_found; - end - else begin - if str_pool[str_start_macro(s)]<>str_pool[str_start_macro(t)] then - goto not_found; - end; - end; - end -else begin - j:=str_start_macro(s); k:=str_start_macro(t); - while jstr_pool[k] then goto not_found; - incr(j); incr(k); - end; -@z - -@x -@ @d app_lc_hex(#)==l:=#; - if l<10 then append_char(l+"0")@+else append_char(l-10+"a") -@y -@ The first 65536 strings will consist of a single character only. -But we don't actually make them; they're simulated on the fly. -@z - -@x -for k:=0 to 255 do - begin if (@) 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 -@y -begin -str_ptr:=too_big_char; -str_start_macro(str_ptr):=pool_ptr; -end -@z - -@x -@= - (k<" ")or(k>"~") -@y -@= -{ this module is not used } -@z - -@x -@* \[5] On-line and off-line printing. -@y -@* \[5] On-line and off-line printing. -@z - -@x -procedure print_char(@!s:ASCII_code); {prints a single character} -label exit; -begin if @ then - if selector= -procedure print_char(@!s:integer); {prints a single character} -label exit; -var l: small_number; -begin if (selector>pseudo) and (not doing_special) then - {"printing" to a new string, encode as UTF-16 rather than UTF-8} - begin if s>=@"10000 then begin - print_visible_char(@"D800 + (s - @"10000) div @"400); - print_visible_char(@"DC00 + (s - @"10000) mod @"400); - end else print_visible_char(s); - return; - end; -if @ then - if selector= 128: encode as UTF8 } - if s<@"800 then begin - print_visible_char(@"C0 + s div @"40); - print_visible_char(@"80 + s mod @"40); - end - else if s<@"10000 then begin - print_visible_char(@"E0 + (s div @"1000)); - print_visible_char(@"80 + (s mod @"1000) div @"40); - print_visible_char(@"80 + (s mod @"40)); - end else begin - print_visible_char(@"F0 + (s div @"40000)); - print_visible_char(@"80 + (s mod @"40000) div @"1000); - print_visible_char(@"80 + (s mod @"1000) div @"40); - print_visible_char(@"80 + (s mod @"40)); - end -end; -exit:end; - -@ @d native_room(#)==while native_text_size <= native_len+# do begin - native_text_size:=native_text_size+128; - native_text:=xrealloc(native_text, native_text_size * sizeof(UTF16_code)); - end -@d append_native(#)==begin native_text[native_len]:=#; incr(native_len); end - -@ @= -@!doing_special: boolean; -@!native_text: ^UTF16_code; { buffer for collecting native-font strings } -@!native_text_size: integer; { size of buffer } -@!native_len: integer; -@!save_native_len: integer; - -@ @= -doing_special:=false; -native_text_size:=128; -native_text:=xmalloc(native_text_size * sizeof(UTF16_code)); -@z - -@x -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 (@) then - if selector=str_ptr then s:="???" {this can't happen} -@.???@> -else if spseudo then - begin print_char(s); return; {internal strings are not expanded} - end; - if (@) then - if selector=@"D800) and (so(str_pool[j])<=@"DFFF) then - begin if (so(str_pool[j])<=@"DBFF) and (j+1=@"DC00) and (so(str_pool[j+1])<=@"DFFF) then - begin print_char(@"10000 + (so(str_pool[j])-@"D800) * @"400 - + so(str_pool[j+1])-@"DC00); j:=j+2; - end - end else begin print_char(so(str_pool[j])); incr(j); - end; -exit:end; -@z - -@x -@ 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: - -@= -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; -if c>=0 then if c<256 then print(c); -@y -begin @; -if c>=0 then if c<=biggest_usv then print_char(c); -@z - -@x -begin j:=str_start["m2d5c2l5x2v5i"]; v:=1000; -@y -begin j:=str_start_macro("m2d5c2l5x2v5i"); v:=1000; -@z - -@x -@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]; -@y -@p procedure print_current_string; {prints a yet-unmade string} -var j:pool_pointer; {points to current character code} -begin j:=str_start_macro(str_ptr); -@z - -@x -k:=first; while k < last do begin print_buffer(k) end; -@y -if last<>first then for k:=first to last-1 do print(buffer[k]); -@z - -@x -@* \[6] Reporting errors. -@y -@* \[6] Reporting errors. -@z - -@x - begin edit_name_start:=str_start[edit_file.name_field]; - edit_name_length:=str_start[edit_file.name_field+1] - - str_start[edit_file.name_field]; -@y - begin edit_name_start:=str_start_macro(edit_file.name_field); - edit_name_length:=str_start_macro(edit_file.name_field+1) - - str_start_macro(edit_file.name_field); -@z - -@x -@* \[7] Arithmetic with scaled dimensions. -@y -@* \[7] Arithmetic with scaled dimensions. -@z - -@x -@* \[8] Packed data. -@y -@* \[8] Packed data. -@z - -@x -@d min_quarterword=0 {smallest allowable value in a |quarterword|} -@d max_quarterword=255 {largest allowable value in a |quarterword|} -@d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|} -@d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|} -@y -@d min_quarterword=0 {smallest allowable value in a |quarterword|} -@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|} -@d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|} -@d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|} -@z - -@x -if (min_quarterword>0)or(max_quarterword<127) then bad:=11; -if (min_halfword>0)or(max_halfword<32767) then bad:=12; -@y -if (min_quarterword>0)or(max_quarterword<@"7FFF) then bad:=11; -if (min_halfword>0)or(max_halfword<@"3FFFFFFF) then bad:=12; -@z - -@x -if max_quarterword-min_quarterword<255 then bad:=19; -@y -if max_quarterword-min_quarterword<@"FFFF then bad:=19; -@z - -@x -@!word_file = file of memory_word; -@y -@!word_file = gzFile; -@z - -@x -@* \[9] Dynamic memory allocation. -@y -@* \[9] Dynamic memory allocation. -@z - -@x -@* \[10] Data structures for boxes and their friends. -@y -@* \[10] Data structures for boxes and their friends. -@z - -@x -@d whatsit_node=8 {|type| of special extension nodes} -@y -@d whatsit_node=8 {|type| of special extension nodes} - -{ added stuff here for |native_word| and picture nodes } -@d native_word_node=40 {|subtype| in whatsits that hold |native_font| words - (0-3 are used for open, write, close, special; 4 is language; pdfTeX uses up through 30-something) - -To support ``native'' fonts, we build |native_word_nodes|, which are variable size whatsits. -These have the same |width|, |depth|, and |height| fields as a |box_node|, at offsets 1-3, -and then a word containing a size field for the node, a font number, a length, and a glyph count. -Then there is a field containing a C pointer to a glyph info array; -this and the glyph count are set by |set_native_metrics|. -Copying and freeing of these nodes needs to take account of this! -This is followed by |2*length| bytes, for the actual characters of the string (in UTF-16). - -So |native_node_size|, which does not include any space for the actual text, is 6.} - -@d native_node_size=6 {size of a |native_word| node (plus the actual chars) -- see also xetex.h} -@d native_size(#)==mem[#+4].qqqq.b0 -@d native_font(#)==mem[#+4].qqqq.b1 -@d native_length(#)==mem[#+4].qqqq.b2 -@d native_glyph_count(#)==mem[#+4].qqqq.b3 -@d native_glyph_info_ptr(#)==mem[#+5].ptr -@d native_glyph_info_size=10 { number of bytes of info per glyph: 16-bit glyph ID, 32-bit x and y coords } - -@d free_native_glyph_info(#) == - begin - if native_glyph_info_ptr(#) <> null_ptr then begin - libc_free(native_glyph_info_ptr(#)); - native_glyph_info_ptr(#) := null_ptr; - native_glyph_count(#) := 0; - end - end - -@p procedure copy_native_glyph_info(src:pointer; dest:pointer); -var glyph_count:integer; -begin - if native_glyph_info_ptr(src) <> null_ptr then begin - glyph_count := native_glyph_count(src); - native_glyph_info_ptr(dest) := xmalloc_array(char, glyph_count * native_glyph_info_size); - memcpy(native_glyph_info_ptr(dest), native_glyph_info_ptr(src), glyph_count * native_glyph_info_size); - native_glyph_count(dest) := glyph_count; - end -end; - -@ There are also |glyph_nodes|; these are like |native_word_nodes| in having |width|, |depth|, and |height| fields, -but then they contain a glyph ID rather than size and length fields, and there's no subsidiary C pointer. - -@d glyph_node_size=5 -@d native_glyph==native_length {in |glyph_node|s, we store the glyph number here} - -@d pic_node=42 {|subtype| in whatsits that hold picture file references} -@d pdf_node=43 {|subtype| in whatsits that hold PDF page references} -@d glyph_node=44 {|subtype| in whatsits that hold glyph numbers} - -@d pdfbox_crop = 1 { |pic_box_type| values in PDF nodes } -@d pdfbox_media = 2 -@d pdfbox_bleed = 3 -@d pdfbox_trim = 4 -@d pdfbox_art = 5 - - -{Picture files are handled with nodes that include fields for the transform associated -with the picture, and a pathname for the picture file itself. -They also have -the |width|, |depth|, and |height| fields of a |box_node| at offsets 1-3. (|depth| will -always be zero, as it happens.) - -So |pic_node_size|, which does not include any space for the picture file pathname, is 7. - -|pdf_nodes| are just like |pic_nodes|, but generate a different xdv file code.} - -@d pic_node_size=8 { must sync with xetex.h } -@d pic_path_length(#)==mem[#+4].hh.b0 -@d pic_page(#)==mem[#+4].hh.b1 -@d pic_box_type(#)==mem[#+4].hh.rh { for PDF, unused in picfile } -@d pic_transform1(#)==mem[#+5].hh.lh -@d pic_transform2(#)==mem[#+5].hh.rh -@d pic_transform3(#)==mem[#+6].hh.lh -@d pic_transform4(#)==mem[#+6].hh.rh -@d pic_transform5(#)==mem[#+7].hh.lh -@d pic_transform6(#)==mem[#+7].hh.rh -@z - -@x -@* \[11] Memory layout. -@y -@* \[11] Memory layout. -@z - -@x -@* \[12] Displaying boxes. -@y -@* \[12] Displaying boxes. -@z - -@x -@ @= -case type(p) of -hlist_node,vlist_node,ins_node,whatsit_node,mark_node,adjust_node, - unset_node: print("[]"); -@y -@ @= -case type(p) of -hlist_node,vlist_node,ins_node,mark_node,adjust_node, - unset_node: print("[]"); -whatsit_node: - case subtype(p) of - native_word_node: begin - if native_font(p)<>font_in_short_display then begin - print_esc(font_id_text(native_font(p))); - print_char(" "); - font_in_short_display:=native_font(p); - end; - print_native_word(p); - end; - othercases print("[]") - endcases; -@z - -@x -@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} -@y -@p procedure show_node_list(@!p:integer); {prints a node list symbolically} -label exit; -var n:integer; {the number of items already printed at this level} -i:integer; {temp index for printing chars of picfile paths} -@z - -@x -@* \[15] The command codes. -@y -@* \[15] The command codes. -@z - -@x -@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.~)} - {or \.{\\charsubdef}} -@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 max_command=100 {the largest command code seen at |big_switch|} -@y -@d math_given=69 {math code defined by \.{\\mathchardef}} -@d XeTeX_math_given=70 -@d last_item=71 {most recent item ( \.{\\lastpenalty}, - \.{\\lastkern}, \.{\\lastskip} )} -@d max_non_prefixed_command=71 {largest command code that can't be \.{\\global}} - -@ The next codes are special; they all relate to mode-independent -assignment of values to \TeX's internal registers or tables. -Codes that are |max_internal| or less represent internal quantities -that might be expanded by `\.{\\the}'. - -@d toks_register=72 {token list register ( \.{\\toks} )} -@d assign_toks=73 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)} -@d assign_int=74 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)} -@d assign_dimen=75 {user-defined length ( \.{\\hsize}, etc.~)} -@d assign_glue=76 {user-defined glue ( \.{\\baselineskip}, etc.~)} -@d assign_mu_glue=77 {user-defined muglue ( \.{\\thinmuskip}, etc.~)} -@d assign_font_dimen=78 {user-defined font dimension ( \.{\\fontdimen} )} -@d assign_font_int=79 {user-defined font integer ( \.{\\hyphenchar}, - \.{\\skewchar} )} -@d set_aux=80 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )} -@d set_prev_graf=81 {specify state info ( \.{\\prevgraf} )} -@d set_page_dimen=82 {specify state info ( \.{\\pagegoal}, etc.~)} -@d set_page_int=83 {specify state info ( \.{\\deadcycles}, - \.{\\insertpenalties} )} - {( or \.{\\interactionmode} )} -@d set_box_dimen=84 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )} -@d set_shape=85 {specify fancy paragraph shape ( \.{\\parshape} )} - {(or \.{\\interlinepenalties}, etc.~)} -@d def_code=86 {define a character code ( \.{\\catcode}, etc.~)} -@d XeTeX_def_code=87 {\.{\\XeTeXmathcode}, \.{\\XeTeXdelcode}} -@d def_family=88 {declare math fonts ( \.{\\textfont}, etc.~)} -@d set_font=89 {set current font ( font identifiers )} -@d def_font=90 {define a font file ( \.{\\font} )} -@d register=91 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)} -@d max_internal=91 {the largest code that can follow \.{\\the}} -@d advance=92 {advance a register or parameter ( \.{\\advance} )} -@d multiply=93 {multiply a register or parameter ( \.{\\multiply} )} -@d divide=94 {divide a register or parameter ( \.{\\divide} )} -@d prefix=95 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )} - {( or \.{\\protected} )} -@d let=96 {assign a command code ( \.{\\let}, \.{\\futurelet} )} -@d shorthand_def=97 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} - {or \.{\\charsubdef}} -@d read_to_cs=98 {read into a control sequence ( \.{\\read} )} - {( or \.{\\readline} )} -@d def=99 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )} -@d set_box=100 {set a box ( \.{\\setbox} )} -@d hyph_data=101 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )} -@d set_interaction=102 {define level of interaction ( \.{\\batchmode}, etc.~)} -@d max_command=102 {the largest command code seen at |big_switch|} -@z - -@x -@* \[17] The table of equivalents. -@y -@* \[17] The table of equivalents. -@z - -@x -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. -@y -In the first region we have |number_chars| equivalents for ``active characters'' -that act as control sequences, followed by |number_chars| equivalents for -single-character control sequences. -@z - -@x -@d single_base=active_base+256 {equivalents of one-character control sequences} -@d null_cs=single_base+256 {equivalent of \.{\\csname\\endcsname}} -@y -@d single_base=active_base+number_usvs - {equivalents of one-character control sequences} -@d null_cs=single_base+number_usvs {equivalent of \.{\\csname\\endcsname}} -@z - -@x -@ 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. -@y -@ Region 3 of |eqtb| contains the |number_regs| \.{\\skip} registers, -as well as the glue parameters defined here. It is important that the -``muskip'' parameters have larger numbers than the others. -@z - -@x -@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} -@y -@d par_fill_skip_code=14 {glue on last line of paragraph} -@d XeTeX_linebreak_skip_code=15 {glue introduced at potential linebreak location} -@d thin_mu_skip_code=16 {thin space in math formula} -@d med_mu_skip_code=17 {medium space in math formula} -@d thick_mu_skip_code=18 {thick space in math formula} -@d glue_pars=19 {total number of glue parameters} -@z - -@x -@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} -@y -@d skip_base=glue_base+glue_pars {table of |number_regs| ``skip'' registers} -@d mu_skip_base=skip_base+number_regs - {table of |number_regs| ``muskip'' registers} -@d local_base=mu_skip_base+number_regs {beginning of region 4} -@z - -@x -@d par_fill_skip==glue_par(par_fill_skip_code) -@y -@d par_fill_skip==glue_par(par_fill_skip_code) -@d XeTeX_linebreak_skip==glue_par(XeTeX_linebreak_skip_code) -@z - -@x -par_fill_skip_code: print_esc("parfillskip"); -@y -par_fill_skip_code: print_esc("parfillskip"); -XeTeX_linebreak_skip_code: print_esc("XeTeXlinebreakskip"); -@z - -@x -primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/ -@!@:par_fill_skip_}{\.{\\parfillskip} primitive@> -@y -primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/ -@!@:par_fill_skip_}{\.{\\parfillskip} primitive@> -primitive("XeTeXlinebreakskip",assign_glue,glue_base+XeTeX_linebreak_skip_code);@/ -@z - -@x -@d etex_toks=etex_toks_base+1 {end of \eTeX's token list parameters} -@y -@d XeTeX_inter_char_loc=every_eof_loc+1 {not really used, but serves as a flag} -@d etex_toks=XeTeX_inter_char_loc+1 {end of \eTeX's token list parameters} -@z - -@x -@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 char_sub_code_base=math_code_base+256 {table of character substitutions} -@d int_base=char_sub_code_base+256 {beginning of region 5} -@y -@d toks_base=etex_toks {table of |number_regs| token list registers} -@# -@d etex_pen_base=toks_base+number_regs {start of table of \eTeX's penalties} -@d inter_line_penalties_loc=etex_pen_base {additional penalties between lines} -@d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines} -@d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines} -@d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display} -@d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties} -@# -@d box_base=etex_pens {table of |number_regs| box registers} -@d cur_font_loc=box_base+number_regs {internal font number outside math mode} -@d math_font_base=cur_font_loc+1 -@d cat_code_base=math_font_base+number_math_fonts - {table of |number_usvs| command codes (the ``catcodes'')} -@d lc_code_base=cat_code_base+number_usvs {table of |number_usvs| lowercase mappings} -@d uc_code_base=lc_code_base+number_usvs {table of |number_usvs| uppercase mappings} -@d sf_code_base=uc_code_base+number_usvs {table of |number_usvs| spacefactor mappings} -@d math_code_base=sf_code_base+number_usvs {table of |number_usvs| math mode mappings} -@d char_sub_code_base=math_code_base+number_usvs {table of character substitutions} -@d int_base=char_sub_code_base+number_usvs {beginning of region 5} -@z - -@x -@d var_code==@'70000 {math code meaning ``use the current family''} -@y -@d var_fam_class = 7 -@d active_math_char = @"1FFFFF -@d is_active_math_char(#) == math_char_field(#) = active_math_char -@d is_var_family(#) == math_class_field(#) = 7 -@z - -@x -for k:=output_routine_loc to toks_base+255 do -@y -for k:=output_routine_loc to toks_base+number_regs-1 do -@z - -@x -for k:=box_base+1 to box_base+255 do eqtb[k]:=eqtb[box_base]; -@y -for k:=box_base+1 to box_base+number_regs-1 do eqtb[k]:=eqtb[box_base]; -@z - -@x -for k:=math_font_base to math_font_base+47 do eqtb[k]:=eqtb[cur_font_loc]; -@y -for k:=math_font_base to math_font_base+number_math_fonts-1 do eqtb[k]:=eqtb[cur_font_loc]; -@z - -@x -for k:=0 to 255 do -@y -for k:=0 to number_usvs-1 do -@z - -@x -for k:="0" to "9" do math_code(k):=hi(k+var_code); -@y -for k:="0" to "9" do math_code(k):=hi(k + set_class_field(var_fam_class)); -@z - -@x - math_code(k):=hi(k+var_code+@"100); - math_code(k+"a"-"A"):=hi(k+"a"-"A"+var_code+@"100);@/ -@y - math_code(k) := hi(k + set_family_field(1) + set_class_field(var_fam_class)); - math_code(k+"a"-"A") := hi(k+"a"-"A" + set_family_field(1) + set_class_field(var_fam_class));@/ -@z - -@x -begin if n=cur_font_loc then print("current font") -else if n -@y -primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/ -@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@> -primitive("XeTeXlinebreakpenalty",assign_int,int_base+XeTeX_linebreak_penalty_code);@/ -@z - -@x -for k:=0 to 255 do del_code(k):=-1; -del_code("."):=0; {this null delimiter is used in error recovery} -@y -for k:=0 to number_chars-1 do del_code(k):=-1; -del_code("."):=0; {this null delimiter is used in error recovery} -@z - -@x -@ The final region of |eqtb| contains the dimension parameters defined -here, and the 256 \.{\\dimen} registers. -@y -@ The final region of |eqtb| contains the dimension parameters defined -here, and the |number_regs| \.{\\dimen} registers. -@z - -@x -@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking} -@d dimen_pars=21 {total number of dimension parameters} -@y -@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking} -@d pdf_page_width_code=21 {page width of the PDF output} -@d pdf_page_height_code=22 {page height of the PDF output} -@d dimen_pars=23 {total number of dimension parameters} -@z - -@x -@d scaled_base=dimen_base+dimen_pars - {table of 256 user-defined \.{\\dimen} registers} -@d eqtb_size=scaled_base+255 {largest subscript of |eqtb|} -@y -@d scaled_base=dimen_base+dimen_pars - {table of |number_regs| user-defined \.{\\dimen} registers} -@d eqtb_size=scaled_base+biggest_reg {largest subscript of |eqtb|} -@z - -@x -@d emergency_stretch==dimen_par(emergency_stretch_code) -@y -@d emergency_stretch==dimen_par(emergency_stretch_code) -@d pdf_page_width == dimen_par(pdf_page_width_code) -@d pdf_page_height == dimen_par(pdf_page_height_code) -@z - -@x -emergency_stretch_code:print_esc("emergencystretch"); -@y -emergency_stretch_code:print_esc("emergencystretch"); -pdf_page_width_code: print_esc("pdfpagewidth"); -pdf_page_height_code: print_esc("pdfpageheight"); -@z - -@x -primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/ -@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@> -@y -primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/ -@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@> - -primitive("pdfpagewidth",assign_dimen,dimen_base+pdf_page_width_code);@/ -@!@:pdf_page_width_}{\.{\\pdfpagewidth} primitive@> -primitive("pdfpageheight",assign_dimen,dimen_base+pdf_page_height_code);@/ -@!@:pdf_page_height_}{\.{\\pdfpageheight} primitive@> -@z - -@x -for q:=active_base to box_base+255 do -@y -for q:=active_base to box_base+biggest_reg do -@z - -@x -@* \[18] The hash table. -@y -@* \[18] The hash table. -@z - -@x -begin @; -p:=h+hash_base; {we start searching here; note that |0<=h0 then if length(text(p))=l then -@y -@!ll:integer; {length in utf16 code units} -begin @; -p:=h+hash_base; {we start searching here; note that |0<=h=@"10000 then incr(ll); -loop@+begin if text(p)>0 then if length(text(p))=ll then -@z - -@x -str_room(l); d:=cur_length; -while pool_ptr>str_start[str_ptr] do -@y -str_room(ll); d:=cur_length; -while pool_ptr>str_start_macro(str_ptr) do -@z - -@x -for k:=j to j+l-1 do append_char(buffer[k]); -@y -for k:=j to j+l-1 do begin - if buffer[k]<@"10000 then append_char(buffer[k]) - else begin - append_char(@"D800+(buffer[k]-@"10000)div@"400); - append_char(@"DC00+(buffer[k]-@"10000)mod@"400); - end -end; -@z - -@x - else print(p-active_base) -@y - else print_char(p-active_base) -@z - -@x - if p -@y -primitive("mathchar",math_char_num,0);@/ -primitive("XeTeXmathcharnum",math_char_num,1);@/ -primitive("XeTeXmathchar",math_char_num,2);@/ -@!@:math_char_}{\.{\\mathchar} primitive@> -@z - -@x -primitive("radical",radical,0);@/ -@y -primitive("radical",radical,0);@/ -primitive("XeTeXradical",radical,1);@/ -@z - -@x -primitive("relax",relax,256); {cf.\ |scan_file_name|} -@y -primitive("relax",relax,too_big_usv); {cf.\ |scan_file_name|} -@z - -@x -delim_num: print_esc("delimiter"); -@y -delim_num: if chr_code=1 then print_esc("XeTeXdelimiter") - else print_esc("delimiter"); -@z - -@x -math_accent: print_esc("mathaccent"); -@y -math_accent: if chr_code=1 then print_esc("XeTeXmathaccent") - else print_esc("mathaccent"); -@z - -@x -math_char_num: print_esc("mathchar"); -@y -math_char_num: if chr_code=2 then print_esc("XeTeXmathchar") - else if chr_code=1 then print_esc("XeTeXmathcharnum") - else print_esc("mathchar"); -@z - -@x -radical: print_esc("radical"); -@y -radical: if chr_code=1 then print_esc("XeTeXradical") else print_esc("radical"); -@z - -@x -@* \[19] Saving and restoring equivalents. -@y -@* \[19] Saving and restoring equivalents. -@z - -@x -@* \[20] Token lists. -@y -@* \[20] Token lists. -@z - -@x -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. -@y -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^16m+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^{20}-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. -@z - -@x -@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$} -@y -@d cs_token_flag= @"1FFFFFF {was @@"FFFFF: amount added to the |eqtb| location in a - token that stands for a control sequence; is a multiple of~65536, less~1} -@d max_char_val= @"200000 {@@"10000 to separate char and command code} -@d left_brace_token= @"200000 {@@"10000 $2^16\cdot|left_brace|$} -@d left_brace_limit= @"400000 {@@"20000 $2^16\cdot(|left_brace|+1)$} -@d right_brace_token= @"400000 {@@"20000 $2^16\cdot|right_brace|$} -@d right_brace_limit= @"600000 {@@"30000 $2^16\cdot(|right_brace|+1)$} -@d math_shift_token= @"600000 {@@"30000 $2^16\cdot|math_shift|$} -@d tab_token= @"800000 {@@"40000 $2^16\cdot|tab_mark|$} -@d out_param_token= @"A00000 {@@"50000 $2^16\cdot|out_param|$} -@d space_token= @"1400020 {@@"A0020 $2^16\cdot|spacer|+|" "|$} -@d letter_token= @"1600000 {@@"B0000 $2^16\cdot|letter|$} -@d other_token= @"1800000 {@@"C0000 $2^16\cdot|other_char|$} -@d match_token= @"1A00000 {@@"D0000 $2^16\cdot|match|$} -@d end_match_token= @"1C00000 {@@"E0000 $2^16\cdot|end_match|$} - -@d protected_token=end_match_token+1 {$2^8\cdot|end_match|+1$} -@z - -@x -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|'} -@y -procedure show_token_list(@!p,@!q:integer;@!l:integer); -label exit; -var m,@!c:integer; {pieces of a token} -@!match_chr:integer; {character used in a `|match|'} -@z - -@x -else begin m:=info(p) div @'400; c:=info(p) mod @'400; -@y -else begin m:=info(p) div max_char_val; c:=info(p) mod max_char_val; -@z - -@x -@= -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); -@y -@= -case m of -left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer, - letter,other_char: print_char(c); -mac_param: begin print_char(c); print_char(c); - end; -out_param: begin print_char(match_chr); - if c<=9 then print_char(c+"0") - else begin print_char("!"); return; - end; - end; -match: begin match_chr:=c; print_char(c); incr(n); print_char(n); -@z - -@x -@* \[21] Introduction to the syntactic routines. -@y -@* \[21] Introduction to the syntactic routines. -@z - -@x -@d chr_cmd(#)==begin print(#); print_ASCII(chr_code); - end -@y -@d chr_cmd(#)==begin print(#); - if chr_code < @"10000 then print_ASCII(chr_code) - {non-Plane 0 Unicodes can't be sent through |print_ASCII|} - else begin print("number "); print_hex(chr_code) end; - end -@z - -@x -procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); -var n:integer; {temp variable} -@y -procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); -var n:integer; {temp variable} -@!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension} -@!quote_char:UTF16_code; -@z - -@x -@* \[22] Input stacks and states. -@y -@* \[22] Input stacks and states. -@z - -@x -@!input_file : ^alpha_file; -@y -@!input_file : ^unicode_file; -@z - -@x -@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 -@y -@d backed_up_char=4 {special code for backed-up char from \\XeTeXinterchartoks hook} -@d inserted=5 {|token_type| code for inserted texts} -@d macro=6 {|token_type| code for defined control sequences} -@d output_text=7 {|token_type| code for output routines} -@d every_par_text=8 {|token_type| code for \.{\\everypar}} -@d every_math_text=9 {|token_type| code for \.{\\everymath}} -@d every_display_text=10 {|token_type| code for \.{\\everydisplay}} -@d every_hbox_text=11 {|token_type| code for \.{\\everyhbox}} -@d every_vbox_text=12 {|token_type| code for \.{\\everyvbox}} -@d every_job_text=13 {|token_type| code for \.{\\everyjob}} -@d every_cr_text=14 {|token_type| code for \.{\\everycr}} -@d mark_text=15 {|token_type| code for \.{\\topmark}, etc.} -@d inter_char_text=16 {text from \\XeTeXinterchartoks} -@# -@d eTeX_text_offset=output_routine_loc-output_text-1 {1 more to make space for the |inter_char_text|} -@z - -@x -backed_up: if loc=null then print_nl(" ") -@y -backed_up_char,backed_up: if loc=null then print_nl(" ") -@z - -@x -every_eof_text: print_nl(" "); -@y -inter_char_text: print_nl(" "); -every_eof_text: print_nl(" "); -@z - -@x -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]); -@y -for q:=p to first_count-1 do print_visible_char(trick_buf[q mod error_line]); -print_ln; -for q:=1 to n do print_visible_char(" "); {print |n| spaces to begin line~2} -if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3); -for q:=first_count to p-1 do print_visible_char(trick_buf[q mod error_line]); -@z - -@x -if j>0 then for i:=start to j-1 do - begin if i=loc then set_trick_count; - print(buffer[i]); - end -@y -if j>0 then for i:=start to j-1 do - begin if i=loc then set_trick_count; - print_char(buffer[i]); - end -@z - -@x -@* \[23] Maintaining the input stacks. -@y -@* \[23] Maintaining the input stacks. -@z - -@x - othercases print_cmd_chr(assign_toks,t-output_text+output_routine_loc) -@y - othercases print_cmd_chr(assign_toks,t-output_text+output_routine_loc+1) -@z - -@x -if name>17 then a_close(cur_file); {forget it} -@y -if name>17 then u_close(cur_file); {forget it} -@z - -@x -@* \[24] Getting the next token. -@y -@* \[24] Getting the next token. -@z - -@x -primitive("par",par_end,256); {cf.\ |scan_file_name|} -@y -primitive("par",par_end,too_big_usv); {cf.\ |scan_file_name|} -@z - -@x -@d start_cs=26 {another} -@y -@d start_cs=26 {another} -@d not_exp=27 -@z - -@x - exit; {go here when the next input token has been got} -@y - not_exp, {go here when ^^ turned out not to start an expanded code} - exit; {go here when the next input token has been got} -@z - -@x -@!c,@!cc:ASCII_code; {constituents of a possible expanded code} -@!d:2..3; {number of excess characters in an expanded code} -@y -@!c:UnicodeScalar; {constituent of a possible expanded code} -@!d:small_number; {number of excess characters in an expanded code} -@!sup_count:small_number; {number of identical |sup_mark| characters} -@z - -@x -@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 -@y -@d hex_to_cur_chr== - if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10; - if cc<="9" then cur_chr:=16*cur_chr+cc-"0" - else cur_chr:=16*cur_chr+cc-"a"+10 -@d long_hex_to_cur_chr== - if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10; - if cc<="9" then cur_chr:=16*cur_chr+cc-"0" - else cur_chr:=16*cur_chr+cc-"a"+10; - if ccc<="9" then cur_chr:=16*cur_chr+ccc-"0" - else cur_chr:=16*cur_chr+ccc-"a"+10; - if cccc<="9" then cur_chr:=16*cur_chr+cccc-"0" - else cur_chr:=16*cur_chr+cccc-"a"+10 -@z - -@x -@= -begin if cur_chr=buffer[loc] then if loc= -begin if cur_chr=buffer[loc] then if locbiggest_usv then - begin cur_chr:=buffer[loc]; - goto not_exp; - end; - loc:=loc+2*sup_count-1; - goto reswitch; - end; -not_exp: -state:=mid_line; -end -@z - -@x -@= -begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k2 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 -@y -@= -begin if (cat=sup_mark) and (buffer[k]=cur_chr) and (k0 then {there were the right number of hex chars, so convert them} - begin cur_chr:=0; - for d:=1 to sup_count do - begin c:=buffer[k+sup_count-2+d]; - if c<="9" then cur_chr:=16*cur_chr+c-"0" - else cur_chr:=16*cur_chr+c-"a"+10; - end; - {check the resulting value is within the valid range} - if cur_chr>biggest_usv then cur_chr:=buffer[k] - else begin buffer[k-1]:=cur_chr; - d:=2*sup_count-1; - {shift the rest of the buffer left by |d| chars} - limit:=limit-d; - while k<=limit do - begin buffer[k]:=buffer[k+d]; incr(k); - end; - goto start_cs; - end - end - end -end -@z - -@x - else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400; -@y - else begin cur_cmd:=t div max_char_val; cur_chr:=t mod max_char_val; -@z - -@x -@d no_expand_flag=257 {this characterizes a special variant of |relax|} -@y -@d no_expand_flag=special_char {this characterizes a special variant of |relax|} -@z - -@x -if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr -@y -if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr -@z - -@x - begin eq_define(cur_cs,relax,256); {N.B.: The |save_stack| might change} -@y - begin eq_define(cur_cs,relax,too_big_usv); - {N.B.: The |save_stack| might change} -@z - -@x - buffer[j]:=info(p) mod @'400; incr(j); p:=link(p); -@y - buffer[j]:=info(p) mod max_char_val; incr(j); p:=link(p); -@z - -@x -done: if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr -@y -done: if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr -@z - -@x -if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr -@y -if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr -@z - -@x -if (info(r)>match_token+255)or(info(r)=end_match_token)or(info(r) - if (cur_cs=0)and@| - ((cur_chr=s)or(cur_chr=s-"a"+"A")) then - begin store_new_token(cur_tok); - flush_list(link(backup_head)); scan_keyword:=true; return; - end - else if (cur_cmd<>spacer)or(p<>backup_head) then - begin back_input; - if p<>backup_head then back_list(link(backup_head)); - scan_keyword:=false; return; - end; - end; - end; -k:=str_start_macro(s); -while k; -@y -def_code: @; -XeTeX_def_code: - begin - scan_usv_num; - if m=sf_code_base then begin - scanned_result(ho(sf_code(cur_val) div @"10000))(int_val) - end - else if m=math_code_base then begin - scanned_result(ho(math_code(cur_val)))(int_val) - end - else if m=math_code_base+1 then begin - print_err("Can't use \XeTeXmathcode as a number (try \XeTeXmathcodenum)"); - help2("\XeTeXmathcode is for setting a mathcode from separate values;")@/ - ("use \XeTeXmathcodenum to access them as single values."); error; - scanned_result(0)(int_val) - end - else if m=del_code_base then begin - scanned_result(ho(del_code(cur_val)))(int_val) - end else begin - print_err("Can't use \XeTeXdelcode as a number (try \XeTeXdelcodenum)"); - help2("\XeTeXdelcode is for setting a delcode from separate values;")@/ - ("use \XeTeXdelcodenum to access them as single values."); error; - scanned_result(0)(int_val); - end; - end; -@z - -@x -@ @= -begin scan_char_num; -@y -@ @= -begin scan_usv_num; -@z - -@x -if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val) -@y -if m=math_code_base then begin - cur_val1:=ho(math_code(cur_val)); - if is_active_math_char(cur_val1) then - cur_val1:=@"8000 - else if (math_class_field(cur_val1)>7) or - (math_fam_field(cur_val1)>15) or - (math_char_field(cur_val1)>255) then - begin print_err("Extended mathchar used as mathchar"); -@.Bad mathchar@> - help2("A mathchar number must be between 0 and ""7FFF.")@/ - ("I changed this one to zero."); int_error(cur_val1); cur_val1:=0; - end; - cur_val1:=(math_class_field(cur_val1)*@"1000) + - (math_fam_field(cur_val1)*@"100) + - math_char_field(cur_val1); - scanned_result(cur_val1)(int_val) - end -else if m=del_code_base then begin - cur_val1:=del_code(cur_val); - if cur_val1>=@"40000000 then begin - print_err("Extended delcode used as delcode"); -@.Bad delcode@> - help2("A delimiter code must be between 0 and ""7FFFFFF.")@/ - ("I changed this one to zero."); error; - scanned_result(0)(int_val); - end else begin - scanned_result(cur_val1)(int_val); - end -end -@z - -@x -else if m= -if m>=input_line_no_code then - if m>=eTeX_glue then @@; - else if m>=eTeX_dim then -@y -@= -if m>=input_line_no_code then - if m>=eTeX_glue then @@; - else if m>=XeTeX_dim then -@z - -@x -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.")@/ -@y -procedure scan_char_class; -begin scan_int; -if (cur_val<0)or(cur_val>256) then - begin print_err("Bad character class"); -@.Bad character code@> - help2("A character class must be between 0 and 256.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_eight_bit_int; -begin scan_int; -if (cur_val<0)or(cur_val>255) then - begin print_err("Bad register code"); -@.Bad register code@> - help2("A register code or char class must be between 0 and 255.")@/ -@z - -@x -procedure scan_char_num; -begin scan_int; -if (cur_val<0)or(cur_val>255) then -@y -procedure scan_usv_num; -begin scan_int; -if (cur_val<0)or(cur_val>@"10FFFF) then - begin print_err("Bad USV code"); -@.Bad character code@> - help2("A Unicode Scalar Value must be between 0 and ""10FFFF.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_char_num; -begin scan_int; -if (cur_val<0)or(cur_val>biggest_char) then -@z - -@x - help2("A character number must be between 0 and 255.")@/ -@y - help2("A character number must be between 0 and 65535.")@/ -@z - -@x -procedure scan_four_bit_int; -@y -procedure scan_xetex_math_char_int; -begin scan_int; - if is_active_math_char(cur_val) then begin - if cur_val <> active_math_char then begin - print_err("Bad active XeTeX math code"); - help2("Since I ignore class and family for active math chars,")@/ - ("I changed this one to ""1FFFFF."); int_error(cur_val); - cur_val := active_math_char; - end - end else if math_char_field(cur_val) > @"10FFFF then begin - print_err("Bad XeTeX math character code"); - help2("Since I expected a character number between 0 and ""10FFFF,")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_math_class_int; -begin scan_int; -if (cur_val<0)or(cur_val>7) then - begin print_err("Bad math class"); -@.Bad number@> - help2("Since I expected to read a number between 0 and 7,")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_math_fam_int; -begin scan_int; -if (cur_val<0)or(cur_val>number_math_families-1) then - begin print_err("Bad math family"); -@.Bad number@> - help2("Since I expected to read a number between 0 and 255,")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; - -procedure scan_four_bit_int; -@z - -@x -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; -@y -procedure scan_delimiter_int; -begin scan_int; -if (cur_val<0)or(cur_val>@'777777777) then - begin print_err("Bad delimiter code"); -@.Bad delimiter code@> - help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; -end; -@z - -@x -if cur_val>255 then -@y -if cur_val>biggest_usv then -@z - -@x -@p procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean); -@y -@p procedure xetex_scan_dimen(@!mu,@!inf,@!shortcut,@!requires_units:boolean); -@z - -@x -@; -@; -@y -if requires_units then begin -@; -@; -end else begin - if cur_val>=@'40000 then arith_error:=true - else cur_val:=cur_val*unity+f; -end; -@z - -@x -@ @= -@y -procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean); -begin - xetex_scan_dimen(mu,inf,shortcut,true); -end; - -@ For XeTeX, we have an additional version |scan_decimal|, like |scan_dimen| -but without any scanning of units. - -@p procedure scan_decimal; - {sets |cur_val| to a quantity expressed as a decimal fraction} -begin - xetex_scan_dimen(false, false, false, false); -end; - -@ @= -@z - -@x -@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} -@y -@d etex_convert_base=5 {base for \eTeX's command codes} -@d eTeX_revision_code=etex_convert_base {command code for \.{\\eTeXrevision}} - -@d XeTeX_revision_code=6 -@d XeTeX_variation_name_code=7 { must match codes in xetexmac.c } -@d XeTeX_feature_name_code=8 -@d XeTeX_selector_name_code=9 -@d XeTeX_glyph_name_code=10 - -@d etex_convert_codes=XeTeX_glyph_name_code+1 {end of \eTeX's command codes} -@z - -@x - eTeX_revision_code: print_esc("eTeXrevision"); -@y - @/@@/ -@z - -@x -@!c:number_code..job_name_code; {desired type of conversion} -@y -@!c:small_number; {desired type of conversion} -@z - -@x -@!b:pool_pointer; {base of temporary string} -@y -@!b:pool_pointer; {base of temporary string} -@!fnt,@!arg1,@!arg2:integer; {args for \XeTeX\ extensions} -@!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension} -@!i:small_number; -@!quote_char:UTF16_code; -@z - -@x -eTeX_revision_code: do_nothing; -@y -@/@@/ -@z - -@x -font_name_code: begin print(font_name[cur_val]); -@y -font_name_code: begin - font_name_str:=font_name[cur_val]; - if is_native_font(cur_val) then begin - quote_char:=""""; - for i:=0 to length(font_name_str) - 1 do - if str_pool[str_start_macro(font_name_str) + i] = """" then quote_char:="'"; - print_char(quote_char); - print(font_name_str); - print_char(quote_char); - end else - print(font_name_str); -@z - -@x -eTeX_revision_code: print(eTeX_revision); -@y -@/@@/ -@z - -@x -job_name_code: print(job_name); -@y -job_name_code: print_file_name(job_name, 0, 0); -@z - -@x -@!read_file:array[0..15] of alpha_file; {used for \.{\\read}} -@y -@!read_file:array[0..15] of unicode_file; {used for \.{\\read}} -@z - -@x -else begin a_close(read_file[m]); read_open[m]:=closed; -@y -else begin u_close(read_file[m]); read_open[m]:=closed; -@z - -@x - begin a_close(read_file[m]); read_open[m]:=closed; -@y - begin u_close(read_file[m]); read_open[m]:=closed; -@z - -@x -if (cur_cmd>active_char)or(cur_chr>255) then {not a character} - begin m:=relax; n:=256; -@y -if (cur_cmd>active_char)or(cur_chr>biggest_usv) then {not a character} - begin m:=relax; n:=too_big_usv; -@z - -@x -if (cur_cmd>active_char)or(cur_chr>255) then - begin cur_cmd:=relax; cur_chr:=256; -@y -if (cur_cmd>active_char)or(cur_chr>biggest_usv) then - begin cur_cmd:=relax; cur_chr:=too_big_usv; -@z - -@x -@* \[29] File names. -@y -@* \[29] File names. -@z - -@x -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. - -@y -@z - -@x -@!ext_delimiter:pool_pointer; {the most recent `\..', if any} -@y -@!ext_delimiter:pool_pointer; {the most recent `\..', if any} -@!file_name_quote_char:UTF16_code; -@z - -@x -begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false; -@y -begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false; -file_name_quote_char:=0; -@z - -@x -@p function more_name(@!c:ASCII_code):boolean; -begin if (c=" ") and stop_at_space and (not quoted_filename) then - more_name:=false -else if c="""" then begin - quoted_filename:=not quoted_filename; - more_name:=true; - end -@y -@p function more_name(@!c:ASCII_code):boolean; -begin if stop_at_space and (c=" ") and (file_name_quote_char=0) then - more_name:=false -else if stop_at_space and (file_name_quote_char<>0) and (c=file_name_quote_char) then begin - file_name_quote_char:=0; - more_name:=true; - end -else if stop_at_space and (file_name_quote_char=0) and ((c="""") or (c="'") or (c="(")) then begin - if c="(" then file_name_quote_char:=")" - else file_name_quote_char:=c; - quoted_filename:=true; - more_name:=true; - end -@z - -@x -@p procedure end_name; -var temp_str: str_number; {result of file name cache lookups} -@!j,@!s,@!t: pool_pointer; {running indices} -@!must_quote:boolean; {whether we need to quote a string} -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@> -str_room(6); {Room for quotes, if needed.} -{add quotes if needed} -if area_delimiter<>0 then begin - {maybe quote |cur_area|} - must_quote:=false; - s:=str_start[str_ptr]; - t:=str_start[str_ptr]+area_delimiter; - j:=s; - while (not must_quote) and (j0 then ext_delimiter:=ext_delimiter+2; - area_delimiter:=area_delimiter+2; - pool_ptr:=pool_ptr+2; - end; - end; -{maybe quote |cur_name|} -s:=str_start[str_ptr]+area_delimiter; -if ext_delimiter=0 then t:=pool_ptr else t:=str_start[str_ptr]+ext_delimiter-1; -must_quote:=false; -j:=s; -while (not must_quote) and (j0 then ext_delimiter:=ext_delimiter+2; - pool_ptr:=pool_ptr+2; - end; -if ext_delimiter<>0 then begin - {maybe quote |cur_ext|} - s:=str_start[str_ptr]+ext_delimiter-1; - t:=pool_ptr; - must_quote:=false; - j:=s; - while (not must_quote) and (jmax_strings then - overflow("number of strings",max_strings-init_str_ptr); -@:TeX capacity exceeded number of strings}{\quad number of strings@> -@z - -@x - str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr); -@y - str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+area_delimiter; incr(str_ptr); -@z - -@x - for j:=str_start[str_ptr+1] to pool_ptr-1 do -@y - for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do -@z - -@x - str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1; -@y - str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+ext_delimiter-area_delimiter-1; -@z - -@x - for j:=str_start[str_ptr+1] to pool_ptr-1 do -@y - for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do -@z - -@x -procedure print_file_name(@!n,@!a,@!e:integer); -var must_quote: boolean; {whether to quote the filename} -@!j:pool_pointer; {index into |str_pool|} -begin -must_quote:=false; -if a<>0 then begin - j:=str_start[a]; - while (not must_quote) and (j0 then begin - j:=str_start[n]; - while (not must_quote) and (j0 then begin - j:=str_start[e]; - while (not must_quote) and (j0)and(|str_pool|[|str_start|[|a|]]=""""))or - ((|n|<>0)and(|str_pool|[|str_start|[|n|]]=""""))or - ((|e|<>0)and(|str_pool|[|str_start|[|e|]]=""""));} -if must_quote then print_char(""""); -if a<>0 then - for j:=str_start[a] to str_start[a+1]-1 do - if so(str_pool[j])<>"""" then - print(so(str_pool[j])); -if n<>0 then - for j:=str_start[n] to str_start[n+1]-1 do - if so(str_pool[j])<>"""" then - print(so(str_pool[j])); -if e<>0 then - for j:=str_start[e] to str_start[e+1]-1 do - if so(str_pool[j])<>"""" then - print(so(str_pool[j])); -if must_quote then print_char(""""); -end; -@y -procedure print_file_name(@!n,@!a,@!e:integer); -var @!must_quote: boolean; {whether to quote the filename} -@!quote_char: integer; {current quote char (single or double)} -@!j:pool_pointer; {index into |str_pool|} -begin -must_quote:=false; -quote_char:=0; -if a<>0 then begin - j:=str_start_macro(a); - while ((not must_quote) or (quote_char=0)) and (j0 then begin - j:=str_start_macro(n); - while ((not must_quote) or (quote_char=0)) and (j0 then begin - j:=str_start_macro(e); - while ((not must_quote) or (quote_char=0)) and (j0 then - for j:=str_start_macro(a) to str_start_macro(a+1)-1 do begin - if str_pool[j]=quote_char then begin - print(quote_char); - quote_char:="""" + "'" - quote_char; - print(quote_char); - end; - print(str_pool[j]); - end; -if n<>0 then - for j:=str_start_macro(n) to str_start_macro(n+1)-1 do begin - if str_pool[j]=quote_char then begin - print(quote_char); - quote_char:="""" + "'" - quote_char; - print(quote_char); - end; - print(str_pool[j]); - end; -if e<>0 then - for j:=str_start_macro(e) to str_start_macro(e+1)-1 do begin - if str_pool[j]=quote_char then begin - print(quote_char); - quote_char:="""" + "'" - quote_char; - print(quote_char); - end; - print(str_pool[j]); - end; -if quote_char<>0 then print_char(quote_char); -end; -@z - -@x -@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k); - if k<=file_name_size then name_of_file[k]:=xchr[c]; - end end -@y -@d append_to_name(#)==begin c:=#; incr(k); - if k<=file_name_size then begin - if (c < 128) then name_of_file[k]:=c - else if (c < @"800) then begin - name_of_file[k]:=@"C0 + c div @"40; incr(k); - name_of_file[k]:=@"80 + c mod @"40; - end else begin - name_of_file[k]:=@"E0 + c div @"1000; incr(k); - name_of_file[k]:=@"80 + (c mod @"1000) div @"40; incr(k); - name_of_file[k]:=@"80 + (c mod @"1000) mod @"40; - end - end - end -@z - -@x -name_of_file:= xmalloc_array (ASCII_code, length(a)+length(n)+length(e)+1); -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])); -@y -name_of_file:= xmalloc_array (UTF8_code, (length(a)+length(n)+length(e))*3+1); -for j:=str_start_macro(a) to str_start_macro(a+1)-1 do append_to_name(so(str_pool[j])); -for j:=str_start_macro(n) to str_start_macro(n+1)-1 do append_to_name(so(str_pool[j])); -for j:=str_start_macro(e) to str_start_macro(e+1)-1 do append_to_name(so(str_pool[j])); -@z - -@x -name_of_file := xmalloc_array (ASCII_code, n+(b-a+1)+format_ext_length+1); -for j:=1 to n do append_to_name(xord[ucharcast(TEX_format_default[j])]); -@y -name_of_file := xmalloc_array (UTF8_code, n+(b-a+1)+format_ext_length+1); -for j:=1 to n do append_to_name(TEX_format_default[j]); -@z - -@x - append_to_name(xord[ucharcast(TEX_format_default[j])]); -@y - append_to_name(TEX_format_default[j]); -@z - -@x -@p function make_name_string:str_number; -var k:1..file_name_size; {index into |name_of_file|} -save_area_delimiter, save_ext_delimiter: pool_pointer; -save_name_in_progress, save_stop_at_space: boolean; -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; - {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to - match the contents of |name_of_file|.} - save_area_delimiter:=area_delimiter; save_ext_delimiter:=ext_delimiter; - save_name_in_progress:=name_in_progress; save_stop_at_space:=stop_at_space; - name_in_progress:=true; - begin_name; - stop_at_space:=false; - k:=1; - while (k<=name_length)and(more_name(name_of_file[k])) do - incr(k); - stop_at_space:=save_stop_at_space; - end_name; - name_in_progress:=save_name_in_progress; - area_delimiter:=save_area_delimiter; ext_delimiter:=save_ext_delimiter; - end; -end; -@y -@p function make_name_string:str_number; -var k:0..file_name_size; {index into |name_of_file|} -save_area_delimiter, save_ext_delimiter: pool_pointer; -save_name_in_progress, save_stop_at_space: boolean; -begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or - (cur_length>0) then - make_name_string:="?" -else begin - make_utf16_name; - for k:=0 to name_length16-1 do append_char(name_of_file16[k]); - make_name_string:=make_string; - {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to - match the contents of |name_of_file|.} - save_area_delimiter:=area_delimiter; save_ext_delimiter:=ext_delimiter; - save_name_in_progress:=name_in_progress; save_stop_at_space:=stop_at_space; - name_in_progress:=true; - begin_name; - stop_at_space:=false; - k:=0; - while (kother_char)or(cur_chr>255) then {not a character} -@y -loop@+begin if (cur_cmd>other_char)or(cur_chr>biggest_char) then - {not a character} -@z - -@x - {If |cur_chr| is a space and we're not scanning a token list, check - whether we're at the end of the buffer. Otherwise we end up adding - spurious spaces to file names in some cases.} - if (cur_chr=" ") and (state<>token_list) and (loc>limit) then goto done; -@y -@z - -@x - pack_job_name(".dvi"); - while not b_open_out(dvi_file) do - prompt_file_name("file name for output",".dvi"); -@y - pack_job_name(output_file_extension); - while not dvi_open_out(dvi_file) do - prompt_file_name("file name for output",output_file_extension); -@z - -@x -@!dvi_file: byte_file; {the device-independent output goes here} -@y -@!output_file_extension: str_number; -@!no_pdf_output: boolean; -@!dvi_file: byte_file; {the device-independent output goes here} -@z - -@x -@ @=output_file_name:=0; -@y -@ @= - output_file_name:=0; - if no_pdf_output then output_file_extension:=".xdv" - else output_file_extension:=".pdf"; -@z - -@x -if translate_filename then begin - wlog_cr; - wlog(' ('); - fputs(translate_filename, log_file); - wlog(')'); - end; -@y -if translate_filename then begin - wlog_cr; - wlog(' (WARNING: translate-file "'); - fputs(translate_filename, log_file); - wlog('" ignored)'); - end; -@z - -@x - if kpse_in_name_ok(stringcast(name_of_file+1)) - and a_open_in(cur_file, kpse_tex_format) then - goto done; -@y - if kpse_in_name_ok(stringcast(name_of_file+1)) - and u_open_in(cur_file, kpse_tex_format, XeTeX_default_input_mode, XeTeX_default_input_encoding) then - {At this point |name_of_file| contains the actual name found, as a UTF8 string. - We convert to UTF16, then extract the |cur_area|, |cur_name|, and |cur_ext| from it.} - begin - make_utf16_name; - name_in_progress:=true; - begin_name; - stop_at_space:=false; - k:=0; - while (k0 then begin - begin_diagnostic; - print_nl("Requested font """); - print_c_string(stringcast(name_of_file+1)); - print('"'); - if s < 0 then begin - print(" scaled "); - print_int(-s); - end else begin - print(" at "); - print_scaled(s); - print("pt"); - end; - end_diagnostic(false); -end; -if quoted_filename then begin - { quoted name, so try for a native font } - g:=load_native_font(u,nom,aire,s); - if g<>null_font then goto done; -end; -{ it was an unquoted name, or not found as an installed font, so try for a TFM file } -@; -@y -if g<>null_font then goto done; -if not quoted_filename then begin - { we failed to find a TFM file, so try for a native font } - g:=load_native_font(u,nom,aire,s); - if g<>null_font then goto done -end; -bad_tfm: -if suppress_fontnotfound_error=0 then begin - @; - end; -@z - -@x -done: if file_opened then b_close(tfm_file); -@y -done: if file_opened then b_close(tfm_file); -if XeTeX_tracing_fonts_state>0 then begin - if g=null_font then begin - begin_diagnostic; - print_nl(" -> font not found, using ""nullfont"""); - end_diagnostic(false); - end else if file_opened then begin - begin_diagnostic; - print_nl(" -> "); - print_c_string(stringcast(name_of_file+1)); - end_diagnostic(false); - end; -end; -@z - -@x -@d start_font_error_message==print_err("Font "); sprint_cs(u); - print_char("="); print_file_name(nom,aire,""); -@y -@d start_font_error_message==print_err("Font "); sprint_cs(u); - print_char("="); - if file_name_quote_char=")" then print_char("(") - else if file_name_quote_char<>0 then print_char(file_name_quote_char); - print_file_name(nom,aire,cur_ext); - if file_name_quote_char<>0 then print_char(file_name_quote_char); -@z - -@x -else print(" not loadable: Metric (TFM) file not found"); -@y -else print(" not loadable: Metric (TFM) file or installed font not found"); -@z - -@x -@ @= -@; -@y -@ @= -@; -@z - -@x -@ -@y -@; -end -@z - -@x -@ @= -file_opened:=false; -@y -@ @= -@z - -@x -if not b_open_in(tfm_file) then abort; -file_opened:=true -@y -check_for_tfm_font_mapping; -if b_open_in(tfm_file) then begin - file_opened:=true -@z - -@x -fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; goto done -@y -fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; -font_mapping[f]:=load_tfm_font_mapping; -goto done -@z - -@x -else if cur_cmd=def_family then - begin m:=cur_chr; scan_four_bit_int; f:=equiv(m+cur_val); - end -@y -else if cur_cmd=def_family then - begin m:=cur_chr; scan_math_fam_int; f:=equiv(m+cur_val); - end -@z - -@x -@ 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; -@y -@ Procedure |char_warning| has been moved in the source. -@z - -@x -@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer; -@y -@p function new_character(@!f:internal_font_number;@!c:ASCII_code):pointer; -@z - -@x -begin ec:=effective_char(false,f,qi(c)); -@y -begin -if is_native_font(f) then - begin new_character:=new_native_character(f,c); return; - end; -ec:=effective_char(false,f,qi(c)); -@z - -@x -@* \[31] Device-independent file format. -@y -@* \[31] Device-independent file format. -@z - -@x -\yskip\noindent Commands 250--255 are undefined at the present time. -@y -\yskip\hang|set_glyph_string| 254 w[4] k[2] x[4k] g[2k]. - -\yskip\hang|set_glyph_array| 253 w[4] k[2] xy[8k] g[2k] - -\yskip\hang|define_native_font| 252 k[4] s[4] flags[2] - lenps[1] lenfam[1] lensty[1] ps[lenps] fam[lenfam] sty[lensty] - if (flags AND COLORED): - rgba[4] - if (flags AND VARIATIONS): - numvars[2] - axes[4nv] - values[4nv] - if (flags AND MATRIX): - ta[4] tb[4] tc[4] td[4] tx[4] ty[4] - -\yskip\hang|pic_file| 251 flags[1] t[4][6] p[2] len[2] path[l] - flags = 0 for raster image, 1 for PDF - t is transform matrix - p is page \# from the graphic file (0-based) - len is length of pathname - path is pathname of graphic file - -\yskip\noindent Commands 250 and 255 are undefined at the present time (but 255 is used by pTeX). -@z - -@x -@d post_post=249 {postamble ending} -@y -@d post_post=249 {postamble ending} - -@d set_glyph_string=254 {sequence of glyphs, all at the current y-position} -@d set_glyph_array=253 {sequence of glyphs with individual x-y coordinates} -@d define_native_font=252 {define native font} -@d pic_file=251 {embed picture or PDF} -@z - -@x -@d id_byte=2 {identifies the kind of \.{DVI} files described here} -@y -XeTeX changes the DVI version to 5, -as we have new DVI opcodes like |set_glyph_array| for native font text; -I used version 3 in an earlier extension of TeX, -and 4 in pre-1.0 XeTeX releases using Mac OS-specific data types. - -@d id_byte=5 {identifies the kind of \.{DVI} files described here} -@z - -@x -@* \[32] Shipping pages out. -@y -@* \[32] Shipping pages out. -@z - -@x -@ A mild optimization of the output is performed by the |dvi_pop| -@y -procedure dvi_two(s: UTF16_code); -begin - dvi_out(s div @'400); - dvi_out(s mod @'400); -end; - -@ A mild optimization of the output is performed by the |dvi_pop| -@z - -@x -@p procedure dvi_font_def(@!f:internal_font_number); -@y -@p procedure dvi_native_font_def(@!f:internal_font_number); -var - font_def_length, i: integer; -begin - dvi_out(define_native_font); - dvi_four(f-font_base-1); - font_def_length := make_font_def(f); - for i := 0 to font_def_length - 1 do dvi_out(xdv_buffer[i]); -end; - -procedure dvi_font_def(@!f:internal_font_number); -@z - -@x -var k:pool_pointer; {index into |str_pool|} -@y -var k:pool_pointer; {index into |str_pool|} -l:integer; {length of name without mapping option} -@z - -@x -begin if f<=256+font_base then -@y -begin if is_native_font(f) then dvi_native_font_def(f) else -begin if f<=256+font_base then -@z - -@x -dvi_out(length(font_name[f])); -@; -@y -l:=0; k:=str_start_macro(font_name[f]); -{search for colon; we will truncate the name there} -while (l=0) and (k= -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])) -@y -@ @= -for k:=str_start_macro(font_area[f]) to str_start_macro(font_area[f]+1)-1 do - dvi_out(so(str_pool[k])); -for k:=str_start_macro(font_name[f]) to str_start_macro(font_name[f]+1)-1 do - dvi_out(so(str_pool[k])) -@z - -@x -@ @= -dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font; -@y -@ @= -dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font; -@; -@z - -@x - print(" TeX output "); print_int(year); print_char("."); -@y - print(" XeTeX output "); print_int(year); print_char("."); -@z - -@x - 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} -@y - for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s])); - pool_ptr:=str_start_macro(str_ptr); {flush the current string} -@z - -@x -@d next_p=15 {go to this label when finished with node |p|} -@y -@d next_p=15 {go to this label when finished with node |p|} - -@d check_next=1236 -@d end_node_run=1237 -@z - -@x -label reswitch, move_past, fin_rule, next_p, continue, found; -@y -label reswitch, move_past, fin_rule, next_p, continue, found, check_next, end_node_run; -@z - -@x -@!prev_p:pointer; {one step behind |p|} -@y -@!prev_p:pointer; {one step behind |p|} -@!len: integer; { length of scratch string for native word output } -@!q,@!r: pointer; -@!k,@!j: integer; -@z - -@x -g_sign:=glue_sign(this_box); p:=list_ptr(this_box); -@y -g_sign:=glue_sign(this_box); -@; -p:=list_ptr(this_box); -@z - -@x -@ We ought to give special care to the efficiency of one part of |hlist_out|, -@y -@ Extra stuff for justifiable AAT text; need to merge runs of words and normal spaces. - -@d is_native_word_node(#) == ((not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = native_word_node)) -@d is_glyph_node(#) == ((not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = glyph_node)) - -@= -p := list_ptr(this_box); -prev_p := this_box+list_offset; -while p<>null do begin - if link(p) <> null then begin {not worth looking ahead at the end} - if is_native_word_node(p) and (font_area[native_font(p)] = aat_font_flag) - and (font_letter_space[native_font(p)] = 0) then begin - {got a word in an AAT font, might be the start of a run} - r := p; {|r| is start of possible run} - k := native_length(r); - q := link(p); -check_next: - @; - if (q <> null) and not is_char_node(q) then begin - if (type(q) = glue_node) and (subtype(q) = normal) and (glue_ptr(q) = font_glue[native_font(r)]) then begin - {found a normal space; if the next node is another word in the same font, we'll merge} - q := link(q); - @; - if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin - p := q; {record new tail of run in |p|} - k := k + 1 + native_length(q); - q := link(q); - goto check_next; - end; - goto end_node_run; - end; - {@@;} - if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin - p := q; {record new tail of run in |p|} - q := link(q); - goto check_next; - end - end; -end_node_run: {now |r| points to first |native_word_node| of the run, and |p| to the last} - if p <> r then begin {merge nodes from |r| to |p| inclusive; total text length is |k|} - str_room(k); - k := 0; {now we'll use this as accumulator for total width} - q := r; - loop begin - if type(q) = whatsit_node then begin - if subtype(q) = native_word_node then begin - for j := 0 to native_length(q)-1 do - append_char(get_native_char(q, j)); - k := k + width(q); - end - end else if type(q) = glue_node then begin - append_char(" "); - g := glue_ptr(q); - k := k + width(g); - if g_sign <> normal then begin - if g_sign = stretching then begin - if stretch_order(g) = g_order then begin - k := k + round(float(glue_set(this_box)) * stretch(g)) - end - end else begin - if shrink_order(g) = g_order then begin - k := k - round(float(glue_set(this_box)) * shrink(g)) - end - end - end - end; - {discretionary and deleted nodes can be discarded here} - if q = p then break - else q := link(q); - end; -done: - q := new_native_word_node(native_font(r), cur_length); - link(prev_p) := q; - for j := 0 to cur_length - 1 do - set_native_char(q, j, str_pool[str_start_macro(str_ptr) + j]); - link(q) := link(p); - link(p) := null; - flush_node_list(r); - width(q) := k; - set_justified_native_glyphs(q); - p := q; - pool_ptr := str_start_macro(str_ptr); {flush the temporary string data} - end - end; - prev_p := p; - end; - p := link(p); -end - -@ @= -while (q <> null) and (not is_char_node(q)) and (type(q) = disc_node) do - q := link(q) - -@ We ought to give special care to the efficiency of one part of |hlist_out|, -@z - -@x - repeat f:=font(p); c:=character(p); -@y - repeat f:=font(p); c:=character(p); - if (p<>lig_trick) and (font_mapping[f]<>nil) then c:=apply_tfm_font_mapping(font_mapping[f],c); -@z - -@x -@p procedure vlist_out; {output a |vlist_node| box} -@y -@p procedure vlist_out; {output a |vlist_node| box} -@z - -@x -@!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); -@y -@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio} -@!upwards:boolean; {whether we're stacking upwards} -begin cur_g:=0; cur_glue:=float_constant(0); -this_box:=temp_ptr; g_order:=glue_order(this_box); -g_sign:=glue_sign(this_box); p:=list_ptr(this_box); -upwards:=(subtype(this_box)=min_quarterword+1); -incr(cur_s); -if cur_s>0 then dvi_out(push); -if cur_s>max_push then max_push:=cur_s; -save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; -if upwards then cur_v:=cur_v+depth(this_box) else cur_v:=cur_v-height(this_box); -@z - -@x -kern_node:cur_v:=cur_v+width(p); -@y -kern_node:if upwards then cur_v:=cur_v-width(p) else cur_v:=cur_v+width(p); -@z - -@x -move_past: cur_v:=cur_v+rule_ht; -@y -move_past: if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht; -@z - -@x -@= -if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p) -@y -@= -if list_ptr(p)=null then begin - if upwards then cur_v:=cur_v-depth(p)-height(p) else cur_v:=cur_v+height(p)+depth(p); - end -@z - -@x -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 -@y -else begin if upwards then cur_v:=cur_v-depth(p) else cur_v:=cur_v+height(p); synch_v; - save_h:=dvi_h; save_v:=dvi_v; - if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p) - else cur_h:=left_edge+shift_amount(p); {shift the box right} - temp_ptr:=p; - if type(p)=vlist_node then vlist_out@+else hlist_out; - dvi_h:=save_h; dvi_v:=save_v; - if upwards then cur_v:=save_v-height(p) else cur_v:=save_v+depth(p); cur_h:=left_edge; - end -@z - -@x -cur_v:=cur_v+rule_ht; -@y -if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht; -@z - -@x -begin if tracing_output>0 then -@y -begin -if job_name=0 then open_log_file; -if tracing_output>0 then -@z - -@x -dvi_four(last_bop); last_bop:=page_loc; -@y -dvi_four(last_bop); last_bop:=page_loc; -{ generate a pagesize special at start of page } -old_setting:=selector; selector:=new_string; -print("pdf:pagesize "); -if (pdf_page_width > 0) and (pdf_page_height > 0) then begin - print("width"); print(" "); - print_scaled(pdf_page_width); - print("pt"); print(" "); - print("height"); print(" "); - print_scaled(pdf_page_height); - print("pt"); -end else - print("default"); -selector:=old_setting; -dvi_out(xxx1); dvi_out(cur_length); -for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s])); -pool_ptr:=str_start_macro(str_ptr); {erase the string} -@z - -@x -cur_v:=height(p)+v_offset; temp_ptr:=p; -@y -cur_v:=height(p)+v_offset; { does this need changing for upwards mode ???? } -temp_ptr:=p; -@z - -@x -dvi_out(eop); incr(total_pages); cur_s:=-1; -@y -dvi_out(eop); incr(total_pages); cur_s:=-1; -if not no_pdf_output then fflush(dvi_file); -@z - -@x - print_nl("Output written on "); print_file_name(0, output_file_name, 0); -@.Output written on x@> - print(" ("); print_int(total_pages); - if total_pages<>1 then print(" pages") - else print(" page"); - print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes)."); - b_close(dvi_file); -@y - k:=dvi_close(dvi_file); - if k=0 then begin - print_nl("Output written on "); print(output_file_name); -@.Output written on x@> - print(" ("); print_int(total_pages); - if total_pages<>1 then print(" pages") - else print(" page"); - if no_pdf_output then begin - print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes)."); - end else print(")."); - end else begin - print_nl("Error "); print_int(k); print(" ("); - if no_pdf_output then print_c_string(strerror(k)) - else print("driver return code"); - print(") generating output;"); - print_nl("file "); print(output_file_name); print(" may not be valid."); - end; -@z - -@x -@* \[33] Packaging. -@y -@* \[33] Packaging. -@z - -@x -@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer; -label reswitch, common_ending, exit; -@y -@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer; -label reswitch, common_ending, exit, restart; -@z - -@x -@!hd:eight_bits; {height and depth indices for a character} -@y -@!hd:eight_bits; {height and depth indices for a character} -@!pp,@!ppp: pointer; -@!total_chars, @!k: integer; -@z - -@x -p:=lig_trick; goto reswitch; -@y -p:=lig_trick; xtx_ligature_present:=true; goto reswitch; -@z - -@x -@d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth} -@y -@d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth} -@z - -@x -subtype(r):=min_quarterword; shift_amount(r):=0; -@y -if XeTeX_upwards then subtype(r):=min_quarterword+1 else subtype(r):=min_quarterword; -shift_amount(r):=0; -@z - -@x -@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>ignore_depth then - begin d:=width(baseline_skip)-prev_depth-height(b); - if dignore_depth then - begin if upwards then d:=width(baseline_skip)-prev_depth-depth(b) - else d:=width(baseline_skip)-prev_depth-height(b); - if dnull do q:=link(q); - link(q):=p; - if (height(b) < height(p)) then height(b):=height(p); - if (depth(b) < depth(p)) then depth(b):=depth(p); - end; - end else begin - link(p):=list_ptr(b); list_ptr(b):=p; - height(b):=height(p); - if (width(b) < width(p)) then width(b):=width(p); - end; -end; - -procedure stack_glue_into_box(@!b:pointer;@!min,max:scaled); -var p,q:pointer; -begin - q:=new_spec(zero_glue); - width(q):=min; - stretch(q):=max-min; - p:=new_glue(q); - if type(b)=hlist_node then begin - q:=list_ptr(b); - if q=null then list_ptr(b):=p else begin - while link(q)<>null do q:=link(q); - link(q):=p; - end; - end else begin - link(p):=list_ptr(b); list_ptr(b):=p; - height(b):=height(p); width(b):=width(p); - end; -end; - -function build_opentype_assembly(@!f:internal_font_number;@!a:void_pointer;@!s:scaled;@!horiz:boolean):pointer; - {return a box with height/width at least |s|, using font |f|, with glyph assembly info from |a|} -var - b:pointer; {the box we're constructing} - n:integer; {the number of repetitions of each extender} - i,j:integer; {indexes} - g:integer; {glyph code} - p:pointer; {temp pointer} - s_max,o,oo,prev_o,min_o:scaled; - no_extenders: boolean; - nat,str:scaled; {natural size, stretch} -begin - b:=new_null_box; - if horiz then - type(b):=hlist_node - else - type(b):=vlist_node; - - {figure out how many repeats of each extender to use} - n:=-1; - no_extenders:=true; - min_o:=ot_min_connector_overlap(f); - repeat - n:=n+1; - {calc max possible size with this number of extenders} - s_max:=0; - prev_o:=0; - for i:=0 to ot_part_count(a)-1 do begin - if ot_part_is_extender(a, i) then begin - no_extenders:=false; - for j:=1 to n do begin - o:=ot_part_start_connector(f, a, i); - if min_o=s) or no_extenders; - - {assemble box using |n| copies of each extender, - with appropriate glue wherever an overlap occurs} - prev_o:=0; - for i:=0 to ot_part_count(a)-1 do begin - if ot_part_is_extender(a, i) then begin - for j:=1 to n do begin - o:=ot_part_start_connector(f, a, i); - if prev_o0 then stack_glue_into_box(b, -oo, -o); - g:=ot_part_glyph(a, i); - stack_glyph_into_box(b, f, g); - prev_o:=ot_part_end_connector(f, a, i); - end - end else begin - o:=ot_part_start_connector(f, a, i); - if prev_o0 then stack_glue_into_box(b, -oo, -o); - g:=ot_part_glyph(a, i); - stack_glyph_into_box(b, f, g); - prev_o:=ot_part_end_connector(f, a, i); - end; - end; - - {find natural size and total stretch of the box} - p:=list_ptr(b); nat:=0; str:=0; - while p<>null do begin - if type(p)=whatsit_node then begin - if horiz then - nat:=nat+width(p) - else - nat:=nat+height(p)+depth(p); - end else if type(p)=glue_node then begin - nat:=nat+width(glue_ptr(p)); - str:=str+stretch(glue_ptr(p)); - end; - p:=link(p); - end; - - {set glue so as to stretch the connections if needed} - o:=0; - if (s>nat) and (str>0) then begin - o:=(s-nat); - {don't stretch more than |str|} - if (o>str) then o:=str; - glue_order(b):=normal; glue_sign(b):=stretching; - glue_set(b):=unfloat(o/str); - if horiz then - width(b):= nat+round(str*float(glue_set(b))) - else - height(b):=nat+round(str*float(glue_set(b))); - end else - if horiz then - width(b):=nat - else - height(b):=nat; - - build_opentype_assembly:=b; -end; - -function var_delimiter(@!d:pointer;@!s:integer;@!v:scaled):pointer; -label found,continue; -var b:pointer; {the box that will be constructed} -ot_assembly_ptr:void_pointer; -@z - -@x -@!z: small_number; {runs through font family members} -@y -@!z: integer; {runs through font family members} -@z - -@x -loop@+ begin @; - 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 - @ -else begin b:=new_null_box; - width(b):=null_delimiter_space; {use this width if no delimiter was found} - end; -@y -ot_assembly_ptr:=nil; -loop@+ begin @; - if large_attempt then goto found; {there were none large enough} - large_attempt:=true; z:=large_fam(d); x:=large_char(d); - end; -found: if f<>null_font then begin - if not is_ot_font(f) then - @ - else begin - {for OT fonts, c is the glyph ID to use} - if ot_assembly_ptr<>nil then - b:=build_opentype_assembly(f, ot_assembly_ptr, v, 0) - else begin - b:=new_null_box; type(b):=vlist_node; list_ptr(b):=get_node(glyph_node_size); - type(list_ptr(b)):=whatsit_node; subtype(list_ptr(b)):=glyph_node; - native_font(list_ptr(b)):=f; native_glyph(list_ptr(b)):=c; - set_native_glyph_metrics(list_ptr(b), 1); - width(b):=width(list_ptr(b)); - height(b):=height(list_ptr(b)); - depth(b):=depth(list_ptr(b)); - end - end -end else begin b:=new_null_box; - width(b):=null_delimiter_space; {use this width if no delimiter was found} - end; -@z - -@x - begin z:=z+s+16; - repeat z:=z-16; g:=fam_fnt(z); -@y - begin z:=z+s+script_size; - repeat z:=z-script_size; g:=fam_fnt(z); -@z - -@x - until z<16; -@y - until z= -@y -@ @= -if is_ot_font(g) then begin - b:=new_native_character(g, x); - x:=get_native_glyph(b, 0); - free_node(b, native_size(b)); - f:=g; c:=x; w:=0; n:=0; - repeat - y:=get_ot_math_variant(g, x, n, addressof(u), 0); - if u>w then begin - c:=y; w:=u; - if u>=v then goto found; - end; - n:=n+1; - until u<0; - {if we get here, then we didn't find a big enough glyph; check if the char is extensible} - ot_assembly_ptr:=get_ot_assembly_ptr(g, x, 0); - if ot_assembly_ptr<>nil then goto found; -end else -@z - -@x -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; -@y -function char_box(@!f:internal_font_number;@!c:integer):pointer; -var q:four_quarters; -@!hd:eight_bits; {|height_depth| byte} -@!b,@!p:pointer; {the new box and its character node} -begin -if is_native_font(f) then begin - b:=new_null_box; - p:=new_native_character(f, c); - list_ptr(b):=p; - height(b):=height(p); width(b):=width(p); - if depth(p)<0 then depth(b):=0 else depth(b):=depth(p); - end -else begin - q:=char_info(f)(c); hd:=height_depth(q); - b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q); - height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd); - p:=get_avail; character(p):=c; font(p):=f; - end; -list_ptr(b):=p; char_box:=b; -end; -@z - -@x -@* \[36] Typesetting math formulas. -@y -@* \[36] Typesetting math formulas. -@z - -@x -@!cur_size:small_number; {size code corresponding to |cur_style|} -@y -@!cur_size:integer; {size code corresponding to |cur_style|} -@z - -@x -@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 - @ -else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then - cur_i:=orig_char_info(cur_f)(cur_c) -@y -@p procedure fetch(@!a:pointer); {unpack the |math_char| field |a|} -begin cur_c:=cast_to_ushort(character(a)); cur_f:=fam_fnt(fam(a)+cur_size); -cur_c:=cur_c + (plane_and_fam_field(a) div @"100) * @"10000; -if cur_f=null_font then - @ -else if is_native_font(cur_f) then begin - cur_i:=null_character; -end else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then - cur_i:=orig_char_info(cur_f)(cur_c) -@z - -@x -@!cur_c:quarterword; {the |character| field of a |math_char|} -@y -@!cur_c:integer; {the |character| field of a |math_char|} -@z - -@x -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; - x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x); - @; - if hempty)or(math_type(subscr(q))<>empty) then - if math_type(nucleus(q))=math_char then - @; - 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); - info(nucleus(q)):=y; - math_type(nucleus(q)):=sub_box; - end; -end; -@y -function compute_ot_math_accent_pos(@!p:pointer):scaled; -var - @!q,@!r:pointer; - @!s,@!g:scaled; -begin - if (math_type(nucleus(p))=math_char) then begin - fetch(nucleus(p)); - q:=new_native_character(cur_f, qo(cur_c)); - g:=get_native_glyph(q, 0); - s:=get_ot_math_accent_pos(cur_f, g); - end else begin - if (math_type(nucleus(p))=sub_mlist) then begin - r:=info(nucleus(p)); - if (r<>null) and (type(r)=accent_noad) then - s:=compute_ot_math_accent_pos(r) - else - s:=@"7FFFFFFF; - end else - s:=@"7FFFFFFF; - end; - compute_ot_math_accent_pos:=s; -end; - -procedure make_math_accent(@!q:pointer); -label done,done1; -var p,@!x,@!y:pointer; {temporary registers for box construction} -@!a:integer; {address of lig/kern instruction} -@!c,@!g:integer; {accent character} -@!f:internal_font_number; {its font} -@!i:four_quarters; {its |char_info|} -@!s,@!sa:scaled; {amount to skew the accent to the right} -@!h:scaled; {height of character being accented} -@!delta:scaled; {space to remove between accent and accentee} -@!w,@!w2:scaled; {width of the accentee, not including sub/superscripts} -@!ot_assembly_ptr:void_pointer; -begin fetch(accent_chr(q)); -x:=null; -if is_native_font(cur_f) then - begin c:=cur_c; f:=cur_f; - if not is_bottom_acc(q) then s:=compute_ot_math_accent_pos(q); - x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x); - end -else if char_exists(cur_i) then - begin i:=cur_i; c:=cur_c; f:=cur_f;@/ - @; - x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x); - @; - end; -if x<>null then begin - if is_new_mathfont(f) then - if is_bottom_acc(q) then delta:=0 - else if hempty)or(math_type(subscr(q))<>empty) then - if math_type(nucleus(q))=math_char then - @; - y:=char_box(f,c); - if is_native_font(f) then begin - {turn the |native_word| node into a |native_glyph| one} - p:=get_node(glyph_node_size); - type(p):=whatsit_node; subtype(p):=glyph_node; - native_font(p):=f; native_glyph(p):=get_native_glyph(list_ptr(y), 0); - set_native_glyph_metrics(p, 1); - free_node(list_ptr(y), native_size(list_ptr(y))); - list_ptr(y):=p; - - @; - - {determine horiz positioning} - sa:=get_ot_math_accent_pos(f,native_glyph(p)); - if sa=@"7FFFFFFF then sa:=half(width(y)); - if is_bottom_acc(q) or (s=@"7FFFFFFF) then s:=half(w); - shift_amount(y):=s-sa; - end else - shift_amount(y):=s+half(w-width(y)); - width(y):=0; - if is_bottom_acc(q) then begin - link(x):=y; y:=vpack(x,natural); shift_amount(y):=-(h - height(y)); - end else begin - p:=new_kern(-delta); link(p):=x; link(y):=p; y:=vpack(y,natural); - if height(y); - end; - width(y):=width(x); - info(nucleus(q)):=y; - math_type(nucleus(q)):=sub_box; - end; -end; -@z - -@x -@ @= -@y -@ @= - if odd(subtype(q)) then {non growing accent} - set_native_glyph_metrics(p, 1) - else begin - c:=native_glyph(p); - a:=0; - repeat - g:=get_ot_math_variant(f, c, a, addressof(w2), 1); - if (w2>0) and (w2<=w) then begin - native_glyph(p):=g; - set_native_glyph_metrics(p, 1); - incr(a); - end; - until (w2<0) or (w2>=w); - if (w2<0) then begin - ot_assembly_ptr:=get_ot_assembly_ptr(f, c, 1); - if ot_assembly_ptr<>nil then begin - free_node(p,glyph_node_size); - p:=build_opentype_assembly(cur_f, ot_assembly_ptr, w, 1); - list_ptr(y):=p; - goto found; - end; - end else - set_native_glyph_metrics(p, 1); - end; -found: - width(y):=width(p); height(y):=height(p); depth(y):=depth(p); - if is_bottom_acc(q) then begin - if height(y)<0 then height(y):=0 - end else if depth(y)<0 then depth(y):=0; - -@ @= -@z - -@x -@= -begin if cur_style= -begin if is_new_mathfont(cur_f) then begin - if cur_style= -begin if cur_style= -begin if is_new_mathfont(cur_f) then begin - delta:=half(thickness(q)); - if cur_styleempty)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 - @; -make_op:=delta; -end; -@y -function make_op(@!q:pointer):scaled; -label found; -var delta:scaled; {offset between subscript and superscript} -@!p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction} -@!c:quarterword;@+@!i:four_quarters; {registers for character examination} -@!shift_up,@!shift_down:scaled; {dimensions for box calculation} -@!h1,@!h2:scaled; {height of original text-style symbol and possible replacement} -@!n,@!g:integer; {potential variant index and glyph code} -@!ot_assembly_ptr:void_pointer; -@!save_f:internal_font_number; -begin if (subtype(q)=normal)and(cur_style0 then begin - native_glyph(p):=g; - set_native_glyph_metrics(p, 1); - end; - incr(n); - until (h2<0) or (h2>=h1); - if (h2<0) then begin - {if we get here, then we didn't find a big enough glyph; check if the char is extensible} - ot_assembly_ptr:=get_ot_assembly_ptr(cur_f, c, 0); - if ot_assembly_ptr<>nil then begin - free_node(p,glyph_node_size); - p:=build_opentype_assembly(cur_f, ot_assembly_ptr, h1, 0); - list_ptr(x):=p; - delta:=0; - goto found; - end; - end else - set_native_glyph_metrics(p, 1); - end; - delta:=get_ot_math_ital_corr(cur_f, native_glyph(p)); -found: - width(x):=width(p); height(x):=height(p); depth(x):=depth(p); - end - end; - if (math_type(subscr(q))<>empty)and(subtype(q)<>limits) then - width(x):=width(x)-delta; {remove italic correction} - shift_amount(x):=half(height(x)-depth(x)) - axis_height(cur_size); - {center vertically} - math_type(nucleus(q)):=sub_box; info(nucleus(q)):=x; - end; -save_f:=cur_f; -if subtype(q)=limits then - @; -make_op:=delta; -end; -@z - -@x -@= -@y -@= -cur_f:=save_f; -@z - -@x - character(nucleus(r)):=rem_byte(cur_i); - fam(nucleus(r)):=fam(nucleus(q));@/ -@y - character(nucleus(r)):=rem_byte(cur_i); - plane_and_fam_field(nucleus(r)):=fam(nucleus(q));@/ -@z - -@x -@ @= -begin fetch(nucleus(q)); -if char_exists(cur_i) then -@y -@ @= -begin fetch(nucleus(q)); -if is_native_font(cur_f) then begin - z:=new_native_character(cur_f, qo(cur_c)); - p:=get_node(glyph_node_size); - type(p):=whatsit_node; subtype(p):=glyph_node; - native_font(p):=cur_f; native_glyph(p):=get_native_glyph(z, 0); - set_native_glyph_metrics(p, 1); - free_node(z, native_size(z)); - delta:=get_ot_math_ital_corr(cur_f, native_glyph(p)); - if (math_type(nucleus(q))=math_text_char)and(not is_new_mathfont(cur_f)<>0) then - delta:=0; {no italic correction in mid-word of text font} - if (math_type(subscr(q))=empty)and(delta<>0) then - begin link(p):=new_kern(delta); delta:=0; - end; -end else if char_exists(cur_i) then -@z - -@x -@ 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 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. - -@= -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 -else begin @; - if math_type(subscr(q))=empty then shift_amount(x):=-shift_up - else @; - 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. - -@= -begin x:=clean_box(subscr(q),sub_style(cur_style)); -width(x):=width(x)+script_space; -if shift_down= -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= -begin y:=clean_box(subscr(q),sub_style(cur_style)); -width(y):=width(y)+script_space; -if shift_down0 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 -@y -@ 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 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. - -@= -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:integer; {subsidiary size code} -@!save_f:internal_font_number; -begin p:=new_hlist(q); -if is_char_node(p) or (p<>null and is_glyph_node(p)) then - begin shift_up:=0; shift_down:=0; - end -else begin z:=hpack(p,natural); - if cur_style -else begin @; - if math_type(subscr(q))=empty then shift_amount(x):=-shift_up - else @; - 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. - -@= -begin -save_f:=cur_f; -x:=clean_box(subscr(q),sub_style(cur_style)); -cur_f:=save_f; -width(x):=width(x)+script_space; -if shift_down= -begin -save_f:=cur_f; -x:=clean_box(supscr(q),sup_style(cur_style)); -cur_f:=save_f; -width(x):=width(x)+script_space; -if odd(cur_style) then clr:=sup3(cur_size) -else if cur_style= -begin -save_f:=cur_f; -y:=clean_box(subscr(q),sub_style(cur_style)); -cur_f:=save_f; -width(y):=width(y)+script_space; -if shift_down0 then - begin shift_down:=shift_down+clr; - if is_new_mathfont(cur_f) then - clr:=get_ot_math_constant(cur_f, superscriptBottomMaxWithSubscript)-(shift_up-depth(x)) - else - clr:=(abs(math_x_height(cur_size)*4) div 5)-(shift_up-depth(x)); - if clr>0 then - begin shift_up:=shift_up+clr; - shift_down:=shift_down-clr; - end; - end; -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 -@z - -@x -magic_offset:=str_start[math_spacing]-9*ord_noad -@y -magic_offset:=str_start_macro(math_spacing)-9*ord_noad -@z - -@x -@* \[37] Alignment. -@y -@* \[37] Alignment. -@z - -@x -@d span_code=256 {distinct from any character} -@d cr_code=257 {distinct from |span_code| and from any character} -@y -@d span_code=special_char {distinct from any character} -@d cr_code=span_code+1 {distinct from |span_code| and from any character} -@z - -@x -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@> -@y -if n>max_quarterword then confusion("too many spans"); - {this can happen, but won't} -@^system dependencies@> -@:this can't happen too many spans}{\quad too many spans@> -@z - -@x -@* \[38] Breaking paragraphs into lines. -@y -@* \[38] Breaking paragraphs into lines. -@z - -@x -label done,done1,done2,done3,done4,done5,continue; -@y -label done,done1,done2,done3,done4,done5,done6,continue, restart; -@z - -@x - ligature_node: begin f:=font(lig_char(v));@/ -@y - ligature_node: begin f:=font(lig_char(v));@/ - xtx_ligature_present:=true; -@z - -@x - othercases confusion("disc1") -@y - whatsit_node: - if (subtype(v)=native_word_node) - or (subtype(v)=glyph_node) - or (subtype(v)=pic_node) - or (subtype(v)=pdf_node) - then break_width[1]:=break_width[1]-width(v) - else confusion("disc1a"); - othercases confusion("disc1") -@z - -@x - ligature_node: begin f:=font(lig_char(s)); -@y - ligature_node: begin f:=font(lig_char(s)); - xtx_ligature_present:=true; -@z - -@x - othercases confusion("disc2") -@y - whatsit_node: - if (subtype(s)=native_word_node) - or (subtype(s)=glyph_node) - or (subtype(s)=pic_node) - or (subtype(s)=pdf_node) - then break_width[1]:=break_width[1]+width(s) - else confusion("disc2a"); - othercases confusion("disc2") -@z - -@x -@* \[39] Breaking paragraphs into lines, continued. -@y -@* \[39] Breaking paragraphs into lines, continued. -@z - -@x -ligature_node: begin f:=font(lig_char(cur_p)); -@y -ligature_node: begin f:=font(lig_char(cur_p)); - xtx_ligature_present:=true; -@z - -@x - ligature_node: begin f:=font(lig_char(s)); -@y - ligature_node: begin f:=font(lig_char(s)); - xtx_ligature_present:=true; -@z - -@x - othercases confusion("disc3") -@y - whatsit_node: - if (subtype(s)=native_word_node) - or (subtype(s)=glyph_node) - or (subtype(s)=pic_node) - or (subtype(s)=pdf_node) - then disc_width:=disc_width+width(s) - else confusion("disc3a"); - othercases confusion("disc3") -@z - -@x - ligature_node: begin f:=font(lig_char(s)); -@y - ligature_node: begin f:=font(lig_char(s)); - xtx_ligature_present:=true; -@z - -@x - othercases confusion("disc4") -@y - whatsit_node: - if (subtype(s)=native_word_node) - or (subtype(s)=glyph_node) - or (subtype(s)=pic_node) - or (subtype(s)=pdf_node) - then act_width:=act_width+width(s) - else confusion("disc4a"); - othercases confusion("disc4") -@z - -@x -@* \[40] Pre-hyphenation. -@y -@* \[40] Pre-hyphenation. -@z - -@x -@!hc:array[0..65] of 0..256; {word to be hyphenated} -@y -@!hc:array[0..66] of 0..number_usvs; {word to be hyphenated} -{ note that element 0 needs to be a full UnicodeScalar, even though we - basically work in utf16 } -@z - -@x -@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase} -@y -@!hu:array[0..64] of 0..too_big_char; - {like |hc|, before conversion to lowercase} -@z - -@x -@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest} -@y -@!cur_lang,@!init_cur_lang:0..biggest_lang; - {current hyphenation table of interest} -@z - -@x -@!hyf_bchar:halfword; {boundary character after $c_n$} -@y -@!hyf_bchar:halfword; {boundary character after $c_n$} -@!max_hyph_char:integer; - -@ @= -max_hyph_char:=too_big_lang; -@z - -@x -@!c:0..255; {character being considered for hyphenation} -@y -@!c:UnicodeScalar; {character being considered for hyphenation} -@z - -@x - @; -@y -if is_native_word_node(ha) then begin - @; - @; -end else begin - @; -end; -@z - -@x -@ The first thing we need to do is find the node |ha| just before the -first letter. -@y -@ @= -s := link(ha); -loop@+ begin if not(is_char_node(s)) then - case type(s) of - ligature_node: do_nothing; - kern_node: if subtype(s)<>normal then goto done6; - whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node: - goto done6; - othercases goto done1 - endcases; - s:=link(s); - end; -done6: - -@ @= -{ note that if there are chars with |lccode = 0|, we split them out into separate |native_word| nodes } -hn := 0; -restart: -for l := 0 to native_length(ha)-1 do begin - c := get_native_usv(ha, l); - set_lc_code(c); - if (hc[0] = 0) then begin - if (hn > 0) then begin - { we've got some letters, and now found a non-letter, so break off the tail of the |native_word| - and link it after this node, and goto done3 } - @; - goto done3; - end - end else if (hn = 0) and (l > 0) then begin - { we've found the first letter after some non-letters, so break off the head of the |native_word| and restart } - @; - ha := link(ha); - goto restart; - end else if (hn = 63) then - { reached max hyphenatable length } - goto done3 - else begin - { found a letter that is part of a potentially hyphenatable sequence } - incr(hn); - if c<@"10000 then begin - hu[hn] := c; hc[hn] := hc[0]; - end - else begin - hu[hn] := (c - @"10000) div @"400 + @"D800; - hc[hn] := (hc[0] - @"10000) div @"400 + @"D800; - incr(hn); - hu[hn] := c mod @"400 + @"DC00; - hc[hn] := hc[0] mod @"400 + @"DC00; - incr(l); - end; - hyf_bchar := non_char; - end -end; - -@ @= - q := new_native_word_node(hf, native_length(ha) - l); - for i := l to native_length(ha) - 1 do - set_native_char(q, i - l, get_native_char(ha, i)); - set_native_metrics(q, XeTeX_use_glyph_metrics); - link(q) := link(ha); - link(ha) := q; - { truncate text in node |ha| } - native_length(ha) := l; - set_native_metrics(ha, XeTeX_use_glyph_metrics); - -@ @= -l: integer; -i: integer; - -@ The first thing we need to do is find the node |ha| just before the -first letter. -@z - -@x - begin @; - goto continue; -@y - begin - if subtype(s) = native_word_node then begin - { we only consider the node if it contains at least one letter, otherwise we'll skip it } - for l:=0 to native_length(s) - 1 do begin - c := get_native_usv(s, l); - if lc_code(c) <> 0 then begin - hf := native_font(s); - prev_s := s; - goto done2; - end; - if c>=@"10000 then incr(l); - end - end; - @; - goto continue -@z - -@x -if hyf_char>255 then goto done1; -@y -if hyf_char>biggest_char then goto done1; -@z - -@x - if hc[0]=0 then goto done3; -@y - if hc[0]=0 then goto done3; - if hc[0]>max_hyph_char then goto done3; -@z - -@x - if hc[0]=0 then goto done3; -@y - if hc[0]=0 then goto done3; - if hc[0]>max_hyph_char then goto done3; -@z - -@x -@* \[41] Post-hyphenation. -@y -@* \[41] Post-hyphenation. -@z - -@x -@= -@y -@= -if is_native_word_node(ha) then begin - @; -end else begin -@z - -@x - begin hu[0]:=256; init_lig:=false; -@y - begin hu[0]:=max_hyph_char; init_lig:=false; -@z - -@x -found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null; -@y -found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null; -@z - -@x -flush_list(init_list) -@y -flush_list(init_list); -end - -@ @= -{ find the node immediately before the word to be hyphenated } -s := cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|} -while link(s) <> ha do s := link(s); - -{ for each hyphen position, - create a |native_word_node| fragment for the text before this point, - and a |disc_node| for the break, with the |hyf_char| in the |pre_break| text -} - -hyphen_passed := 0; { location of last hyphen we saw } - -for j := l_hyf to hn - r_hyf do begin - { if this is a valid break.... } - if odd(hyf[j]) then begin - - { make a |native_word_node| for the fragment before the hyphen } - q := new_native_word_node(hf, j - hyphen_passed); - for i := 0 to j - hyphen_passed - 1 do - set_native_char(q, i, get_native_char(ha, i + hyphen_passed)); - set_native_metrics(q, XeTeX_use_glyph_metrics); - link(s) := q; { append the new node } - s := q; - - { make the |disc_node| for the hyphenation point } - q := new_disc; - pre_break(q) := new_native_character(hf, hyf_char); - link(s) := q; - s := q; - - hyphen_passed := j; - end -end; - -{ make a |native_word_node| for the last fragment of the word } -hn := native_length(ha); { ensure trailing punctuation is not lost! } -q := new_native_word_node(hf, hn - hyphen_passed); -for i := 0 to hn - hyphen_passed - 1 do - set_native_char(q, i, get_native_char(ha, i + hyphen_passed)); -set_native_metrics(q, XeTeX_use_glyph_metrics); -link(s) := q; { append the new node } -s := q; - -q := link(ha); -link(s) := q; -link(ha) := null; -flush_node_list(ha); -@z - -@x -@!c:ASCII_code; {character temporarily replaced by a hyphen} -@y -@!c:UnicodeScalar; {character temporarily replaced by a hyphen} -@z - -@x - begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256; -@y - begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char; -@z - -@x -@* \[42] Hyphenation. -@y -@* \[42] Hyphenation. -@z - -@x -@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language} -@y -@!op_start:array[0..biggest_lang] of 0..trie_op_size; {offset for current language} -@z - -@x -hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters} -@y -hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters} -@z - -@x - begin j:=1; u:=str_start[k]; -@y - begin j:=1; u:=str_start_macro(k); -@z - -@x - else if language>255 then cur_lang:=0 -@y - else if language>biggest_lang then cur_lang:=0 -@z - -@x - else if n<63 then - begin incr(n); hc[n]:=hc[0]; - end; -@y - else if n<63 then - begin incr(n); - if hc[0]<@"10000 then hc[n]:=hc[0] - else begin - hc[n] := (hc[0] - @"10000) div @"400 + @"D800; - incr(n); - hc[n] := hc[0] mod @"400 + @"DC00; - end; - end; -@z - -@x -u:=str_start[k]; v:=str_start[s]; -@y -u:=str_start_macro(k); v:=str_start_macro(s); -@z - -@x -until u=str_start[k+1]; -@y -until u=str_start_macro(k+1); -@z - -@x -@* \[43] Initializing the hyphenation tables. -@y -@* \[43] Initializing the hyphenation tables. -@z - -@x -@!trie_used:array[ASCII_code] of trie_opcode; -@y -@!trie_used:array[0..biggest_lang] of trie_opcode; -@z - -@x -@!trie_op_lang:array[1..trie_op_size] of ASCII_code; -@y -@!trie_op_lang:array[1..trie_op_size] of 0..biggest_lang; -@z - -@x -for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]); -@y -for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]); -@z - -@x -for k:=0 to 255 do trie_used[k]:=min_trie_op; -@y -for k:=0 to biggest_lang do trie_used[k]:=min_trie_op; -@z - -@x -for p:=0 to 255 do trie_min[p]:=p+1; -@y -for p:=0 to biggest_char do trie_min[p]:=p+1; -@z - -@x -@!ll:1..256; {upper limit of |trie_min| updating} -@y -@!ll:1..too_big_char; {upper limit of |trie_min| updating} -@z - -@x - @=h+256|@>; -@y - @=h+max_hyph_char|@>; -@z - -@x -@ By making sure that |trie_max| is at least |h+256|, we can be sure that -@y -@ By making sure that |trie_max| is at least |h+max_hyph_char|, -we can be sure that -@z - -@x -@=h+256|@>= -if trie_max=h+max_hyph_char|@>= -if trie_maxmax_hyph_char then max_hyph_char:=cur_chr; - if k<63 then -@z - -@x -begin @; -@y -begin -incr(max_hyph_char); -@; -@z - -@x -@* \[44] Breaking vertical lists into pages. -@y -@* \[44] Breaking vertical lists into pages. -@z - -@x -@* \[45] The page builder. -@y -@* \[45] The page builder. -@z - -@x -@!n:min_quarterword..255; {insertion box number} -@y -@!n:min_quarterword..biggest_reg; {insertion box number} -@z - -@x -@!n:min_quarterword..255; {insertion box number} -@y -@!n:min_quarterword..biggest_reg; {insertion box number} -@z - -@x -@* \[46] The chief executive. -@y -@* \[46] The chief executive. -@z - -@x -@d main_loop=70 {go here to typeset a string of consecutive characters} -@y -@d main_loop=70 {go here to typeset a string of consecutive characters} -@d collect_native=71 {go here to collect characters in a "native" font string} -@d collected=72 -@z - -@x - append_normal_space,exit; -@y - collect_native,collected, - append_normal_space,exit; -@z - -@x -hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end; -@y -hmode+char_num: begin scan_usv_num; cur_chr:=cur_val; goto main_loop;@+end; -@z - -@x -hmode+spacer: if space_factor=1000 then goto append_normal_space - else app_space; -hmode+ex_space,mmode+ex_space: goto append_normal_space; -@t\4@>@@; -end; {of the big |case| statement} -@y -othercases begin - if abs(mode)=hmode then check_for_post_char_toks(big_switch); - case abs(mode)+cur_cmd of - hmode+spacer: if space_factor=1000 then goto append_normal_space - else app_space; - hmode+ex_space,mmode+ex_space: goto append_normal_space; - @t\4@>@ - end - end -endcases; {of the big |case| statement} -@z - -@x -append_normal_space:@@;@/ - main_s:=sf_code(cur_chr); -@y -@d adjust_space_factor==@t@>@;@/ - main_s:=sf_code(cur_chr) mod @"10000; -@z - -@x -@= -if ((head=tail) and (mode>0)) then begin - if (insert_src_special_auto) then append_src_special; -end; -adjust_space_factor;@/ -@y -@d check_for_inter_char_toks(#)=={check for a spacing token list, goto |#| if found, - or |big_switch| in case of the initial letter of a run} - cur_ptr:=null; - space_class:=sf_code(cur_chr) div @"10000; - - if XeTeX_inter_char_tokens_en and space_class <> 256 then begin {class 256 = ignored (for combining marks etc)} - if prev_class = 255 then begin {boundary} - if (state<>token_list) or (token_type<>backed_up_char) then begin - find_sa_element(inter_char_val, 255*@"100 + space_class, false); - if cur_ptr<>null then begin - if cur_cmd<>letter then cur_cmd:=other_char; - cur_tok:=(cur_cmd*max_char_val)+cur_chr; - back_input; token_type:=backed_up_char; - begin_token_list(sa_ptr(cur_ptr), inter_char_text); - goto big_switch; - end - end - end else begin - find_sa_element(inter_char_val, prev_class*@"100 + space_class, false); - if cur_ptr<>null then begin - if cur_cmd<>letter then cur_cmd:=other_char; - cur_tok:=(cur_cmd*max_char_val)+cur_chr; - back_input; token_type:=backed_up_char; - begin_token_list(sa_ptr(cur_ptr), inter_char_text); - prev_class:=255; - goto #; - end; - end; - prev_class:=space_class; - end - -@d check_for_post_char_toks(#)== - if XeTeX_inter_char_tokens_en and (space_class<>256) and (prev_class<>255) then begin - prev_class:=255; - find_sa_element(inter_char_val, space_class*@"100 + 255, false); {boundary} - if cur_ptr<>null then begin - if cur_cs=0 then begin - if cur_cmd=char_num then cur_cmd:=other_char; - cur_tok:=(cur_cmd*max_char_val)+cur_chr; - end else cur_tok:=cs_token_flag+cur_cs; - back_input; - begin_token_list(sa_ptr(cur_ptr), inter_char_text); - goto #; - end; - end - -@= -if ((head=tail) and (mode>0)) then begin - if (insert_src_special_auto) then append_src_special; -end; - -prev_class := 255; {boundary} - -{ added code for native font support } -if is_native_font(cur_font) then begin - if mode>0 then if language<>clang then fix_language; - - main_h := 0; - main_f := cur_font; - native_len := 0; - -collect_native: - adjust_space_factor; - - check_for_inter_char_toks(collected); - - if (cur_chr > @"FFFF) then begin - native_room(2); - append_native((cur_chr - @"10000) div 1024 + @"D800); - append_native((cur_chr - @"10000) mod 1024 + @"DC00); - end else begin - native_room(1); - append_native(cur_chr); - end; - is_hyph := (cur_chr = hyphen_char[main_f]) - or (XeTeX_dash_break_en and ((cur_chr = @"2014) or (cur_chr = @"2013))); - if (main_h = 0) and is_hyph then main_h := native_len; - - {try to collect as many chars as possible in the same font} - get_next; - if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native; - x_token; - if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native; - if cur_cmd=char_num then begin - scan_usv_num; - cur_chr:=cur_val; - goto collect_native; - end; - - check_for_post_char_toks(collected); - -collected: - if (font_mapping[main_f] <> 0) then begin - main_k := apply_mapping(font_mapping[main_f], native_text, native_len); - native_len := 0; - native_room(main_k); - main_h := 0; - for main_p := 0 to main_k - 1 do begin - append_native(mapped_text[main_p]); - if (main_h = 0) and ((mapped_text[main_p] = hyphen_char[main_f]) - or (XeTeX_dash_break_en and ((mapped_text[main_p] = @"2014) or (mapped_text[main_p] = @"2013)) ) ) - then main_h := native_len; - end - end; - - if tracing_lost_chars > 0 then begin - temp_ptr := 0; - while (temp_ptr < native_len) do begin - main_k := native_text[temp_ptr]; - incr(temp_ptr); - if (main_k >= @"D800) and (main_k < @"DC00) then begin - main_k := @"10000 + (main_k - @"D800) * 1024; - main_k := main_k + native_text[temp_ptr] - @"DC00; - incr(temp_ptr); - end; - if map_char_to_glyph(main_f, main_k) = 0 then - char_warning(main_f, main_k); - end - end; - - main_k := native_len; - main_pp := tail; - - if mode=hmode then begin - - main_ppp := head; - if main_ppp<>main_pp then { find node preceding tail, skipping discretionaries } - while (link(main_ppp)<>main_pp) do begin - if (not is_char_node(main_ppp)) and (type(main_ppp=disc_node)) then begin - temp_ptr:=main_ppp; - for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp); - end; - if main_ppp<>main_pp then main_ppp:=link(main_ppp); - end; - - temp_ptr := 0; - repeat - if main_h = 0 then main_h := main_k; - - if is_native_word_node(main_pp) - and (native_font(main_pp)=main_f) - and (main_ppp<>main_pp) - and (not is_char_node(main_ppp)) - and (type(main_ppp)<>disc_node) - then begin - - { make a new temp string that contains the concatenated text of |tail| + the current word/fragment } - main_k := main_h + native_length(main_pp); - native_room(main_k); - - save_native_len := native_len; - for main_p := 0 to native_length(main_pp) - 1 do - append_native(get_native_char(main_pp, main_p)); - for main_p := 0 to main_h - 1 do - append_native(native_text[temp_ptr + main_p]); - - do_locale_linebreaks(save_native_len, main_k); - - native_len := save_native_len; { discard the temp string } - main_k := native_len - main_h - temp_ptr; { and set |main_k| to remaining length of new word } - temp_ptr := main_h; { pointer to remaining fragment } - - main_h := 0; - while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f]) - and ( (not XeTeX_dash_break_en) - or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) ) - do incr(main_h); { look for next hyphen or end of text } - if (main_h < main_k) then incr(main_h); - - { remove the preceding node from the list } - link(main_ppp) := link(main_pp); - link(main_pp) := null; - flush_node_list(main_pp); - main_pp := tail; - while (link(main_ppp)<>main_pp) do - main_ppp:=link(main_ppp); - - end else begin - - do_locale_linebreaks(temp_ptr, main_h); { append fragment of current word } - - temp_ptr := temp_ptr + main_h; { advance ptr to remaining fragment } - main_k := main_k - main_h; { decrement remaining length } - - main_h := 0; - while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f]) - and ( (not XeTeX_dash_break_en) - or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) ) - do incr(main_h); { look for next hyphen or end of text } - if (main_h < main_k) then incr(main_h); - - end; - - if (main_k > 0) or is_hyph then begin - tail_append(new_disc); { add a break if we aren't at end of text (must be a hyphen), - or if last char in original text was a hyphen } - main_pp:=tail; - end; - until main_k = 0; - - end else begin - { must be restricted hmode, so no need for line-breaking or discretionaries } - { but there might already be explicit |disc_node|s in the list } - main_ppp := head; - if main_ppp<>main_pp then { find node preceding tail, skipping discretionaries } - while (link(main_ppp)<>main_pp) do begin - if (not is_char_node(main_ppp)) and (type(main_ppp=disc_node)) then begin - temp_ptr:=main_ppp; - for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp); - end; - if main_ppp<>main_pp then main_ppp:=link(main_ppp); - end; - if is_native_word_node(main_pp) - and (native_font(main_pp)=main_f) - and (main_ppp<>main_pp) - and (not is_char_node(main_ppp)) - and (type(main_ppp)<>disc_node) - then begin - { total string length for the new merged whatsit } - link(main_pp) := new_native_word_node(main_f, main_k + native_length(main_pp)); - tail := link(main_pp); - - { copy text from the old one into the new } - for main_p := 0 to native_length(main_pp) - 1 do - set_native_char(tail, main_p, get_native_char(main_pp, main_p)); - { append the new text } - for main_p := 0 to main_k - 1 do - set_native_char(tail, main_p + native_length(main_pp), native_text[main_p]); - set_native_metrics(tail, XeTeX_use_glyph_metrics); - - { remove the preceding node from the list } - main_p := head; - if main_p<>main_pp then - while link(main_p)<>main_pp do - main_p := link(main_p); - link(main_p) := link(main_pp); - link(main_pp) := null; - flush_node_list(main_pp); - end else begin - { package the current string into a |native_word| whatsit } - link(main_pp) := new_native_word_node(main_f, main_k); - tail := link(main_pp); - for main_p := 0 to main_k - 1 do - set_native_char(tail, main_p, native_text[main_p]); - set_native_metrics(tail, XeTeX_use_glyph_metrics); - end - end; - - if cur_ptr<>null then goto big_switch - else goto reswitch; -end; -{ End of added code for native fonts } - -adjust_space_factor;@/ -check_for_inter_char_toks(big_switch); -@z - -@x -main_loop_lookahead+1: adjust_space_factor; -@y -main_loop_lookahead+1: adjust_space_factor; -check_for_inter_char_toks(big_switch); -@z - -@x -non_math(math_given), non_math(math_comp), non_math(delim_num), -@y -non_math(math_given), non_math(XeTeX_math_given), non_math(math_comp), non_math(delim_num), -@z - -@x -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 @; - end; -pop_nest; box_end(saved(0)); -@y -@!u,v:integer; {saved values for upwards mode flag} -begin d:=box_max_depth; u:=XeTeX_upwards_state; unsave; save_ptr:=save_ptr-3; -v:=XeTeX_upwards_state; XeTeX_upwards_state:=u; -if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1)) -else begin cur_box:=vpackage(link(head),saved(2),saved(1),d); - if c=vtop_code then @; - end; -XeTeX_upwards_state:=v; -pop_nest; box_end(saved(0)); -@z - -@x -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; -@y -procedure append_italic_correction; -label exit; -var p:pointer; {|char_node| at the tail of the current list} -@!f:internal_font_number; {the font in the |char_node|} -begin if tail<>head then - begin if is_char_node(tail) then p:=tail - else if type(tail)=ligature_node then p:=lig_char(tail) - else if (type(tail)=whatsit_node) then begin - if (subtype(tail)=native_word_node) then begin - tail_append(new_kern(get_native_italic_correction(tail))); subtype(tail):=explicit; - end - else if (subtype(tail)=glyph_node) then begin - tail_append(new_kern(get_native_glyph_italic_correction(tail))); subtype(tail):=explicit; - end; - return; - end - else return; -@z - -@x - if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c); -@y - if c>=0 then if c<=biggest_char then pre_break(tail):=new_character(cur_font,c); -@z - -@x - if type(p)<>kern_node then if type(p)<>ligature_node then - begin print_err("Improper discretionary list"); -@y - if type(p)<>kern_node then if type(p)<>ligature_node then - if (type(p)<>whatsit_node) or ((subtype(p)<>native_word_node) - and (subtype(p)<>glyph_node)) then - begin print_err("Improper discretionary list"); -@z - -@x -@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above} -@y -@!a,@!h,@!x,@!w,@!delta,@!lsb,@!rsb:scaled; {heights and widths, as explained above} -@z - -@x - a:=char_width(f)(char_info(f)(character(p)));@/ -@y - if is_native_font(f) then - begin a:=width(p); - if a=0 then get_native_char_sidebearings(f, cur_val, addressof(lsb), addressof(rsb)) - end - else a:=char_width(f)(char_info(f)(character(p)));@/ -@z - -@x -if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then - q:=new_character(f,cur_chr) -@y -if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then - begin q:=new_character(f,cur_chr); cur_val:=cur_chr - end -@z - -@x -i:=char_info(f)(character(q)); -w:=char_width(f)(i); h:=char_height(f)(height_depth(i)); -@y -if is_native_font(f) then begin - w:=width(q); - get_native_char_height_depth(f, cur_val, addressof(h), addressof(delta)) - {using delta as scratch space for the unneeded depth value} -end else begin - i:=char_info(f)(character(q)); - w:=char_width(f)(i); h:=char_height(f)(height_depth(i)) -end; -@z - -@x -delta:=round((w-a)/float_constant(2)+h*t-x*s); -@y -if is_native_font(f) and (a=0) then { special case for non-spacing marks } - delta:=round((w-lsb+rsb)/float_constant(2)+h*t-x*s) -else delta:=round((w-a)/float_constant(2)+h*t-x*s); -@z - -@x -procedure cs_error; -begin -if cur_chr = 10 then -begin - print_err("Extra "); print_esc("endmubyte"); -@.Extra \\endmubyte@> - help1("I'm ignoring this, since I wasn't doing a \mubyte."); -end else begin - print_err("Extra "); print_esc("endcsname"); -@.Extra \\endcsname@> - help1("I'm ignoring this, since I wasn't doing a \csname."); -end; -error; -end; -@y -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; -@z - -@x -whatsit_node: @; -@y -whatsit_node: @; -@z - -@x -@d fam_in_range==((cur_fam>=0)and(cur_fam<16)) -@y -@d fam_in_range==((cur_fam>=0)and(cur_fam } - scan_math_class_int; c := set_class_field(cur_val); - scan_math_fam_int; c := c + set_family_field(cur_val); - scan_usv_num; c := c + cur_val; - end else begin {delimiter <27-bit delcode>} - scan_delimiter_int; - c := cur_val div @'10000; {get the 'small' delimiter field} - c := set_class_field(c div @"1000) + - set_family_field((c mod @"1000) div @"100) + - (c mod @"100); {and convert it to a xetex mathchar code} - end; -@z - -@x -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; -@y -math_type(p):=math_char; character(p):=qi(c mod @"10000); -if (is_var_family(c)) and fam_in_range then plane_and_fam_field(p):=cur_fam -else plane_and_fam_field(p):=(math_fam_field(c)); -plane_and_fam_field(p) := plane_and_fam_field(p) + (math_char_field(c) div @"10000) * @"100; -@z - -@x -mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val); - end; -@y -mmode+math_char_num: if cur_chr = 2 then begin { XeTeXmathchar } - scan_math_class_int; t := set_class_field(cur_val); - scan_math_fam_int; t := t + set_family_field(cur_val); - scan_usv_num; t := t + cur_val; - set_math_char(t); - end else if cur_chr = 1 then begin { XeTeXmathcharnum } - scan_xetex_math_char_int; set_math_char(cur_val); - end else begin scan_fifteen_bit_int; - set_math_char(set_class_field(cur_val div @"1000) + - set_family_field((cur_val mod @"1000) div @"100) + - (cur_val mod @"100)); - end; -@z - -@x -mmode+math_given: set_math_char(cur_chr); -mmode+delim_num: begin scan_twenty_seven_bit_int; - set_math_char(cur_val div @'10000); -@y -mmode+math_given: begin - set_math_char(set_class_field(cur_chr div @"1000) + - set_family_field((cur_chr mod @"1000) div @"100) + - (cur_chr mod @"100)); - end; -mmode+XeTeX_math_given: set_math_char(cur_chr); -mmode+delim_num: begin - if cur_chr=1 then begin {XeTeXdelimiter} - scan_math_class_int; t := set_class_field(cur_val); - scan_math_fam_int; t := t + set_family_field(cur_val); - scan_usv_num; t := t + cur_val; - set_math_char(t); - end else begin - scan_delimiter_int; - cur_val:=cur_val div @'10000; {discard the large delimiter code} - set_math_char(set_class_field(cur_val div @"1000) + - set_family_field((cur_val mod @"1000) div @"100) + - (cur_val mod @"100)); - end; -@z - -@x -procedure set_math_char(@!c:integer); -var p:pointer; {the new noad} -begin if c>=@'100000 then - @ -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); -@y -procedure set_math_char(@!c:integer); -var p,q,r:pointer; {the new noad} - ch: UnicodeScalar; -begin if is_active_math_char(c) then - @ -else begin p:=new_noad; math_type(nucleus(p)):=math_char; - ch:=math_char_field(c); - character(nucleus(p)):=qi(ch mod @"10000); - plane_and_fam_field(nucleus(p)):=math_fam_field(c); - if is_var_family(c) then - begin if fam_in_range then plane_and_fam_field(nucleus(p)):=cur_fam; - type(p):=ord_noad; - end - else type(p):=ord_noad+math_class_field(c); - plane_and_fam_field(nucleus(p)) := plane_and_fam_field(nucleus(p)) + (ch div @"10000) * @"100; -@z - -@x -procedure scan_delimiter(@!p:pointer;@!r:boolean); -begin if r then scan_twenty_seven_bit_int -@y -procedure scan_delimiter(@!p:pointer;@!r:boolean); -begin - if r then begin - if cur_chr=1 then begin {XeTeXradical} - cur_val1 := @"40000000; {extended delcode flag} - scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000; - scan_usv_num; cur_val := cur_val1 + cur_val; - end else {radical} - scan_delimiter_int; - end -@z - -@x - letter,other_char: cur_val:=del_code(cur_chr); - delim_num: scan_twenty_seven_bit_int; - othercases cur_val:=-1 -@y - letter,other_char: begin - cur_val:=del_code(cur_chr); - end; - delim_num: if cur_chr=1 then begin {XeTeXdelimiter} - cur_val1 := @"40000000; {extended delcode flag} - scan_math_class_int; {discarded} - scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000; - scan_usv_num; cur_val := cur_val1 + cur_val; - end else scan_delimiter_int; {normal delimiter} - othercases begin cur_val:=-1; end; -@z - -@x -if cur_val<0 then @; -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); -@y -if cur_val<0 then begin @; - end; -if cur_val>=@"40000000 then begin {extended delcode, only one size} - small_plane_and_fam_field(p) := ((cur_val mod @"200000) div @"10000) * @"100 {plane} - + (cur_val div @"200000) mod @"100; {family} - small_char_field(p) := qi(cur_val mod @"10000); - large_plane_and_fam_field(p) := 0; - large_char_field(p) := 0; -end else begin {standard delcode, 4-bit families and 8-bit char codes} - small_plane_and_fam_field(p) := (cur_val div @'4000000) mod 16; - small_char_field(p) := qi((cur_val div @'10000) mod 256); - large_plane_and_fam_field(p) := (cur_val div 256) mod 16; - large_char_field(p) := qi(cur_val mod 256); -end; -@z - -@x -procedure math_ac; -@y -procedure math_ac; -var c: integer; -@z - -@x -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; -@y -if cur_chr=1 then begin - if scan_keyword("fixed") then - subtype(tail):=fixed_acc - else if scan_keyword("bottom") then begin - if scan_keyword("fixed") then - subtype(tail):=bottom_acc+fixed_acc - else - subtype(tail):=bottom_acc; - end; - scan_math_class_int; c := set_class_field(cur_val); - scan_math_fam_int; c := c + set_family_field(cur_val); - scan_usv_num; cur_val := cur_val + c; -end -else begin - scan_fifteen_bit_int; - cur_val := set_class_field(cur_val div @"1000) + - set_family_field((cur_val mod @"1000) div @"100) + - (cur_val mod @"100); -end; -character(accent_chr(tail)):=qi(cur_val mod @"10000); -if (is_var_family(cur_val))and fam_in_range then plane_and_fam_field(accent_chr(tail)):=cur_fam -else plane_and_fam_field(accent_chr(tail)):=math_fam_field(cur_val); -plane_and_fam_field(accent_chr(tail)) - := plane_and_fam_field(accent_chr(tail)) + (math_char_field(cur_val) div @"10000) * @"100; -@z - -@x -@ @= -if (font_params[fam_fnt(2+text_size)]= -if ((font_params[fam_fnt(2+text_size)] -@y -primitive("mathchardef",shorthand_def,math_char_def_code);@/ -primitive("XeTeXmathcharnumdef",shorthand_def,XeTeX_math_char_num_def_code);@/ -primitive("XeTeXmathchardef",shorthand_def,XeTeX_math_char_def_code);@/ -@!@:math_char_def_}{\.{\\mathchardef} primitive@> -@z - -@x - math_char_def_code: print_esc("mathchardef"); -@y - math_char_def_code: print_esc("mathchardef"); - XeTeX_math_char_def_code: print_esc("XeTeXmathchardef"); - XeTeX_math_char_num_def_code: print_esc("XeTeXmathcharnumdef"); -@z - -@x -math_given: begin print_esc("mathchar"); print_hex(chr_code); - end; -@y -math_given: begin print_esc("mathchar"); print_hex(chr_code); - end; -XeTeX_math_given: begin print_esc("XeTeXmathchar"); print_hex(chr_code); - end; -@z - -@x -else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256); -@y -else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,too_big_usv); -@z - -@x - char_def_code: begin scan_char_num; define(p,char_given,cur_val); -@y - char_def_code: begin scan_usv_num; define(p,char_given,cur_val); -@z - -@x - math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val); - end; -@y - math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val); - end; - XeTeX_math_char_num_def_code: begin scan_xetex_math_char_int; - define(p, XeTeX_math_given, cur_val); - end; - XeTeX_math_char_def_code: begin - scan_math_class_int; n := set_class_field(cur_val); - scan_math_fam_int; n := n + set_family_field(cur_val); - scan_usv_num; n := n + cur_val; - define(p, XeTeX_math_given, n); - end; -@z - -@x - else e:=true; -@y - else e:=true - else if cur_chr=XeTeX_inter_char_loc then begin - scan_eight_bit_int; cur_ptr:=cur_val; - scan_eight_bit_int; - find_sa_element(inter_char_val, cur_ptr*@"100 + cur_val, true); - cur_chr:=cur_ptr; e:=true; - end; -@z - -@x - else q:=equiv(cur_chr); -@y - else if cur_chr=XeTeX_inter_char_loc then begin - scan_eight_bit_int; cur_ptr:=cur_val; - scan_eight_bit_int; - find_sa_element(inter_char_val, cur_ptr*@"100 + cur_val, false); - if cur_ptr=null then q:=null - else q:=sa_ptr(cur_ptr); - end else q:=equiv(cur_chr); -@z - -@x -primitive("mathcode",def_code,math_code_base); -@y -primitive("mathcode",def_code,math_code_base); -primitive("XeTeXmathcodenum",XeTeX_def_code,math_code_base); -primitive("XeTeXmathcode",XeTeX_def_code,math_code_base+1); -@z - -@x -primitive("sfcode",def_code,sf_code_base); -@!@:sf_code_}{\.{\\sfcode} primitive@> -primitive("delcode",def_code,del_code_base); -@y -primitive("sfcode",def_code,sf_code_base); -@!@:sf_code_}{\.{\\sfcode} primitive@> -primitive("XeTeXcharclass",XeTeX_def_code,sf_code_base); -primitive("delcode",def_code,del_code_base); -primitive("XeTeXdelcodenum",XeTeX_def_code,del_code_base); -primitive("XeTeXdelcode",XeTeX_def_code,del_code_base+1); -@z - -@x -def_family: print_size(chr_code-math_font_base); -@y -XeTeX_def_code: - if chr_code=sf_code_base then print_esc("XeTeXcharclass") - else if chr_code=math_code_base then print_esc("XeTeXmathcodenum") - else if chr_code=math_code_base+1 then print_esc("XeTeXmathcode") - else if chr_code=del_code_base then print_esc("XeTeXdelcodenum") - else print_esc("XeTeXdelcode"); -def_family: print_size(chr_code-math_font_base); -@z - -@x -def_code: begin @; - p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals; -@y -XeTeX_def_code: begin - if cur_chr = sf_code_base then begin - p:=cur_chr; scan_usv_num; - p:=p+cur_val; - n:=sf_code(cur_val) mod @"10000; - scan_optional_equals; - scan_char_class; - define(p,data,cur_val*@"10000 + n); - end - else if cur_chr = math_code_base then begin - p:=cur_chr; scan_usv_num; - p:=p+cur_val; - scan_optional_equals; - scan_xetex_math_char_int; - define(p,data,hi(cur_val)); - end - else if cur_chr = math_code_base+1 then begin - p:=cur_chr-1; scan_usv_num; - p:=p+cur_val; - scan_optional_equals; - scan_math_class_int; n := set_class_field(cur_val); - scan_math_fam_int; n := n + set_family_field(cur_val); - scan_usv_num; n := n + cur_val; - define(p,data,hi(n)); - end - else if cur_chr = del_code_base then begin - p:=cur_chr; scan_usv_num; - p:=p+cur_val; - scan_optional_equals; - scan_int; {|scan_xetex_del_code_int|; !!FIXME!!} - word_define(p,hi(cur_val)); - end else begin -{ -bit usage in delcode values: -original layout: @@"00cffCFF small/LARGE family \& char -extended: @@"40000000 FLAG - + ff << 21 (mult by @@"200000) FAMILY - + 1ccccc (21 bits) USV -} - p:=cur_chr-1; scan_usv_num; - p:=p+cur_val; - scan_optional_equals; - n := @"40000000; {extended delcode flag} - scan_math_fam_int; n := n + cur_val * @"200000; - scan_usv_num; n := n + cur_val; - word_define(p,hi(n)); - end; - end; -def_code: begin @; - p:=cur_chr; scan_usv_num; p:=p+cur_val; scan_optional_equals; -@z - -@x - if p=sf_code_base then begin - n:=equiv(p) div @"10000; - define(p,data,n*@"10000 + cur_val); - end else - define(p,data,cur_val) - end else if p0 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 -for f:=font_base+1 to font_ptr do begin - if str_eq_str(font_name[f],cur_name) and - (((cur_area = "") and is_native_font(f)) or str_eq_str(font_area[f],cur_area)) then - begin if s>0 then - begin if s=font_size[f] then goto common_ending; - end - else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then - goto common_ending; - end; - { could be a native font whose "name" ended up partly in area or extension } - append_str(cur_area); append_str(cur_name); append_str(cur_ext); - if str_eq_str(font_name[f], make_string) then begin - flush_string; - if is_native_font(f) then - begin if s>0 then - begin if s=font_size[f] then goto common_ending; - end - else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then - goto common_ending; - end - end - else flush_string; - end -@z - -@x -set_font:begin print("select font "); slow_print(font_name[chr_code]); -@y -set_font:begin print("select font "); - font_name_str:=font_name[chr_code]; - if is_native_font(chr_code) then begin - quote_char:=""""; - for n:=0 to length(font_name_str) - 1 do - if str_pool[str_start_macro(font_name_str) + n] = """" then quote_char:="'"; - print_char(quote_char); - slow_print(font_name_str); - print_char(quote_char); - end else - slow_print(font_name_str); -@z - -@x - begin a_close(read_file[n]); read_open[n]:=closed; -@y - begin u_close(read_file[n]); read_open[n]:=closed; -@z - -@x - and a_open_in(read_file[n], kpse_tex_format) then - read_open[n]:=just_open; -@y - and u_open_in(read_file[n], kpse_tex_format, XeTeX_default_input_mode, XeTeX_default_input_encoding) then - begin - make_utf16_name; - name_in_progress:=true; - begin_name; - stop_at_space:=false; - k:=0; - while (k; -@y -@z - -@x -format_engine:=xmalloc_array(text_char, x); -@y -format_engine:=xmalloc_array(char, x); -@z - -@x -@; -@y -@z - -@x -dump_things(str_start[0], str_ptr+1); -@y -dump_things(str_start_macro(too_big_char), str_ptr+1-too_big_char); -@z - -@x -undump_checked_things(0, pool_ptr, str_start[0], str_ptr+1);@/ -@y -undump_checked_things(0, pool_ptr, str_start_macro(too_big_char), str_ptr+1-too_big_char);@/ -@z - -@x -if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]); -@y -if eTeX_ex then for k:=int_val to inter_char_val do dump_int(sa_root[k]); -@z - -@x -if eTeX_ex then for k:=int_val to tok_val do -@y -if eTeX_ex then for k:=int_val to inter_char_val do -@z - -@x - print_file_name(font_name[k],font_area[k],""); -@y - if is_native_font(k) or (font_mapping[k]<>0) then - begin print_file_name(font_name[k],"",""); - print_err("Can't \dump a format with native fonts or font-mappings"); - help3("You really, really don't want to do this.") - ("It won't work, and only confuses me.") - ("(Load them at runtime, not as part of the format file.)"); - error; - end - else print_file_name(font_name[k],font_area[k],""); -@z - -@x -begin {Allocate the font arrays} -@y -begin {Allocate the font arrays} -font_mapping:=xmalloc_array(void_pointer, font_max); -font_layout_engine:=xmalloc_array(void_pointer, font_max); -font_flags:=xmalloc_array(char, font_max); -font_letter_space:=xmalloc_array(scaled, font_max); -@z - -@x -font_bc:=xmalloc_array(eight_bits, font_max); -font_ec:=xmalloc_array(eight_bits, font_max); -@y -font_bc:=xmalloc_array(UTF16_code, font_max); -font_ec:=xmalloc_array(UTF16_code, font_max); -@z - -@x -undump_things(font_check[null_font], font_ptr+1-null_font); -@y -for k:=null_font to font_ptr do font_mapping[k]:=0; -undump_things(font_check[null_font], font_ptr+1-null_font); -@z - -@x -dump_int(trie_op_ptr); -@y -dump_int(max_hyph_char); -dump_int(trie_op_ptr); -@z - -@x -for k:=255 downto 0 do if trie_used[k]>min_quarterword then -@y -for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then -@z - -@x -undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini -@y -undump_int(max_hyph_char); -undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini -@z - -@x -init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/ -k:=256; -@y -init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/ -k:=biggest_lang+1; -@z - -@x -@* \[51] The main program. -@y -@* \[51] The main program. -@z - -@x - setup_bound_var (15000)('max_strings')(max_strings); -@y - setup_bound_var (15000)('max_strings')(max_strings); - max_strings:=max_strings+too_big_char; {the |max_strings| value doesn't include the 64K synthetic strings} -@z - -@x - buffer:=xmalloc_array (ASCII_code, buf_size); -@y - buffer:=xmalloc_array (UnicodeScalar, buf_size); -@z - -@x - input_file:=xmalloc_array (alpha_file, max_in_open); -@y - input_file:=xmalloc_array (unicode_file, max_in_open); -@z - -@x - print_file_name(0, log_name, 0); print_char("."); -@y - print(log_name); print_char("."); -@z - -@x - {Allocate and initialize font arrays} -@y - {Allocate and initialize font arrays} - font_mapping:=xmalloc_array(void_pointer, font_max); - font_layout_engine:=xmalloc_array(void_pointer, font_max); - font_flags:=xmalloc_array(char, font_max); - font_letter_space:=xmalloc_array(scaled, font_max); -@z - -@x - font_bc:=xmalloc_array(eight_bits, font_max); - font_ec:=xmalloc_array(eight_bits, font_max); -@y - font_bc:=xmalloc_array(UTF16_code, font_max); - font_ec:=xmalloc_array(UTF16_code, font_max); -@z - -@x - param_base[null_font]:=-1; -@y - font_mapping[null_font]:=0; - param_base[null_font]:=-1; -@z - -@x -@* \[53] Extensions. -@y -@* \[53] Extensions. -@z - -@x -@d set_language_code=5 {command modifier for \.{\\setlanguage}} -@y -@d set_language_code=5 {command modifier for \.{\\setlanguage}} - -@d pdftex_first_extension_code = 6 -@d pdf_save_pos_node == pdftex_first_extension_code + 0 - -@d pic_file_code=41 { command modifier for \.{\\XeTeXpicfile}, skipping codes pdfTeX might use } -@d pdf_file_code=42 { command modifier for \.{\\XeTeXpdffile} } -@d glyph_code=43 { command modifier for \.{\\XeTeXglyph} } - -@d XeTeX_input_encoding_extension_code=44 -@d XeTeX_default_encoding_extension_code=45 -@d XeTeX_linebreak_locale_extension_code=46 -@z - -@x -@!@:set_language_}{\.{\\setlanguage} primitive@> -@y -@!@:set_language_}{\.{\\setlanguage} primitive@> - -@ The \.{\\XeTeXpicfile} and \.{\\XeTeXpdffile} primitives are only defined in extended mode. - -@= -primitive("XeTeXpicfile",extension,pic_file_code);@/ -primitive("XeTeXpdffile",extension,pdf_file_code);@/ -primitive("XeTeXglyph",extension,glyph_code);@/ -primitive("XeTeXlinebreaklocale", extension, XeTeX_linebreak_locale_extension_code);@/ -primitive("XeTeXinterchartoks",assign_toks,XeTeX_inter_char_loc); - -primitive("pdfsavepos",extension,pdf_save_pos_node);@/ -@z - -@x - set_language_code:print_esc("setlanguage"); -@y - set_language_code:print_esc("setlanguage"); - pic_file_code:print_esc("XeTeXpicfile"); - pdf_file_code:print_esc("XeTeXpdffile"); - glyph_code:print_esc("XeTeXglyph"); - XeTeX_linebreak_locale_extension_code:print_esc("XeTeXlinebreaklocale"); - XeTeX_input_encoding_extension_code:print_esc("XeTeXinputencoding"); - XeTeX_default_encoding_extension_code:print_esc("XeTeXdefaultencoding"); - pdf_save_pos_node: print_esc("pdfsavepos"); -@z - -% i and j are unused by TeX but required for XeTeX -@x [53.1348] (do_extension) -var k:integer; {all-purpose integers} -@y -var i,@!j,@!k:integer; {all-purpose integers} -@z - -@x -set_language_code:@; -@y -set_language_code:@; -pic_file_code:@; -pdf_file_code:@; -glyph_code:@; -XeTeX_input_encoding_extension_code:@; -XeTeX_default_encoding_extension_code:@; -XeTeX_linebreak_locale_extension_code:@; - -pdf_save_pos_node: @; -@z - -@x -@ @= -@y -procedure print_native_word(@!p:pointer); -var i,c,cc:integer; -begin - for i:=0 to native_length(p) - 1 do begin - c:=get_native_char(p,i); - if (c >= @"D800) and (c <= @"DBFF) then begin - if i < native_length(p) - 1 then begin - cc:=get_native_char(p, i+1); - if (cc >= @"DC00) and (cc <= @"DFFF) then begin - c := @"10000 + (c - @"D800) * @"400 + (cc - @"DC00); - print_char(c); - incr(i); - end else - print("."); - end else - print("."); - end else - print_char(c); - end -end; - -@ @= -@z - -@x -othercases print("whatsit?") -@y -native_word_node:begin - print_esc(font_id_text(native_font(p))); - print_char(" "); - print_native_word(p); - end; -glyph_node:begin - print_esc(font_id_text(native_font(p))); - print(" glyph#"); - print_int(native_glyph(p)); - end; -pic_node,pdf_node: begin - if subtype(p) = pic_node then print_esc("XeTeXpicfile") - else print_esc("XeTeXpdffile"); - print(" """); - for i:=0 to pic_path_length(p)-1 do - print_visible_char(pic_path_byte(p, i)); - print(""""); - end; -pdf_save_pos_node: print_esc("pdfsavepos"); -othercases print("whatsit?") -@z - -@x -@ @= -@y -@ Picture nodes are tricky in that they are variable size. -@d total_pic_node_size(#) == (pic_node_size + (pic_path_length(#) + sizeof(memory_word) - 1) div sizeof(memory_word)) - -@= -@z - -@x -othercases confusion("ext2") -@y -native_word_node: begin words:=native_size(p); - r:=get_node(words); - while words > 0 do - begin decr(words); mem[r+words]:=mem[p+words]; end; - native_glyph_info_ptr(r):=null_ptr; native_glyph_count(r):=0; - copy_native_glyph_info(p, r); - end; -glyph_node: begin r:=get_node(glyph_node_size); - words:=glyph_node_size; - end; -pic_node,pdf_node: begin words:=total_pic_node_size(p); - r:=get_node(words); - end; -pdf_save_pos_node: - r := get_node(small_node_size); -othercases confusion("ext2") -@z - -@x -othercases confusion("ext3") -@y -native_word_node: begin free_native_glyph_info(p); free_node(p,native_size(p)); end; -glyph_node: free_node(p,glyph_node_size); -pic_node,pdf_node: free_node(p,total_pic_node_size(p)); -pdf_save_pos_node: - free_node(p, small_node_size); -othercases confusion("ext3") -@z - -@x -@ @=do_nothing -@y -@ @= -begin - if (subtype(p)=pic_node) - or (subtype(p)=pdf_node) - then begin - x := x + d + height(p); - d := depth(p); - if width(p) > w then w := width(p); - end; -end -@z - -@x -@ @=do_nothing -@y -@ @= -begin - case subtype(p) of - - native_word_node: - begin - { merge with any following word fragments in same font, discarding discretionary breaks } - if type(q) = disc_node then k:=replace_count(q) else k:=0; - while (link(q) <> p) do begin - decr(k); - q := link(q); { bring q up in preparation for deletion of nodes starting at p } - if type(q) = disc_node then k:=replace_count(q); - end; - pp := link(p); - restart: - if (k <= 0) and (pp <> null) and (not is_char_node(pp)) then begin - if (type(pp) = whatsit_node) - and (subtype(pp) = native_word_node) - and (native_font(pp) = native_font(p)) then begin - pp := link(pp); - goto restart; - end - else if (type(pp) = disc_node) then begin - ppp := link(pp); - if (ppp <> null) and is_native_word_node(ppp) - and (native_font(ppp) = native_font(p)) then begin - pp := link(ppp); - goto restart; - end - end - end; - - { now pp points to the non-|native_word| node that ended the chain, or null } - - { we can just check type(p)=|whatsit_node| below, as we know that the chain - contains only discretionaries and |native_word| nodes, no other whatsits or |char_nodes| } - - if (pp <> link(p)) then begin - { found a chain of at least two pieces starting at p } - total_chars := 0; - p := link(q); { the first fragment } - while (p <> pp) do begin - if (type(p) = whatsit_node) then - total_chars := total_chars + native_length(p); { accumulate char count } - ppp := p; { remember last node seen } - p := link(p); { point to next fragment or discretionary or terminator } - end; - - p := link(q); { the first fragment again } - pp := new_native_word_node(native_font(p), total_chars); { make new node for merged word } - link(q) := pp; { link to preceding material } - link(pp) := link(ppp); { attach remainder of hlist to it } - link(ppp) := null; { and detach from the old fragments } - - { copy the chars into new node } - total_chars := 0; - ppp := p; - repeat - if (type(ppp) = whatsit_node) then - for k := 0 to native_length(ppp)-1 do begin - set_native_char(pp, total_chars, get_native_char(ppp, k)); - incr(total_chars); - end; - ppp := link(ppp); - until (ppp = null); - - flush_node_list(p); { delete the fragments } - p := link(q); { update p to point to the new node } - set_native_metrics(p, XeTeX_use_glyph_metrics); { and measure it (i.e., re-do the OT layout) } - end; - - { now incorporate the |native_word| node measurements into the box we're packing } - if height(p) > h then - h := height(p); - if depth(p) > d then - d := depth(p); - x := x + width(p); - end; - - glyph_node, pic_node, pdf_node: - begin - if height(p) > h then - h := height(p); - if depth(p) > d then - d := depth(p); - x := x + width(p); - end; - - othercases - do_nothing - - endcases -end -@z - -@x -@ @=d:=0 -@y -@ @= -if (subtype(p)=native_word_node) -or (subtype(p)=glyph_node) -or (subtype(p)=pic_node) -or (subtype(p)=pdf_node) -then begin - d:=width(p); - goto found; -end else - d := 0 -@z - -@x -@ @d adv_past(#)==@+if subtype(#)=language_node then - begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#); - set_hyph_index; - end - -@=@+ -adv_past(cur_p) -@y -@ @d adv_past_linebreak(#)==@+if subtype(#)=language_node then - begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#); - set_hyph_index; - end - else if (subtype(#)=native_word_node) - or (subtype(#)=glyph_node) - or (subtype(#)=pic_node) - or (subtype(#)=pdf_node) - then - begin act_width:=act_width+width(#); end - -@=@+ -adv_past_linebreak(cur_p) -@z - -@x -@ @=@+ -adv_past(s) -@y -@ @d adv_past_prehyph(#)==@+if subtype(#)=language_node then - begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#); - set_hyph_index; - end - -@=@+ -adv_past_prehyph(s) -@z - -@x -@ @= -goto contribute -@y -@ @= -begin - if (subtype(p)=pic_node) - or (subtype(p)=pdf_node) - then begin - page_total := page_total + page_depth + height(p); - page_depth := depth(p); - end; - goto contribute; -end -@z - -@x -@ @= -goto not_found -@y -@ @= -begin - if (subtype(p)=pic_node) - or (subtype(p)=pdf_node) - then begin - cur_height := cur_height + prev_dp + height(p); prev_dp := depth(p); - end; - goto not_found; -end -@z - -@x -@ @= -out_what(p) -@y -@ @= -begin - case subtype(p) of - glyph_node: begin - cur_v:=cur_v+height(p); - cur_h:=left_edge; - - { synch DVI state to TeX state } - synch_h; synch_v; - f := native_font(p); - if f<>dvi_f then @; - - dvi_out(set_glyph_string); - dvi_four(0); { width } - dvi_two(1); { glyph count } - dvi_four(0); { x-offset as fixed point } - dvi_two(native_glyph(p)); - - cur_v:=cur_v+depth(p); - cur_h:=left_edge; - end; - pic_node, pdf_node: begin - save_h:=dvi_h; save_v:=dvi_v; - cur_v:=cur_v+height(p); - pic_out(p, subtype(p) = pdf_node); - dvi_h:=save_h; dvi_v:=save_v; - cur_v:=save_v+depth(p); cur_h:=left_edge; - end; - - pdf_save_pos_node: - @; - - othercases - out_what(p) - - endcases -end -@z - -@x -@ @= -out_what(p) -@y -@ @= -begin - pdf_last_x_pos := cur_h + cur_h_offset; - pdf_last_y_pos := cur_page_height - cur_v - cur_v_offset -end - -@ @= -cur_h_offset := h_offset + (unity * 7227) / 100; -cur_v_offset := v_offset + (unity * 7227) / 100; -if pdf_page_width <> 0 then - cur_page_width := pdf_page_width -else - cur_page_width := width(p) + 2*cur_h_offset; -if pdf_page_height <> 0 then - cur_page_height := pdf_page_height -else - cur_page_height := height(p) + depth(p) + 2*cur_v_offset - -@ @= -@!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} - -@ @= -begin - case subtype(p) of - native_word_node, glyph_node: begin - { synch DVI state to TeX state } - synch_h; synch_v; - f := native_font(p); - if f<>dvi_f then @; - - if subtype(p) = glyph_node then begin - dvi_out(set_glyph_string); - dvi_four(width(p)); - dvi_two(1); { glyph count } - dvi_four(0); { x-offset as fixed point } - dvi_two(native_glyph(p)); - cur_h := cur_h + width(p); - end else begin - if native_glyph_info_ptr(p) <> null_ptr then begin - len := make_xdv_glyph_array_data(p); - for k := 0 to len-1 do - dvi_out(xdv_buffer_byte(k)); - end; - cur_h := cur_h + width(p); - end; - - dvi_h := cur_h; - end; - - pic_node, pdf_node: begin - save_h:=dvi_h; save_v:=dvi_v; - cur_v:=base_line; - edge:=cur_h+width(p); - if cur_dir=right_to_left then cur_h:=edge; - pic_out(p, subtype(p) = pdf_node); - dvi_h:=save_h; dvi_v:=save_v; - cur_h:=edge; cur_v:=base_line; - end; - - pdf_save_pos_node: - @; - - othercases - out_what(p) - - endcases -end -@z - -@x -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;@/ -@y -procedure special_out(@!p:pointer); -var old_setting:0..max_selector; {holds print |selector|} -@!k:pool_pointer; {index into |str_pool|} -begin synch_h; synch_v;@/ -doing_special := true; -@z - -@x -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} -@y -for k:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[k])); -pool_ptr:=str_start_macro(str_ptr); {erase the string} -doing_special := false; -@z - -@x -@!j:small_number; {write stream number} -@y -@!j:small_number; {write stream number} -@!k:integer; -@z - -@x - print(so(str_pool[str_start[str_ptr]+d])); {N.B.: not |print_char|} -@y - print(so(str_pool[str_start_macro(str_ptr)+d])); {N.B.: not |print_char|} -@z - -@x - str_pool[str_start[str_ptr]+d]:=xchr[str_pool[str_start[str_ptr]+d]]; - if (str_pool[str_start[str_ptr]+d]=null_code) -@y - if (str_pool[str_start_macro(str_ptr)+d]=null_code) -@z - -@x convert from UTF-16 to UTF-8 for system(3). - runsystem_ret := runsystem(conststringcast(addressof( - str_pool[str_start[str_ptr]]))); -@y - if name_of_file then libc_free(name_of_file); - name_of_file := xmalloc(cur_length * 3 + 2); - k := 0; - for d:=0 to cur_length-1 do - append_to_name(str_pool[str_start_macro(str_ptr)+d]); - name_of_file[k+1] := 0; - runsystem_ret := runsystem(conststringcast(name_of_file+1)); -@z - -@x - pool_ptr:=str_start[str_ptr]; {erase the string} -@y - pool_ptr:=str_start_macro(str_ptr); {erase the string} -@z - -@x -@= -@y -@= -procedure pic_out(@!p:pointer; @!is_pdf:boolean); -var - i:integer; -begin -synch_h; synch_v; -dvi_out(pic_file); -if is_pdf then - dvi_out(pic_box_type(p)) -else - dvi_out(0); -dvi_four(pic_transform1(p)); -dvi_four(pic_transform2(p)); -dvi_four(pic_transform3(p)); -dvi_four(pic_transform4(p)); -dvi_four(pic_transform5(p)); -dvi_four(pic_transform6(p)); -dvi_two(pic_page(p)); -dvi_two(pic_path_length(p)); -for i:=0 to pic_path_length(p)-1 do - dvi_out(pic_path_byte(p, i)); -end; - -@z - -@x -language_node:do_nothing; -@y -language_node:do_nothing; -@z - -@x -@ @= -for k:=0 to 15 do if write_open[k] then a_close(write_file[k]) -@y -@ @= -terminate_font_manager; -for k:=0 to 15 do if write_open[k] then a_close(write_file[k]) - -@ @= -if abs(mode)=mmode then report_illegal_case -else load_picture(false) - -@ @= -if abs(mode)=mmode then report_illegal_case -else load_picture(true) - -@ @= -begin - if abs(mode)=vmode then begin - back_input; - new_graf(true); - end else if abs(mode)=mmode then report_illegal_case - else begin - if is_native_font(cur_font) then begin - new_whatsit(glyph_node,glyph_node_size); - scan_int; - if (cur_val<0)or(cur_val>65535) then - begin print_err("Bad glyph number"); - help2("A glyph number must be between 0 and 65535.")@/ - ("I changed this one to zero."); int_error(cur_val); cur_val:=0; - end; - native_font(tail):=cur_font; - native_glyph(tail):=cur_val; - set_native_glyph_metrics(tail, XeTeX_use_glyph_metrics); - end else not_native_font_error(extension, glyph_code, cur_font); - end -end - -@ Load a picture file and handle following keywords. - -@d calc_min_and_max== - begin - xmin := 1000000.0; - xmax := -xmin; - ymin := xmin; - ymax := xmax; - for i := 0 to 3 do begin - if xCoord(corners[i]) < xmin then xmin := xCoord(corners[i]); - if xCoord(corners[i]) > xmax then xmax := xCoord(corners[i]); - if yCoord(corners[i]) < ymin then ymin := yCoord(corners[i]); - if yCoord(corners[i]) > ymax then ymax := yCoord(corners[i]); - end; - end - -@d update_corners== - for i := 0 to 3 do - transform_point(addressof(corners[i]), addressof(t2)) - -@d do_size_requests==begin - { calculate current width and height } - calc_min_and_max; - if x_size_req = 0.0 then begin - make_scale(addressof(t2), y_size_req / (ymax - ymin), y_size_req / (ymax - ymin)); - end else if y_size_req = 0.0 then begin - make_scale(addressof(t2), x_size_req / (xmax - xmin), x_size_req / (xmax - xmin)); - end else begin - make_scale(addressof(t2), x_size_req / (xmax - xmin), y_size_req / (ymax - ymin)); - end; - update_corners; - x_size_req := 0.0; - y_size_req := 0.0; - transform_concat(addressof(t), addressof(t2)); -end - -@= -procedure load_picture(@!is_pdf:boolean); -var - pic_path: ^char; - bounds: real_rect; - t, t2: transform; - corners: array[0..3] of real_point; - x_size_req,y_size_req: real; - check_keywords: boolean; - xmin,xmax,ymin,ymax: real; - i: small_number; - page: integer; - pdf_box_type: integer; - result: integer; -begin - { scan the filename and pack into |name_of_file| } - scan_file_name; - pack_cur_name; - - pdf_box_type := 0; - page := 0; - if is_pdf then begin - if scan_keyword("page") then begin - scan_int; - page := cur_val; - end; - pdf_box_type := pdfbox_crop; - if scan_keyword("crop") then do_nothing - else if scan_keyword("media") then pdf_box_type := pdfbox_media - else if scan_keyword("bleed") then pdf_box_type := pdfbox_bleed - else if scan_keyword("trim") then pdf_box_type := pdfbox_trim - else if scan_keyword("art") then pdf_box_type := pdfbox_art; - end; - - { access the picture file and check its size } - result := find_pic_file(addressof(pic_path), addressof(bounds), pdf_box_type, page); - - setPoint(corners[0], xField(bounds), yField(bounds)); - setPoint(corners[1], xField(corners[0]), yField(bounds) + htField(bounds)); - setPoint(corners[2], xField(bounds) + wdField(bounds), yField(corners[1])); - setPoint(corners[3], xField(corners[2]), yField(corners[0])); - - x_size_req := 0.0; - y_size_req := 0.0; - - { look for any scaling requests for this picture } - make_identity(addressof(t)); - - check_keywords := true; - while check_keywords do begin - if scan_keyword("scaled") then begin - scan_int; - if (x_size_req = 0.0) and (y_size_req = 0.0) then begin - make_scale(addressof(t2), float(cur_val) / 1000.0, float(cur_val) / 1000.0); - update_corners; - transform_concat(addressof(t), addressof(t2)); - end - end else if scan_keyword("xscaled") then begin - scan_int; - if (x_size_req = 0.0) and (y_size_req = 0.0) then begin - make_scale(addressof(t2), float(cur_val) / 1000.0, 1.0); - update_corners; - transform_concat(addressof(t), addressof(t2)); - end - end else if scan_keyword("yscaled") then begin - scan_int; - if (x_size_req = 0.0) and (y_size_req = 0.0) then begin - make_scale(addressof(t2), 1.0, float(cur_val) / 1000.0); - update_corners; - transform_concat(addressof(t), addressof(t2)); - end - end else if scan_keyword("width") then begin - scan_normal_dimen; - if cur_val <= 0 then begin - print_err("Improper image "); - print("size ("); - print_scaled(cur_val); - print("pt) will be ignored"); - help2("I can't scale images to zero or negative sizes, ") - ("so I'm ignoring this."); - error; - end else - x_size_req := Fix2X(cur_val); - end else if scan_keyword("height") then begin - scan_normal_dimen; - if cur_val <= 0 then begin - print_err("Improper image "); - print("size ("); - print_scaled(cur_val); - print("pt) will be ignored"); - help2("I can't scale images to zero or negative sizes, ") - ("so I'm ignoring this."); - error; - end else - y_size_req := Fix2X(cur_val); - end else if scan_keyword("rotated") then begin - scan_decimal; - if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests; - make_rotation(addressof(t2), Fix2X(cur_val) * 3.141592653589793 / 180.0); - update_corners; - calc_min_and_max; - setPoint(corners[0], xmin, ymin); - setPoint(corners[1], xmin, ymax); - setPoint(corners[2], xmax, ymax); - setPoint(corners[3], xmax, ymin); - transform_concat(addressof(t), addressof(t2)); - end else - check_keywords := false; - end; - - if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests; - - calc_min_and_max; - make_translation(addressof(t2), -xmin * 72 / 72.27, -ymin * 72 / 72.27); - transform_concat(addressof(t), addressof(t2)); - - if result = 0 then begin - - new_whatsit(pic_node, pic_node_size + (strlen(pic_path) + sizeof(memory_word) - 1) div sizeof(memory_word)); - if is_pdf then begin - subtype(tail) := pdf_node; - pic_box_type(tail) := pdf_box_type; - end; - pic_path_length(tail) := strlen(pic_path); - pic_page(tail) := page; - - width(tail) := X2Fix(xmax - xmin); - height(tail) := X2Fix(ymax - ymin); - depth(tail) := 0; - - pic_transform1(tail) := X2Fix(aField(t)); - pic_transform2(tail) := X2Fix(bField(t)); - pic_transform3(tail) := X2Fix(cField(t)); - pic_transform4(tail) := X2Fix(dField(t)); - pic_transform5(tail) := X2Fix(txField(t)); - pic_transform6(tail) := X2Fix(tyField(t)); - - memcpy(addressof(mem[tail + pic_node_size]), pic_path, strlen(pic_path)); - libc_free(pic_path); - - end else begin - - print_err("Unable to load picture or PDF file '"); - print_file_name(cur_name,cur_area,cur_ext); print("'"); - if result = -43 then begin { Mac OS file not found error } - help2("The requested image couldn't be read because ") - ("the file was not found."); - end - else begin { otherwise assume GraphicImport failed } - help2("The requested image couldn't be read because ") - ("it was not a recognized image format."); - end; - error; - - end; - -end; - -@ @= -begin - { scan a filename-like arg for the input encoding } - scan_and_pack_name; - - { convert it to "mode" and "encoding" values, and apply to the current input file } - i := get_encoding_mode_and_info(addressof(j)); - if i = XeTeX_input_mode_auto then begin - print_err("Encoding mode `auto' is not valid for \XeTeXinputencoding."); - help2("You can't use `auto' encoding here, only for \XeTeXdefaultencoding. ") - ("I'll ignore this and leave the current encoding unchanged."); - error; - end else set_input_file_encoding(input_file[in_open], i, j); -end - -@ @= -begin - { scan a filename-like arg for the input encoding } - scan_and_pack_name; - - { convert it to "mode" and "encoding" values, and store them as defaults for new input files } - XeTeX_default_input_mode := get_encoding_mode_and_info(addressof(j)); - XeTeX_default_input_encoding := j; -end - -@ @= -begin - { scan a filename-like arg for the locale name } - scan_file_name; - if length(cur_name) = 0 then XeTeX_linebreak_locale := 0 - else XeTeX_linebreak_locale := cur_name; { we ignore the area and extension! } -end - -@ @= -@!pdf_last_x_pos: integer; -@!pdf_last_y_pos: integer; - -@ @= -begin - new_whatsit(pdf_save_pos_node, small_node_size); -end - -@z - -@x -@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}} -@y -@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}} -@z - -@x -@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@> -@y -@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@> - -primitive("XeTeXversion",last_item,XeTeX_version_code); -@!@:XeTeX_version_}{\.{\\XeTeXversion} primitive@> -primitive("XeTeXrevision",convert,XeTeX_revision_code);@/ -@!@:XeTeXrevision_}{\.{\\XeTeXrevision} primitive@> - -primitive("XeTeXcountglyphs",last_item,XeTeX_count_glyphs_code); - -primitive("XeTeXcountvariations",last_item,XeTeX_count_variations_code); -primitive("XeTeXvariation",last_item,XeTeX_variation_code); -primitive("XeTeXfindvariationbyname",last_item,XeTeX_find_variation_by_name_code); -primitive("XeTeXvariationmin",last_item,XeTeX_variation_min_code); -primitive("XeTeXvariationmax",last_item,XeTeX_variation_max_code); -primitive("XeTeXvariationdefault",last_item,XeTeX_variation_default_code); - -primitive("XeTeXcountfeatures",last_item,XeTeX_count_features_code); -primitive("XeTeXfeaturecode",last_item,XeTeX_feature_code_code); -primitive("XeTeXfindfeaturebyname",last_item,XeTeX_find_feature_by_name_code); -primitive("XeTeXisexclusivefeature",last_item,XeTeX_is_exclusive_feature_code); -primitive("XeTeXcountselectors",last_item,XeTeX_count_selectors_code); -primitive("XeTeXselectorcode",last_item,XeTeX_selector_code_code); -primitive("XeTeXfindselectorbyname",last_item,XeTeX_find_selector_by_name_code); -primitive("XeTeXisdefaultselector",last_item,XeTeX_is_default_selector_code); - -primitive("XeTeXvariationname",convert,XeTeX_variation_name_code); -primitive("XeTeXfeaturename",convert,XeTeX_feature_name_code); -primitive("XeTeXselectorname",convert,XeTeX_selector_name_code); - -primitive("XeTeXOTcountscripts",last_item,XeTeX_OT_count_scripts_code); -primitive("XeTeXOTcountlanguages",last_item,XeTeX_OT_count_languages_code); -primitive("XeTeXOTcountfeatures",last_item,XeTeX_OT_count_features_code); -primitive("XeTeXOTscripttag",last_item,XeTeX_OT_script_code); -primitive("XeTeXOTlanguagetag",last_item,XeTeX_OT_language_code); -primitive("XeTeXOTfeaturetag",last_item,XeTeX_OT_feature_code); - -primitive("XeTeXcharglyph", last_item, XeTeX_map_char_to_glyph_code); -primitive("XeTeXglyphindex", last_item, XeTeX_glyph_index_code); -primitive("XeTeXglyphbounds", last_item, XeTeX_glyph_bounds_code); - -primitive("XeTeXglyphname",convert,XeTeX_glyph_name_code); - -primitive("XeTeXfonttype", last_item, XeTeX_font_type_code); - -primitive("XeTeXfirstfontchar", last_item, XeTeX_first_char_code); -primitive("XeTeXlastfontchar", last_item, XeTeX_last_char_code); - -primitive("pdflastxpos",last_item,pdf_last_x_pos_code); -primitive("pdflastypos",last_item,pdf_last_y_pos_code); - -primitive("XeTeXpdfpagecount",last_item,XeTeX_pdf_page_count_code); -@z - -@x -eTeX_version_code: print_esc("eTeXversion"); -@y -eTeX_version_code: print_esc("eTeXversion"); -XeTeX_version_code: print_esc("XeTeXversion"); - -XeTeX_count_glyphs_code: print_esc("XeTeXcountglyphs"); - -XeTeX_count_variations_code: print_esc("XeTeXcountvariations"); -XeTeX_variation_code: print_esc("XeTeXvariation"); -XeTeX_find_variation_by_name_code: print_esc("XeTeXfindvariationbyname"); -XeTeX_variation_min_code: print_esc("XeTeXvariationmin"); -XeTeX_variation_max_code: print_esc("XeTeXvariationmax"); -XeTeX_variation_default_code: print_esc("XeTeXvariationdefault"); - -XeTeX_count_features_code: print_esc("XeTeXcountfeatures"); -XeTeX_feature_code_code: print_esc("XeTeXfeaturecode"); -XeTeX_find_feature_by_name_code: print_esc("XeTeXfindfeaturebyname"); -XeTeX_is_exclusive_feature_code: print_esc("XeTeXisexclusivefeature"); -XeTeX_count_selectors_code: print_esc("XeTeXcountselectors"); -XeTeX_selector_code_code: print_esc("XeTeXselectorcode"); -XeTeX_find_selector_by_name_code: print_esc("XeTeXfindselectorbyname"); -XeTeX_is_default_selector_code: print_esc("XeTeXisdefaultselector"); - -XeTeX_OT_count_scripts_code: print_esc("XeTeXOTcountscripts"); -XeTeX_OT_count_languages_code: print_esc("XeTeXOTcountlanguages"); -XeTeX_OT_count_features_code: print_esc("XeTeXOTcountfeatures"); -XeTeX_OT_script_code: print_esc("XeTeXOTscripttag"); -XeTeX_OT_language_code: print_esc("XeTeXOTlanguagetag"); -XeTeX_OT_feature_code: print_esc("XeTeXOTfeaturetag"); - -XeTeX_map_char_to_glyph_code: print_esc("XeTeXcharglyph"); -XeTeX_glyph_index_code: print_esc("XeTeXglyphindex"); -XeTeX_glyph_bounds_code: print_esc("XeTeXglyphbounds"); - -XeTeX_font_type_code: print_esc("XeTeXfonttype"); - -XeTeX_first_char_code: print_esc("XeTeXfirstfontchar"); -XeTeX_last_char_code: print_esc("XeTeXlastfontchar"); - - pdf_last_x_pos_code: print_esc("pdflastxpos"); - pdf_last_y_pos_code: print_esc("pdflastypos"); - -XeTeX_pdf_page_count_code: print_esc("XeTeXpdfpagecount"); -@z - -@x -eTeX_version_code: cur_val:=eTeX_version; -@y -eTeX_version_code: cur_val:=eTeX_version; -XeTeX_version_code: cur_val:=XeTeX_version; - -XeTeX_count_glyphs_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then - cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n]) - else if is_otgr_font(n) then - cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n]) - else - cur_val:=0; - end; - -XeTeX_count_variations_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then - cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n]) - else begin - cur_val:=0; - end; - end; -XeTeX_count_features_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then - cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n]) - else if is_gr_font(n) then - cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n]) - else - cur_val:=0; - end; - -XeTeX_variation_code, -XeTeX_variation_min_code, -XeTeX_variation_max_code, -XeTeX_variation_default_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_int; k:=cur_val; - cur_val:=atsu_font_get_1(m - XeTeX_int, font_layout_engine[n], k); - end else begin - not_atsu_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_feature_code_code, -XeTeX_is_exclusive_feature_code, -XeTeX_count_selectors_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_int; k:=cur_val; - cur_val:=atsu_font_get_1(m - XeTeX_int, font_layout_engine[n], k); - end else if is_gr_font(n) then begin - scan_int; k:=cur_val; - cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], k); - end else begin - not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_selector_code_code, -XeTeX_is_default_selector_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_int; k:=cur_val; scan_int; - cur_val:=atsu_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val); - end else if is_gr_font(n) then begin - scan_int; k:=cur_val; scan_int; - cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val); - end else begin - not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_find_variation_by_name_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_and_pack_name; - cur_val:=atsu_font_get_named(m - XeTeX_int, font_layout_engine[n]); - end else begin - not_atsu_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_find_feature_by_name_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_and_pack_name; - cur_val:=atsu_font_get_named(m - XeTeX_int, font_layout_engine[n]); - end else if is_gr_font(n) then begin - scan_and_pack_name; - cur_val:=gr_font_get_named(m - XeTeX_int, font_layout_engine[n]); - end else begin - not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_find_selector_by_name_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then begin - scan_int; k:=cur_val; scan_and_pack_name; - cur_val:=atsu_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k); - end else if is_gr_font(n) then begin - scan_int; k:=cur_val; scan_and_pack_name; - cur_val:=gr_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k); - end else begin - not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_OT_count_scripts_code: - begin - scan_font_ident; n:=cur_val; - if is_ot_font(n) then - cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n]) - else begin - cur_val:=0; - end; - end; - -XeTeX_OT_count_languages_code, -XeTeX_OT_script_code: - begin - scan_font_ident; n:=cur_val; - if is_ot_font(n) then begin - scan_int; - cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], cur_val); - end else begin - not_ot_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_OT_count_features_code, -XeTeX_OT_language_code: - begin - scan_font_ident; n:=cur_val; - if is_ot_font(n) then begin - scan_int; k:=cur_val; scan_int; - cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val); - end else begin - not_ot_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_OT_feature_code: - begin - scan_font_ident; n:=cur_val; - if is_ot_font(n) then begin - scan_int; k:=cur_val; scan_int; kk:=cur_val; scan_int; - cur_val:=ot_font_get_3(m - XeTeX_int, font_layout_engine[n], k, kk, cur_val); - end else begin - not_ot_font_error(last_item, m, n); cur_val:=-1; - end; - end; - -XeTeX_map_char_to_glyph_code: - begin - if is_native_font(cur_font) then begin - scan_int; n:=cur_val; cur_val:=map_char_to_glyph(cur_font, n) - end else begin - not_native_font_error(last_item, m, cur_font); cur_val:=0 - end - end; - -XeTeX_glyph_index_code: - begin - if is_native_font(cur_font) then begin - scan_and_pack_name; - cur_val:=map_glyph_to_index(cur_font) - end else begin - not_native_font_error(last_item, m, cur_font); cur_val:=0 - end - end; - -XeTeX_font_type_code: - begin - scan_font_ident; n:=cur_val; - if is_atsu_font(n) then cur_val:=1 - else if is_ot_font(n) then cur_val:=2 - else if is_gr_font(n) then cur_val:=3 - else cur_val:=0; - end; - -XeTeX_first_char_code,XeTeX_last_char_code: - begin - scan_font_ident; n:=cur_val; - if is_native_font(n) then - cur_val:=get_font_char_range(n, m = XeTeX_first_char_code) - else begin - if m = XeTeX_first_char_code then cur_val:=font_bc[n] - else cur_val:=font_ec[n]; - end - end; - - pdf_last_x_pos_code: cur_val := pdf_last_x_pos; - pdf_last_y_pos_code: cur_val := pdf_last_y_pos; - -XeTeX_pdf_page_count_code: - begin - scan_and_pack_name; - cur_val:=count_pdf_file_pages; - end; - -@ Slip in an extra procedure here and there.... - -@= -procedure scan_and_pack_name; forward; - -@ @= -procedure scan_and_pack_name; -begin - scan_file_name; pack_cur_name; -end; - -@ @= -procedure not_atsu_font_error(cmd, c: integer; f: integer); -begin - print_err("Cannot use "); print_cmd_chr(cmd, c); - print(" with "); print(font_name[f]); - print("; not an AAT font"); - error; -end; - -procedure not_atsu_gr_font_error(cmd, c: integer; f: integer); -begin - print_err("Cannot use "); print_cmd_chr(cmd, c); - print(" with "); print(font_name[f]); - print("; not an AAT or Graphite font"); - error; -end; - -procedure not_ot_font_error(cmd, c: integer; f: integer); -begin - print_err("Cannot use "); print_cmd_chr(cmd, c); - print(" with "); print(font_name[f]); - print("; not an OpenType Layout font"); - error; -end; - -procedure not_native_font_error(cmd, c: integer; f: integer); -begin - print_err("Cannot use "); print_cmd_chr(cmd, c); - print(" with "); print(font_name[f]); - print("; not a native platform font"); - error; -end; - -@ @= -XeTeX_glyph_bounds_code: - begin - if is_native_font(cur_font) then begin - scan_int; n:=cur_val; { which edge: 1=left, 2=top, 3=right, 4=bottom } - if (n < 1) or (n > 4) then begin - print_err("\\XeTeXglyphbounds requires an edge index from 1 to 4;"); - print_nl("I don't know anything about edge "); print_int(n); - error; - cur_val:=0; - end else begin - scan_int; { glyph number } - cur_val:=get_glyph_bounds(cur_font, n, cur_val); - end - end else begin - not_native_font_error(last_item, m, cur_font); cur_val:=0 - end - end; - -@ @= -eTeX_revision_code: print_esc("eTeXrevision"); -XeTeX_revision_code: print_esc("XeTeXrevision"); - -XeTeX_variation_name_code: print_esc("XeTeXvariationname"); -XeTeX_feature_name_code: print_esc("XeTeXfeaturename"); -XeTeX_selector_name_code: print_esc("XeTeXselectorname"); -XeTeX_glyph_name_code: print_esc("XeTeXglyphname"); - -@ @= -eTeX_revision_code: do_nothing; -XeTeX_revision_code: do_nothing; - -XeTeX_variation_name_code: - begin - scan_font_ident; fnt:=cur_val; - if is_atsu_font(fnt) then begin - scan_int; arg1:=cur_val; arg2:=0; - end else - not_atsu_font_error(convert, c, fnt); - end; - -XeTeX_feature_name_code: - begin - scan_font_ident; fnt:=cur_val; - if is_atsu_font(fnt) or is_gr_font(fnt) then begin - scan_int; arg1:=cur_val; arg2:=0; - end else - not_atsu_gr_font_error(convert, c, fnt); - end; - -XeTeX_selector_name_code: - begin - scan_font_ident; fnt:=cur_val; - if is_atsu_font(fnt) or is_gr_font(fnt) then begin - scan_int; arg1:=cur_val; scan_int; arg2:=cur_val; - end else - not_atsu_gr_font_error(convert, c, fnt); - end; - -XeTeX_glyph_name_code: - begin - scan_font_ident; fnt:=cur_val; - if is_native_font(fnt) then begin - scan_int; arg1:=cur_val; - end else - not_native_font_error(convert, c, fnt); - end; - -@ @= -eTeX_revision_code: print(eTeX_revision); -XeTeX_revision_code: print(XeTeX_revision); - -XeTeX_variation_name_code: - if is_atsu_font(fnt) then - atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2); - -XeTeX_feature_name_code, -XeTeX_selector_name_code: - if is_atsu_font(fnt) then - atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2) - else if is_gr_font(fnt) then - gr_print_font_name(c, font_layout_engine[fnt], arg1, arg2); - -XeTeX_glyph_name_code: - if is_native_font(fnt) then print_glyph_name(fnt, arg1); -@z - -@x -@ @= -dump_int(eTeX_mode); -for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements} -@y -@ @= -dump_int(eTeX_mode); -{ in a deliberate change from e-TeX, we allow non-zero state variables to be dumped } -@z - -@x -every_eof_loc: print_esc("everyeof"); -@y -every_eof_loc: print_esc("everyeof"); -XeTeX_inter_char_loc: print_esc("XeTeXinterchartoks"); -@z - -@x -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; -@y -font_char_wd_code, -font_char_ht_code, -font_char_dp_code, -font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_usv_num; - if is_native_font(q) then begin - case m of - font_char_wd_code: cur_val := getnativecharwd(q, cur_val); - font_char_ht_code: cur_val := getnativecharht(q, cur_val); - font_char_dp_code: cur_val := getnativechardp(q, cur_val); - font_char_ic_code: cur_val := getnativecharic(q, cur_val); - end; {there are no other cases} - end else begin - if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then - begin i:=char_info(q)(qi(cur_val)); - case m of - font_char_wd_code: cur_val:=char_width(q)(i); - font_char_ht_code: cur_val:=char_height(q)(height_depth(i)); - font_char_dp_code: cur_val:=char_depth(q)(height_depth(i)); - font_char_ic_code: cur_val:=char_italic(q)(i); - end; {there are no other cases} - end - else cur_val:=0; - end - end; -@z - -@x -@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?} -@y -@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?} - -@d XeTeX_upwards_state==eTeX_state(XeTeX_upwards_code) -@d XeTeX_upwards==(XeTeX_upwards_state>0) - -@d XeTeX_use_glyph_metrics_state==eTeX_state(XeTeX_use_glyph_metrics_code) -@d XeTeX_use_glyph_metrics==(XeTeX_use_glyph_metrics_state>0) - -@d XeTeX_inter_char_tokens_state==eTeX_state(XeTeX_inter_char_tokens_code) -@d XeTeX_inter_char_tokens_en==(XeTeX_inter_char_tokens_state>0) - -@d XeTeX_dash_break_state == eTeX_state(XeTeX_dash_break_code) -@d XeTeX_dash_break_en == (XeTeX_dash_break_state>0) - -@d XeTeX_input_normalization_state == eTeX_state(XeTeX_input_normalization_code) -@d XeTeX_tracing_fonts_state == eTeX_state(XeTeX_tracing_fonts_code) - -@d XeTeX_default_input_mode == eTeX_state(XeTeX_default_input_mode_code) -@d XeTeX_default_input_encoding == eTeX_state(XeTeX_default_input_encoding_code) -@z - -@x -eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate"); -@y -suppress_fontnotfound_error_code:print_esc("suppressfontnotfounderror"); -eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate"); -eTeX_state_code+XeTeX_upwards_code:print_esc("XeTeXupwardsmode"); -eTeX_state_code+XeTeX_use_glyph_metrics_code:print_esc("XeTeXuseglyphmetrics"); -eTeX_state_code+XeTeX_inter_char_tokens_code:print_esc("XeTeXinterchartokenstate"); -eTeX_state_code+XeTeX_dash_break_code:print_esc("XeTeXdashbreakstate"); -eTeX_state_code+XeTeX_input_normalization_code:print_esc("XeTeXinputnormalization"); -eTeX_state_code+XeTeX_tracing_fonts_code:print_esc("XeTeXtracingfonts"); -@z - -@x -primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code); -@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@> -@y -primitive("suppressfontnotfounderror",assign_int,int_base+suppress_fontnotfound_error_code);@/ -primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code); -@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@> -primitive("XeTeXupwardsmode",assign_int,eTeX_state_base+XeTeX_upwards_code); -@!@:XeTeX_upwards_mode_}{\.{\\XeTeX_upwards_mode} primitive@> -primitive("XeTeXuseglyphmetrics",assign_int,eTeX_state_base+XeTeX_use_glyph_metrics_code); -@!@:XeTeX_use_glyph_metrics_}{\.{\\XeTeX_use_glyph_metrics} primitive@> -primitive("XeTeXinterchartokenstate",assign_int,eTeX_state_base+XeTeX_inter_char_tokens_code); -@!@:XeTeX_use_inter_char_tokens_}{\.{\\XeTeX_use_inter_char_tokens} primitive@> - -primitive("XeTeXdashbreakstate",assign_int,eTeX_state_base+XeTeX_dash_break_code); -@!@:XeTeX_dash_break_state_}{\.{\\XeTeX_dash_break_state} primitive@> - -primitive("XeTeXinputnormalization",assign_int,eTeX_state_base+XeTeX_input_normalization_code); -@!@:XeTeX_input_normalization_}{\.{\\XeTeX_input_normalization} primitive@> - -primitive("XeTeXtracingfonts",assign_int,eTeX_state_base+XeTeX_tracing_fonts_code); - -primitive("XeTeXinputencoding",extension,XeTeX_input_encoding_extension_code); -primitive("XeTeXdefaultencoding",extension,XeTeX_default_encoding_extension_code); -@z - -@x -@ Here we compute the effective width of a glue node as in |hlist_out|. - -@= -glue_node: begin round_glue; - @; - end; -@y -@ Need to measure |native_word| and picture nodes when reversing! -@= -whatsit_node: - if (subtype(p)=native_word_node) - or (subtype(p)=glyph_node) - or (subtype(p)=pic_node) - or (subtype(p)=pdf_node) - then - rule_wd:=width(p) - else - goto next_p; - -@ Here we compute the effective width of a glue node as in |hlist_out|. - -@= -glue_node: begin round_glue; - @; - end; -@z - -@x -str_pool[pool_ptr]:=si(" "); l:=str_start[s]; -@y -str_pool[pool_ptr]:=si(" "); l:=str_start_macro(s); -@z - -@x - buffer[m]:=info(p) mod @'400; incr(m); p:=link(p); -@y - buffer[m]:=info(p) mod max_char_val; incr(m); p:=link(p); -@z - -@x -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; -@y -if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num; - if is_native_font(n) then - b := (map_char_to_glyph(n, cur_val) > 0) - else begin - if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then - b:=char_exists(char_info(n)(qi(cur_val))) - else b:=false; - end; - end; -@z - -@x -@d mark_val=6 {the additional mark classes} -@y -@d mark_val=7 {the additional mark classes} -@z - -@x -for i:=int_val to tok_val do sa_root[i]:=null; -@y -for i:=int_val to inter_char_val do sa_root[i]:=null; -@z - -@x {hyphenation code is only saved for chars 0..255} -@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|} - if hyph_index=0 then hc[0]:=lc_code(#) -@y -@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|} - if (hyph_index=0) or ((#)>255) then hc[0]:=lc_code(#) -@z - -@x - for c := str_start[text(h)] to str_start[text(h) + 1] - 1 -@y - for c := str_start_macro(text(h)) to str_start_macro(text(h) + 1) - 1 -@z - -@x -@ Dumping the |xord|, |xchr|, and |xprn| arrays. We dump these always -in the format, so a TCX file loaded during format creation can set a -default for users of the format. - -@= -dump_things(xord[0], 256); -dump_things(xchr[0], 256); -dump_things(xprn[0], 256); - -@ Undumping the |xord|, |xchr|, and |xprn| arrays. This code is more -complicated, because we want to ensure that a TCX file specified on -the command line will override whatever is in the format. Since the -tcx file has already been loaded, that implies throwing away the data -in the format. Also, if no |translate_filename| is given, but -|eight_bit_p| is set we have to make all characters printable. - -@= -if translate_filename then begin - for k:=0 to 255 do undump_things(dummy_xord, 1); - for k:=0 to 255 do undump_things(dummy_xchr, 1); - for k:=0 to 255 do undump_things(dummy_xprn, 1); - end -else begin - undump_things(xord[0], 256); - undump_things(xchr[0], 256); - undump_things(xprn[0], 256); - if eight_bit_p then - for k:=0 to 255 do - xprn[k]:=1; -end; - - -@y -@z - -@x - while s>255 do {first 256 strings depend on implementation!!} -@y - while s>65535 do {first 64K strings don't really exist in the pool!} -@z - -@x -@!mltex_enabled_p:boolean; {enable character substitution} -@y -@!mltex_enabled_p:boolean; {enable character substitution} -@!native_font_type_flag:integer; {used by XeTeX font loading code to record which font technology was used} -@!xtx_ligature_present:boolean; {to suppress tfm font mapping of char codes from ligature nodes (already mapped)} -@z - -@x -begin result:=c; {return |c| unless it does not exist in the font} -@y -begin if (not xtx_ligature_present) and (font_mapping[f]<>nil) then - c:=apply_tfm_font_mapping(font_mapping[f],c); -xtx_ligature_present:=false; -result:=c; {return |c| unless it does not exist in the font} -@z - -@x -begin if not mltex_enabled_p then -@y -begin if (not xtx_ligature_present) and (font_mapping[f]<>nil) then - c:=apply_tfm_font_mapping(font_mapping[f],c); -xtx_ligature_present:=false; -if not mltex_enabled_p then -@z - -@x -effective_char_info:=null_character; -exit:end; -@y -effective_char_info:=null_character; -exit:end; - -{ the following procedure has been moved so that |new_native_character| can call it } - -procedure char_warning(@!f:internal_font_number;@!c:integer); -var old_setting: integer; {saved value of |tracing_online|} -begin if tracing_lost_chars>0 then - begin old_setting:=tracing_online; - if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1; - begin begin_diagnostic; - print_nl("Missing character: There is no "); -@.Missing character@> - if c < @"10000 then print_ASCII(c) - else begin { non-Plane 0 Unicodes can't be sent through |print_ASCII| } - print("character number "); - print_hex(c); - end; - print(" in font "); - slow_print(font_name[f]); print_char("!"); end_diagnostic(false); - end; - tracing_online:=old_setting; - end; -end; - -{ additional functions for native font support } - -function new_native_word_node(@!f:internal_font_number;@!n:integer):pointer; - { note that this function creates the node, but does not actually set its metrics; - call |set_native_metrics(node)| if that is required! } -var - l: integer; - q: pointer; -begin - l := native_node_size + (n * sizeof(UTF16_code) + sizeof(memory_word) - 1) div sizeof(memory_word); - - q := get_node(l); - type(q) := whatsit_node; - subtype(q) := native_word_node; - - native_size(q) := l; - native_font(q) := f; - native_length(q) := n; - - native_glyph_count(q) := 0; - native_glyph_info_ptr(q) := null_ptr; - - new_native_word_node := q; -end; - -function new_native_character(@!f:internal_font_number;@!c:UnicodeScalar):pointer; -var - p: pointer; - i, len: integer; -begin - if font_mapping[f] <> 0 then begin - if c > @"FFFF then begin - str_room(2); - append_char((c - @"10000) div 1024 + @"D800); - append_char((c - @"10000) mod 1024 + @"DC00); - end - else begin - str_room(1); - append_char(c); - end; - len := apply_mapping(font_mapping[f], addressof(str_pool[str_start_macro(str_ptr)]), cur_length); - pool_ptr := str_start_macro(str_ptr); { flush the string, as we'll be using the mapped text instead } - - i := 0; - while i < len do begin - if (mapped_text[i] >= @"D800) and (mapped_text[i] < @"DC00) then begin - c := (mapped_text[i] - @"D800) * 1024 + mapped_text[i+1] - @"DC00 + @"10000; - if map_char_to_glyph(f, c) = 0 then begin - char_warning(f, c); - end; - i := i + 2; - end - else begin - if map_char_to_glyph(f, mapped_text[i]) = 0 then begin - char_warning(f, mapped_text[i]); - end; - i := i + 1; - end; - end; - - p := new_native_word_node(f, len); - for i := 0 to len-1 do begin - set_native_char(p, i, mapped_text[i]); - end - end - else begin - if tracing_lost_chars > 0 then - if map_char_to_glyph(f, c) = 0 then begin - char_warning(f, c); - end; - - p := get_node(native_node_size + 1); - type(p) := whatsit_node; - subtype(p) := native_word_node; - - native_size(p) := native_node_size + 1; - native_glyph_count(p) := 0; - native_glyph_info_ptr(p) := null_ptr; - native_font(p) := f; - - if c > @"FFFF then begin - native_length(p) := 2; - set_native_char(p, 0, (c - @"10000) div 1024 + @"D800); - set_native_char(p, 1, (c - @"10000) mod 1024 + @"DC00); - end - else begin - native_length(p) := 1; - set_native_char(p, 0, c); - end; - end; - - set_native_metrics(p, XeTeX_use_glyph_metrics); - - new_native_character := p; -end; - -procedure font_feature_warning(featureNameP:void_pointer; featLen:integer; - settingNameP:void_pointer; setLen:integer); -var - i: integer; -begin - begin_diagnostic; - print_nl("Unknown "); - if setLen > 0 then begin - print("selector `"); - print_utf8_str(settingNameP, setLen); - print("' for "); - end; - print("feature `"); - print_utf8_str(featureNameP, featLen); - print("' in font `"); - i := 1; - while ord(name_of_file[i]) <> 0 do begin - print_visible_char(name_of_file[i]); { this is already UTF-8 } - incr(i); - end; - print("'."); - end_diagnostic(false); -end; - -procedure font_mapping_warning(mappingNameP:void_pointer; - mappingNameLen:integer; - warningType:integer); { 0: just logging; 1: file not found; 2: can't load } -var - i: integer; -begin - begin_diagnostic; - if warningType=0 then print_nl("Loaded mapping `") - else print_nl("Font mapping `"); - print_utf8_str(mappingNameP, mappingNameLen); - print("' for font `"); - i := 1; - while ord(name_of_file[i]) <> 0 do begin - print_visible_char(name_of_file[i]); { this is already UTF-8 } - incr(i); - end; - case warningType of - 1: print("' not found."); - 2: begin print("' not usable;"); - print_nl("bad mapping file or incorrect mapping type."); - end; - othercases print("'.") - endcases; - end_diagnostic(false); -end; - -procedure graphite_warning; -var - i: integer; -begin - begin_diagnostic; - print_nl("Font `"); - i := 1; - while ord(name_of_file[i]) <> 0 do begin - print_visible_char(name_of_file[i]); { this is already UTF-8 } - incr(i); - end; - print("' does not support Graphite. Trying ICU layout instead."); - end_diagnostic(false); -end; - -function load_native_font(u: pointer; nom, aire:str_number; s: scaled): internal_font_number; -label - done; -const - first_math_fontdimen = 10; -var - k, num_font_dimens: integer; - font_engine: void_pointer; {really an ATSUStyle or XeTeXLayoutEngine} - actual_size: scaled; {|s| converted to real size, if it was negative} - p: pointer; {for temporary |native_char| node we'll create} - ascent, descent, font_slant, x_ht, cap_ht: scaled; - f: internal_font_number; - full_name: str_number; -begin - { on entry here, the full name is packed into |name_of_file| in UTF8 form } - - load_native_font := null_font; - - font_engine := find_native_font(name_of_file + 1, s); - if font_engine = 0 then goto done; - - if s>=0 then - actual_size := s - else begin - if (s <> -1000) then - actual_size := xn_over_d(loaded_font_design_size,-s,1000) - else - actual_size := loaded_font_design_size; - end; - - { look again to see if the font is already loaded, now that we know its canonical name } - str_room(name_length); - for k := 1 to name_length do - append_char(name_of_file[k]); - full_name := make_string; { not |slow_make_string| because we'll flush it if the font was already loaded } - - for f:=font_base+1 to font_ptr do - if (font_area[f] = native_font_type_flag) and str_eq_str(font_name[f], full_name) and (font_size[f] = actual_size) then begin - release_font_engine(font_engine, native_font_type_flag); - flush_string; - load_native_font := f; - goto done; - end; - - if (native_font_type_flag = otgr_font_flag) and isOpenTypeMathFont(font_engine) then - num_font_dimens := first_math_fontdimen + lastMathConstant - else - num_font_dimens := 8; - - if (font_ptr = font_max) or (fmem_ptr + num_font_dimens > font_mem_size) then begin - @; - end; - - { we've found a valid installed font, and have room } - incr(font_ptr); - font_area[font_ptr] := native_font_type_flag; { set by |find_native_font| to either |aat_font_flag| or |ot_font_flag| } - - { store the canonical name } - font_name[font_ptr] := full_name; - - font_check[font_ptr].b0 := 0; - font_check[font_ptr].b1 := 0; - font_check[font_ptr].b2 := 0; - font_check[font_ptr].b3 := 0; - font_glue[font_ptr] := null; - font_dsize[font_ptr] := loaded_font_design_size; - font_size[font_ptr] := actual_size; - - if (native_font_type_flag = aat_font_flag) then begin - atsu_get_font_metrics(font_engine, addressof(ascent), addressof(descent), - addressof(x_ht), addressof(cap_ht), addressof(font_slant)) - end else begin - ot_get_font_metrics(font_engine, addressof(ascent), addressof(descent), - addressof(x_ht), addressof(cap_ht), addressof(font_slant)); - end; - - height_base[font_ptr] := ascent; - depth_base[font_ptr] := -descent; - - font_params[font_ptr] := num_font_dimens; { we add an extra fontdimen: \#8 -> |cap_height|; - then OT math fonts have a bunch more } - font_bc[font_ptr] := 0; - font_ec[font_ptr] := 65535; - font_used[font_ptr] := false; - hyphen_char[font_ptr] := default_hyphen_char; - skew_char[font_ptr] := default_skew_char; - param_base[font_ptr] := fmem_ptr-1; - - font_layout_engine[font_ptr] := font_engine; - font_mapping[font_ptr] := 0; { don't use the mapping, if any, when measuring space here } - font_letter_space[font_ptr] := loaded_font_letter_space; - - {measure the width of the space character and set up font parameters} - p := new_native_character(font_ptr, " "); - s := width(p) + loaded_font_letter_space; - free_node(p, native_size(p)); - - font_info[fmem_ptr].sc := font_slant; {|slant|} - incr(fmem_ptr); - font_info[fmem_ptr].sc := s; {|space| = width of space character} - incr(fmem_ptr); - font_info[fmem_ptr].sc := s div 2; {|space_stretch| = 1/2 * space} - incr(fmem_ptr); - font_info[fmem_ptr].sc := s div 3; {|space_shrink| = 1/3 * space} - incr(fmem_ptr); - font_info[fmem_ptr].sc := x_ht; {|x_height|} - incr(fmem_ptr); - font_info[fmem_ptr].sc := font_size[font_ptr]; {|quad| = font size} - incr(fmem_ptr); - font_info[fmem_ptr].sc := s div 3; {|extra_space| = 1/3 * space} - incr(fmem_ptr); - font_info[fmem_ptr].sc := cap_ht; {|cap_height|} - incr(fmem_ptr); - - if num_font_dimens = first_math_fontdimen + lastMathConstant then begin - font_info[fmem_ptr].int := num_font_dimens; { \fontdimen9 = number of assigned fontdimens } - incr(fmem_ptr); - for k := 0 to lastMathConstant do begin - font_info[fmem_ptr].sc := get_ot_math_constant(font_ptr, k); - incr(fmem_ptr); - end; - end; - - font_mapping[font_ptr] := loaded_font_mapping; - font_flags[font_ptr] := loaded_font_flags; - - load_native_font := font_ptr; -done: -end; - -procedure do_locale_linebreaks(s: integer; len: integer); -var - offs, prevOffs, i: integer; - use_penalty, use_skip: boolean; -begin - if (XeTeX_linebreak_locale = 0) or (len = 1) then begin - link(tail) := new_native_word_node(main_f, len); - tail := link(tail); - for i := 0 to len - 1 do - set_native_char(tail, i, native_text[s + i]); - set_native_metrics(tail, XeTeX_use_glyph_metrics); - end else begin - use_skip := XeTeX_linebreak_skip <> zero_glue; - use_penalty := XeTeX_linebreak_penalty <> 0 or not use_skip; - if (is_gr_font(main_f)) and (str_eq_str(XeTeX_linebreak_locale, "G")) then begin - initGraphiteBreaking(font_layout_engine[main_f], native_text + s, len); - offs := 0; - repeat - prevOffs := offs; - offs := findNextGraphiteBreak(offs, 15); {klbWordBreak = 15} - if offs > 0 then begin - if prevOffs <> 0 then begin - if use_penalty then - tail_append(new_penalty(XeTeX_linebreak_penalty)); - if use_skip then - tail_append(new_param_glue(XeTeX_linebreak_skip_code)); - end; - link(tail) := new_native_word_node(main_f, offs - prevOffs); - tail := link(tail); - for i := prevOffs to offs - 1 do - set_native_char(tail, i - prevOffs, native_text[s + i]); - set_native_metrics(tail, XeTeX_use_glyph_metrics); - end; - until offs < 0; - end - else begin - linebreak_start(XeTeX_linebreak_locale, native_text + s, len); - offs := 0; - repeat - prevOffs := offs; - offs := linebreak_next; - if offs > 0 then begin - if prevOffs <> 0 then begin - if use_penalty then - tail_append(new_penalty(XeTeX_linebreak_penalty)); - if use_skip then - tail_append(new_param_glue(XeTeX_linebreak_skip_code)); - end; - link(tail) := new_native_word_node(main_f, offs - prevOffs); - tail := link(tail); - for i := prevOffs to offs - 1 do - set_native_char(tail, i - prevOffs, native_text[s + i]); - set_native_metrics(tail, XeTeX_use_glyph_metrics); - end; - until offs < 0; - end - end -end; - -procedure bad_utf8_warning; -begin - begin_diagnostic; - print_nl("Invalid UTF-8 byte or sequence"); - if terminal_input then print(" in terminal input") - else begin - print(" at line "); - print_int(line); - end; - print(" replaced by U+FFFD."); - end_diagnostic(false); -end; - -function get_input_normalization_state: integer; -begin - if eqtb=nil then get_input_normalization_state:=0 { may be called before eqtb is initialized } - else get_input_normalization_state:=XeTeX_input_normalization_state; -end; - -function get_tracing_fonts_state: integer; -begin - get_tracing_fonts_state:=XeTeX_tracing_fonts_state; -end; - -@z diff --git a/Build/source/texk/web2c/xetexdir/am/xetex.am b/Build/source/texk/web2c/xetexdir/am/xetex.am index 5250fd4dc88..e2665c2ab24 100644 --- a/Build/source/texk/web2c/xetexdir/am/xetex.am +++ b/Build/source/texk/web2c/xetexdir/am/xetex.am @@ -1,6 +1,6 @@ ## texk/web2c/xetexdir/am/xetex.am: Makefile fragment for XeTeX. ## -## Copyright (C) 2009-2012 Peter Breitenlohner +## Copyright (C) 2009-2013 Peter Breitenlohner ## You may freely use, modify and/or distribute this file. ## XeTeX @@ -96,57 +96,6 @@ xetex_ch_srcs = \ $(xetex_post_ch_synctex) \ tex-binpool.ch -## Merging in XeTeX change files - begin -if XETEX_SYNCTEX -Xold_ch_synctex = \ - synctexdir/synctex-mem.ch0 \ - synctexdir/synctex-e-mem.ch0 \ - synctexdir/synctex-e-mem.ch1 \ - synctexdir/synctex-xe-mem.ch2 \ - synctexdir/synctex-rec.ch0 \ - synctexdir/synctex-e-rec.ch0 \ - synctexdir/synctex-xe-rec.ch2 -Xold_post_ch_synctex = \ - synctexdir/synctex-xe-rec.ch3 -endif XETEX_SYNCTEX - -Xold.p Xold.pool: Xold-tangle - @$(xe_tangle) Xold -Xold-tangle: otangle$(EXEEXT) Xold.web tangle-sh - @$(xe_tangle) Xold -Xold.web: tie$(EXEEXT) $(Xold_web_srcs) - $(tie) -m Xold.web $(Xold_web_srcs) -Xold_web_srcs = \ - tex.web \ - etexdir/etex.ch \ - etexdir/tex.ch0 \ - tex.ch \ - xetexdir/tex.mod \ - etexdir/tex.ch1 \ - etexdir/tex.ech \ - tex-binpool.ch \ - $(Xold_ch_synctex) \ - xetex-orig.ch \ - xetex-latex3.ch \ - xetex-hz.ch \ - $(Xold_post_ch_synctex) -# -Xnew.web: tie$(EXEEXT) xetexdir/xetex.web xetex.ch - $(tie) -m Xnew.web xetexdir/xetex.web xetex.ch -# -Xweb.diff: Xold.web Xnew.web - diff -u Xold.web Xnew.web >Xweb.diff; : -Xp.diff: Xold.p xetex.p - diff -u Xold.p xetex.p >Xp.diff; : -Xpool.diff: Xold.pool xetex.pool - diff -u Xold.pool xetex.pool >Xpool.diff; : -X.diff: Xweb.diff Xp.diff Xpool.diff - cat Xweb.diff Xp.diff Xpool.diff >X.diff -# -EXTRA_DIST += $(Xold_web_srcs) -DISTCLEANFILES += X* -## Merging in XeTeX change files - end - ## EXTRA_DIST += $(xetex_web_srcs) $(xetex_ch_srcs) xetexdir/xetex.defines diff --git a/Build/source/texk/web2c/xetexdir/tex.mod b/Build/source/texk/web2c/xetexdir/tex.mod deleted file mode 100644 index af75344b1f5..00000000000 --- a/Build/source/texk/web2c/xetexdir/tex.mod +++ /dev/null @@ -1,87 +0,0 @@ -% Compensate recent changes in ../tex.ch - -@x [5.71] encTeX - native buffer printing -if last<>first then for k:=first to last-1 do print(buffer[k]); -@y -k:=first; while k < last do begin print_buffer(k) end; -@z - -@x [29.518] l.10042 - print_file_name: quote if spaces in names. -some operating systems put the file area last instead of first.) -@^system dependencies@> - -@d check_quoted(#) == {check if string |#| needs quoting} -if #<>0 then begin - j:=str_start[#]; - while (not must_quote) and (j0 then - for j:=str_start[#] to str_start[#+1]-1 do - if so(str_pool[j])<>"""" then - print(so(str_pool[j])) -@y -some operating systems put the file area last instead of first.) -@^system dependencies@> -@z - -@x [29.518] l.10042 - print_file_name: quote if spaces in names. -check_quoted(a); check_quoted(n); check_quoted(e); -@y -if a<>0 then begin - j:=str_start[a]; - while (not must_quote) and (j0 then begin - j:=str_start[n]; - while (not must_quote) and (j0 then begin - j:=str_start[e]; - while (not must_quote) and (j0 then - for j:=str_start[a] to str_start[a+1]-1 do - if so(str_pool[j])<>"""" then - print(so(str_pool[j])); -if n<>0 then - for j:=str_start[n] to str_start[n+1]-1 do - if so(str_pool[j])<>"""" then - print(so(str_pool[j])); -if e<>0 then - for j:=str_start[e] to str_start[e+1]-1 do - if so(str_pool[j])<>"""" then - print(so(str_pool[j])); -@z - -@x [48.1138] l.21648 - encTeX: \endmubyte primitive -begin print_err("Extra "); print_esc("endcsname"); -@.Extra \\endcsname@> -help1("I'm ignoring this, since I wasn't doing a \csname."); -@y -begin -if cur_chr = 10 then -begin - print_err("Extra "); print_esc("endmubyte"); -@.Extra \\endmubyte@> - help1("I'm ignoring this, since I wasn't doing a \mubyte."); -end else begin - print_err("Extra "); print_esc("endcsname"); -@.Extra \\endcsname@> - help1("I'm ignoring this, since I wasn't doing a \csname."); -end; -@z -- cgit v1.2.3