From 7a5384a896a4eb618fcfb16188793a09db053bdd Mon Sep 17 00:00:00 2001 From: Peter Breitenlohner Date: Wed, 7 Nov 2012 16:20:12 +0000 Subject: Start merging XeTeX change files git-svn-id: svn://tug.org/texlive/trunk@28202 c570f23f-e606-0410-a88d-b1316a301751 --- Build/source/texk/web2c/Makefile.in | 150 +- 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 | 64 +- Build/source/texk/web2c/xetexdir/tex.ch0 | 40 + Build/source/texk/web2c/xetexdir/xetex-hz.ch | 199 - Build/source/texk/web2c/xetexdir/xetex-latex3.ch | 33 - Build/source/texk/web2c/xetexdir/xetex.ch | 2936 +- Build/source/texk/web2c/xetexdir/xetex.web | 29712 +++++++++++++++++++++ 10 files changed, 40742 insertions(+), 3106 deletions(-) create mode 100644 Build/source/texk/web2c/xetex-hz.ch create mode 100644 Build/source/texk/web2c/xetex-latex3.ch create mode 100644 Build/source/texk/web2c/xetex-orig.ch create mode 100644 Build/source/texk/web2c/xetexdir/tex.ch0 create mode 100644 Build/source/texk/web2c/xetexdir/xetex.web diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in index 484d4241b4f..a75dae525fc 100644 --- a/Build/source/texk/web2c/Makefile.in +++ b/Build/source/texk/web2c/Makefile.in @@ -1392,6 +1392,7 @@ 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 \ @@ -1473,17 +1474,17 @@ EXTRA_DIST = PROJECTS cftests cpascal.h help.h w2c/config.h \ euptexdir/EUPTEX.txt eptexdir/eptrip/etrip.log \ eptexdir/eptrip/etrip.tex euptexdir/euptrip/euptrip.diffs \ euptexdir/euptrip/texmf.cnf $(pdftex_ch_srcs) \ - pdftexdir/pdftex.defines \ - pdftexdir/ChangeLog pdftexdir/NEWS pdftexdir/README \ - pdftexdir/change-files.txt $(pdftex_tests) tests/wprob.tex \ - pdftexdir/regex/COPYING.LIB pdftexdir/regex/README \ - $(pdftosrc_tests) pdftexdir/tests/test-13.pdf \ - pdftexdir/tests/test-13.xref pdftexdir/tests/test-15.pdf \ - pdftexdir/tests/test-15.xref luatexdir/ptexlib.h \ - luatexdir/getluatexsvnversion.sh $(luatex_tests) \ - luatexdir/lua51/Makefile luatexdir/lua51/liolib.c \ - luatexdir/lua51/lua.c luatexdir/lua51/luac.c \ - luatexdir/lua51/print.c luatexdir/luasocket/src/socket_lua.c \ + pdftexdir/pdftex.defines pdftexdir/ChangeLog pdftexdir/NEWS \ + pdftexdir/README pdftexdir/change-files.txt $(pdftex_tests) \ + tests/wprob.tex pdftexdir/regex/COPYING.LIB \ + pdftexdir/regex/README $(pdftosrc_tests) \ + pdftexdir/tests/test-13.pdf pdftexdir/tests/test-13.xref \ + pdftexdir/tests/test-15.pdf pdftexdir/tests/test-15.xref \ + luatexdir/ptexlib.h luatexdir/getluatexsvnversion.sh \ + $(luatex_tests) luatexdir/lua51/Makefile \ + luatexdir/lua51/liolib.c luatexdir/lua51/lua.c \ + luatexdir/lua51/luac.c luatexdir/lua51/print.c \ + luatexdir/luasocket/src/socket_lua.c \ luatexdir/luasocket/src/ftp_lua.c \ luatexdir/luasocket/src/http_lua.c \ luatexdir/luasocket/src/smtp_lua.c \ @@ -1576,42 +1577,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 $(xetex_web_srcs) \ - xetexdir/xetex.defines xetexdir/unicode-char-prep.pl \ - xetexdir/appleGlyphNames.c xetexdir/ChangeLog $(xetex_tests) \ - xetexdir/LICENSE.txt 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 $(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/LICENSE.txt \ + 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 \ @@ -1671,8 +1672,8 @@ 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 \ - $(nodist_xetex_SOURCES) xetex.web xetex-web2c xetex.p \ + $(nodist_libluatex_a_SOURCES) txt2zlib.c X* \ + $(nodist_xetex_SOURCES) xetex.web xetex.ch xetex-web2c xetex.p \ xetex.pool xetex-tangle $(omegaware_programs:=.c) \ $(omegaware_programs:=.h) $(omegaware_programs:=.p) \ $(omegaware_programs:=-web2c) ovf2ovp.web ovp2ovf.web \ @@ -2566,6 +2567,7 @@ txt2zlib_LDADD = $(ZLIB_LIBS) # Force Automake to use CXXLD for linking nodist_EXTRA_xetex_SOURCES = dummy.cxx +xe_tangle = WEBINPUTS=.:$(srcdir)/xetexdir $(SHELL) ./tangle-sh $@ $(OTANGLE) libxetex = libxetex.a xetex_cppflags = $(AM_CPPFLAGS) -I$(srcdir)/xetexdir $(ICU_INCLUDES) \ $(FREETYPE2_INCLUDES) $(TECKIT_INCLUDES) $(am__append_68) \ @@ -2587,7 +2589,18 @@ xetex_c_h = xetexini.c xetex0.c xetexcoerce.h xetexd.h nodist_xetex_SOURCES = $(xetex_c_h) xetex-pool.c dist_xetex_SOURCES = xetexdir/xetexextra.c xetexdir/xetexextra.h \ xetexdir/xetex_version.h $(am__append_113) -xetex_web_srcs = \ +xetex_ch_srcs = \ + xetexdir/xetex.web \ + xetexdir/tex.ch0 \ + tex.ch \ + $(xetex_ch_synctex) \ + xetexdir/xetex.ch \ + xetexdir/xetex-latex3.ch \ + xetexdir/xetex-hz.ch \ + $(xetex_post_ch_synctex) \ + tex-binpool.ch + +Xold_web_srcs = \ tex.web \ etexdir/etex.ch \ etexdir/tex.ch0 \ @@ -2596,9 +2609,9 @@ xetex_web_srcs = \ etexdir/tex.ech \ tex-binpool.ch \ $(xetex_ch_synctex) \ - xetexdir/xetex.ch \ - xetexdir/xetex-latex3.ch \ - xetexdir/xetex-hz.ch \ + xetex-orig.ch \ + xetex-latex3.ch \ + xetex-hz.ch \ $(xetex_post_ch_synctex) libxetex_a_CPPFLAGS = $(xetex_cppflags) @@ -10252,17 +10265,36 @@ xetex-pool.c: xetex.pool xetexd.h $(makecpool_stamp) $(makecpool) xetex >$@ || rm -f $@ xetex.p xetex.pool: xetex-tangle - @$(o_tangle) xetex -xetex-tangle: ./otangle$(EXEEXT) xetex.web tangle-sh - @$(o_tangle) xetex + @$(xe_tangle) xetex xetex +xetex-tangle: otangle$(EXEEXT) xetexdir/xetex.web xetex.ch tangle-sh + @$(xe_tangle) xetex xetex xetexdir/xetex_version.h: xetexdir/xetex.ch $(MKDIR_P) xetexdir - grep '^@d XeTeX_version_string==' $(srcdir)/xetexdir/xetex.ch \ + grep '^@d XeTeX_version_string==' $(srcdir)/xetexdir/xetex.web \ | sed "s/^.*'-/#define XETEX_VERSION \"/;s/'.*$$/\"/" >$@ -xetex.web: tie$(EXEEXT) $(xetex_web_srcs) - $(tie) -m xetex.web $(xetex_web_srcs) +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/xetex-hz.ch b/Build/source/texk/web2c/xetex-hz.ch new file mode 100644 index 00000000000..a6c6414f442 --- /dev/null +++ b/Build/source/texk/web2c/xetex-hz.ch @@ -0,0 +1,1035 @@ +/****************************************************************************\ + 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 new file mode 100644 index 00000000000..42463cc342a --- /dev/null +++ b/Build/source/texk/web2c/xetex-latex3.ch @@ -0,0 +1,974 @@ +/****************************************************************************\ + 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 new file mode 100644 index 00000000000..16cc05c8650 --- /dev/null +++ b/Build/source/texk/web2c/xetex-orig.ch @@ -0,0 +1,8705 @@ +/****************************************************************************\ + 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 7243a75b0f0..7c428e7cb45 100644 --- a/Build/source/texk/web2c/xetexdir/am/xetex.am +++ b/Build/source/texk/web2c/xetexdir/am/xetex.am @@ -13,6 +13,8 @@ EXTRA_PROGRAMS += xetex # Force Automake to use CXXLD for linking nodist_EXTRA_xetex_SOURCES = dummy.cxx +xe_tangle = WEBINPUTS=.:$(srcdir)/xetexdir $(SHELL) ./tangle-sh $@ $(OTANGLE) + libxetex = libxetex.a xetex_cppflags = $(AM_CPPFLAGS) -I$(srcdir)/xetexdir @@ -78,21 +80,38 @@ xetex-pool.c: xetex.pool xetexd.h $(makecpool_stamp) ## Tangling XeTeX xetex.p xetex.pool: xetex-tangle - @$(o_tangle) xetex -xetex-tangle: ./otangle$(EXEEXT) xetex.web tangle-sh - @$(o_tangle) xetex + @$(xe_tangle) xetex xetex +xetex-tangle: otangle$(EXEEXT) xetexdir/xetex.web xetex.ch tangle-sh + @$(xe_tangle) xetex xetex ## Extract xetex version xetexdir/xetex_version.h: xetexdir/xetex.ch $(MKDIR_P) xetexdir - grep '^@d XeTeX_version_string==' $(srcdir)/xetexdir/xetex.ch \ + grep '^@d XeTeX_version_string==' $(srcdir)/xetexdir/xetex.web \ | sed "s/^.*'-/#define XETEX_VERSION \"/;s/'.*$$/\"/" >$@ -## Generate xetex.web -xetex.web: tie$(EXEEXT) $(xetex_web_srcs) - $(tie) -m xetex.web $(xetex_web_srcs) - -xetex_web_srcs = \ +## Generate xetex.ch +xetex.ch: tie$(EXEEXT) $(xetex_ch_srcs) + $(tie) -c xetex.ch $(xetex_ch_srcs) +xetex_ch_srcs = \ + xetexdir/xetex.web \ + xetexdir/tex.ch0 \ + tex.ch \ + $(xetex_ch_synctex) \ + xetexdir/xetex.ch \ + xetexdir/xetex-latex3.ch \ + xetexdir/xetex-hz.ch \ + $(xetex_post_ch_synctex) \ + tex-binpool.ch + +## Merging in XeTeX change files - begin +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 \ @@ -101,14 +120,31 @@ xetex_web_srcs = \ etexdir/tex.ech \ tex-binpool.ch \ $(xetex_ch_synctex) \ - xetexdir/xetex.ch \ - xetexdir/xetex-latex3.ch \ - xetexdir/xetex-hz.ch \ + xetex-orig.ch \ + xetex-latex3.ch \ + xetex-hz.ch \ $(xetex_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) xetexdir/xetex.defines +EXTRA_DIST += $(xetex_web_srcs) $(xetex_ch_srcs) xetexdir/xetex.defines -DISTCLEANFILES += $(nodist_xetex_SOURCES) xetex.web xetex-web2c \ +DISTCLEANFILES += $(nodist_xetex_SOURCES) xetex.web xetex.ch xetex-web2c \ xetex.p xetex.pool xetex-tangle EXTRA_DIST += \ diff --git a/Build/source/texk/web2c/xetexdir/tex.ch0 b/Build/source/texk/web2c/xetexdir/tex.ch0 new file mode 100644 index 00000000000..85740e2625d --- /dev/null +++ b/Build/source/texk/web2c/xetexdir/tex.ch0 @@ -0,0 +1,40 @@ +% Change file to assist in creating the web2c-specific change file. +% This one comes first, resolves inconsistencies between the generated +% etex.web and tex.ch +% Public domain. + +@x [1.2] l.188 +@d TeX_banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts} +@# +@d banner==XeTeX_banner +@y +@d banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts} +@z + +@x [8.110] l.2405 - increase |max_halfword| +@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|} +@y +@d max_quarterword=255 {largest allowable value in a |quarterword|} +@d min_halfword==0 {smallest allowable value in a |halfword|} +@d max_halfword==65535 {largest allowable value in a |halfword|} +@z + +@x [15.209] l.4165 - additional XeTeX commands +@d shorthand_def=97 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} +@y +@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} +@z + +@x [17.230] l.4731 - MLTeX: char_sub_code_base +@d int_base=math_code_base+number_usvs {beginning of region 5} +@y +@d int_base=math_code_base+256 {beginning of region 5} +@z + +@x [17.236] l.4960 - first web2c, then e-TeX additional integer parameters +@d tex_int_pars=55 {total number of \TeX's integer parameters} +@y +@d int_pars=55 {total number of integer parameters} +@z diff --git a/Build/source/texk/web2c/xetexdir/xetex-hz.ch b/Build/source/texk/web2c/xetexdir/xetex-hz.ch index a6c6414f442..62df37aab1f 100644 --- a/Build/source/texk/web2c/xetexdir/xetex-hz.ch +++ b/Build/source/texk/web2c/xetexdir/xetex-hz.ch @@ -31,174 +31,6 @@ 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; @@ -214,37 +46,6 @@ margin_kern_node: begin 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); diff --git a/Build/source/texk/web2c/xetexdir/xetex-latex3.ch b/Build/source/texk/web2c/xetexdir/xetex-latex3.ch index 42463cc342a..75712a7b643 100644 --- a/Build/source/texk/web2c/xetexdir/xetex-latex3.ch +++ b/Build/source/texk/web2c/xetexdir/xetex-latex3.ch @@ -32,39 +32,6 @@ 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 diff --git a/Build/source/texk/web2c/xetexdir/xetex.ch b/Build/source/texk/web2c/xetexdir/xetex.ch index 16cc05c8650..b15ed29c152 100644 --- a/Build/source/texk/web2c/xetexdir/xetex.ch +++ b/Build/source/texk/web2c/xetexdir/xetex.ch @@ -31,162 +31,21 @@ 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 +@x [1] m.2 l.188 - banner +@d banner==TeX_banner +@d banner_k==TeX_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|} +@d banner_k==XeTeX_banner @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; @@ -196,106 +55,6 @@ xprn: array [ASCII_code] of ASCII_code; {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; @@ -304,2240 +63,124 @@ for i:=@'177 to @'377 do xchr[i]:=i; @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 +{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<="~"))); -@d etex_convert_codes=XeTeX_glyph_name_code+1 {end of \eTeX's command codes} -@z +{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.} -@x - eTeX_revision_code: print_esc("eTeXrevision"); +{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 -@!c:number_code..job_name_code; {desired type of conversion} +@!name_of_file:^text_char; @y -@!c:small_number; {desired type of conversion} +@!name_of_file:^UTF8_code; {we build filenames in utf8 to pass to the OS} @z @x -@!b:pool_pointer; {base of temporary string} +@!name_of_file16:array[1..file_name_size] of UTF16_code;@;@/ @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; +@!name_of_file16:^UTF16_code; @z @x -eTeX_revision_code: do_nothing; +@!buffer:^ASCII_code; {lines of characters being read} @y -@/@@/ +@!buffer:^UnicodeScalar; {lines of characters being read} @z @x -font_name_code: begin print(font_name[cur_val]); +@d term_in==stdin {the terminal as an input file} @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); +@!bound_default:integer; {temporary for setup} @y -@/@@/ +@!term_in:unicode_file; +@# +@!bound_default:integer; {temporary for setup} @z @x -job_name_code: print(job_name); +if translate_filename then begin + wterm(' ('); + fputs(translate_filename, stdout); + wterm_ln(')'); @y -job_name_code: print_file_name(job_name, 0, 0); +if translate_filename then begin + wterm(' (WARNING: translate-file "'); + fputs(translate_filename, stdout); + wterm_ln('" ignored)'); @z @x -@!read_file:array[0..15] of alpha_file; {used for \.{\\read}} +k:=first; while k < last do begin print_buffer(k) end; @y -@!read_file:array[0..15] of unicode_file; {used for \.{\\read}} +if last<>first then for k:=first to last-1 do print(buffer[k]); @z -@x -else begin a_close(read_file[m]); read_open[m]:=closed; +@x [6.84] l.1904 - Implement the switch-to-editor option. + 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 -else begin u_close(read_file[m]); read_open[m]:=closed; + 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 - begin a_close(read_file[m]); read_open[m]:=closed; +@x [8.110] l.2406 +@d max_quarterword=255 {largest allowable value in a |quarterword|} @y - begin u_close(read_file[m]); read_open[m]:=closed; +@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|} @z - -@x -if (cur_cmd>active_char)or(cur_chr>255) then {not a character} - begin m:=relax; n:=256; +@x [8.110] l.2408 +@d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|} @y -if (cur_cmd>active_char)or(cur_chr>biggest_usv) then {not a character} - begin m:=relax; n:=too_big_usv; +@d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|} @z -@x -if (cur_cmd>active_char)or(cur_chr>255) then - begin cur_cmd:=relax; cur_chr:=256; +@x [15.209] l.4165 +@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} @y -if (cur_cmd>active_char)or(cur_chr>biggest_usv) then - begin cur_cmd:=relax; cur_chr:=too_big_usv; +@d shorthand_def=97 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} @z -@x -@* \[29] File names. +@x [17.230] l.4731 +@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 -@* \[29] File names. +@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 -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. - +@x [17.236] l.4960 - first web2c, then e-TeX additional integer parameters +@d int_pars=web2c_int_pars {total number of integer parameters} +@# +@d etex_int_base=tex_int_pars {base for \eTeX's integer parameters} @y +@d etex_int_base=web2c_int_pars {base for \eTeX's integer parameters} @z @x -@!ext_delimiter:pool_pointer; {the most recent `\..', if any} +@!input_file : ^alpha_file; @y -@!ext_delimiter:pool_pointer; {the most recent `\..', if any} -@!file_name_quote_char:UTF16_code; +@!input_file : ^unicode_file; @z @x -begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false; +@* \[29] File names. @y -begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false; -file_name_quote_char:=0; +@* \[29] File names. @z @x @@ -2884,13 +527,6 @@ begin u_make_name_string:=make_name_string; end; @z -@x -loop@+begin if (cur_cmd>other_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 @@ -2900,46 +536,13 @@ loop@+begin if (cur_cmd>other_char)or(cur_chr>biggest_char) then @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 @@ -2972,23 +575,6 @@ if translate_filename then begin @* \[30] Font metric data. @z -@x -@d non_char==qi(256) {a |halfword| code that can't match a real character} -@y -@d otgr_font_flag=@"FFFE -@d aat_font_flag=@"FFFF -@d is_atsu_font(#)==(font_area[#]=aat_font_flag) -@d is_ot_font(#)==((font_area[#]=otgr_font_flag) and (usingOpenType(font_layout_engine[#]))) -@d is_gr_font(#)==((font_area[#]=otgr_font_flag) and (usingGraphite(font_layout_engine[#]))) -@d is_otgr_font(#)==(font_area[#]=otgr_font_flag) -@d is_native_font(#)==(is_atsu_font(#) or is_otgr_font(#)) - {native fonts have |font_area| = 65534 or 65535, - which would be a string containing an invalid Unicode character} -@d is_new_mathfont(#)==(is_ot_font(#) and (isOpenTypeMathFont(font_layout_engine[#]))) - -@d non_char==qi(too_big_char) {a |halfword| code that can't match a real character} -@z - @x @!font_bc: ^eight_bits; {beginning (smallest) character code} @@ -3022,69 +608,6 @@ if translate_filename then begin @!xdv_buffer: ^char; { scratch buffer used in generating XDV output } @z -@x -@0 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,""); @@ -3104,54 +627,12 @@ 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 @@ -3192,158 +673,12 @@ if is_native_font(f) then 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} @@ -3769,13 +1104,6 @@ print_ASCII(qo(character(p)) + (fam(p) div @"100) * @"10000); @* \[35] Subroutines for math mode. @z -@x -@d text_size=0 {size code for the largest size in a family} -@d script_size=16 {size code for the medium size in a family} -@d script_script_size=32 {size code for the smallest size in a family} -@y -@z - @x @d mathsy_end(#)==fam_fnt(2+#)]].sc @d mathsy(#)==font_info[#+param_base[mathsy_end @@ -6687,12 +4015,28 @@ k:=biggest_lang+1; input_file:=xmalloc_array (unicode_file, max_in_open); @z +@x [51.1332] l.24203 (ca.) texarray + line_stack:=xmalloc_array (integer, max_in_open); +@y + line_stack:=xmalloc_array (integer, max_in_open); + eof_seen:=xmalloc_array (boolean, max_in_open); + grp_stack:=xmalloc_array (save_pointer, max_in_open); + if_stack:=xmalloc_array (pointer, max_in_open); +@z + @x print_file_name(0, log_name, 0); print_char("."); @y print(log_name); print_char("."); @z +@x [51.1337] l.24371 (ca.) texarray + trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0; +@y + trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0; + hyph_root:=0; hyph_start:=0; +@z + @x {Allocate and initialize font arrays} @y @@ -7571,6 +4915,19 @@ end @z +@x [53a.1379] l.??? -etex command line switch +@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then +@y +@!init if (etex_p or(buffer[loc]="*"))and(format_ident=" (INITEX)") then +@z + +@x [53a.1379] l.??? -etex command line switch + incr(loc); eTeX_mode:=1; {enter extended mode} +@y + if (buffer[loc]="*") then incr(loc); + eTeX_mode:=1; {enter extended mode} +@z + @x @d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}} @y @@ -8024,6 +5381,13 @@ XeTeX_glyph_name_code: if is_native_font(fnt) then print_glyph_name(fnt, arg1); @z +@x [53a.1383] l.??? -etex command line switch +@!eTeX_mode: 0..1; {identifies compatibility and extended mode} +@y +@!eTeX_mode: 0..1; {identifies compatibility and extended mode} +@!etex_p: boolean; {was the -etex option specified} +@z + @x @ @= dump_int(eTeX_mode); @@ -8041,6 +5405,12 @@ every_eof_loc: print_esc("everyeof"); XeTeX_inter_char_loc: print_esc("XeTeXinterchartoks"); @z +@x [53a.1391] l.??? texarray +@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?} +@y +@!eof_seen : ^boolean; {has eof been seen?} +@z + @x font_char_wd_code, font_char_ht_code, @@ -8084,69 +5454,6 @@ font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_usv_num; 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|. @@ -8205,6 +5512,14 @@ if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num; end; @z +@x [53a.1506] l.??? texarray +@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|} +@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|} +@y +@!grp_stack : ^save_pointer; {initial |cur_boundary|} +@!if_stack : ^pointer; {initial |cond_ptr|} +@z + @x @d mark_val=6 {the additional mark classes} @y @@ -8217,6 +5532,11 @@ for i:=int_val to tok_val do sa_root[i]:=null; for i:=int_val to inter_char_val do sa_root[i]:=null; @z +@x [53a.1587] l.??? texarray +hyph_root:=0; hyph_start:=0; +@y +@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(#) @@ -8281,6 +5601,20 @@ end; @!xtx_ligature_present:boolean; {to suppress tfm font mapping of char codes from ligature nodes (already mapped)} @z +@x [54/web2c.???] l.??? needed earlier +replacement, but always existing character |font_bc[f]|. +@^inner loop@> + +@= +function effective_char(@!err_p:boolean; +@y +replacement, but always existing character |font_bc[f]|. +@^inner loop@> + +@= +function effective_char(@!err_p:boolean; +@z + @x begin result:=c; {return |c| unless it does not exist in the font} @y diff --git a/Build/source/texk/web2c/xetexdir/xetex.web b/Build/source/texk/web2c/xetexdir/xetex.web new file mode 100644 index 00000000000..3125a7c5dbc --- /dev/null +++ b/Build/source/texk/web2c/xetexdir/xetex.web @@ -0,0 +1,29712 @@ +% e-TeX is copyright (C) 1999-2012 by P. Breitenlohner (1994,98 by the NTS +% team); all rights are reserved. Copying of this file is authorized only if +% (1) you are P. Breitenlohner, or if (2) you make absolutely no changes to +% your copy. (Programs such as TIE allow the application of several change +% files to tex.web; the master files tex.web and etex.ch should stay intact.) + +% See etex_gen.tex for hints on how to install this program. +% And see etripman.tex for details about how to validate it. + +% e-TeX and NTS are trademarks of the NTS group. +% TeX is a trademark of the American Mathematical Society. +% METAFONT is a trademark of Addison-Wesley Publishing Company. + +% This program is directly derived from Donald E. Knuth's TeX; +% the change history which follows and the reward offered for finders of +% bugs refer specifically to TeX; they should not be taken as referring +% to e-TeX, although the change history is relevant in that it +% demonstrates the evolutionary path followed. This program is not TeX; +% that name is reserved strictly for the program which is the creation +% and sole responsibility of Professor Knuth. + +% Version 0 was released in September 1982 after it passed a variety of tests. +% Version 1 was released in November 1983 after thorough testing. +% Version 1.1 fixed ``disappearing font identifiers'' et alia (July 1984). +% Version 1.2 allowed `0' in response to an error, et alia (October 1984). +% Version 1.3 made memory allocation more flexible and local (November 1984). +% Version 1.4 fixed accents right after line breaks, et alia (April 1985). +% Version 1.5 fixed \the\toks after other expansion in \edefs (August 1985). +% Version 2.0 (almost identical to 1.5) corresponds to "Volume B" (April 1986). +% Version 2.1 corrected anomalies in discretionary breaks (January 1987). +% Version 2.2 corrected "(Please type...)" with null \endlinechar (April 1987). +% Version 2.3 avoided incomplete page in premature termination (August 1987). +% Version 2.4 fixed \noaligned rules in indented displays (August 1987). +% Version 2.5 saved cur_order when expanding tokens (September 1987). +% Version 2.6 added 10sp slop when shipping leaders (November 1987). +% Version 2.7 improved rounding of negative-width characters (November 1987). +% Version 2.8 fixed weird bug if no \patterns are used (December 1987). +% Version 2.9 made \csname\endcsname's "relax" local (December 1987). +% Version 2.91 fixed \outer\def\a0{}\a\a bug (April 1988). +% Version 2.92 fixed \patterns, also file names with complex macros (May 1988). +% Version 2.93 fixed negative halving in allocator when mem_min<0 (June 1988). +% Version 2.94 kept open_log_file from calling fatal_error (November 1988). +% Version 2.95 solved that problem a better way (December 1988). +% Version 2.96 corrected bug in "Infinite shrinkage" recovery (January 1989). +% Version 2.97 corrected blunder in creating 2.95 (February 1989). +% Version 2.98 omitted save_for_after at outer level (March 1989). +% Version 2.99 caught $$\begingroup\halign..$$ (June 1989). +% Version 2.991 caught .5\ifdim.6... (June 1989). +% Version 2.992 introduced major changes for 8-bit extensions (September 1989). +% Version 2.993 fixed a save_stack synchronization bug et alia (December 1989). +% Version 3.0 fixed unusual displays; was more \output robust (March 1990). +% Version 3.1 fixed nullfont, disabled \write{\the\prevgraf} (September 1990). +% Version 3.14 fixed unprintable font names and corrected typos (March 1991). +% Version 3.141 more of same; reconstituted ligatures better (March 1992). +% Version 3.1415 preserved nonexplicit kerns, tidied up (February 1993). +% Version 3.14159 allowed fontmemsize to change; bulletproofing (March 1995). +% Version 3.141592 fixed \xleaders, glueset, weird alignments (December 2002). +% Version 3.1415926 was a general cleanup with minor fixes (February 2008). + +% A reward of $327.68 will be paid to the first finder of any remaining bug. + +% A preliminary version of TeX--XeT was released in April 1992. +% TeX--XeT version 1.0 was released in June 1992, +% version 1.1 prevented arith overflow in glue computation (Oct 1992). +% A preliminary e-TeX version 0.95 was operational in March 1994. +% Version 1.0beta was released in May 1995. +% Version 1.01beta fixed bugs in just_copy and every_eof (December 1995). +% Version 1.02beta allowed 256 mark classes (March 1996). +% Version 1.1 changed \group{type,level} -> \currentgroup{type,level}, +% first public release (October 1996). +% Version 2.0 development was started in March 1997; +% fixed a ligature-\beginR bug in January 1998; +% was released in March 1998. +% Version 2.1 fixed a \marks bug (when min_halfword<>0) (January 1999). +% Version 2.2 development was started in Feb 2003; released in Oct 2004. +% fixed a bug in sparse array handling (0=>null), Jun 2002; +% fixed a bug in \lastnodetype (cur_val=>cur_val_level) +% reported by Hartmut Henkel , +% fix by Fabrice Popineau , +% Jan 2004; +% another bug in sparse array handling (cur_ptr=>cur_chr) +% reported by Taco Hoekwater , Jul 2004; +% fixed a sparse array reference count bug (\let,\futurelet), +% fix by Bernd Raichle , Aug 2004; +% reorganized handling of banner, additional token list and +% integer parameters, and similar in order to reduce the +% interference between eTeX, pdfTeX, and web2c change files. +% adapted to tex.web 3.141592, revised glue rounding for mixed +% direction typesetting; +% fixed a bug in the revised glue rounding code, detected by +% Tigran Aivazian , Oct 2004. +% Version 2.3 development was started in Feb 2008; released in Apr 2011. +% fixed a bug in hyph_code handling (\savinghyphcodes) +% reported by Vladimir Volovich , Feb 2008. +% fixed the error messages for improper use of \protected, +% reported by Heiko Oberdiek +% , May 2010. +% some rearrangements to reduce interferences between +% e-TeX and pTeX, in part suggested by Hironori Kitagawa +% , Mar 2011. +% Version 2.4 fixed an uninitialized line number bug, released in May 2012. +% Version 2.5 development was started in Aug 2012; released in ??? 20??. +% better tracing of font definitions, reported by +% Bruno Le Floch , Jul 2012. + +% Although considerable effort has been expended to make the e-TeX program +% correct and reliable, no warranty is implied; the author disclaims any +% obligation or liability for damages, including but not limited to +% special, indirect, or consequential damages arising out of or in +% connection with the use or performance of this software. This work has +% been a ``labor of love'' and the author hopes that users enjoy it. + +% Here is TeX material that gets inserted after \input webmac +\def\hang{\hangindent 3em\noindent\ignorespaces} +\def\hangg#1 {\hang\hbox{#1 }} +\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces} +\font\ninerm=cmr9 +\let\mc=\ninerm % medium caps for names like SAIL +\def\XeTeX{Xe\TeX} +\def\eTeX{$\varepsilon$-\TeX} +\font\revrm=xbmc10 % for right-to-left text +% to generate xbmc10 (i.e., reflected cmbx10) use a file +% xbmc10.mf containing: +%+++++++++++++++++++++++++++++++++++++++++++++++++ +% if unknown cmbase: input cmbase fi +% extra_endchar := extra_endchar & +% "currentpicture:=currentpicture " & +% "reflectedabout((.5[l,r],0),(.5[l,r],1));"; +% input cmbx10 +%+++++++++++++++++++++++++++++++++++++++++++++++++ +\ifx\beginL\undefined % this is TeX + \def\XeT{X\kern-.125em\lower.5ex\hbox{E}\kern-.1667emT} + \def\TeXeT{\TeX-\hbox{\revrm \XeT}} % for TeX-XeT + \def\TeXXeT{\TeX-\hbox{\revrm -\XeT}} % for TeX--XeT +\else + \ifx\eTeXversion\undefined % this is \TeXeT + \def\TeXeT{\TeX-{\revrm\beginR\TeX\endR}} % for TeX-XeT + \def\TeXXeT{\TeX-{\revrm\beginR\TeX-\endR}} % for TeX--XeT + \else % this is \eTeX + \def\TeXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX\endR}} % for TeX-XeT + \def\TeXXeT{\TeX-{\TeXXeTstate=1\revrm\beginR\TeX-\endR}} % for TeX--XeT + \fi +\fi +\def\PASCAL{Pascal} +\def\ph{\hbox{Pascal-H}} +\def\pct!{{\char`\%}} % percent sign in ordinary text +\def\grp{\.{\char'173...\char'175}} +\font\logo=logo10 % font used for the METAFONT logo +\def\MF{{\logo META}\-{\logo FONT}} +\def\<#1>{$\langle#1\rangle$} +\def\section{\mathhexbox278} + +\def\(#1){} % this is used to make section names sort themselves better +\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@> + +\outer\def\N#1. \[#2]#3.{\MN#1.\vfil\eject % begin starred section + \def\rhead{PART #2:\uppercase{#3}} % define running headline + \message{*\modno} % progress report + \edef\next{\write\cont{\Z{\?#2]#3}{\modno}{\the\pageno}}}\next + \ifon\startsection{\bf\ignorespaces#3.\quad}\ignorespaces} +\let\?=\relax % we want to be able to \write a \? + +\def\title{\XeTeX} +% system dependent redefinitions of \title should come later +% and should use: +% \toks0=\expandafter{\title} +% \edef\title{...\the\toks0...} +\def\topofcontents{\hsize 5.5in + \vglue 0pt plus 1fil minus 1.5in + \def\?##1]{\hbox to 1in{\hfil##1.\ }} + } +\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} +\pageno=3 +\def\glob{13} % this should be the section number of "" +\def\gglob{20, 26} % this should be the next two sections of "" + +@* \[1] Introduction. +This is \eTeX, a program derived from and extending the capabilities of +\TeX, a document compiler intended to produce typesetting of high +quality. +The \PASCAL\ program that follows is the definition of \TeX82, a standard +@:PASCAL}{\PASCAL@> +@!@:TeX82}{\TeX82@> +version of \TeX\ that is designed to be highly portable so that identical output +will be obtainable on a great variety of computers. + +The main purpose of the following program is to explain the algorithms of \TeX\ +as clearly as possible. As a result, the program will not necessarily be very +efficient when a particular \PASCAL\ compiler has translated it into a +particular machine language. However, the program has been written so that it +can be tuned to run efficiently in a wide variety of operating environments +by making comparatively few changes. Such flexibility is possible because +the documentation that follows is written in the \.{WEB} language, which is +at a higher level than \PASCAL; the preprocessing step that converts \.{WEB} +to \PASCAL\ is able to introduce most of the necessary refinements. +Semi-automatic translation to other languages is also feasible, because the +program below does not make extensive use of features that are peculiar to +\PASCAL. + +A large piece of software like \TeX\ has inherent complexity that cannot +be reduced below a certain level of difficulty, although each individual +part is fairly simple by itself. The \.{WEB} language is intended to make +the algorithms as readable as possible, by reflecting the way the +individual program pieces fit together and by providing the +cross-references that connect different parts. Detailed comments about +what is going on, and about why things were done in certain ways, have +been liberally sprinkled throughout the program. These comments explain +features of the implementation, but they rarely attempt to explain the +\TeX\ language itself, since the reader is supposed to be familiar with +{\sl The \TeX book}. +@.WEB@> +@:TeXbook}{\sl The \TeX book@> + +@ The present implementation has a long ancestry, beginning in the summer +of~1977, when Michael~F. Plass and Frank~M. Liang designed and coded +a prototype +@^Plass, Michael Frederick@> +@^Liang, Franklin Mark@> +@^Knuth, Donald Ervin@> +based on some specifications that the author had made in May of that year. +This original proto\TeX\ included macro definitions and elementary +manipulations on boxes and glue, but it did not have line-breaking, +page-breaking, mathematical formulas, alignment routines, error recovery, +or the present semantic nest; furthermore, +it used character lists instead of token lists, so that a control sequence +like \.{\\halign} was represented by a list of seven characters. A +complete version of \TeX\ was designed and coded by the author in late +1977 and early 1978; that program, like its prototype, was written in the +{\mc SAIL} language, for which an excellent debugging system was +available. Preliminary plans to convert the {\mc SAIL} code into a form +somewhat like the present ``web'' were developed by Luis Trabb~Pardo and +@^Trabb Pardo, Luis Isidoro@> +the author at the beginning of 1979, and a complete implementation was +created by Ignacio~A. Zabala in 1979 and 1980. The \TeX82 program, which +@^Zabala Salelles, Ignacio Andr\'es@> +was written by the author during the latter part of 1981 and the early +part of 1982, also incorporates ideas from the 1979 implementation of +@^Guibas, Leonidas Ioannis@> +@^Sedgewick, Robert@> +@^Wyatt, Douglas Kirk@> +\TeX\ in {\mc MESA} that was written by Leonidas Guibas, Robert Sedgewick, +and Douglas Wyatt at the Xerox Palo Alto Research Center. Several hundred +refinements were introduced into \TeX82 based on the experiences gained with +the original implementations, so that essentially every part of the system +has been substantially improved. After the appearance of ``Version 0'' in +September 1982, this program benefited greatly from the comments of +many other people, notably David~R. Fuchs and Howard~W. Trickey. +A final revision in September 1989 extended the input character set to +eight-bit codes and introduced the ability to hyphenate words from +different languages, based on some ideas of Michael~J. Ferguson. +@^Fuchs, David Raymond@> +@^Trickey, Howard Wellington@> +@^Ferguson, Michael John@> + +No doubt there still is plenty of room for improvement, but the author +is firmly committed to keeping \TeX82 ``frozen'' from now on; stability +and reliability are to be its main virtues. + +On the other hand, the \.{WEB} description can be extended without changing +the core of \TeX82 itself, and the program has been designed so that such +extensions are not extremely difficult to make. +The |banner| string defined here should be changed whenever \TeX\ +undergoes any modifications, so that it will be clear which version of +\TeX\ might be the guilty party when a problem arises. +@^extensions to \TeX@> +@^system dependencies@> + +This program contains code for various features extending \TeX, +therefore this program is called `\eTeX' and not +`\TeX'; the official name `\TeX' by itself is reserved +for software systems that are fully compatible with each other. +A special test suite called the ``\.{TRIP} test'' is available for +helping to determine whether a particular implementation deserves to be +known as `\TeX' [cf.~Stanford Computer Science report CS1027, +November 1984]. + +A similar test suite called the ``\.{e-TRIP} test'' is available for +helping to determine whether a particular implementation deserves to be +known as `\eTeX'. + +@d eTeX_version=2 { \.{\\eTeXversion} } +@d eTeX_revision==".5" { \.{\\eTeXrevision} } +@d eTeX_version_string=='-2.5' {current \eTeX\ version} +@# +@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 TeX_banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts} +@# +@d banner==XeTeX_banner +@# +@d TEX==XETEX {change program name into |XETEX|} +@# +@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|} + +@ Different \PASCAL s have slightly different conventions, and the present +@!@:PASCAL H}{\ph@> +program expresses \TeX\ in terms of the \PASCAL\ that was +available to the author in 1982. Constructions that apply to +this particular compiler, which we shall call \ph, should help the +reader see how to make an appropriate interface for other systems +if necessary. (\ph\ is Charles Hedrick's modification of a compiler +@^Hedrick, Charles Locke@> +for the DECsystem-10 that was originally developed at the University of +Hamburg; cf.\ {\sl SOFTWARE---Practice \AM\ Experience \bf6} (1976), +29--42. The \TeX\ program below is intended to be adaptable, without +extensive changes, to most other versions of \PASCAL, so it does not fully +use the admirable features of \ph. Indeed, a conscious effort has been +made here to avoid using several idiosyncratic features of standard +\PASCAL\ itself, so that most of the code can be translated mechanically +into other high-level languages. For example, the `\&{with}' and `\\{new}' +features are not used, nor are pointer types, set types, or enumerated +scalar types; there are no `\&{var}' parameters, except in the case of files +--- \eTeX, however, does use `\&{var}' parameters for the |reverse| function; +there are no tag fields on variant records; there are no assignments +|real:=integer|; no procedures are declared local to other procedures.) + +The portions of this program that involve system-dependent code, where +changes might be necessary because of differences between \PASCAL\ compilers +and/or differences between +operating systems, can be identified by looking at the sections whose +numbers are listed under `system dependencies' in the index. Furthermore, +the index entries for `dirty \PASCAL' list all places where the restrictions +of \PASCAL\ have not been followed perfectly, for one reason or another. +@!@^system dependencies@> +@!@^dirty \PASCAL@> + +Incidentally, \PASCAL's standard |round| function can be problematical, +because it disagrees with the IEEE floating-point standard. +Many implementors have +therefore chosen to substitute their own home-grown rounding procedure. + +@ The program begins with a normal \PASCAL\ program heading, whose +components will be filled in later, using the conventions of \.{WEB}. +@.WEB@> +For example, the portion of the program called `\X\glob:Global +variables\X' below will be replaced by a sequence of variable declarations +that starts in $\section\glob$ of this documentation. In this way, we are able +to define each individual global variable when we are prepared to +understand what it means; we do not have to define all of the globals at +once. Cross references in $\section\glob$, where it says ``See also +sections \gglob, \dots,'' also make it possible to look at the set of +all global variables, if desired. Similar remarks apply to the other +portions of the program heading. + +Actually the heading shown here is not quite normal: The |program| line +does not mention any |output| file, because \ph\ would ask the \TeX\ user +to specify a file name if |output| were specified here. +@:PASCAL H}{\ph@> +@^system dependencies@> + +@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:} +@f mtype==type {`\&{mtype}' will be equivalent to `\&{type}'} +@f type==true {but `|type|' will not be treated as a reserved word} + +@p @t\4@>@@/ +program TEX; {all file names are defined dynamically} +label @@/ +const @@/ +mtype @@/ +var @@/ +@# +procedure initialize; {this procedure gets things started properly} + var @@/ + begin @@; + end;@# +@t\4@>@@/ +@t\4@>@@/ + +@ The overall \TeX\ program begins with the heading just shown, after which +comes a bunch of procedure declarations and function declarations. +Finally we will get to the main program, which begins with the +comment `|start_here|'. If you want to skip down to the +main program now, you can look up `|start_here|' in the index. +But the author suggests that the best way to understand this program +is to follow pretty much the order of \TeX's components as they appear in the +\.{WEB} description you are now reading, since the present ordering is +intended to combine the advantages of the ``bottom up'' and ``top down'' +approaches to the problem of understanding a somewhat complicated system. + +@ Three labels must be declared in the main program, so we give them +symbolic names. + +@d start_of_TEX=1 {go here when \TeX's variables are initialized} +@d end_of_TEX=9998 {go here to close files and terminate gracefully} +@d final_end=9999 {this label marks the ending of the program} + +@= +start_of_TEX@t\hskip-2pt@>, end_of_TEX@t\hskip-2pt@>,@,final_end; + {key control points} + +@ Some of the code below is intended to be used only when diagnosing the +strange behavior that sometimes occurs when \TeX\ is being installed or +when system wizards are fooling around with \TeX\ without quite knowing +what they are doing. Such code will not normally be compiled; it is +delimited by the codewords `$|debug|\ldots|gubed|$', with apologies +to people who wish to preserve the purity of English. + +Similarly, there is some conditional code delimited by +`$|stat|\ldots|tats|$' that is intended for use when statistics are to be +kept about \TeX's memory usage. The |stat| $\ldots$ |tats| code also +implements diagnostic information for \.{\\tracingparagraphs} and +\.{\\tracingpages}. +@^debugging@> + +@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} +@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} +@f debug==begin +@f gubed==end +@# +@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering + usage statistics} +@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering + usage statistics} +@f stat==begin +@f tats==end + +@ This program has two important variations: (1) There is a long and slow +version called \.{INITEX}, which does the extra calculations needed to +@.INITEX@> +initialize \TeX's internal tables; and (2)~there is a shorter and faster +production version, which cuts the initialization to a bare minimum. +Parts of the program that are needed in (1) but not in (2) are delimited by +the codewords `$|init|\ldots|tini|$'. + +@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version} +@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version} +@f init==begin +@f tini==end + +@= +@@/ +@!init @@;@+tini + +@ If the first character of a \PASCAL\ comment is a dollar sign, +\ph\ treats the comment as a list of ``compiler directives'' that will +affect the translation of this program into machine language. The +directives shown below specify full checking and inclusion of the \PASCAL\ +debugger when \TeX\ is being debugged, but they cause range checking and other +redundant code to be eliminated when the production system is being generated. +Arithmetic overflow will be detected in all cases. +@:PASCAL H}{\ph@> +@^system dependencies@> +@^overflow in arithmetic@> + +@= +@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} +@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} + +@ This \TeX\ implementation conforms to the rules of the {\sl Pascal User +@:PASCAL}{\PASCAL@> +@^system dependencies@> +Manual} published by Jensen and Wirth in 1975, except where system-dependent +@^Wirth, Niklaus@> +@^Jensen, Kathleen@> +code is necessary to make a useful system program, and except in another +respect where such conformity would unnecessarily obscure the meaning +and clutter up the code: We assume that |case| statements may include a +default case that applies if no matching label is found. Thus, we shall use +constructions like +$$\vbox{\halign{\ignorespaces#\hfil\cr +|case x of|\cr +1: $\langle\,$code for $x=1\,\rangle$;\cr +3: $\langle\,$code for $x=3\,\rangle$;\cr +|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr +|endcases|\cr}}$$ +since most \PASCAL\ compilers have plugged this hole in the language by +incorporating some sort of default mechanism. For example, the \ph\ +compiler allows `|others|:' as a default label, and other \PASCAL s allow +syntaxes like `\&{else}' or `\&{otherwise}' or `\\{otherwise}:', etc. The +definitions of |othercases| and |endcases| should be changed to agree with +local conventions. Note that no semicolon appears before |endcases| in +this program, so the definition of |endcases| should include a semicolon +if the compiler wants one. (Of course, if no default mechanism is +available, the |case| statements of \TeX\ will have to be laboriously +extended by listing all remaining cases. People who are stuck with such +\PASCAL s have, in fact, done this, successfully but not happily!) +@:PASCAL H}{\ph@> + +@d othercases == others: {default for cases not listed explicitly} +@d endcases == @+end {follows the default case in an extended |case| statement} +@f othercases == else +@f endcases == end + +@ The following parameters can be changed at compile time to extend or +reduce \TeX's capacity. They may have different values in \.{INITEX} and +in production versions of \TeX. +@.INITEX@> +@^system dependencies@> + +@= +@!mem_max=30000; {greatest index in \TeX's internal |mem| array; + must be strictly less than |max_halfword|; + must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|} +@!mem_min=0; {smallest index in \TeX's internal |mem| array; + must be |min_halfword| or more; + must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|} +@!buf_size=500; {maximum number of characters simultaneously present in + current lines of open files and in control sequences between + \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|} +@!error_line=72; {width of context lines on terminal error messages} +@!half_error_line=42; {width of first lines of contexts in terminal + error messages; should be between 30 and |error_line-15|} +@!max_print_line=79; {width of longest text lines output; should be at least 60} +@!stack_size=200; {maximum number of simultaneous input sources} +@!max_in_open=6; {maximum number of input files and error insertions that + can be going on simultaneously} +@!font_max=75; {maximum internal font number; must not exceed |max_quarterword| + and must be at most |font_base+256|} +@!font_mem_size=20000; {number of words of |font_info| for all fonts} +@!param_size=60; {maximum number of simultaneous macro parameters} +@!nest_size=40; {maximum number of semantic levels simultaneously active} +@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|} +@!string_vacancies=8000; {the minimum number of characters that should be + available for the user's control sequences and font names, + after \TeX's own error messages are stored} +@!pool_size=32000; {maximum number of characters in strings, including all + error messages and help texts, and the names of all fonts and + control sequences; must exceed |string_vacancies| by the total + length of \TeX's own strings, which is currently about 23000} +@!save_size=600; {space for saving values outside of current group; must be + at most |max_halfword|} +@!trie_size=8000; {space for hyphenation patterns; should be larger for + \.{INITEX} than it is in production versions of \TeX} +@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns} +@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8} +@!file_name_size=40; {file names shouldn't be longer than this} +@!pool_name='TeXformats:TEX.POOL '; + {string of length |file_name_size|; tells where the string pool appears} +@.TeXformats@> + +@ Like the preceding parameters, the following quantities can be changed +at compile time to extend or reduce \TeX's capacity. But if they are changed, +it is necessary to rerun the initialization program \.{INITEX} +@.INITEX@> +to generate new tables for the production \TeX\ program. +One can't simply make helter-skelter changes to the following constants, +since certain rather complex initialization +numbers are computed from them. They are defined here using +\.{WEB} macros, instead of being put into \PASCAL's |const| list, in order to +emphasize this distinction. + +@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX}; + must not be less than |mem_min|} +@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX}; + must be substantially larger than |mem_bot| + and not greater than |mem_max|} +@d font_base=0 {smallest internal font number; must not be less + than |min_quarterword|} +@d hash_size=2100 {maximum number of control sequences; it should be at most + about |(mem_max-mem_min)/10|} +@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|} +@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions} +@d biggest_char=65535 {the largest allowed character number; + must be |<=max_quarterword|} +{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_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 +@^system dependencies@> + +@ In case somebody has inadvertently made bad settings of the ``constants,'' +\TeX\ checks them using a global variable called |bad|. + +This is the first of many sections of \TeX\ where global variables are +defined. + +@= +@!bad:integer; {is some ``constant'' wrong?} + +@ Later on we will say `\ignorespaces|if mem_max>=max_halfword then bad:=14|', +or something similar. (We can't do that until |max_halfword| has been defined.) + +@= +bad:=0; +if (half_error_line<30)or(half_error_line>error_line-15) then bad:=1; +if max_print_line<60 then bad:=2; +if dvi_buf_size mod 8<>0 then bad:=3; +if mem_bot+1100>mem_top then bad:=4; +if hash_prime>hash_size then bad:=5; +if max_in_open>=128 then bad:=6; +if mem_top<256+11 then bad:=7; {we will want |null_list>255|} + +@ Labels are given symbolic names by the following definitions, so that +occasional |goto| statements will be meaningful. We insert the label +`|exit|' just before the `\ignorespaces|end|\unskip' of a procedure in +which we have used the `|return|' statement defined below; the label +`|restart|' is occasionally used at the very beginning of a procedure; and +the label `|reswitch|' is occasionally used just prior to a |case| +statement in which some cases change the conditions and we wish to branch +to the newly applicable case. Loops that are set up with the |loop| +construction defined below are commonly exited by going to `|done|' or to +`|found|' or to `|not_found|', and they are sometimes repeated by going to +`|continue|'. If two or more parts of a subroutine start differently but +end up the same, the shared code may be gathered together at +`|common_ending|'. + +Incidentally, this program never declares a label that isn't actually used, +because some fussy \PASCAL\ compilers will complain about redundant labels. + +@d exit=10 {go here to leave a procedure} +@d restart=20 {go here to start a procedure again} +@d reswitch=21 {go here to start a case statement again} +@d continue=22 {go here to resume a loop} +@d done=30 {go here to exit a loop} +@d done1=31 {like |done|, when there is more than one loop} +@d done2=32 {for exiting the second loop in a long block} +@d done3=33 {for exiting the third loop in a very long block} +@d done4=34 {for exiting the fourth loop in an extremely long block} +@d done5=35 {for exiting the fifth loop in an immense block} +@d done6=36 {for exiting the sixth loop in a block} +@d found=40 {go here when you've found it} +@d found1=41 {like |found|, when there's more than one per routine} +@d found2=42 {like |found|, when there's more than two per routine} +@d not_found=45 {go here when you've found nothing} +@d not_found1=46 {like |not_found|, when there's more than one} +@d not_found2=47 {like |not_found|, when there's more than two} +@d not_found3=48 {like |not_found|, when there's more than three} +@d not_found4=49 {like |not_found|, when there's more than four} +@d common_ending=50 {go here when you want to merge with another branch} + +@ Here are some macros for common programming idioms. + +@d incr(#) == #:=#+1 {increase a variable by unity} +@d decr(#) == #:=#-1 {decrease a variable by unity} +@d negate(#) == #:=-# {change the sign of a variable} +@d loop == @+ while true do@+ {repeat over and over until a |goto| happens} +@f loop == xclause + {\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'} +@d do_nothing == {empty statement} +@d return == goto exit {terminate a procedure call} +@f return == nil +@d empty=0 {symbolic name for a null constant} + +@* \[2] The character set. +In order to make \TeX\ readily portable to a wide variety of +computers, all of its input text is converted to an internal eight-bit +code that includes standard ASCII, the ``American Standard Code for +Information Interchange.'' This conversion is done immediately when each +character is read in. Conversely, characters are converted from ASCII to +the user's external representation just before they are output to a +text file. + +Such an internal code is relevant to users of \TeX\ primarily because it +governs the positions of characters in the fonts. For example, the +character `\.A' has ASCII code $65=@'101$, and when \TeX\ typesets +this letter it specifies character number 65 in the current font. +If that font actually has `\.A' in a different position, \TeX\ doesn't +know what the real position is; the program that does the actual printing from +\TeX's device-independent files is responsible for converting from ASCII to +a particular font encoding. +@^ASCII code@> + +\TeX's internal code also defines the value of constants +that begin with a reverse apostrophe; and it provides an index to the +\.{\\catcode}, \.{\\mathcode}, \.{\\uccode}, \.{\\lccode}, and \.{\\delcode} +tables. + +@ Characters of text that have been converted to \TeX's internal form +are said to be of type |ASCII_code|, which is a subrange of the integers. +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} + +@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit +character sets were common, so it did not make provision for lowercase +letters. Nowadays, of course, we need to deal with both capital and small +letters in a convenient way, especially in a program for typesetting; +so the present specification of \TeX\ has been written under the assumption +that the \PASCAL\ compiler and run-time system permit the use of text files +with more than 64 distinguishable characters. More precisely, we assume that +the character set contains at least the letters and symbols associated +with ASCII codes @'40 through @'176; all of these characters are now +available on most computer terminals. + +Since we are dealing with more characters than were present in the first +\PASCAL\ compilers, we have to decide what to call the associated data +type. Some \PASCAL s use the original name |char| for the +characters in text files, even though there now are more than 64 such +characters, while other \PASCAL s consider |char| to be a 64-element +subrange of a larger data type that has some other name. + +In order to accommodate this difference, we shall use the name |text_char| +to stand for the data type of the characters that are converted to and +from |ASCII_code| when they are input and output. We shall also assume +that |text_char| consists of the elements |chr(first_text_char)| through +|chr(last_text_char)|, inclusive. The following definitions should be +adjusted if necessary. +@^system dependencies@> + +@d text_char == char {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=biggest_char {ordinal number of the largest element of |text_char|} + +@= +@!i:integer; + +@ The \TeX\ processor converts between ASCII code and +the user's external character set by means of arrays |xord| and |xchr| +that are analogous to \PASCAL's |ord| and |chr| functions. + +@= +@!xchr: array [ASCII_code] of text_char; + {specifies conversion of output characters} + +@ Since we are assuming that our \PASCAL\ system is able to read and +write the visible characters of standard ASCII (although not +necessarily using the ASCII codes to represent them), the following +assignment statements initialize the standard part of the |xchr| array +properly, without needing any system-dependent changes. On the other +hand, it is possible to implement \TeX\ with less complete character +sets, and in such cases it will be necessary to change something here. +@^system dependencies@> + +@= +{ don't need to set up xchr here } + +@ Some of the ASCII codes without visible characters have been given symbolic +names in this program because they are used with a special meaning. + +@d null_code=@'0 {ASCII code that might disappear} +@d carriage_return=@'15 {ASCII code used at end of line} +@d invalid_code=@'177 {ASCII code that many systems prohibit in text files} + +@ The ASCII code is ``standard'' only to a certain extent, since many +computer installations have found it advantageous to have ready access +to more than 94 printing characters. Appendix~C of {\sl The \TeX book\/} +gives a complete specification of the intended correspondence between +characters and \TeX's internal representation. +@:TeXbook}{\sl The \TeX book@> + +If \TeX\ is being used +on a garden-variety \PASCAL\ for which only standard ASCII +codes will appear in the input and output files, it doesn't really matter +what codes are specified in |xchr[0..@'37]|, but the safest policy is to +blank everything out by using the code shown below. + +However, other settings of |xchr| will make \TeX\ more friendly on +computers that have an extended character set, so that users can type things +like `\.^^Z' instead of `\.{\\ne}'. People with extended character sets can +assign codes arbitrarily, giving an |xchr| equivalent to whatever +characters the users of \TeX\ are allowed to have in their input files. +It is best to make the codes correspond to the intended interpretations as +shown in Appendix~C whenever possible; but this is not necessary. For +example, in countries with an alphabet of more than 26 letters, it is +usually best to map the additional letters into codes less than~@'40. +To get the most ``permissive'' character set, change |' '| on the +right of these assignment statements to |chr(i)|. +@^character set dependencies@> +@^system dependencies@> + +@= +for i:=0 to @'37 do xchr[i]:=' '; +for i:=@'177 to @'377 do xchr[i]:=' '; + +@ The following system-independent code makes the |xord| array contain a +suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]| +where |i= +for i:=0 to @'176 do xord[xchr[i]]:=i; + +@* \[3] Input and output. +The bane of portability is the fact that different operating systems treat +input and output quite differently, perhaps because computer scientists +have not given sufficient attention to this problem. People have felt somehow +that input and output are not part of ``real'' programming. Well, it is true +that some kinds of programming are more fun than others. With existing +input/output conventions being so diverse and so messy, the only sources of +joy in such parts of the code are the rare occasions when one can find a +way to make the program a little less bad than it might have been. We have +two choices, either to attack I/O now and get it over with, or to postpone +I/O until near the end. Neither prospect is very attractive, so let's +get it over with. + +The basic operations we need to do are (1)~inputting and outputting of +text, to or from a file or the user's terminal; (2)~inputting and +outputting of eight-bit bytes, to or from a file; (3)~instructing the +operating system to initiate (``open'') or to terminate (``close'') input or +output from a specified file; (4)~testing whether the end of an input +file has been reached. + +\TeX\ needs to deal with two kinds of files. +We shall use the term |alpha_file| for a file that contains textual data, +and the term |byte_file| for a file that contains eight-bit binary information. +These two types turn out to be the same on many computers, but +sometimes there is a significant distinction, so we shall be careful to +distinguish between them. Standard protocols for transferring +such files from computer to computer, via high-speed networks, are +now becoming available to more and more communities of users. + +The program actually makes use also of a third kind of file, called a +|word_file|, when dumping and reloading base information for its own +initialization. We shall define a word file later; but it will be possible +for us to specify simple operations on word files before they are defined. + +@= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!alpha_file=packed file of text_char; {files that contain textual data} +@!byte_file=packed file of eight_bits; {files that contain binary data} + +@ Most of what we need to do with respect to input and output can be handled +by the I/O facilities that are standard in \PASCAL, i.e., the routines +called |get|, |put|, |eof|, and so on. But +standard \PASCAL\ does not allow file variables to be associated with file +names that are determined at run time, so it cannot be used to implement +\TeX; some sort of extension to \PASCAL's ordinary |reset| and |rewrite| +is crucial for our purposes. We shall assume that |name_of_file| is a variable +of an appropriate type such that the \PASCAL\ run-time system being used to +implement \TeX\ can open a file whose external name is specified by +|name_of_file|. +@^system dependencies@> + +@= +@!name_of_file:packed array[1..file_name_size] of char;@;@/ + {on some systems this may be a \&{record} variable} +@!name_of_file16:array[1..file_name_size] of 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; + +@ The \ph\ compiler with which the present version of \TeX\ was prepared has +extended the rules of \PASCAL\ in a very convenient way. To open file~|f|, +we can write +$$\vbox{\halign{#\hfil\qquad&#\hfil\cr +|reset(f,@t\\{name}@>,'/O')|&for input;\cr +|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$ +The `\\{name}' parameter, which is of type `{\bf packed array +$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of +the external file that is being opened for input or output. +Blank spaces that might appear in \\{name} are ignored. + +The `\.{/O}' parameter tells the operating system not to issue its own +error messages if something goes wrong. If a file of the specified name +cannot be found, or if such a file cannot be opened for some other reason +(e.g., someone may already be trying to write the same file), we will have +|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows +\TeX\ to undertake appropriate corrective action. +@:PASCAL H}{\ph@> +@^system dependencies@> + +\TeX's file-opening procedures return |false| if no file identified by +|name_of_file| could be opened. + +@d reset_OK(#)==erstat(#)=0 +@d rewrite_OK(#)==erstat(#)=0 + +@p function a_open_in(var f:alpha_file):boolean; + {open a text file for input} +begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f); +end; +@# +function a_open_out(var f:alpha_file):boolean; + {open a text file for output} +begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f); +end; +@# +function b_open_in(var f:byte_file):boolean; + {open a binary file for input} +begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f); +end; +@# +function b_open_out(var f:byte_file):boolean; + {open a binary file for output} +begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f); +end; +@# +function w_open_in(var f:word_file):boolean; + {open a word file for input} +begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f); +end; +@# +function w_open_out(var f:word_file):boolean; + {open a word file for output} +begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f); +end; + +@ Files can be closed with the \ph\ routine `|close(f)|', which +@:PASCAL H}{\ph@> +@^system dependencies@> +should be used when all input or output with respect to |f| has been completed. +This makes |f| available to be opened again, if desired; and if |f| was used for +output, the |close| operation makes the corresponding external file appear +on the user's area, ready to be read. + +These procedures should not generate error messages if a file is +being closed before it has been successfully opened. + +@p procedure a_close(var f:alpha_file); {close a text file} +begin close(f); +end; +@# +procedure b_close(var f:byte_file); {close a binary file} +begin close(f); +end; +@# +procedure w_close(var f:word_file); {close a word file} +begin close(f); +end; + +@ Binary input and output are done with \PASCAL's ordinary |get| and |put| +procedures, so we don't have to make any other special arrangements for +binary~I/O. Text output is also easy to do with standard \PASCAL\ routines. +The treatment of text input is more difficult, however, because +of the necessary translation to |ASCII_code| values. +\TeX's conventions should be efficient, and they should +blend nicely with the user's operating environment. + +@ Input from text files is read one line at a time, using a routine called +|input_ln|. This function is defined in terms of global variables called +|buffer|, |first|, and |last| that will be described in detail later; for +now, it suffices for us to know that |buffer| is an array of |ASCII_code| +values, and that |first| and |last| are indices into this array +representing the beginning and ending of a line of text. + +@= +@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read} +@!first:0..buf_size; {the first unused position in |buffer|} +@!last:0..buf_size; {end of the line just input to |buffer|} +@!max_buf_stack:0..buf_size; {largest index used in |buffer|} + +@ The |input_ln| function brings the next line of input from the specified +file into available positions of the buffer array and returns the value +|true|, unless the file has already been entirely read, in which case it +returns |false| and sets |last:=first|. In general, the |ASCII_code| +numbers that represent the next line of the file are input into +|buffer[first]|, |buffer[first+1]|, \dots, |buffer[last-1]|; and the +global variable |last| is set equal to |first| plus the length of the +line. Trailing blanks are removed from the line; thus, either |last=first| +(in which case the line was entirely blank) or |buffer[last-1]<>" "|. + +An overflow error is given, however, if the normal actions of |input_ln| +would make |last>=buf_size|; this is done so that other parts of \TeX\ +can safely look at the contents of |buffer[last+1]| without overstepping +the bounds of the |buffer| array. Upon entry to |input_ln|, the condition +|first + +@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean; + {inputs the next line or returns |false|} +var last_nonblank:0..buf_size; {|last| with trailing blanks removed} +begin if bypass_eoln then if not eof(f) then get(f); + {input the first character of the line into |f^|} +last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} +if eof(f) then input_ln:=false +else begin last_nonblank:=first; + while not eoln(f) do + begin if last>=max_buf_stack then + begin max_buf_stack:=last+1; + if max_buf_stack=buf_size then + @; + end; + buffer[last]:=xord[f^]; get(f); incr(last); + if buffer[last-1]<>" " then last_nonblank:=last; + end; + last:=last_nonblank; input_ln:=true; + end; +end; + +@ The user's terminal acts essentially like other files of text, except +that it is used both for input and for output. When the terminal is +considered an input file, the file variable is called |term_in|, and when it +is considered an output file the file variable is |term_out|. +@^system dependencies@> + +@= +@!term_in:alpha_file; {the terminal as an input file} +@!term_out:alpha_file; {the terminal as an output file} + +@ Here is how to open the terminal files +in \ph. The `\.{/I}' switch suppresses the first |get|. +@:PASCAL H}{\ph@> +@^system dependencies@> + +@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input} +@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output} + +@ Sometimes it is necessary to synchronize the input/output mixture that +happens on the user's terminal, and three system-dependent +procedures are used for this +purpose. The first of these, |update_terminal|, is called when we want +to make sure that everything we have output to the terminal so far has +actually left the computer's internal buffers and been sent. +The second, |clear_terminal|, is called when we wish to cancel any +input that the user may have typed ahead (since we are about to +issue an unexpected error message). The third, |wake_up_terminal|, +is supposed to revive the terminal if the user has disabled it by +some instruction to the operating system. The following macros show how +these operations can be specified in \ph: +@:PASCAL H}{\ph@> +@^system dependencies@> + +@d update_terminal == break(term_out) {empty the terminal output buffer} +@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer} +@d wake_up_terminal == do_nothing {cancel the user's cancellation of output} + +@ We need a special routine to read the first line of \TeX\ input from +the user's terminal. This line is different because it is read before we +have opened the transcript file; there is sort of a ``chicken and +egg'' problem here. If the user types `\.{\\input paper}' on the first +line, or if some macro invoked by that line does such an \.{\\input}, +the transcript file will be named `\.{paper.log}'; but if no \.{\\input} +commands are performed during the first line of terminal input, the transcript +file will acquire its default name `\.{texput.log}'. (The transcript file +will not contain error messages generated by the first line before the +first \.{\\input} command.) +@.texput@> + +The first line is even more special if we are lucky enough to have an operating +system that treats \TeX\ differently from a run-of-the-mill \PASCAL\ object +program. It's nice to let the user start running a \TeX\ job by typing +a command line like `\.{tex paper}'; in such a case, \TeX\ will operate +as if the first line of input were `\.{paper}', i.e., the first line will +consist of the remainder of the command line, after the part that invoked +\TeX. + +The first line is special also because it may be read before \TeX\ has +input a format file. In such cases, normal error messages cannot yet +be given. The following code uses concepts that will be explained later. +(If the \PASCAL\ compiler does not support non-local |@!goto|\unskip, the +@^system dependencies@> +statement `|goto final_end|' should be replaced by something that +quietly terminates the program.) + +@= +if format_ident=0 then + begin write_ln(term_out,'Buffer size exceeded!'); goto final_end; +@.Buffer size exceeded@> + end +else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1; + overflow("buffer size",buf_size); +@:TeX capacity exceeded buffer size}{\quad buffer size@> + end + +@ Different systems have different ways to get started. But regardless of +what conventions are adopted, the routine that initializes the terminal +should satisfy the following specifications: + +\yskip\textindent{1)}It should open file |term_in| for input from the + terminal. (The file |term_out| will already be open for output to the + terminal.) + +\textindent{2)}If the user has given a command line, this line should be + considered the first line of terminal input. Otherwise the + user should be prompted with `\.{**}', and the first line of input + should be whatever is typed in response. + +\textindent{3)}The first line of input, which might or might not be a + command line, should appear in locations |first| to |last-1| of the + |buffer| array. + +\textindent{4)}The global variable |loc| should be set so that the + character to be read next by \TeX\ is in |buffer[loc]|. This + character should not be blank, and we should have |loc + +@p function init_terminal:boolean; {gets the terminal input started} +label exit; +begin t_open_in; +loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal; +@.**@> + if not input_ln(term_in,true) then {this shouldn't happen} + begin write_ln(term_out); + write(term_out,'! End of file on the terminal... why?'); +@.End of file on the terminal@> + init_terminal:=false; return; + end; + loc:=first; + while (loc +which converts single-character strings into the ASCII code number of the +single character involved, while it converts other strings into integers +and builds a string pool file. Thus, when the string constant \.{"."} appears +in the program below, \.{WEB} converts it into the integer 46, which is the +ASCII code for a period, while \.{WEB} will convert a string like \.{"hello"} +into some integer greater than~255. String number 46 will presumably be the +single character `\..'; but some ASCII codes have no standard visible +representation, and \TeX\ sometimes needs to be able to print an arbitrary +ASCII character, so the first 256 strings are used to specify exactly what +should be printed for each of the 256 possibilities. + +Elements of the |str_pool| array must be ASCII codes that can actually +be printed; i.e., they must have an |xchr| equivalent in the local +character set. (This restriction applies only to preloaded strings, +not to those generated dynamically by the user.) + +Some \PASCAL\ compilers won't pack integers into a single byte unless the +integers lie in the range |-128..127|. To accommodate such systems +we access the string pool only via macros that can easily be redefined. +@^system dependencies@> + +@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|} +@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|} +@d str_start_macro(#) == str_start[(#) - too_big_char] + +@= +@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|} +@!str_number = 0..max_strings; {for variables that point into |str_start|} +@!packed_ASCII_code = 0..65535; {elements of |str_pool| array} + +@ @= +@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters} +@!str_start : array[str_number] of pool_pointer; {the starting pointers} +@!pool_ptr : pool_pointer; {first unused position in |str_pool|} +@!str_ptr : str_number; {number of the current string being created} +@!init_pool_ptr : pool_pointer; {the starting value of |pool_ptr|} +@!init_str_ptr : str_number; {the starting value of |str_ptr|} + +@ Several of the elementary string operations are performed using \.{WEB} +macros instead of \PASCAL\ procedures, because many of the +operations are done quite frequently and we want to avoid the +overhead of procedure calls. For example, here is +a simple macro that computes the length of a string. +@.WEB@> + +@p function length(s:str_number):integer; + {the number of characters in string number |s|} +begin if (s>=@"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; + +@ The length of the current string is called |cur_length|: + +@d cur_length == (pool_ptr - str_start_macro(str_ptr)) + +@ Strings are created by appending character codes to |str_pool|. +The |append_char| macro, defined here, does not check to see if the +value of |pool_ptr| has gotten too high; this test is supposed to be +made before |append_char| is used. There is also a |flush_char| +macro, which erases the last character appended. + +To test if there is room to append |l| more characters to |str_pool|, +we shall write |str_room(l)|, which aborts \TeX\ and gives an +apologetic error message if there isn't enough room. + +@d append_char(#) == {put |ASCII_code| \# at the end of |str_pool|} +begin str_pool[pool_ptr]:=si(#); incr(pool_ptr); +end +@d flush_char == decr(pool_ptr) {forget the last character in the pool} +@d str_room(#) == {make sure that the pool hasn't overflowed} + begin if pool_ptr+# > pool_size then + overflow("pool size",pool_size-init_pool_ptr); +@:TeX capacity exceeded pool size}{\quad pool size@> + end + +@ Once a sequence of characters has been appended to |str_pool|, it +officially becomes a string when the function |make_string| is called. +This function returns the identification number of the new string as its +value. + +@p function make_string : str_number; {current string enters the pool} +begin if str_ptr=max_strings then + overflow("number of strings",max_strings-init_str_ptr); +@:TeX capacity exceeded number of strings}{\quad number of strings@> +incr(str_ptr); str_start_macro(str_ptr):=pool_ptr; +make_string:=str_ptr-1; +end; + +@ To destroy the most recently made string, we say |flush_string|. + +@d flush_string==begin decr(str_ptr); pool_ptr:=str_start_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; + +@ The following subroutine compares string |s| with another string of the +same length that appears in |buffer| starting at position |k|; +the result is |true| if and only if the strings are equal. +Empirical tests indicate that |str_eq_buf| is used in such a way that +it tends to return |true| about 80 percent of the time. + +@p function str_eq_buf(@!s:str_number;@!k:integer):boolean; + {test equality of strings} +label not_found; {loop exit} +var j: pool_pointer; {running index} +@!result: boolean; {result of comparison} +begin j:=str_start_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 + begin result:=false; goto not_found; + end; + incr(j); incr(k); + end; +result:=true; +not_found: str_eq_buf:=result; +end; + +@ Here is a similar routine, but it compares two strings in the string pool, +and it does not assume that they have the same length. + +@p function str_eq_str(@!s,@!t:str_number):boolean; + {test equality of strings} +label not_found; {loop exit} +var j,@!k: pool_pointer; {running indices} +@!result: boolean; {result of comparison} +begin result:=false; +if length(s)<>length(t) then goto not_found; +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; + end; +result:=true; +not_found: str_eq_str:=result; +end; + +@ The initial values of |str_pool|, |str_start|, |pool_ptr|, +and |str_ptr| are computed by the \.{INITEX} program, based in part +on the information that \.{WEB} has output while processing \TeX. +@.INITEX@> +@^string pool@> + +@p @!init function get_strings_started:boolean; {initializes the string pool, + but returns |false| if something goes wrong} +label done,exit; +var k,@!l:0..255; {small indices or counters} +@!m,@!n:text_char; {characters input from |pool_file|} +@!g:str_number; {garbage} +@!a:integer; {accumulator for check sum} +@!c:boolean; {check sum has been checked} +begin pool_ptr:=0; str_ptr:=0; str_start[0]:=0; +@; +@; +exit:end; +tini + +@ The first 65536 strings will consist of a single character only. +But we don't actually make them; they're simulated on the fly. + +@= +begin +str_ptr:=too_big_char; +str_start_macro(str_ptr):=pool_ptr; +end + +@ The first 128 strings will contain 95 standard ASCII characters, and the +other 33 characters will be printed in three-symbol form like `\.{\^\^A}' +unless a system-dependent change is made here. Installations that have +an extended character set, where for example |xchr[@'32]=@t\.{\'^^Z\'}@>|, +would like string @'32 to be the single character @'32 instead of the +three characters @'136, @'136, @'132 (\.{\^\^Z}). On the other hand, +even people with an extended character set will want to represent string +@'15 by \.{\^\^M}, since @'15 is |carriage_return|; the idea is to +produce visible strings instead of tabs or line-feeds or carriage-returns +or bell-rings or characters that are treated anomalously in text files. + +Unprintable characters of codes 128--255 are, similarly, rendered +\.{\^\^80}--\.{\^\^ff}. + +The boolean expression defined here should be |true| unless \TeX\ +internal code number~|k| corresponds to a non-troublesome visible +symbol in the local character set. An appropriate formula for the +extended character set recommended in {\sl The \TeX book\/} would, for +example, be `|k in [0,@'10..@'12,@'14,@'15,@'33,@'177..@'377]|'. +If character |k| cannot be printed, and |k<@'200|, then character |k+@'100| or +|k-@'100| must be printable; moreover, ASCII codes |[@'41..@'46, +@'60..@'71, @'136, @'141..@'146, @'160..@'171]| must be printable. +Thus, at least 81 printable characters are needed. +@:TeXbook}{\sl The \TeX book@> +@^character set dependencies@> +@^system dependencies@> + +@= +{ this module is not used } + +@ When the \.{WEB} system program called \.{TANGLE} processes the \.{TEX.WEB} +description that you are now reading, it outputs the \PASCAL\ program +\.{TEX.PAS} and also a string pool file called \.{TEX.POOL}. The \.{INITEX} +@.WEB@>@.INITEX@> +program reads the latter file, where each string appears as a two-digit decimal +length followed by the string itself, and the information is recorded in +\TeX's string memory. + +@= +@!init @!pool_file:alpha_file; {the string-pool file output by \.{TANGLE}} +tini + +@ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#); + a_close(pool_file); get_strings_started:=false; return; + end +@= +name_of_file:=pool_name; {we needn't set |name_length|} +if a_open_in(pool_file) then + begin c:=false; + repeat @; + until c; + a_close(pool_file); get_strings_started:=true; + end +else bad_pool('! I can''t read TEX.POOL.') +@.I can't read TEX.POOL@> + +@ @= +begin if eof(pool_file) then bad_pool('! TEX.POOL has no check sum.'); +@.TEX.POOL has no check sum@> +read(pool_file,m,n); {read two digits of string length} +if m='*' then @ +else begin if (xord[m]<"0")or(xord[m]>"9")or@| + (xord[n]<"0")or(xord[n]>"9") then + bad_pool('! TEX.POOL line doesn''t begin with two digits.'); +@.TEX.POOL line doesn't...@> + l:=xord[m]*10+xord[n]-"0"*11; {compute the length} + if pool_ptr+l+string_vacancies>pool_size then + bad_pool('! You have to increase POOLSIZE.'); +@.You have to increase POOLSIZE@> + for k:=1 to l do + begin if eoln(pool_file) then m:=' '@+else read(pool_file,m); + append_char(xord[m]); + end; + read_ln(pool_file); g:=make_string; + end; +end + +@ The \.{WEB} operation \.{@@\$} denotes the value that should be at the +end of this \.{TEX.POOL} file; any other value means that the wrong pool +file has been loaded. +@^check sum@> + +@= +begin a:=0; k:=1; +loop@+ begin if (xord[n]<"0")or(xord[n]>"9") then + bad_pool('! TEX.POOL check sum doesn''t have nine digits.'); +@.TEX.POOL check sum...@> + a:=10*a+xord[n]-"0"; + if k=9 then goto done; + incr(k); read(pool_file,n); + end; +done: if a<>@$ then bad_pool('! TEX.POOL doesn''t match; TANGLE me again.'); +@.TEX.POOL doesn't match@> +c:=true; +end + +@* \[5] On-line and off-line printing. +Messages that are sent to a user's terminal and to the transcript-log file +are produced by several `|print|' procedures. These procedures will +direct their output to a variety of places, based on the setting of +the global variable |selector|, which has the following possible +values: + +\yskip +\hang |term_and_log|, the normal setting, prints on the terminal and on the + transcript file. + +\hang |log_only|, prints only on the transcript file. + +\hang |term_only|, prints only on the terminal. + +\hang |no_print|, doesn't print at all. This is used only in rare cases + before the transcript file is open. + +\hang |pseudo|, puts output into a cyclic buffer that is used + by the |show_context| routine; when we get to that routine we shall discuss + the reasoning behind this curious mode. + +\hang |new_string|, appends the output to the current string in the + string pool. + +\hang 0 to 15, prints on one of the sixteen files for \.{\\write} output. + +\yskip +\noindent The symbolic names `|term_and_log|', etc., have been assigned +numeric codes that satisfy the convenient relations |no_print+1=term_only|, +|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|. + +Three additional global variables, |tally| and |term_offset| and +|file_offset|, record the number of characters that have been printed +since they were most recently cleared to zero. We use |tally| to record +the length of (possibly very long) stretches of printing; |term_offset| +and |file_offset|, on the other hand, keep track of how many characters +have appeared so far on the current line that has been output to the +terminal or to the transcript file, respectively. + +@d no_print=16 {|selector| setting that makes data disappear} +@d term_only=17 {printing is destined for the terminal only} +@d log_only=18 {printing is destined for the transcript file only} +@d term_and_log=19 {normal |selector| setting} +@d pseudo=20 {special |selector| setting for |show_context|} +@d new_string=21 {printing is deflected to the string pool} +@d max_selector=21 {highest selector setting} + +@= +@!log_file : alpha_file; {transcript of \TeX\ session} +@!selector : 0..max_selector; {where to print a message} +@!dig : array[0..22] of 0..15; {digits in a number being output} +@!tally : integer; {the number of characters recently printed} +@!term_offset : 0..max_print_line; + {the number of characters on the current terminal line} +@!file_offset : 0..max_print_line; + {the number of characters on the current file line} +@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for + pseudoprinting} +@!trick_count: integer; {threshold for pseudoprinting, explained later} +@!first_count: integer; {another variable for pseudoprinting} + +@ @= +selector:=term_only; tally:=0; term_offset:=0; file_offset:=0; + +@ Macro abbreviations for output to the terminal and to the log file are +defined here for convenience. Some systems need special conventions +for terminal output, and it is possible to adhere to those conventions +by changing |wterm|, |wterm_ln|, and |wterm_cr| in this section. +@^system dependencies@> + +@d wterm(#)==write(term_out,#) +@d wterm_ln(#)==write_ln(term_out,#) +@d wterm_cr==write_ln(term_out) +@d wlog(#)==write(log_file,#) +@d wlog_ln(#)==write_ln(log_file,#) +@d wlog_cr==write_ln(log_file) + +@ To end a line of text output, we call |print_ln|. + +@= +procedure print_ln; {prints an end-of-line} +begin case selector of +term_and_log: begin wterm_cr; wlog_cr; + term_offset:=0; file_offset:=0; + end; +log_only: begin wlog_cr; file_offset:=0; + end; +term_only: begin wterm_cr; term_offset:=0; + end; +no_print,pseudo,new_string: do_nothing; +othercases write_ln(write_file[selector]) +endcases;@/ +end; {|tally| is not affected} + +@ The |print_char| procedure sends one character to the desired destination, +using the |xchr| array to map it into an external character compatible with +|input_ln|. All printing comes through |print_ln| or |print_char|. + +@= +procedure print_visible_char(@!s:ASCII_code); {prints a single character} +label exit; {label is not used but nonetheless kept (for other changes?)} +begin +case selector of +term_and_log: begin wterm(xchr[s]); wlog(xchr[s]); + incr(term_offset); incr(file_offset); + if term_offset=max_print_line then + begin wterm_cr; term_offset:=0; + end; + if file_offset=max_print_line then + begin wlog_cr; file_offset:=0; + end; + end; +log_only: begin wlog(xchr[s]); incr(file_offset); + if file_offset=max_print_line then print_ln; + end; +term_only: begin wterm(xchr[s]); incr(term_offset); + if term_offset=max_print_line then print_ln; + end; +no_print: do_nothing; +pseudo: if tally= +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)); + +@ An entire string is output by calling |print|. Note that if we are outputting +the single standard ASCII character \.c, we could call |print("c")|, since +|"c"=99| is the number of a single-character string, as explained above. But +|print_char("c")| is quicker, so \TeX\ goes directly to the |print_char| +routine when it knows that this is safe. (The present implementation +assumes that it is always safe to print a visible ASCII character.) +@^system dependencies@> + +@= +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 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; + +@ Old versions of \TeX\ needed a procedure called |slow_print| whose function +is now subsumed by |print| and the new functionality of |print_char| and +|print_visible_char|. We retain the old name |slow_print| here as a +possible aid to future software arch\ae ologists. + +@d slow_print == print + +@ Here is the very first thing that \TeX\ prints: a headline that identifies +the version number and format package. The |term_offset| variable is temporarily +incorrect, but the discrepancy is not serious since we assume that the banner +and format identifier together will occupy at most |max_print_line| +character positions. + +@= +wterm(banner); +if format_ident=0 then wterm_ln(' (no format preloaded)') +else begin slow_print(format_ident); print_ln; + end; +update_terminal; + +@ The procedure |print_nl| is like |print|, but it makes sure that the +string appears at the beginning of a new line. + +@= +procedure print_nl(@!s:str_number); {prints string |s| at beginning of line} +begin if ((term_offset>0)and(odd(selector)))or@| + ((file_offset>0)and(selector>=log_only)) then print_ln; +print(s); +end; + +@ The procedure |print_esc| prints a string that is preceded by +the user's escape character (which is usually a backslash). + +@= +procedure print_esc(@!s:str_number); {prints escape character, then |s|} +var c:integer; {the escape character code} +begin @; +if c>=0 then if c<=biggest_usv then print_char(c); +slow_print(s); +end; + +@ An array of digits in the range |0..15| is printed by |print_the_digs|. + +@= +procedure print_the_digs(@!k:eight_bits); + {prints |dig[k-1]|$\,\ldots\,$|dig[0]|} +begin while k>0 do + begin decr(k); + if dig[k]<10 then print_char("0"+dig[k]) + else print_char("A"-10+dig[k]); + end; +end; + +@ The following procedure, which prints out the decimal representation of a +given integer |n|, has been written carefully so that it works properly +if |n=0| or if |(-n)| would cause overflow. It does not apply |mod| or |div| +to negative arguments, since such operations are not implemented consistently +by all \PASCAL\ compilers. + +@= +procedure print_int(@!n:integer); {prints an integer in decimal form} +var k:0..23; {index to current digit; we assume that $|n|<10^{23}$} +@!m:integer; {used to negate |n| in possibly dangerous cases} +begin k:=0; +if n<0 then + begin print_char("-"); + if n>-100000000 then negate(n) + else begin m:=-1-n; n:=m div 10; m:=(m mod 10)+1; k:=1; + if m<10 then dig[0]:=m + else begin dig[0]:=0; incr(n); + end; + end; + end; +repeat dig[k]:=n mod 10; n:=n div 10; incr(k); +until n=0; +print_the_digs(k); +end; + +@ Here is a trivial procedure to print two digits; it is usually called with +a parameter in the range |0<=n<=99|. + +@p procedure print_two(@!n:integer); {prints two least significant digits} +begin n:=abs(n) mod 100; print_char("0"+(n div 10)); +print_char("0"+(n mod 10)); +end; + +@ Hexadecimal printing of nonnegative integers is accomplished by |print_hex|. + +@p procedure print_hex(@!n:integer); + {prints a positive integer in hexadecimal form} +var k:0..22; {index to current digit; we assume that $0\L n<16^{22}$} +begin k:=0; print_char(""""); +repeat dig[k]:=n mod 16; n:=n div 16; incr(k); +until n=0; +print_the_digs(k); +end; + +@ Old versions of \TeX\ needed a procedure called |print_ASCII| whose function +is now subsumed by |print|. We retain the old name here as a possible aid to +future software arch\ae ologists. + +@d print_ASCII == print + +@ Roman numerals are produced by the |print_roman_int| routine. Readers +who like puzzles might enjoy trying to figure out how this tricky code +works; therefore no explanation will be given. Notice that 1990 yields +\.{mcmxc}, not \.{mxm}. + +@p procedure print_roman_int(@!n:integer); +label exit; +var j,@!k: pool_pointer; {mysterious indices into |str_pool|} +@!u,@!v: nonnegative_integer; {mysterious numbers} +begin j:=str_start_macro("m2d5c2l5x2v5i"); v:=1000; +loop@+ begin while n>=v do + begin print_char(so(str_pool[j])); n:=n-v; + end; + if n<=0 then return; {nonpositive input produces no output} + k:=j+2; u:=v div (so(str_pool[k-1])-"0"); + if str_pool[k-1]=si("2") then + begin k:=k+2; u:=u div (so(str_pool[k-1])-"0"); + end; + if n+u>=v then + begin print_char(so(str_pool[k])); n:=n+u; + end + else begin j:=j+2; v:=v div (so(str_pool[j-1])-"0"); + end; + end; +exit:end; + +@ The |print| subroutine will not print a string that is still being +created. The following procedure will. + +@p procedure print_current_string; {prints a yet-unmade string} +var j:pool_pointer; {points to current character code} +begin j:=str_start_macro(str_ptr); +while j +term_offset:=0; {the user's line ended with \<\rm return>} +decr(selector); {prepare to echo the input} +if last<>first then for k:=first to last-1 do print(buffer[k]); +print_ln; incr(selector); {restore previous status} +end; + +@* \[6] Reporting errors. +When something anomalous is detected, \TeX\ typically does something like this: +$$\vbox{\halign{#\hfil\cr +|print_err("Something anomalous has been detected");|\cr +|help3("This is the first line of my offer to help.")|\cr +|("This is the second line. I'm trying to")|\cr +|("explain the best way for you to proceed.");|\cr +|error;|\cr}}$$ +A two-line help message would be given using |help2|, etc.; these informal +helps should use simple vocabulary that complements the words used in the +official error message that was printed. (Outside the U.S.A., the help +messages should preferably be translated into the local vernacular. Each +line of help is at most 60 characters long, in the present implementation, +so that |max_print_line| will not be exceeded.) + +The |print_err| procedure supplies a `\.!' before the official message, +and makes sure that the terminal is awake if a stop is going to occur. +The |error| procedure supplies a `\..' after the official message, then it +shows the location of the error; and if |interaction=error_stop_mode|, +it also enters into a dialog with the user, during which time the help +message may be printed. +@^system dependencies@> + +@ The global variable |interaction| has four settings, representing increasing +amounts of user interaction: + +@d batch_mode=0 {omits all stops and omits terminal output} +@d nonstop_mode=1 {omits all stops} +@d scroll_mode=2 {omits error stops} +@d error_stop_mode=3 {stops at every opportunity to interact} +@d print_err(#)==begin if interaction=error_stop_mode then wake_up_terminal; + print_nl("! "); print(#); + end + +@= +@!interaction:batch_mode..error_stop_mode; {current level of interaction} + +@ @=interaction:=error_stop_mode; + +@ \TeX\ is careful not to call |error| when the print |selector| setting +might be unusual. The only possible values of |selector| at the time of +error messages are + +\yskip\hang|no_print| (when |interaction=batch_mode| + and |log_file| not yet open); + +\hang|term_only| (when |interaction>batch_mode| and |log_file| not yet open); + +\hang|log_only| (when |interaction=batch_mode| and |log_file| is open); + +\hang|term_and_log| (when |interaction>batch_mode| and |log_file| is open). + +@= +if interaction=batch_mode then selector:=no_print@+else selector:=term_only + +@ A global variable |deletions_allowed| is set |false| if the |get_next| +routine is active when |error| is called; this ensures that |get_next| +and related routines like |get_token| will never be called recursively. +A similar interlock is provided by |set_box_allowed|. +@^recursion@> + +The global variable |history| records the worst level of error that +has been detected. It has four possible values: |spotless|, |warning_issued|, +|error_message_issued|, and |fatal_error_stop|. + +Another global variable, |error_count|, is increased by one when an +|error| occurs without an interactive dialog, and it is reset to zero at +the end of every paragraph. If |error_count| reaches 100, \TeX\ decides +that there is no point in continuing further. + +@d spotless=0 {|history| value when nothing has been amiss yet} +@d warning_issued=1 {|history| value when |begin_diagnostic| has been called} +@d error_message_issued=2 {|history| value when |error| has been called} +@d fatal_error_stop=3 {|history| value when termination was premature} + +@= +@!deletions_allowed:boolean; {is it safe for |error| to call |get_token|?} +@!set_box_allowed:boolean; {is it safe to do a \.{\\setbox} assignment?} +@!history:spotless..fatal_error_stop; {has the source input been clean so far?} +@!error_count:-1..100; {the number of scrolled errors since the + last paragraph ended} + +@ The value of |history| is initially |fatal_error_stop|, but it will +be changed to |spotless| if \TeX\ survives the initialization process. + +@= +deletions_allowed:=true; set_box_allowed:=true; +error_count:=0; {|history| is initialized elsewhere} + +@ Since errors can be detected almost anywhere in \TeX, we want to declare the +error procedures near the beginning of the program. But the error procedures +in turn use some other procedures, which need to be declared |forward| +before we get to |error| itself. + +It is possible for |error| to be called recursively if some error arises +when |get_token| is being used to delete a token, and/or if some fatal error +occurs while \TeX\ is trying to fix a non-fatal one. But such recursion +@^recursion@> +is never more than two levels deep. + +@= +procedure@?normalize_selector; forward;@t\2@>@/ +procedure@?get_token; forward;@t\2@>@/ +procedure@?term_input; forward;@t\2@>@/ +procedure@?show_context; forward;@t\2@>@/ +procedure@?begin_file_reading; forward;@t\2@>@/ +procedure@?open_log_file; forward;@t\2@>@/ +procedure@?close_files_and_terminate; forward;@t\2@>@/ +procedure@?clear_for_error_prompt; forward;@t\2@>@/ +procedure@?give_err_help; forward;@t\2@>@/ +@t\4\hskip-\fontdimen2\font@>@;@+@!debug@+procedure@?debug_help; + forward;@;@+gubed + +@ Individual lines of help are recorded in the array |help_line|, which +contains entries in positions |0..(help_ptr-1)|. They should be printed +in reverse order, i.e., with |help_line[0]| appearing last. + +@d hlp1(#)==help_line[0]:=#;@+end +@d hlp2(#)==help_line[1]:=#; hlp1 +@d hlp3(#)==help_line[2]:=#; hlp2 +@d hlp4(#)==help_line[3]:=#; hlp3 +@d hlp5(#)==help_line[4]:=#; hlp4 +@d hlp6(#)==help_line[5]:=#; hlp5 +@d help0==help_ptr:=0 {sometimes there might be no help} +@d help1==@+begin help_ptr:=1; hlp1 {use this with one help line} +@d help2==@+begin help_ptr:=2; hlp2 {use this with two help lines} +@d help3==@+begin help_ptr:=3; hlp3 {use this with three help lines} +@d help4==@+begin help_ptr:=4; hlp4 {use this with four help lines} +@d help5==@+begin help_ptr:=5; hlp5 {use this with five help lines} +@d help6==@+begin help_ptr:=6; hlp6 {use this with six help lines} + +@= +@!help_line:array[0..5] of str_number; {helps for the next |error|} +@!help_ptr:0..6; {the number of help lines present} +@!use_err_help:boolean; {should the |err_help| list be shown?} + +@ @= +help_ptr:=0; use_err_help:=false; + +@ The |jump_out| procedure just cuts across all active procedure levels and +goes to |end_of_TEX|. This is the only nontrivial |@!goto| statement in the +whole program. It is used when there is no recovery from a particular error. + +Some \PASCAL\ compilers do not implement non-local |goto| statements. +@^system dependencies@> +In such cases the body of |jump_out| should simply be +`|close_files_and_terminate|;\thinspace' followed by a call on some system +procedure that quietly terminates the program. + +@= +procedure jump_out; +begin goto end_of_TEX; +end; + +@ Here now is the general |error| routine. + +@= +procedure error; {completes the job of error reporting} +label continue,exit; +var c:ASCII_code; {what the user types} +@!s1,@!s2,@!s3,@!s4:integer; + {used to save global variables when deleting tokens} +begin if history; +incr(error_count); +if error_count=100 then + begin print_nl("(That makes 100 errors; please try again.)"); +@.That makes 100 errors...@> + history:=fatal_error_stop; jump_out; + end; +@; +exit:end; + +@ @= +loop@+begin continue: clear_for_error_prompt; prompt_input("? "); +@.?\relax@> + if last=first then return; + c:=buffer[first]; + if c>="a" then c:=c+"A"-"a"; {convert to uppercase} + @; + end + +@ It is desirable to provide an `\.E' option here that gives the user +an easy way to return from \TeX\ to the system editor, with the offending +line ready to be edited. But such an extension requires some system +wizardry, so the present implementation simply types out the name of the +file that should be +edited and the relevant line number. +@^system dependencies@> + +There is a secret `\.D' option available when the debugging routines haven't +been commented~out. +@^debugging@> + +@= +case c of +"0","1","2","3","4","5","6","7","8","9": if deletions_allowed then + @; +@t\4\4@>@;@+@!debug "D": begin debug_help; goto continue;@+end;@+gubed@/ +"E": if base_ptr>0 then + begin print_nl("You want to edit file "); +@.You want to edit file x@> + slow_print(input_stack[base_ptr].name_field); + print(" at line "); print_int(line); + interaction:=scroll_mode; jump_out; + end; +"H": @; +"I":@; +"Q","R","S":@; +"X":begin interaction:=scroll_mode; jump_out; + end; +othercases do_nothing +endcases;@/ +@ + +@ @= +begin print("Type to proceed, S to scroll future error messages,");@/ +@.Type to proceed...@> +print_nl("R to run without stopping, Q to run quietly,");@/ +print_nl("I to insert something, "); +if base_ptr>0 then print("E to edit your file,"); +if deletions_allowed then + print_nl("1 or ... or 9 to ignore the next 1 to 9 tokens of input,"); +print_nl("H for help, X to quit."); +end + +@ Here the author of \TeX\ apologizes for making use of the numerical +relation between |"Q"|, |"R"|, |"S"|, and the desired interaction settings +|batch_mode|, |nonstop_mode|, |scroll_mode|. +@^Knuth, Donald Ervin@> + +@= +begin error_count:=0; interaction:=batch_mode+c-"Q"; +print("OK, entering "); +case c of +"Q":begin print_esc("batchmode"); decr(selector); + end; +"R":print_esc("nonstopmode"); +"S":print_esc("scrollmode"); +end; {there are no other cases} +print("..."); print_ln; update_terminal; return; +end + +@ When the following code is executed, |buffer[(first+1)..(last-1)]| may +contain the material inserted by the user; otherwise another prompt will +be given. In order to understand this part of the program fully, you need +to be familiar with \TeX's input stacks. + +@= +begin begin_file_reading; {enter a new syntactic level for terminal input} +{now |state=mid_line|, so an initial blank space will count as a blank} +if last>first+1 then + begin loc:=first+1; buffer[first]:=" "; + end +else begin prompt_input("insert>"); loc:=first; +@.insert>@> + end; +first:=last; +cur_input.limit_field:=last-1; {no |end_line_char| ends this line} +return; +end + +@ We allow deletion of up to 99 tokens at a time. + +@= +begin s1:=cur_tok; s2:=cur_cmd; s3:=cur_chr; s4:=align_state; +align_state:=1000000; OK_to_interrupt:=false; +if (last>first+1) and (buffer[first+1]>="0")and(buffer[first+1]<="9") then + c:=c*10+buffer[first+1]-"0"*11 +else c:=c-"0"; +while c>0 do + begin get_token; {one-level recursive call of |error| is possible} + decr(c); + end; +cur_tok:=s1; cur_cmd:=s2; cur_chr:=s3; align_state:=s4; OK_to_interrupt:=true; +help2("I have just deleted some text, as you asked.")@/ +("You can now delete more, or insert, or whatever."); +show_context; goto continue; +end + +@ @= +begin if use_err_help then + begin give_err_help; use_err_help:=false; + end +else begin if help_ptr=0 then + help2("Sorry, I don't know how to help in this situation.")@/ + @t\kern1em@>("Maybe you should try asking a human?"); + repeat decr(help_ptr); print(help_line[help_ptr]); print_ln; + until help_ptr=0; + end; +help4("Sorry, I already gave what help I could...")@/ + ("Maybe you should try asking a human?")@/ + ("An error might have occurred before I noticed any problems.")@/ + ("``If all else fails, read the instructions.''");@/ +goto continue; +end + +@ @= +if interaction>batch_mode then decr(selector); {avoid terminal output} +if use_err_help then + begin print_ln; give_err_help; + end +else while help_ptr>0 do + begin decr(help_ptr); print_nl(help_line[help_ptr]); + end; +print_ln; +if interaction>batch_mode then incr(selector); {re-enable terminal output} +print_ln + +@ A dozen or so error messages end with a parenthesized integer, so we +save a teeny bit of program space by declaring the following procedure: + +@p procedure int_error(@!n:integer); +begin print(" ("); print_int(n); print_char(")"); error; +end; + +@ In anomalous cases, the print selector might be in an unknown state; +the following subroutine is called to fix things just enough to keep +running a bit longer. + +@p procedure normalize_selector; +begin if log_opened then selector:=term_and_log +else selector:=term_only; +if job_name=0 then open_log_file; +if interaction=batch_mode then decr(selector); +end; + +@ The following procedure prints \TeX's last words before dying. + +@d succumb==begin if interaction=error_stop_mode then + interaction:=scroll_mode; {no more interaction} + if log_opened then error; + @!debug if interaction>batch_mode then debug_help;@+gubed@;@/ + history:=fatal_error_stop; jump_out; {irrecoverable error} + end + +@= +procedure fatal_error(@!s:str_number); {prints |s|, and that's it} +begin normalize_selector;@/ +print_err("Emergency stop"); help1(s); succumb; +@.Emergency stop@> +end; + +@ Here is the most dreaded error message. + +@= +procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness} +begin normalize_selector; +print_err("TeX capacity exceeded, sorry ["); +@.TeX capacity exceeded ...@> +print(s); print_char("="); print_int(n); print_char("]"); +help2("If you really absolutely need more capacity,")@/ + ("you can ask a wizard to enlarge me."); +succumb; +end; + +@ The program might sometime run completely amok, at which point there is +no choice but to stop. If no previous error has been detected, that's bad +news; a message is printed that is really intended for the \TeX\ +maintenance person instead of the user (unless the user has been +particularly diabolical). The index entries for `this can't happen' may +help to pinpoint the problem. +@^dry rot@> + +@= +procedure confusion(@!s:str_number); + {consistency check violated; |s| tells where} +begin normalize_selector; +if history + help1("I'm broken. Please show this to someone who can fix can fix"); + end +else begin print_err("I can't go on meeting you like this"); +@.I can't go on...@> + help2("One of your faux pas seems to have wounded me deeply...")@/ + ("in fact, I'm barely conscious. Please fix it and try again."); + end; +succumb; +end; + +@ Users occasionally want to interrupt \TeX\ while it's running. +If the \PASCAL\ runtime system allows this, one can implement +a routine that sets the global variable |interrupt| to some nonzero value +when such an interrupt is signalled. Otherwise there is probably at least +a way to make |interrupt| nonzero using the \PASCAL\ debugger. +@^system dependencies@> +@^debugging@> + +@d check_interrupt==begin if interrupt<>0 then pause_for_instructions; + end + +@= +@!interrupt:integer; {should \TeX\ pause for instructions?} +@!OK_to_interrupt:boolean; {should interrupts be observed?} + +@ @= +interrupt:=0; OK_to_interrupt:=true; + +@ When an interrupt has been detected, the program goes into its +highest interaction level and lets the user have nearly the full flexibility of +the |error| routine. \TeX\ checks for interrupts only at times when it is +safe to do this. + +@p procedure pause_for_instructions; +begin if OK_to_interrupt then + begin interaction:=error_stop_mode; + if (selector=log_only)or(selector=no_print) then + incr(selector); + print_err("Interruption"); +@.Interruption@> + help3("You rang?")@/ + ("Try to insert some instructions for me (e.g.,`I\showlists'),")@/ + ("unless you just want to quit by typing `X'."); + deletions_allowed:=false; error; deletions_allowed:=true; + interrupt:=0; + end; +end; + +@* \[7] Arithmetic with scaled dimensions. +The principal computations performed by \TeX\ are done entirely in terms of +integers less than $2^{31}$ in magnitude; and divisions are done only when both +dividend and divisor are nonnegative. Thus, the arithmetic specified in this +program can be carried out in exactly the same way on a wide variety of +computers, including some small ones. Why? Because the arithmetic +calculations need to be spelled out precisely in order to guarantee that +\TeX\ will produce identical output on different machines. If some +quantities were rounded differently in different implementations, we would +find that line breaks and even page breaks might occur in different places. +Hence the arithmetic of \TeX\ has been designed with care, and systems that +claim to be implementations of \TeX82 should follow precisely the +@:TeX82}{\TeX82@> +calculations as they appear in the present program. + +(Actually there are three places where \TeX\ uses |div| with a possibly negative +numerator. These are harmless; see |div| in the index. Also if the user +sets the \.{\\time} or the \.{\\year} to a negative value, some diagnostic +information will involve negative-numerator division. The same remarks +apply for |mod| as well as for |div|.) + +@ Here is a routine that calculates half of an integer, using an +unambiguous convention with respect to signed odd numbers. + +@p function half(@!x:integer):integer; +begin if odd(x) then half:=(x+1) div 2 +else half:=x @!div 2; +end; + +@ Fixed-point arithmetic is done on {\sl scaled integers\/} that are multiples +of $2^{-16}$. In other words, a binary point is assumed to be sixteen bit +positions from the right end of a binary computer word. + +@d unity == @'200000 {$2^{16}$, represents 1.00000} +@d two == @'400000 {$2^{17}$, represents 2.00000} + +@= +@!scaled = integer; {this type is used for scaled integers} +@!nonnegative_integer=0..@'17777777777; {$0\L x<2^{31}$} +@!small_number=0..63; {this type is self-explanatory} + +@ The following function is used to create a scaled integer from a given decimal +fraction $(.d_0d_1\ldots d_{k-1})$, where |0<=k<=17|. The digit $d_i$ is +given in |dig[i]|, and the calculation produces a correctly rounded result. + +@p function round_decimals(@!k:small_number) : scaled; + {converts a decimal fraction} +var a:integer; {the accumulator} +begin a:=0; +while k>0 do + begin decr(k); a:=(a+dig[k]*two) div 10; + end; +round_decimals:=(a+1) div 2; +end; + +@ Conversely, here is a procedure analogous to |print_int|. If the output +of this procedure is subsequently read by \TeX\ and converted by the +|round_decimals| routine above, it turns out that the original value will +be reproduced exactly; the ``simplest'' such decimal number is output, +but there is always at least one digit following the decimal point. + +The invariant relation in the \&{repeat} loop is that a sequence of +decimal digits yet to be printed will yield the original number if and only if +they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}funity then s:=s+@'100000-50000; {round the last digit} +print_char("0"+(s div unity)); s:=10*(s mod unity); delta:=delta*10; +until s<=delta; +end; + +@ Physical sizes that a \TeX\ user specifies for portions of documents are +represented internally as scaled points. Thus, if we define an `sp' (scaled +@^sp@> +point) as a unit equal to $2^{-16}$ printer's points, every dimension +inside of \TeX\ is an integer number of sp. There are exactly +4,736,286.72 sp per inch. Users are not allowed to specify dimensions +larger than $2^{30}-1$ sp, which is a distance of about 18.892 feet (5.7583 +meters); two such quantities can be added without overflow on a 32-bit +computer. + +The present implementation of \TeX\ does not check for overflow when +@^overflow in arithmetic@> +dimensions are added or subtracted. This could be done by inserting a +few dozen tests of the form `\ignorespaces|if x>=@'10000000000 then +@t\\{report\_overflow}@>|', but the chance of overflow is so remote that +such tests do not seem worthwhile. + +\TeX\ needs to do only a few arithmetic operations on scaled quantities, +other than addition and subtraction, and the following subroutines do most of +the work. A single computation might use several subroutine calls, and it is +desirable to avoid producing multiple error messages in case of arithmetic +overflow; so the routines set the global variable |arith_error| to |true| +instead of reporting errors directly to the user. Another global variable, +|remainder|, holds the remainder after a division. + +@= +@!arith_error:boolean; {has arithmetic overflow occurred recently?} +@!remainder:scaled; {amount subtracted to get an exact division} + +@ The first arithmetical subroutine we need computes $nx+y$, where |x| +and~|y| are |scaled| and |n| is an integer. We will also use it to +multiply integers. + +@d nx_plus_y(#)==mult_and_add(#,@'7777777777) +@d mult_integers(#)==mult_and_add(#,0,@'17777777777) + +@p function mult_and_add(@!n:integer;@!x,@!y,@!max_answer:scaled):scaled; +begin if n<0 then + begin negate(x); negate(n); + end; +if n=0 then mult_and_add:=y +else if ((x<=(max_answer-y) div n)and(-x<=(max_answer+y) div n)) then + mult_and_add:=n*x+y +else begin arith_error:=true; mult_and_add:=0; + end; +end; + +@ We also need to divide scaled dimensions by integers. + +@p function x_over_n(@!x:scaled;@!n:integer):scaled; +var negative:boolean; {should |remainder| be negated?} +begin negative:=false; +if n=0 then + begin arith_error:=true; x_over_n:=0; remainder:=x; + end +else begin if n<0 then + begin negate(x); negate(n); negative:=true; + end; + if x>=0 then + begin x_over_n:=x div n; remainder:=x mod n; + end + else begin x_over_n:=-((-x) div n); remainder:=-((-x) mod n); + end; + end; +if negative then negate(remainder); +end; + +@ Then comes the multiplication of a scaled number by a fraction |n/d|, +where |n| and |d| are nonnegative integers |<=@t$2^{16}$@>| and |d| is +positive. It would be too dangerous to multiply by~|n| and then divide +by~|d|, in separate operations, since overflow might well occur; and it +would be too inaccurate to divide by |d| and then multiply by |n|. Hence +this subroutine simulates 1.5-precision arithmetic. + +@p function xn_over_d(@!x:scaled; @!n,@!d:integer):scaled; +var positive:boolean; {was |x>=0|?} +@!t,@!u,@!v:nonnegative_integer; {intermediate quantities} +begin if x>=0 then positive:=true +else begin negate(x); positive:=false; + end; +t:=(x mod @'100000)*n; +u:=(x div @'100000)*n+(t div @'100000); +v:=(u mod d)*@'100000 + (t mod @'100000); +if u div d>=@'100000 then arith_error:=true +else u:=@'100000*(u div d) + (v div d); +if positive then + begin xn_over_d:=u; remainder:=v mod d; + end +else begin xn_over_d:=-u; remainder:=-(v mod d); + end; +end; + +@ The next subroutine is used to compute the ``badness'' of glue, when a +total~|t| is supposed to be made from amounts that sum to~|s|. According +to {\sl The \TeX book}, the badness of this situation is $100(t/s)^3$; +however, badness is simply a heuristic, so we need not squeeze out the +last drop of accuracy when computing it. All we really want is an +approximation that has similar properties. +@:TeXbook}{\sl The \TeX book@> + +The actual method used to compute the badness is easier to read from the +program than to describe in words. It produces an integer value that is a +reasonably close approximation to $100(t/s)^3$, and all implementations +of \TeX\ should use precisely this method. Any badness of $2^{13}$ or more is +treated as infinitely bad, and represented by 10000. + +It is not difficult to prove that $$\hbox{|badness(t+1,s)>=badness(t,s) +>=badness(t,s+1)|}.$$ The badness function defined here is capable of +computing at most 1095 distinct values, but that is plenty. + +@d inf_bad = 10000 {infinitely bad value} + +@p function badness(@!t,@!s:scaled):halfword; {compute badness, given |t>=0|} +var r:integer; {approximation to $\alpha t/s$, where $\alpha^3\approx + 100\cdot2^{18}$} +begin if t=0 then badness:=0 +else if s<=0 then badness:=inf_bad +else begin if t<=7230584 then r:=(t*297) div s {$297^3=99.94\times2^{18}$} + else if s>=1663497 then r:=t div (s div 297) + else r:=t; + if r>1290 then badness:=inf_bad {$1290^3<2^{31}<1291^3$} + else badness:=(r*r*r+@'400000) div @'1000000; + end; {that was $r^3/2^{18}$, rounded to the nearest integer} +end; + +@ When \TeX\ ``packages'' a list into a box, it needs to calculate the +proportionality ratio by which the glue inside the box should stretch +or shrink. This calculation does not affect \TeX's decision making, +so the precise details of rounding, etc., in the glue calculation are not +of critical importance for the consistency of results on different computers. + +We shall use the type |glue_ratio| for such proportionality ratios. +A glue ratio should take the same amount of memory as an +|integer| (usually 32 bits) if it is to blend smoothly with \TeX's +other data structures. Thus |glue_ratio| should be equivalent to +|short_real| in some implementations of \PASCAL. Alternatively, +it is possible to deal with glue ratios using nothing but fixed-point +arithmetic; see {\sl TUGboat \bf3},1 (March 1982), 10--27. (But the +routines cited there must be modified to allow negative glue ratios.) +@^system dependencies@> + +@d set_glue_ratio_zero(#) == #:=0.0 {store the representation of zero ratio} +@d set_glue_ratio_one(#) == #:=1.0 {store the representation of unit ratio} +@d float(#) == # {convert from |glue_ratio| to type |real|} +@d unfloat(#) == # {convert from |real| to type |glue_ratio|} +@d float_constant(#) == #.0 {convert |integer| constant to |real|} + +@= +@!glue_ratio=real; {one-word representation of a glue expansion factor} + +@* \[8] Packed data. +In order to make efficient use of storage space, \TeX\ bases its major data +structures on a |memory_word|, which contains either a (signed) integer, +possibly scaled, or a (signed) |glue_ratio|, or a small number of +fields that are one half or one quarter of the size used for storing +integers. + +If |x| is a variable of type |memory_word|, it contains up to four +fields that can be referred to as follows: +$$\vbox{\halign{\hfil#&#\hfil&#\hfil\cr +|x|&.|int|&(an |integer|)\cr +|x|&.|sc|\qquad&(a |scaled| integer)\cr +|x|&.|gr|&(a |glue_ratio|)\cr +|x.hh.lh|, |x.hh|&.|rh|&(two halfword fields)\cr +|x.hh.b0|, |x.hh.b1|, |x.hh|&.|rh|&(two quarterword fields, one halfword + field)\cr +|x.qqqq.b0|, |x.qqqq.b1|, |x.qqqq|&.|b2|, |x.qqqq.b3|\hskip-100pt + &\qquad\qquad\qquad(four quarterword fields)\cr}}$$ +This is somewhat cumbersome to write, and not very readable either, but +macros will be used to make the notation shorter and more transparent. +The \PASCAL\ code below gives a formal definition of |memory_word| and +its subsidiary types, using packed variant records. \TeX\ makes no +assumptions about the relative positions of the fields within a word. + +Since we are assuming 32-bit integers, a halfword must contain at least +16 bits, and a quarterword must contain at least 8 bits. +@^system dependencies@> +But it doesn't hurt to have more bits; for example, with enough 36-bit +words you might be able to have |mem_max| as large as 262142, which is +eight times as much memory as anybody had during the first four years of +\TeX's existence. + +N.B.: Valuable memory space will be dreadfully wasted unless \TeX\ is compiled +by a \PASCAL\ that packs all of the |memory_word| variants into +the space of a single integer. This means, for example, that |glue_ratio| +words should be |short_real| instead of |real| on some computers. Some +\PASCAL\ compilers will pack an integer whose subrange is `|0..255|' into +an eight-bit field, but others insist on allocating space for an additional +sign bit; on such systems you can get 256 values into a quarterword only +if the subrange is `|-128..127|'. + +The present implementation tries to accommodate as many variations as possible, +so it makes few assumptions. If integers having the subrange +`|min_quarterword..max_quarterword|' can be packed into a quarterword, +and if integers having the subrange `|min_halfword..max_halfword|' +can be packed into a halfword, everything should work satisfactorily. + +It is usually most efficient to have |min_quarterword=min_halfword=0|, +so one should try to achieve this unless it causes a severe problem. +The values defined here are recommended for most 32-bit computers. + +@d min_quarterword=0 {smallest allowable value in a |quarterword|} +@d max_quarterword=@"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|} + +@ Here are the inequalities that the quarterword and halfword values +must satisfy (or rather, the inequalities that they mustn't satisfy): + +@= +init if (mem_min<>mem_bot)or(mem_max<>mem_top) then bad:=10;@+tini@;@/ +if (mem_min>mem_bot)or(mem_max0)or(max_quarterword<@"7FFF) then bad:=11; +if (min_halfword>0)or(max_halfword<@"3FFFFFFF) then bad:=12; +if (min_quarterwordmax_halfword) then bad:=13; +if (mem_min=max_halfword)or@| + (mem_bot-mem_min>max_halfword+1) then bad:=14; +if (font_basemax_quarterword) then bad:=15; +if font_max>font_base+256 then bad:=16; +if (save_size>max_halfword)or(max_strings>max_halfword) then bad:=17; +if buf_size>max_halfword then bad:=18; +if max_quarterword-min_quarterword<@"FFFF then bad:=19; + +@ The operation of adding or subtracting |min_quarterword| occurs quite +frequently in \TeX, so it is convenient to abbreviate this operation +by using the macros |qi| and |qo| for input and output to and from +quarterword format. + +The inner loop of \TeX\ will run faster with respect to compilers +that don't optimize expressions like `|x+0|' and `|x-0|', if these +macros are simplified in the obvious way when |min_quarterword=0|. +@^inner loop@>@^system dependencies@> + +@d qi(#)==#+min_quarterword + {to put an |eight_bits| item into a quarterword} +@d qo(#)==#-min_quarterword + {to take an |eight_bits| item out of a quarterword} +@d hi(#)==#+min_halfword + {to put a sixteen-bit item into a halfword} +@d ho(#)==#-min_halfword + {to take a sixteen-bit item from a halfword} + +@ The reader should study the following definitions closely: +@^system dependencies@> + +@d sc==int {|scaled| data is equivalent to |integer|} + +@= +@!quarterword = min_quarterword..max_quarterword; {1/4 of a word} +@!halfword=min_halfword..max_halfword; {1/2 of a word} +@!two_choices = 1..2; {used when there are two variants in a record} +@!four_choices = 1..4; {used when there are four variants in a record} +@!two_halves = packed record@;@/ + @!rh:halfword; + case two_choices of + 1: (@!lh:halfword); + 2: (@!b0:quarterword; @!b1:quarterword); + end; +@!four_quarters = packed record@;@/ + @!b0:quarterword; + @!b1:quarterword; + @!b2:quarterword; + @!b3:quarterword; + end; +@!memory_word = record@;@/ + case four_choices of + 1: (@!int:integer); + 2: (@!gr:glue_ratio); + 3: (@!hh:two_halves); + 4: (@!qqqq:four_quarters); + end; +@!word_file = gzFile; + +@ When debugging, we may want to print a |memory_word| without knowing +what type it is; so we print it in all modes. +@^dirty \PASCAL@>@^debugging@> + +@p @!debug procedure print_word(@!w:memory_word); + {prints |w| in all ways} +begin print_int(w.int); print_char(" ");@/ +print_scaled(w.sc); print_char(" ");@/ +print_scaled(round(unity*float(w.gr))); print_ln;@/ +@^real multiplication@> +print_int(w.hh.lh); print_char("="); print_int(w.hh.b0); print_char(":"); +print_int(w.hh.b1); print_char(";"); print_int(w.hh.rh); print_char(" ");@/ +print_int(w.qqqq.b0); print_char(":"); print_int(w.qqqq.b1); print_char(":"); +print_int(w.qqqq.b2); print_char(":"); print_int(w.qqqq.b3); +end; +gubed + +@* \[9] Dynamic memory allocation. +The \TeX\ system does nearly all of its own memory allocation, so that it +can readily be transported into environments that do not have automatic +facilities for strings, garbage collection, etc., and so that it can be in +control of what error messages the user receives. The dynamic storage +requirements of \TeX\ are handled by providing a large array |mem| in +which consecutive blocks of words are used as nodes by the \TeX\ routines. + +Pointer variables are indices into this array, or into another array +called |eqtb| that will be explained later. A pointer variable might +also be a special flag that lies outside the bounds of |mem|, so we +allow pointers to assume any |halfword| value. The minimum halfword +value represents a null pointer. \TeX\ does not assume that |mem[null]| exists. + +@d pointer==halfword {a flag or a location in |mem| or |eqtb|} +@d null==min_halfword {the null pointer} + +@= +@!temp_ptr:pointer; {a pointer variable for occasional emergency use} + +@ The |mem| array is divided into two regions that are allocated separately, +but the dividing line between these two regions is not fixed; they grow +together until finding their ``natural'' size in a particular job. +Locations less than or equal to |lo_mem_max| are used for storing +variable-length records consisting of two or more words each. This region +is maintained using an algorithm similar to the one described in exercise +2.5--19 of {\sl The Art of Computer Programming}. However, no size field +appears in the allocated nodes; the program is responsible for knowing the +relevant size when a node is freed. Locations greater than or equal to +|hi_mem_min| are used for storing one-word records; a conventional +\.{AVAIL} stack is used for allocation in this region. + +Locations of |mem| between |mem_bot| and |mem_top| may be dumped as part +of preloaded format files, by the \.{INITEX} preprocessor. +@.INITEX@> +Production versions of \TeX\ may extend the memory at both ends in order to +provide more space; locations between |mem_min| and |mem_bot| are always +used for variable-size nodes, and locations between |mem_top| and |mem_max| +are always used for single-word nodes. + +The key pointers that govern |mem| allocation have a prescribed order: +$$\advance\thickmuskip-2mu +\hbox{|null<=mem_min<=mem_bot= +@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area} +@!lo_mem_max : pointer; {the largest location of variable-size memory in use} +@!hi_mem_min : pointer; {the smallest location of one-word memory in use} + +@ In order to study the memory requirements of particular applications, it +is possible to prepare a version of \TeX\ that keeps track of current and +maximum memory usage. When code between the delimiters |@!stat| $\ldots$ +|tats| is not ``commented out,'' \TeX\ will run a bit slower but it will +report these statistics when |tracing_stats| is sufficiently large. + +@= +@!var_used, @!dyn_used : integer; {how much memory is in use} + +@ Let's consider the one-word memory region first, since it's the +simplest. The pointer variable |mem_end| holds the highest-numbered location +of |mem| that has ever been used. The free locations of |mem| that +occur between |hi_mem_min| and |mem_end|, inclusive, are of type +|two_halves|, and we write |info(p)| and |link(p)| for the |lh| +and |rh| fields of |mem[p]| when it is of this type. The single-word +free locations form a linked list +$$|avail|,\;\hbox{|link(avail)|},\;\hbox{|link(link(avail))|},\;\ldots$$ +terminated by |null|. + +@d link(#) == mem[#].hh.rh {the |link| field of a memory word} +@d info(#) == mem[#].hh.lh {the |info| field of a memory word} + +@= +@!avail : pointer; {head of the list of available one-word nodes} +@!mem_end : pointer; {the last one-word node used in |mem|} + +@ If memory is exhausted, it might mean that the user has forgotten +a right brace. We will define some procedures later that try to help +pinpoint the trouble. + +@p @@/ +@ + +@ The function |get_avail| returns a pointer to a new one-word node whose +|link| field is null. However, \TeX\ will halt if there is no more room left. +@^inner loop@> + +If the available-space list is empty, i.e., if |avail=null|, +we try first to increase |mem_end|. If that cannot be done, i.e., if +|mem_end=mem_max|, we try to decrease |hi_mem_min|. If that cannot be +done, i.e., if |hi_mem_min=lo_mem_max+1|, we have to quit. + +@p function get_avail : pointer; {single-word node allocation} +var p:pointer; {the new node being got} +begin p:=avail; {get top location in the |avail| stack} +if p<>null then avail:=link(avail) {and pop it off} +else if mem_end + end; + end; +link(p):=null; {provide an oft-desired initialization of the new node} +@!stat incr(dyn_used);@+tats@;{maintain statistics} +get_avail:=p; +end; + +@ Conversely, a one-word node is recycled by calling |free_avail|. +This routine is part of \TeX's ``inner loop,'' so we want it to be fast. +@^inner loop@> + +@d free_avail(#)== {single-word node liberation} + begin link(#):=avail; avail:=#; + @!stat decr(dyn_used);@+tats@/ + end + +@ There's also a |fast_get_avail| routine, which saves the procedure-call +overhead at the expense of extra programming. This routine is used in +the places that would otherwise account for the most calls of |get_avail|. +@^inner loop@> + +@d fast_get_avail(#)==@t@>@;@/ + begin #:=avail; {avoid |get_avail| if possible, to save time} + if #=null then #:=get_avail + else begin avail:=link(#); link(#):=null; + @!stat incr(dyn_used);@+tats@/ + end; + end + +@ The procedure |flush_list(p)| frees an entire linked list of +one-word nodes that starts at position |p|. +@^inner loop@> + +@p procedure flush_list(@!p:pointer); {makes list of single-word nodes + available} +var @!q,@!r:pointer; {list traversers} +begin if p<>null then + begin r:=p; + repeat q:=r; r:=link(r); @!stat decr(dyn_used);@+tats@/ + until r=null; {now |q| is the last node on the list} + link(q):=avail; avail:=p; + end; +end; + +@ The available-space list that keeps track of the variable-size portion +of |mem| is a nonempty, doubly-linked circular list of empty nodes, +pointed to by the roving pointer |rover|. + +Each empty node has size 2 or more; the first word contains the special +value |max_halfword| in its |link| field and the size in its |info| field; +the second word contains the two pointers for double linking. + +Each nonempty node also has size 2 or more. Its first word is of type +|two_halves|\kern-1pt, and its |link| field is never equal to |max_halfword|. +Otherwise there is complete flexibility with respect to the contents +of its other fields and its other words. + +(We require |mem_max= +@!rover : pointer; {points to some node in the list of empties} + +@ A call to |get_node| with argument |s| returns a pointer to a new node +of size~|s|, which must be 2~or more. The |link| field of the first word +of this new node is set to null. An overflow stop occurs if no suitable +space exists. + +If |get_node| is called with $s=2^{30}$, it simply merges adjacent free +areas and returns the value |max_halfword|. + +@p function get_node(@!s:integer):pointer; {variable-size node allocation} +label found,exit,restart; +var p:pointer; {the node currently under inspection} +@!q:pointer; {the node physically after node |p|} +@!r:integer; {the newly allocated node, or a candidate for this honor} +@!t:integer; {temporary register} +begin restart: p:=rover; {start at some free node in the ring} +repeat @; +@^inner loop@> +p:=rlink(p); {move to the next node in the ring} +until p=rover; {repeat until the whole list has been traversed} +if s=@'10000000000 then + begin get_node:=max_halfword; return; + end; +if lo_mem_max+2; +overflow("main memory size",mem_max+1-mem_min); + {sorry, nothing satisfactory is left} +@:TeX capacity exceeded main memory size}{\quad main memory size@> +found: link(r):=null; {this node is now nonempty} +@!stat var_used:=var_used+s; {maintain usage statistics} +tats@;@/ +get_node:=r; +exit:end; + +@ The lower part of |mem| grows by 1000 words at a time, unless +we are very close to going under. When it grows, we simply link +a new node into the available-space list. This method of controlled +growth helps to keep the |mem| usage consecutive when \TeX\ is +implemented on ``virtual memory'' systems. +@^virtual memory@> + +@= +begin if hi_mem_min-lo_mem_max>=1998 then t:=lo_mem_max+1000 +else t:=lo_mem_max+1+(hi_mem_min-lo_mem_max) div 2; + {|lo_mem_max+2<=tmem_bot+max_halfword then t:=mem_bot+max_halfword; +rlink(q):=rover; llink(q):=p; link(q):=empty_flag; node_size(q):=t-lo_mem_max;@/ +lo_mem_max:=t; link(lo_mem_max):=null; info(lo_mem_max):=null; +rover:=q; goto restart; +end + +@ Empirical tests show that the routine in this section performs a +node-merging operation about 0.75 times per allocation, on the average, +after which it finds that |r>p+1| about 95\pct! of the time. + +@= +q:=p+node_size(p); {find the physical successor} +@^inner loop@> +while is_empty(q) do {merge node |p| with node |q|} + begin t:=rlink(q); + if q=rover then rover:=t; + llink(t):=llink(q); rlink(llink(q)):=t;@/ + q:=q+node_size(q); + end; +r:=q-s; +if r>p+1 then @; +if r=p then if rlink(p)<>p then + @; +node_size(p):=q-p {reset the size in case it grew} + +@ @= +begin node_size(p):=r-p; {store the remaining size} +@^inner loop@> +rover:=p; {start searching here next time} +goto found; +end + +@ Here we delete node |p| from the ring, and let |rover| rove around. + +@= +begin rover:=rlink(p); t:=llink(p); +llink(rover):=t; rlink(t):=rover; +goto found; +end + +@ Conversely, when some variable-size node |p| of size |s| is no longer needed, +the operation |free_node(p,s)| will make its words available, by inserting +|p| as a new empty node just before where |rover| now points. +@^inner loop@> + +@p procedure free_node(@!p:pointer; @!s:halfword); {variable-size node + liberation} +var q:pointer; {|llink(rover)|} +begin node_size(p):=s; link(p):=empty_flag; +q:=llink(rover); llink(p):=q; rlink(p):=rover; {set both links} +llink(rover):=p; rlink(q):=p; {insert |p| into the ring} +@!stat var_used:=var_used-s;@+tats@;{maintain statistics} +end; + +@ Just before \.{INITEX} writes out the memory, it sorts the doubly linked +available space list. The list is probably very short at such times, so a +simple insertion sort is used. The smallest available location will be +pointed to by |rover|, the next-smallest by |rlink(rover)|, etc. + +@p @!init procedure sort_avail; {sorts the available variable-size nodes + by location} +var p,@!q,@!r: pointer; {indices into |mem|} +@!old_rover:pointer; {initial |rover| setting} +begin p:=get_node(@'10000000000); {merge adjacent free areas} +p:=rlink(rover); rlink(rover):=max_halfword; old_rover:=rover; +while p<>old_rover do @; +p:=rover; +while rlink(p)<>max_halfword do + begin llink(rlink(p)):=p; p:=rlink(p); + end; +rlink(p):=rover; llink(rover):=p; +end; +tini + +@ The following |while| loop is guaranteed to +terminate, since the list that starts at +|rover| ends with |max_halfword| during the sorting procedure. + +@= +if p@^Chinese characters@>@^Japanese characters@> +and styles of type. It is suggested that Chinese and Japanese fonts be +handled by representing such characters in two consecutive |char_node| +entries: The first of these has |font=font_base|, and its |link| points +to the second; +the second identifies the font and the character dimensions. +The saving feature about oriental characters is that most of them have +the same box dimensions. The |character| field of the first |char_node| +is a ``\\{charext}'' that distinguishes between graphic symbols whose +dimensions are identical for typesetting purposes. (See the \MF\ manual.) +Such an extension of \TeX\ would not be difficult; further details are +left to the reader. + +In order to make sure that the |character| code fits in a quarterword, +\TeX\ adds the quantity |min_quarterword| to the actual code. + +Character nodes appear only in horizontal lists, never in vertical lists. + +@d is_char_node(#) == (#>=hi_mem_min) + {does the argument point to a |char_node|?} +@d font == type {the font code in a |char_node|} +@d character == subtype {the character code in a |char_node|} + +@ An |hlist_node| stands for a box that was made from a horizontal list. +Each |hlist_node| is seven words long, and contains the following fields +(in addition to the mandatory |type| and |link|, which we shall not +mention explicitly when discussing the other node types): The |height| and +|width| and |depth| are scaled integers denoting the dimensions of the +box. There is also a |shift_amount| field, a scaled integer indicating +how much this box should be lowered (if it appears in a horizontal list), +or how much it should be moved to the right (if it appears in a vertical +list). There is a |list_ptr| field, which points to the beginning of the +list from which this box was fabricated; if |list_ptr| is |null|, the box +is empty. Finally, there are three fields that represent the setting of +the glue: |glue_set(p)| is a word of type |glue_ratio| that represents +the proportionality constant for glue setting; |glue_sign(p)| is +|stretching| or |shrinking| or |normal| depending on whether or not the +glue should stretch or shrink or remain rigid; and |glue_order(p)| +specifies the order of infinity to which glue setting applies (|normal|, +|fil|, |fill|, or |filll|). The |subtype| field is not used in \TeX. +In \eTeX\ the |subtype| field records the box direction mode |box_lr|. + +@d hlist_node=0 {|type| of hlist nodes} +@d box_node_size=7 {number of words to allocate for a box node} +@d width_offset=1 {position of |width| field in a box node} +@d depth_offset=2 {position of |depth| field in a box node} +@d height_offset=3 {position of |height| field in a box node} +@d width(#) == mem[#+width_offset].sc {width of the box, in sp} +@d depth(#) == mem[#+depth_offset].sc {depth of the box, in sp} +@d height(#) == mem[#+height_offset].sc {height of the box, in sp} +@d shift_amount(#) == mem[#+4].sc {repositioning distance, in sp} +@d list_offset=5 {position of |list_ptr| field in a box node} +@d list_ptr(#) == link(#+list_offset) {beginning of the list inside the box} +@d glue_order(#) == subtype(#+list_offset) {applicable order of infinity} +@d glue_sign(#) == type(#+list_offset) {stretching or shrinking} +@d normal=0 {the most common case when several cases are named} +@d stretching = 1 {glue setting applies to the stretch components} +@d shrinking = 2 {glue setting applies to the shrink components} +@d glue_offset = 6 {position of |glue_set| in a box node} +@d glue_set(#) == mem[#+glue_offset].gr + {a word of type |glue_ratio| for glue setting} + +@ The |new_null_box| function returns a pointer to an |hlist_node| in +which all subfields have the values corresponding to `\.{\\hbox\{\}}'. +The |subtype| field is set to |min_quarterword|, since that's the desired +|span_count| value if this |hlist_node| is changed to an |unset_node|. + +@p function new_null_box:pointer; {creates a new box node} +var p:pointer; {the new node} +begin p:=get_node(box_node_size); type(p):=hlist_node; +subtype(p):=min_quarterword; +width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null; +glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p)); +new_null_box:=p; +end; + +@ A |vlist_node| is like an |hlist_node| in all respects except that it +contains a vertical list. + +@d vlist_node=1 {|type| of vlist nodes} + +@ A |rule_node| stands for a solid black rectangle; it has |width|, +|depth|, and |height| fields just as in an |hlist_node|. However, if +any of these dimensions is $-2^{30}$, the actual value will be determined +by running the rule up to the boundary of the innermost enclosing box. +This is called a ``running dimension.'' The |width| is never running in +an hlist; the |height| and |depth| are never running in a~vlist. + +@d rule_node=2 {|type| of rule nodes} +@d rule_node_size=4 {number of words to allocate for a rule node} +@d null_flag==-@'10000000000 {$-2^{30}$, signifies a missing item} +@d is_running(#) == (#=null_flag) {tests for a running dimension} + +@ A new rule node is delivered by the |new_rule| function. It +makes all the dimensions ``running,'' so you have to change the +ones that are not allowed to run. + +@p function new_rule:pointer; +var p:pointer; {the new node} +begin p:=get_node(rule_node_size); type(p):=rule_node; +subtype(p):=0; {the |subtype| is not used} +width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag; +new_rule:=p; +end; + +@ Insertions are represented by |ins_node| records, where the |subtype| +indicates the corresponding box number. For example, `\.{\\insert 250}' +leads to an |ins_node| whose |subtype| is |250+min_quarterword|. +The |height| field of an |ins_node| is slightly misnamed; it actually holds +the natural height plus depth of the vertical list being inserted. +The |depth| field holds the |split_max_depth| to be used in case this +insertion is split, and the |split_top_ptr| points to the corresponding +|split_top_skip|. The |float_cost| field holds the |floating_penalty| that +will be used if this insertion floats to a subsequent page after a +split insertion of the same class. There is one more field, the +|ins_ptr|, which points to the beginning of the vlist for the insertion. + +@d ins_node=3 {|type| of insertion nodes} +@d ins_node_size=5 {number of words to allocate for an insertion} +@d float_cost(#)==mem[#+1].int {the |floating_penalty| to be used} +@d ins_ptr(#)==info(#+4) {the vertical list to be inserted} +@d split_top_ptr(#)==link(#+4) {the |split_top_skip| to be used} + +@ A |mark_node| has a |mark_ptr| field that points to the reference count +of a token list that contains the user's \.{\\mark} text. +In addition there is a |mark_class| field that contains the mark class. + +@d mark_node=4 {|type| of a mark node} +@d small_node_size=2 {number of words to allocate for most node types} +@d mark_ptr(#)==link(#+1) {head of the token list for a mark} +@d mark_class(#)==info(#+1) {the mark class} + +@ An |adjust_node|, which occurs only in horizontal lists, +specifies material that will be moved out into the surrounding +vertical list; i.e., it is used to implement \TeX's `\.{\\vadjust}' +operation. The |adjust_ptr| field points to the vlist containing this +material. + +@d adjust_node=5 {|type| of an adjust node} +@d adjust_pre == subtype {<>0 => pre-adjustment} +@#{|append_list| is used to append a list to |tail|} +@d append_list(#) == begin link(tail) := link(#); append_list_end +@d append_list_end(#) == tail := #; end +@d adjust_ptr(#)==mem[#+1].int + {vertical list to be moved out of horizontal list} + +@ A |ligature_node|, which occurs only in horizontal lists, specifies +a character that was fabricated from the interaction of two or more +actual characters. The second word of the node, which is called the +|lig_char| word, contains |font| and |character| fields just as in a +|char_node|. The characters that generated the ligature have not been +forgotten, since they are needed for diagnostic messages and for +hyphenation; the |lig_ptr| field points to a linked list of character +nodes for all original characters that have been deleted. (This list +might be empty if the characters that generated the ligature were +retained in other nodes.) + +The |subtype| field is 0, plus 2 and/or 1 if the original source of the +ligature included implicit left and/or right boundaries. + +@d ligature_node=6 {|type| of a ligature node} +@d lig_char(#)==#+1 {the word where the ligature is to be found} +@d lig_ptr(#)==link(lig_char(#)) {the list of characters} + +@ The |new_ligature| function creates a ligature node having given +contents of the |font|, |character|, and |lig_ptr| fields. We also have +a |new_lig_item| function, which returns a two-word node having a given +|character| field. Such nodes are used for temporary processing as ligatures +are being created. + +@p function new_ligature(@!f,@!c:quarterword; @!q:pointer):pointer; +var p:pointer; {the new node} +begin p:=get_node(small_node_size); type(p):=ligature_node; +font(lig_char(p)):=f; character(lig_char(p)):=c; lig_ptr(p):=q; +subtype(p):=0; new_ligature:=p; +end; +@# +function new_lig_item(@!c:quarterword):pointer; +var p:pointer; {the new node} +begin p:=get_node(small_node_size); character(p):=c; lig_ptr(p):=null; +new_lig_item:=p; +end; + +@ A |disc_node|, which occurs only in horizontal lists, specifies a +``dis\-cretion\-ary'' line break. If such a break occurs at node |p|, the text +that starts at |pre_break(p)| will precede the break, the text that starts at +|post_break(p)| will follow the break, and text that appears in the next +|replace_count(p)| nodes will be ignored. For example, an ordinary +discretionary hyphen, indicated by `\.{\\-}', yields a |disc_node| with +|pre_break| pointing to a |char_node| containing a hyphen, |post_break=null|, +and |replace_count=0|. All three of the discretionary texts must be +lists that consist entirely of character, kern, box, rule, and ligature nodes. + +If |pre_break(p)=null|, the |ex_hyphen_penalty| will be charged for this +break. Otherwise the |hyphen_penalty| will be charged. The texts will +actually be substituted into the list by the line-breaking algorithm if it +decides to make the break, and the discretionary node will disappear at +that time; thus, the output routine sees only discretionaries that were +not chosen. + +@d disc_node=7 {|type| of a discretionary node} +@d replace_count==subtype {how many subsequent nodes to replace} +@d pre_break==llink {text that precedes a discretionary break} +@d post_break==rlink {text that follows a discretionary break} + +@p function new_disc:pointer; {creates an empty |disc_node|} +var p:pointer; {the new node} +begin p:=get_node(small_node_size); type(p):=disc_node; +replace_count(p):=0; pre_break(p):=null; post_break(p):=null; +new_disc:=p; +end; + +@ A |whatsit_node| is a wild card reserved for extensions to \TeX. The +|subtype| field in its first word says what `\\{whatsit}' it is, and +implicitly determines the node size (which must be 2 or more) and the +format of the remaining words. When a |whatsit_node| is encountered +in a list, special actions are invoked; knowledgeable people who are +careful not to mess up the rest of \TeX\ are able to make \TeX\ do new +things by adding code at the end of the program. For example, there +might be a `\TeX nicolor' extension to specify different colors of ink, +@^extensions to \TeX@> +and the whatsit node might contain the desired parameters. + +The present implementation of \TeX\ treats the features associated with +`\.{\\write}' and `\.{\\special}' as if they were extensions, in order to +illustrate how such routines might be coded. We shall defer further +discussion of extensions until the end of this program. + +@d whatsit_node=8 {|type| of special extension nodes} + +{ 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 + +@ A |math_node|, which occurs only in horizontal lists, appears before and +after mathematical formulas. The |subtype| field is |before| before the +formula and |after| after it. There is a |width| field, which represents +the amount of surrounding space inserted by \.{\\mathsurround}. + +In addition a |math_node| with |subtype>after| and |width=0| will be +(ab)used to record a regular |math_node| reinserted after being +discarded at a line break or one of the text direction primitives ( +\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} ). + +@d math_node=9 {|type| of a math node} +@d before=0 {|subtype| for math node that introduces a formula} +@d after=1 {|subtype| for math node that winds up a formula} +@# +@d M_code=2 +@d begin_M_code=M_code+before {|subtype| for \.{\\beginM} node} +@d end_M_code=M_code+after {|subtype| for \.{\\endM} node} +@d L_code=4 +@d begin_L_code=L_code+begin_M_code {|subtype| for \.{\\beginL} node} +@d end_L_code=L_code+end_M_code {|subtype| for \.{\\endL} node} +@d R_code=L_code+L_code +@d begin_R_code=R_code+begin_M_code {|subtype| for \.{\\beginR} node} +@d end_R_code=R_code+end_M_code {|subtype| for \.{\\endR} node} +@# +@d end_LR(#)==odd(subtype(#)) +@d end_LR_type(#)==(L_code*(subtype(#) div L_code)+end_M_code) +@d begin_LR_type(#)==(#-after+before) + +@p function new_math(@!w:scaled;@!s:small_number):pointer; +var p:pointer; {the new node} +begin p:=get_node(small_node_size); type(p):=math_node; +subtype(p):=s; width(p):=w; new_math:=p; +end; + +@ \TeX\ makes use of the fact that |hlist_node|, |vlist_node|, +|rule_node|, |ins_node|, |mark_node|, |adjust_node|, |ligature_node|, +|disc_node|, |whatsit_node|, and |math_node| are at the low end of the +type codes, by permitting a break at glue in a list if and only if the +|type| of the previous node is less than |math_node|. Furthermore, a +node is discarded after a break if its type is |math_node| or~more. + +@d precedes_break(#)==(type(#) +representing |null| plus the number of glue nodes that point to it (less one). +Note that the reference count appears in the same position as +the |link| field in list nodes; this is the field that is initialized +to |null| when a node is allocated, and it is also the field that is flagged +by |empty_flag| in empty nodes. + +Glue specifications also contain three |scaled| fields, for the |width|, +|stretch|, and |shrink| dimensions. Finally, there are two one-byte +fields called |stretch_order| and |shrink_order|; these contain the +orders of infinity (|normal|, |fil|, |fill|, or |filll|) +corresponding to the stretch and shrink values. + +@d glue_spec_size=4 {number of words to allocate for a glue specification} +@d glue_ref_count(#) == link(#) {reference count of a glue specification} +@d stretch(#) == mem[#+2].sc {the stretchability of this glob of glue} +@d shrink(#) == mem[#+3].sc {the shrinkability of this glob of glue} +@d stretch_order == type {order of infinity for stretching} +@d shrink_order == subtype {order of infinity for shrinking} +@d fil=1 {first-order infinity} +@d fill=2 {second-order infinity} +@d filll=3 {third-order infinity} + +@= +@!glue_ord=normal..filll; {infinity to the 0, 1, 2, or 3 power} + +@ Here is a function that returns a pointer to a copy of a glue spec. +The reference count in the copy is |null|, because there is assumed +to be exactly one reference to the new specification. + +@p function new_spec(@!p:pointer):pointer; {duplicates a glue specification} +var q:pointer; {the new spec} +begin q:=get_node(glue_spec_size);@/ +mem[q]:=mem[p]; glue_ref_count(q):=null;@/ +width(q):=width(p); stretch(q):=stretch(p); shrink(q):=shrink(p); +new_spec:=q; +end; + +@ And here's a function that creates a glue node for a given parameter +identified by its code number; for example, +|new_param_glue(line_skip_code)| returns a pointer to a glue node for the +current \.{\\lineskip}. + +@p function new_param_glue(@!n:small_number):pointer; +var p:pointer; {the new node} +@!q:pointer; {the glue specification} +begin p:=get_node(small_node_size); type(p):=glue_node; subtype(p):=n+1; +leader_ptr(p):=null;@/ +q:=@@t@>; +glue_ptr(p):=q; incr(glue_ref_count(q)); +new_param_glue:=p; +end; + +@ Glue nodes that are more or less anonymous are created by |new_glue|, +whose argument points to a glue specification. + +@p function new_glue(@!q:pointer):pointer; +var p:pointer; {the new node} +begin p:=get_node(small_node_size); type(p):=glue_node; subtype(p):=normal; +leader_ptr(p):=null; glue_ptr(p):=q; incr(glue_ref_count(q)); +new_glue:=p; +end; + +@ Still another subroutine is needed: This one is sort of a combination +of |new_param_glue| and |new_glue|. It creates a glue node for one of +the current glue parameters, but it makes a fresh copy of the glue +specification, since that specification will probably be subject to change, +while the parameter will stay put. The global variable |temp_ptr| is +set to the address of the new spec. + +@p function new_skip_param(@!n:small_number):pointer; +var p:pointer; {the new node} +begin temp_ptr:=new_spec(@); +p:=new_glue(temp_ptr); glue_ref_count(temp_ptr):=null; subtype(p):=n+1; +new_skip_param:=p; +end; + +@ A |kern_node| has a |width| field to specify a (normally negative) +amount of spacing. This spacing correction appears in horizontal lists +between letters like A and V when the font designer said that it looks +better to move them closer together or further apart. A kern node can +also appear in a vertical list, when its `|width|' denotes additional +spacing in the vertical direction. The |subtype| is either |normal| (for +kerns inserted from font information or math mode calculations) or |explicit| +(for kerns inserted from \.{\\kern} and \.{\\/} commands) or |acc_kern| +(for kerns inserted from non-math accents) or |mu_glue| (for kerns +inserted from \.{\\mkern} specifications in math formulas). + +@d kern_node=11 {|type| of a kern node} +@d explicit=1 {|subtype| of kern nodes from \.{\\kern} and \.{\\/}} +@d acc_kern=2 {|subtype| of kern nodes from accents} + +@ The |new_kern| function creates a kern node having a given width. + +@p function new_kern(@!w:scaled):pointer; +var p:pointer; {the new node} +begin p:=get_node(small_node_size); type(p):=kern_node; +subtype(p):=normal; +width(p):=w; +new_kern:=p; +end; + +@ 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|} + +@ A |penalty_node| specifies the penalty associated with line or page +breaking, in its |penalty| field. This field is a fullword integer, but +the full range of integer values is not used: Any penalty |>=10000| is +treated as infinity, and no break will be allowed for such high values. +Similarly, any penalty |<=-10000| is treated as negative infinity, and a +break will be forced. + +@d penalty_node=12 {|type| of a penalty node} +@d inf_penalty=inf_bad {``infinite'' penalty value} +@d eject_penalty=-inf_penalty {``negatively infinite'' penalty value} +@d penalty(#) == mem[#+1].int {the added cost of breaking a list here} + +@ Anyone who has been reading the last few sections of the program will +be able to guess what comes next. + +@p function new_penalty(@!m:integer):pointer; +var p:pointer; {the new node} +begin p:=get_node(small_node_size); type(p):=penalty_node; +subtype(p):=0; {the |subtype| is not used} +penalty(p):=m; new_penalty:=p; +end; + +@ You might think that we have introduced enough node types by now. Well, +almost, but there is one more: An |unset_node| has nearly the same format +as an |hlist_node| or |vlist_node|; it is used for entries in \.{\\halign} +or \.{\\valign} that are not yet in their final form, since the box +dimensions are their ``natural'' sizes before any glue adjustment has been +made. The |glue_set| word is not present; instead, we have a |glue_stretch| +field, which contains the total stretch of order |glue_order| that is +present in the hlist or vlist being boxed. +Similarly, the |shift_amount| field is replaced by a |glue_shrink| field, +containing the total shrink of order |glue_sign| that is present. +The |subtype| field is called |span_count|; an unset box typically +contains the data for |qo(span_count)+1| columns. +Unset nodes will be changed to box nodes when alignment is completed. + +@d unset_node=13 {|type| for an unset node} +@d glue_stretch(#)==mem[#+glue_offset].sc {total stretch in an unset node} +@d glue_shrink==shift_amount {total shrink in an unset node} +@d span_count==subtype {indicates the number of spanned columns} + +@ In fact, there are still more types coming. When we get to math formula +processing we will see that a |style_node| has |type=14|; and a number +of larger type codes will also be defined, for use in math mode only. + +@ Warning: If any changes are made to these data structure layouts, such as +changing any of the node sizes or even reordering the words of nodes, +the |copy_node_list| procedure and the memory initialization code +below may have to be changed. Such potentially dangerous parts of the +program are listed in the index under `data structure assumptions'. +@!@^data structure assumptions@> +However, other references to the nodes are made symbolically in terms of +the \.{WEB} macro definitions above, so that format changes will leave +\TeX's other algorithms intact. +@^system dependencies@> + +@* \[11] Memory layout. +Some areas of |mem| are dedicated to fixed usage, since static allocation is +more efficient than dynamic allocation when we can get away with it. For +example, locations |mem_bot| to |mem_bot+3| are always used to store the +specification for glue that is `\.{0pt plus 0pt minus 0pt}'. The +following macro definitions accomplish the static allocation by giving +symbolic names to the fixed positions. Static variable-size nodes appear +in locations |mem_bot| through |lo_mem_stat_max|, and static single-word nodes +appear in locations |hi_mem_stat_min| through |mem_top|, inclusive. It is +harmless to let |lig_trick| and |garbage| share the same location of |mem|. + +@d zero_glue==mem_bot {specification for \.{0pt plus 0pt minus 0pt}} +@d fil_glue==zero_glue+glue_spec_size {\.{0pt plus 1fil minus 0pt}} +@d fill_glue==fil_glue+glue_spec_size {\.{0pt plus 1fill minus 0pt}} +@d ss_glue==fill_glue+glue_spec_size {\.{0pt plus 1fil minus 1fil}} +@d fil_neg_glue==ss_glue+glue_spec_size {\.{0pt plus -1fil minus 0pt}} +@d lo_mem_stat_max==fil_neg_glue+glue_spec_size-1 {largest statically + allocated word in the variable-size |mem|} +@# +@d page_ins_head==mem_top {list of insertion data for current page} +@d contrib_head==mem_top-1 {vlist of items not yet on current page} +@d page_head==mem_top-2 {vlist for current page} +@d temp_head==mem_top-3 {head of a temporary list of some kind} +@d hold_head==mem_top-4 {head of a temporary list of another kind} +@d adjust_head==mem_top-5 {head of adjustment list returned by |hpack|} +@d active==mem_top-7 {head of active list in |line_break|, needs two words} +@d align_head==mem_top-8 {head of preamble list for alignments} +@d end_span==mem_top-9 {tail of spanned-width lists} +@d omit_template==mem_top-10 {a constant token list} +@d null_list==mem_top-11 {permanently empty list} +@d lig_trick==mem_top-12 {a ligature masquerading as a |char_node|} +@d garbage==mem_top-12 {used for scrap information} +@d backup_head==mem_top-13 {head of token list built by |scan_keyword|} +@d pre_adjust_head==mem_top-14 {head of pre-adjustment list returned by |hpack|} +@d hi_mem_stat_min==mem_top-14 {smallest statically allocated word in + the one-word |mem|} +@d hi_mem_stat_usage=15 {the number of one-word nodes always present} + +@ The following code gets |mem| off to a good start, when \TeX\ is +initializing itself the slow~way. + +@= +@!k:integer; {index into |mem|, |eqtb|, etc.} + +@ @= +for k:=mem_bot+1 to lo_mem_stat_max do mem[k].sc:=0; + {all glue dimensions are zeroed} +@^data structure assumptions@> +k:=mem_bot;@+while k<=lo_mem_stat_max do + {set first words of glue specifications} + begin glue_ref_count(k):=null+1; + stretch_order(k):=normal; shrink_order(k):=normal; + k:=k+glue_spec_size; + end; +stretch(fil_glue):=unity; stretch_order(fil_glue):=fil;@/ +stretch(fill_glue):=unity; stretch_order(fill_glue):=fill;@/ +stretch(ss_glue):=unity; stretch_order(ss_glue):=fil;@/ +shrink(ss_glue):=unity; shrink_order(ss_glue):=fil;@/ +stretch(fil_neg_glue):=-unity; stretch_order(fil_neg_glue):=fil;@/ +rover:=lo_mem_stat_max+1; +link(rover):=empty_flag; {now initialize the dynamic memory} +node_size(rover):=1000; {which is a 1000-word available node} +llink(rover):=rover; rlink(rover):=rover;@/ +lo_mem_max:=rover+1000; link(lo_mem_max):=null; info(lo_mem_max):=null;@/ +for k:=hi_mem_stat_min to mem_top do + mem[k]:=mem[lo_mem_max]; {clear list heads} +@; +avail:=null; mem_end:=mem_top; +hi_mem_min:=hi_mem_stat_min; {initialize the one-word memory} +var_used:=lo_mem_stat_max+1-mem_bot; dyn_used:=hi_mem_stat_usage; + {initialize statistics} + +@ If \TeX\ is extended improperly, the |mem| array might get screwed up. +For example, some pointers might be wrong, or some ``dead'' nodes might not +have been freed when the last reference to them disappeared. Procedures +|check_mem| and |search_mem| are available to help diagnose such +problems. These procedures make use of two arrays called |free| and +|was_free| that are present only if \TeX's debugging routines have +been included. (You may want to decrease the size of |mem| while you +@^debugging@> +are debugging.) + +@= +@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells} +@t\hskip10pt@>@!was_free: packed array [mem_min..mem_max] of boolean; + {previously free cells} +@t\hskip10pt@>@!was_mem_end,@!was_lo_max,@!was_hi_min: pointer; + {previous |mem_end|, |lo_mem_max|, and |hi_mem_min|} +@t\hskip10pt@>@!panicking:boolean; {do we want to check memory constantly?} +gubed + +@ @= +@!debug was_mem_end:=mem_min; {indicate that everything was previously free} +was_lo_max:=mem_min; was_hi_min:=mem_max; +panicking:=false; +gubed + +@ Procedure |check_mem| makes sure that the available space lists of +|mem| are well formed, and it optionally prints out all locations +that are reserved now but were free the last time this procedure was called. + +@p @!debug procedure check_mem(@!print_locs : boolean); +label done1,done2; {loop exits} +var p,@!q:pointer; {current locations of interest in |mem|} +@!clobbered:boolean; {is something amiss?} +begin for p:=mem_min to lo_mem_max do free[p]:=false; {you can probably + do this faster} +for p:=hi_mem_min to mem_end do free[p]:=false; {ditto} +@; +@; +@; +if print_locs then @; +for p:=mem_min to lo_mem_max do was_free[p]:=free[p]; +for p:=hi_mem_min to mem_end do was_free[p]:=free[p]; + {|was_free:=free| might be faster} +was_mem_end:=mem_end; was_lo_max:=lo_mem_max; was_hi_min:=hi_mem_min; +end; +gubed + +@ @= +p:=avail; q:=null; clobbered:=false; +while p<>null do + begin if (p>mem_end)or(p + print_int(q); goto done1; + end; + free[p]:=true; q:=p; p:=link(q); + end; +done1: + +@ @= +p:=rover; q:=null; clobbered:=false; +repeat if (p>=lo_mem_max)or(p=lo_mem_max)or(rlink(p)lo_mem_max)or@| (llink(rlink(p))<>p) then clobbered:=true; + if clobbered then + begin print_nl("Double-AVAIL list clobbered at "); + print_int(q); goto done2; + end; +for q:=p to p+node_size(p)-1 do {mark all locations free} + begin if free[q] then + begin print_nl("Doubly free location at "); +@.Doubly free location...@> + print_int(q); goto done2; + end; + free[q]:=true; + end; +q:=p; p:=rlink(p); +until p=rover; +done2: + +@ @= +p:=mem_min; +while p<=lo_mem_max do {node |p| should not be empty} + begin if is_empty(p) then + begin print_nl("Bad flag at "); print_int(p); +@.Bad flag...@> + end; + while (p<=lo_mem_max) and not free[p] do incr(p); + while (p<=lo_mem_max) and free[p] do incr(p); + end + +@ @= +begin print_nl("New busy locs:"); +for p:=mem_min to lo_mem_max do + if not free[p] and ((p>was_lo_max) or was_free[p]) then + begin print_char(" "); print_int(p); + end; +for p:=hi_mem_min to mem_end do + if not free[p] and + ((pwas_mem_end) or was_free[p]) then + begin print_char(" "); print_int(p); + end; +end + +@ The |search_mem| procedure attempts to answer the question ``Who points +to node~|p|?'' In doing so, it fetches |link| and |info| fields of |mem| +that might not be of type |two_halves|. Strictly speaking, this is +@^dirty \PASCAL@> +undefined in \PASCAL, and it can lead to ``false drops'' (words that seem to +point to |p| purely by coincidence). But for debugging purposes, we want +to rule out the places that do {\sl not\/} point to |p|, so a few false +drops are tolerable. + +@p @!debug procedure search_mem(@!p:pointer); {look for pointers to |p|} +var q:integer; {current position being searched} +begin for q:=mem_min to lo_mem_max do + begin if link(q)=p then + begin print_nl("LINK("); print_int(q); print_char(")"); + end; + if info(q)=p then + begin print_nl("INFO("); print_int(q); print_char(")"); + end; + end; +for q:=hi_mem_min to mem_end do + begin if link(q)=p then + begin print_nl("LINK("); print_int(q); print_char(")"); + end; + if info(q)=p then + begin print_nl("INFO("); print_int(q); print_char(")"); + end; + end; +@; +@; +@; +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; + +@* \[12] Displaying boxes. +We can reinforce our knowledge of the data structures just introduced +by considering two procedures that display a list in symbolic form. +The first of these, called |short_display|, is used in ``overfull box'' +messages to give the top-level description of a list. The other one, +called |show_node_list|, prints a detailed description of exactly what +is in the data structure. + +The philosophy of |short_display| is to ignore the fine points about exactly +what is inside boxes, except that ligatures and discretionary breaks are +expanded. As a result, |short_display| is a recursive procedure, but the +recursion is never more than one level deep. +@^recursion@> + +A global variable |font_in_short_display| keeps track of the font code that +is assumed to be present when |short_display| begins; deviations from this +font will be printed. + +@= +@!font_in_short_display:integer; {an internal font number} + +@ Boxes, rules, inserts, whatsits, marks, and things in general that are +sort of ``complicated'' are indicated only by printing `\.{[]}'. + +@p procedure short_display(@!p:integer); {prints highlights of list |p|} +var n:integer; {for replacement counts} +begin while p>mem_min do + begin if is_char_node(p) then + begin if p<=mem_end then + begin if font(p)<>font_in_short_display then + begin if (font(p)font_max) then + print_char("*") +@.*\relax@> + else @; + print_char(" "); font_in_short_display:=font(p); + end; + print_ASCII(qo(character(p))); + end; + end + else @; + p:=link(p); + end; +end; + +@ @= +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; +rule_node: print_char("|"); +glue_node: if glue_ptr(p)<>zero_glue then print_char(" "); +math_node: if subtype(p)>=L_code then print("[]") + else print_char("$"); +ligature_node: short_display(lig_ptr(p)); +disc_node: begin short_display(pre_break(p)); + short_display(post_break(p));@/ + n:=replace_count(p); + while n>0 do + begin if link(p)<>null then p:=link(p); + decr(n); + end; + end; +othercases do_nothing +endcases + +@ The |show_node_list| routine requires some auxiliary subroutines: one to +print a font-and-character combination, one to print a token list without +its reference count, and one to print a rule dimension. + +@p procedure print_font_and_char(@!p:integer); {prints |char_node| data} +begin if p>mem_end then print_esc("CLOBBERED.") +else begin if (font(p)font_max) then print_char("*") +@.*\relax@> + else @; + print_char(" "); print_ASCII(qo(character(p))); + end; +end; +@# +procedure print_mark(@!p:integer); {prints token list data in braces} +begin print_char("{"); +if (pmem_end) then print_esc("CLOBBERED.") +else show_token_list(link(p),null,max_print_line-10); +print_char("}"); +end; +@# +procedure print_rule_dimen(@!d:scaled); {prints dimension in rule node} +begin if is_running(d) then print_char("*") else print_scaled(d); +@.*\relax@> +end; + +@ Then there is a subroutine that prints glue stretch and shrink, possibly +followed by the name of finite units: + +@p procedure print_glue(@!d:scaled;@!order:integer;@!s:str_number); + {prints a glue component} +begin print_scaled(d); +if (orderfilll) then print("foul") +else if order>normal then + begin print("fil"); + while order>fil do + begin print_char("l"); decr(order); + end; + end +else if s<>0 then print(s); +end; + +@ The next subroutine prints a whole glue specification. + +@p procedure print_spec(@!p:integer;@!s:str_number); + {prints a glue specification} +begin if (p=lo_mem_max) then print_char("*") +@.*\relax@> +else begin print_scaled(width(p)); + if s<>0 then print(s); + if stretch(p)<>0 then + begin print(" plus "); print_glue(stretch(p),stretch_order(p),s); + end; + if shrink(p)<>0 then + begin print(" minus "); print_glue(shrink(p),shrink_order(p),s); + end; + end; +end; + +@ We also need to declare some procedures that appear later in this +documentation. + +@p @@; +@ + +@ Since boxes can be inside of boxes, |show_node_list| is inherently recursive, +@^recursion@> +up to a given maximum number of levels. The history of nesting is indicated +by the current string, which will be printed at the beginning of each line; +the length of this string, namely |cur_length|, is the depth of nesting. + +Recursive calls on |show_node_list| therefore use the following pattern: + +@d node_list_display(#)== + begin append_char("."); show_node_list(#); flush_char; + end {|str_room| need not be checked; see |show_box| below} + +@ A global variable called |depth_threshold| is used to record the maximum +depth of nesting for which |show_node_list| will show information. If we +have |depth_threshold=0|, for example, only the top level information will +be given and no sublists will be traversed. Another global variable, called +|breadth_max|, tells the maximum number of items to show at each level; +|breadth_max| had better be positive, or you won't see anything. + +@= +@!depth_threshold : integer; {maximum nesting depth in box displays} +@!breadth_max : integer; {maximum number of items shown at the same list level} + +@ Now we are ready for |show_node_list| itself. This procedure has been +written to be ``extra robust'' in the sense that it should not crash or get +into a loop even if the data structures have been messed up by bugs in +the rest of the program. You can safely call its parent routine +|show_box(p)| for arbitrary values of |p| when you are debugging \TeX. +However, in the presence of bad data, the procedure may +@^dirty \PASCAL@>@^debugging@> +fetch a |memory_word| whose variant is different from the way it was stored; +for example, it might try to read |mem[p].hh| when |mem[p]| +contains a scaled integer, if |p| is a pointer that has been +clobbered or chosen at random. + +@p procedure show_node_list(@!p:integer); {prints a node list symbolically} +label exit; +var n:integer; {the number of items already printed at this level} +i:integer; {temp index for printing chars of picfile paths} +@!g:real; {a glue ratio, as a floating point number} +begin if cur_length>depth_threshold then + begin if p>null then print(" []"); + {indicate that there's been some truncation} + return; + end; +n:=0; +while p>mem_min do + begin print_ln; print_current_string; {display the nesting history} + if p>mem_end then {pointer out of range} + begin print("Bad link, display aborted."); return; +@.Bad link...@> + end; + incr(n); if n>breadth_max then {time to stop} + begin print("etc."); return; +@.etc@> + end; + @; + p:=link(p); + end; +exit: +end; + +@ @= +if is_char_node(p) then print_font_and_char(p) +else case type(p) of + hlist_node,vlist_node,unset_node: @; + rule_node: @; + ins_node: @; + whatsit_node: @; + glue_node: @; + 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; + math_node: @; + ligature_node: @; + penalty_node: @; + disc_node: @; + mark_node: @; + adjust_node: @; + @t\4@>@@; + othercases print("Unknown node type!") + endcases + +@ @= +begin if type(p)=hlist_node then print_esc("h") +else if type(p)=vlist_node then print_esc("v") +else print_esc("unset"); +print("box("); print_scaled(height(p)); print_char("+"); +print_scaled(depth(p)); print(")x"); print_scaled(width(p)); +if type(p)=unset_node then + @ +else begin @; + if shift_amount(p)<>0 then + begin print(", shifted "); print_scaled(shift_amount(p)); + end; + if eTeX_ex then @; + end; +node_list_display(list_ptr(p)); {recursive call} +end + +@ @= +begin if span_count(p)<>min_quarterword then + begin print(" ("); print_int(qo(span_count(p))+1); + print(" columns)"); + end; +if glue_stretch(p)<>0 then + begin print(", stretch "); print_glue(glue_stretch(p),glue_order(p),0); + end; +if glue_shrink(p)<>0 then + begin print(", shrink "); print_glue(glue_shrink(p),glue_sign(p),0); + end; +end + +@ The code will have to change in this place if |glue_ratio| is +a structured type instead of an ordinary |real|. Note that this routine +should avoid arithmetic errors even if the |glue_set| field holds an +arbitrary random value. The following code assumes that a properly +formed nonzero |real| number has absolute value $2^{20}$ or more when +it is regarded as an integer; this precaution was adequate to prevent +floating point underflow on the author's computer. +@^system dependencies@> +@^dirty \PASCAL@> + +@= +g:=float(glue_set(p)); +if (g<>float_constant(0))and(glue_sign(p)<>normal) then + begin print(", glue set "); + if glue_sign(p)=shrinking then print("- "); + if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?") + else if abs(g)>float_constant(20000) then + begin if g>float_constant(0) then print_char(">") + else print("< -"); + print_glue(20000*unity,glue_order(p),0); + end + else print_glue(round(unity*g),glue_order(p),0); +@^real multiplication@> + end + +@ @= +begin print_esc("rule("); print_rule_dimen(height(p)); print_char("+"); +print_rule_dimen(depth(p)); print(")x"); print_rule_dimen(width(p)); +end + +@ @= +begin print_esc("insert"); print_int(qo(subtype(p))); +print(", natural size "); print_scaled(height(p)); +print("; split("); print_spec(split_top_ptr(p),0); +print_char(","); print_scaled(depth(p)); +print("); float cost "); print_int(float_cost(p)); +node_list_display(ins_ptr(p)); {recursive call} +end + +@ @= +if subtype(p)>=a_leaders then @ +else begin print_esc("glue"); + if subtype(p)<>normal then + begin print_char("("); + if subtype(p)cond_math_glue then + begin print_char(" "); + if subtype(p)= +begin print_esc(""); +if subtype(p)=c_leaders then print_char("c") +else if subtype(p)=x_leaders then print_char("x"); +print("leaders "); print_spec(glue_ptr(p),0); +node_list_display(leader_ptr(p)); {recursive call} +end + +@ An ``explicit'' kern value is indicated implicitly by an explicit space. + +@= +if subtype(p)<>mu_glue then + begin print_esc("kern"); + if subtype(p)<>normal then print_char(" "); + print_scaled(width(p)); + if subtype(p)=acc_kern then print(" (for accent)"); +@.for accent@> + end +else begin print_esc("mkern"); print_scaled(width(p)); print("mu"); + end + +@ @= +if subtype(p)>after then + begin if end_LR(p) then print_esc("end") + else print_esc("begin"); + if subtype(p)>R_code then print_char("R") + else if subtype(p)>L_code then print_char("L") + else print_char("M"); + end else +begin print_esc("math"); +if subtype(p)=before then print("on") +else print("off"); +if width(p)<>0 then + begin print(", surrounded "); print_scaled(width(p)); + end; +end + +@ @= +begin print_font_and_char(lig_char(p)); print(" (ligature "); +if subtype(p)>1 then print_char("|"); +font_in_short_display:=font(lig_char(p)); short_display(lig_ptr(p)); +if odd(subtype(p)) then print_char("|"); +print_char(")"); +end + +@ @= +begin print_esc("penalty "); print_int(penalty(p)); +end + +@ The |post_break| list of a discretionary node is indicated by a prefixed +`\.{\char'174}' instead of the `\..' before the |pre_break| list. + +@= +begin print_esc("discretionary"); +if replace_count(p)>0 then + begin print(" replacing "); print_int(replace_count(p)); + end; +node_list_display(pre_break(p)); {recursive call} +append_char("|"); show_node_list(post_break(p)); flush_char; {recursive call} +end + +@ @= +begin print_esc("mark"); +if mark_class(p)<>0 then + begin print_char("s"); print_int(mark_class(p)); + end; +print_mark(mark_ptr(p)); +end + +@ @= +begin print_esc("vadjust"); if adjust_pre(p) <> 0 then print(" pre "); +node_list_display(adjust_ptr(p)); {recursive call} +end + +@ The recursive machinery is started by calling |show_box|. +@^recursion@> + +@p procedure show_box(@!p:pointer); +begin @; +if breadth_max<=0 then breadth_max:=5; +if pool_ptr+depth_threshold>=pool_size then + depth_threshold:=pool_size-pool_ptr-1; + {now there's enough room for prefix string} +show_node_list(p); {the show starts at |p|} +print_ln; +end; + +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; + +@* \[13] Destroying boxes. +When we are done with a node list, we are obliged to return it to free +storage, including all of its sublists. The recursive procedure +|flush_node_list| does this for us. + +@ First, however, we shall consider two non-recursive procedures that do +simpler tasks. The first of these, |delete_token_ref|, is called when +a pointer to a token list's reference count is being removed. This means +that the token list should disappear if the reference count was |null|, +otherwise the count should be decreased by one. +@^reference counts@> + +@d token_ref_count(#) == info(#) {reference count preceding a token list} + +@p procedure delete_token_ref(@!p:pointer); {|p| points to the reference count + of a token list that is losing one reference} +begin if token_ref_count(p)=null then flush_list(p) +else decr(token_ref_count(p)); +end; + +@ Similarly, |delete_glue_ref| is called when a pointer to a glue +specification is being withdrawn. +@^reference counts@> +@d fast_delete_glue_ref(#)==@t@>@;@/ + begin if glue_ref_count(#)=null then free_node(#,glue_spec_size) + else decr(glue_ref_count(#)); + end + +@p procedure delete_glue_ref(@!p:pointer); {|p| points to a glue specification} +fast_delete_glue_ref(p); + +@ Now we are ready to delete any node list, recursively. +In practice, the nodes deleted are usually charnodes (about 2/3 of the time), +and they are glue nodes in about half of the remaining cases. +@^recursion@> + +@p procedure flush_node_list(@!p:pointer); {erase list of nodes starting at |p|} +label done; {go here when node |p| has been freed} +var q:pointer; {successor to node |p|} +begin while p<>null do +@^inner loop@> + begin q:=link(p); + if is_char_node(p) then free_avail(p) + else begin case type(p) of + hlist_node,vlist_node,unset_node: begin flush_node_list(list_ptr(p)); + free_node(p,box_node_size); goto done; + end; + rule_node: begin free_node(p,rule_node_size); goto done; + end; + ins_node: begin flush_node_list(ins_ptr(p)); + delete_glue_ref(split_top_ptr(p)); + free_node(p,ins_node_size); goto done; + end; + whatsit_node: @; + glue_node: begin fast_delete_glue_ref(glue_ptr(p)); + if leader_ptr(p)<>null then flush_node_list(leader_ptr(p)); + end; + kern_node,math_node,penalty_node: do_nothing; + margin_kern_node: begin +{ free_avail(margin_char(p)); } + free_node(p, margin_kern_node_size); + goto done; + end; + ligature_node: flush_node_list(lig_ptr(p)); + mark_node: delete_token_ref(mark_ptr(p)); + disc_node: begin flush_node_list(pre_break(p)); + flush_node_list(post_break(p)); + end; + adjust_node: flush_node_list(adjust_ptr(p)); + @t\4@>@@; + othercases confusion("flushing") +@:this can't happen flushing}{\quad flushing@> + endcases;@/ + free_node(p,small_node_size); + done:end; + p:=q; + end; +end; + +@* \[14] Copying boxes. +Another recursive operation that acts on boxes is sometimes needed: The +procedure |copy_node_list| returns a pointer to another node list that has +the same structure and meaning as the original. Note that since glue +specifications and token lists have reference counts, we need not make +copies of them. Reference counts can never get too large to fit in a +halfword, since each pointer to a node is in a different memory address, +and the total number of memory addresses fits in a halfword. +@^recursion@> +@^reference counts@> + +(Well, there actually are also references from outside |mem|; if the +|save_stack| is made arbitrarily large, it would theoretically be possible +to break \TeX\ by overflowing a reference count. But who would want to do that?) + +@d add_token_ref(#)==incr(token_ref_count(#)) {new reference to a token list} +@d add_glue_ref(#)==incr(glue_ref_count(#)) {new reference to a glue spec} + +@ The copying procedure copies words en masse without bothering +to look at their individual fields. If the node format changes---for +example, if the size is altered, or if some link field is moved to another +relative position---then this code may need to be changed too. +@^data structure assumptions@> + +@p function copy_node_list(@!p:pointer):pointer; {makes a duplicate of the + node list that starts at |p| and returns a pointer to the new list} +var h:pointer; {temporary head of copied list} +@!q:pointer; {previous position in new list} +@!r:pointer; {current node being fabricated for new list} +@!words:0..5; {number of words remaining to be copied} +begin h:=get_avail; q:=h; +while p<>null do + begin @; + link(q):=r; q:=r; p:=link(p); + end; +link(q):=null; q:=link(h); free_avail(h); +copy_node_list:=q; +end; + +@ @= +words:=1; {this setting occurs in more branches than any other} +if is_char_node(p) then r:=get_avail +else @; +while words>0 do + begin decr(words); mem[r+words]:=mem[p+words]; + end + +@ @= +case type(p) of +hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size); + mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words} + list_ptr(r):=copy_node_list(list_ptr(p)); {this affects |mem[r+5]|} + words:=5; + end; +rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size; + end; +ins_node: begin r:=get_node(ins_node_size); mem[r+4]:=mem[p+4]; + add_glue_ref(split_top_ptr(p)); + ins_ptr(r):=copy_node_list(ins_ptr(p)); {this affects |mem[r+4]|} + words:=ins_node_size-1; + end; +whatsit_node:@; +glue_node: begin r:=get_node(small_node_size); add_glue_ref(glue_ptr(p)); + glue_ptr(r):=glue_ptr(p); leader_ptr(r):=copy_node_list(leader_ptr(p)); + end; +kern_node,math_node,penalty_node: begin r:=get_node(small_node_size); + words:=small_node_size; + end; +ligature_node: begin r:=get_node(small_node_size); + mem[lig_char(r)]:=mem[lig_char(p)]; {copy |font| and |character|} + lig_ptr(r):=copy_node_list(lig_ptr(p)); + end; +disc_node: begin r:=get_node(small_node_size); + pre_break(r):=copy_node_list(pre_break(p)); + post_break(r):=copy_node_list(post_break(p)); + end; +mark_node: begin r:=get_node(small_node_size); add_token_ref(mark_ptr(p)); + words:=small_node_size; + end; +adjust_node: begin r:=get_node(small_node_size); + adjust_ptr(r):=copy_node_list(adjust_ptr(p)); + end; {|words=1=small_node_size-1|} +othercases confusion("copying") +@:this can't happen copying}{\quad copying@> +endcases + +@* \[15] The command codes. +Before we can go any further, we need to define symbolic names for the internal +code numbers that represent the various commands obeyed by \TeX. These codes +are somewhat arbitrary, but not completely so. For example, the command +codes for character types are fixed by the language, since a user says, +e.g., `\.{\\catcode \`\\\${} = 3}' to make \.{\char'44} a math delimiter, +and the command code |math_shift| is equal to~3. Some other codes have +been made adjacent so that |case| statements in the program need not consider +cases that are widely spaced, or so that |case| statements can be replaced +by |if| statements. + +At any rate, here is the list, for future reference. First come the +``catcode'' commands, several of which share their numeric codes with +ordinary commands when the catcode cannot emerge from \TeX's scanning routine. + +@d escape=0 {escape delimiter (called \.\\ in {\sl The \TeX book\/})} +@:TeXbook}{\sl The \TeX book@> +@d relax=0 {do nothing ( \.{\\relax} )} +@d left_brace=1 {beginning of a group ( \.\{ )} +@d right_brace=2 {ending of a group ( \.\} )} +@d math_shift=3 {mathematics shift character ( \.\$ )} +@d tab_mark=4 {alignment delimiter ( \.\&, \.{\\span} )} +@d car_ret=5 {end of line ( |carriage_return|, \.{\\cr}, \.{\\crcr} )} +@d out_param=5 {output a macro parameter} +@d mac_param=6 {macro parameter symbol ( \.\# )} +@d sup_mark=7 {superscript ( \.{\char'136} )} +@d sub_mark=8 {subscript ( \.{\char'137} )} +@d ignore=9 {characters to ignore ( \.{\^\^@@} )} +@d endv=9 {end of \ list in alignment template} +@d spacer=10 {characters equivalent to blank space ( \.{\ } )} +@d letter=11 {characters regarded as letters ( \.{A..Z}, \.{a..z} )} +@d other_char=12 {none of the special character types} +@d active_char=13 {characters that invoke macros ( \.{\char`\~} )} +@d par_end=13 {end of paragraph ( \.{\\par} )} +@d match=13 {match a macro parameter} +@d comment=14 {characters that introduce comments ( \.\% )} +@d end_match=14 {end of parameters to macro} +@d stop=14 {end of job ( \.{\\end}, \.{\\dump} )} +@d invalid_char=15 {characters that shouldn't appear ( \.{\^\^?} )} +@d delim_num=15 {specify delimiter numerically ( \.{\\delimiter} )} +@d max_char_code=15 {largest catcode for individual characters} + +@ Next are the ordinary run-of-the-mill command codes. Codes that are +|min_internal| or more represent internal quantities that might be +expanded by `\.{\\the}'. + +@d char_num=16 {character specified numerically ( \.{\\char} )} +@d math_char_num=17 {explicit math code ( \.{\\mathchar} )} +@d mark=18 {mark definition ( \.{\\mark} )} +@d xray=19 {peek inside of \TeX\ ( \.{\\show}, \.{\\showbox}, etc.~)} +@d make_box=20 {make a box ( \.{\\box}, \.{\\copy}, \.{\\hbox}, etc.~)} +@d hmove=21 {horizontal motion ( \.{\\moveleft}, \.{\\moveright} )} +@d vmove=22 {vertical motion ( \.{\\raise}, \.{\\lower} )} +@d un_hbox=23 {unglue a box ( \.{\\unhbox}, \.{\\unhcopy} )} +@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )} + {( or \.{\\pagediscards}, \.{\\splitdiscards} )} +@d remove_item=25 {nullify last item ( \.{\\unpenalty}, + \.{\\unkern}, \.{\\unskip} )} +@d hskip=26 {horizontal glue ( \.{\\hskip}, \.{\\hfil}, etc.~)} +@d vskip=27 {vertical glue ( \.{\\vskip}, \.{\\vfil}, etc.~)} +@d mskip=28 {math glue ( \.{\\mskip} )} +@d kern=29 {fixed space ( \.{\\kern})} +@d mkern=30 {math kern ( \.{\\mkern} )} +@d leader_ship=31 {use a box ( \.{\\shipout}, \.{\\leaders}, etc.~)} +@d halign=32 {horizontal table alignment ( \.{\\halign} )} +@d valign=33 {vertical table alignment ( \.{\\valign} )} + {or text direction directives ( \.{\\beginL}, etc.~)} +@d no_align=34 {temporary escape from alignment ( \.{\\noalign} )} +@d vrule=35 {vertical rule ( \.{\\vrule} )} +@d hrule=36 {horizontal rule ( \.{\\hrule} )} +@d insert=37 {vlist inserted in box ( \.{\\insert} )} +@d vadjust=38 {vlist inserted in enclosing paragraph ( \.{\\vadjust} )} +@d ignore_spaces=39 {gobble |spacer| tokens ( \.{\\ignorespaces} )} +@d after_assignment=40 {save till assignment is done ( \.{\\afterassignment} )} +@d after_group=41 {save till group is done ( \.{\\aftergroup} )} +@d break_penalty=42 {additional badness ( \.{\\penalty} )} +@d start_par=43 {begin paragraph ( \.{\\indent}, \.{\\noindent} )} +@d ital_corr=44 {italic correction ( \.{\\/} )} +@d accent=45 {attach accent in text ( \.{\\accent} )} +@d math_accent=46 {attach accent in math ( \.{\\mathaccent} )} +@d discretionary=47 {discretionary texts ( \.{\\-}, \.{\\discretionary} )} +@d eq_no=48 {equation number ( \.{\\eqno}, \.{\\leqno} )} +@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )} + {( or \.{\\middle} )} +@d math_comp=50 {component of formula ( \.{\\mathbin}, etc.~)} +@d limit_switch=51 {diddle limit conventions ( \.{\\displaylimits}, etc.~)} +@d above=52 {generalized fraction ( \.{\\above}, \.{\\atop}, etc.~)} +@d math_style=53 {style specification ( \.{\\displaystyle}, etc.~)} +@d math_choice=54 {choice specification ( \.{\\mathchoice} )} +@d non_script=55 {conditional math glue ( \.{\\nonscript} )} +@d vcenter=56 {vertically center a vbox ( \.{\\vcenter} )} +@d case_shift=57 {force specific case ( \.{\\lowercase}, \.{\\uppercase}~)} +@d message=58 {send to user ( \.{\\message}, \.{\\errmessage} )} +@d extension=59 {extensions to \TeX\ ( \.{\\write}, \.{\\special}, etc.~)} +@d in_stream=60 {files for reading ( \.{\\openin}, \.{\\closein} )} +@d begin_group=61 {begin local grouping ( \.{\\begingroup} )} +@d end_group=62 {end local grouping ( \.{\\endgroup} )} +@d omit=63 {omit alignment template ( \.{\\omit} )} +@d ex_space=64 {explicit space ( \.{\\\ } )} +@d no_boundary=65 {suppress boundary ligatures ( \.{\\noboundary} )} +@d radical=66 {square root and similar signs ( \.{\\radical} )} +@d end_cs_name=67 {end control sequence ( \.{\\endcsname} )} +@d min_internal=68 {the smallest code that can follow \.{\\the}} +@d char_given=68 {character code defined by \.{\\chardef}} +@d math_given=69 {math code defined by \.{\\mathchardef}} +@d 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.~)} +@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|} + +@ The remaining command codes are extra special, since they cannot get through +\TeX's scanner to the main control routine. They have been given values higher +than |max_command| so that their special nature is easily discernible. +The ``expandable'' commands come first. + +@d undefined_cs=max_command+1 {initial state of most |eq_type| fields} +@d expand_after=max_command+2 {special expansion ( \.{\\expandafter} )} +@d no_expand=max_command+3 {special nonexpansion ( \.{\\noexpand} )} +@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )} + {( or \.{\\scantokens} )} +@d if_test=max_command+5 {conditional text ( \.{\\if}, \.{\\ifcase}, etc.~)} +@d fi_or_else=max_command+6 {delimiters for conditionals ( \.{\\else}, etc.~)} +@d cs_name=max_command+7 {make a control sequence from tokens ( \.{\\csname} )} +@d convert=max_command+8 {convert to text ( \.{\\number}, \.{\\string}, etc.~)} +@d the=max_command+9 {expand an internal quantity ( \.{\\the} )} + {( or \.{\\unexpanded}, \.{\\detokenize} )} +@d top_bot_mark=max_command+10 {inserted mark ( \.{\\topmark}, etc.~)} +@d call=max_command+11 {non-long, non-outer control sequence} +@d long_call=max_command+12 {long, non-outer control sequence} +@d outer_call=max_command+13 {non-long, outer control sequence} +@d long_outer_call=max_command+14 {long, outer control sequence} +@d end_template=max_command+15 {end of an alignment template} +@d dont_expand=max_command+16 {the following token was marked by \.{\\noexpand}} +@d glue_ref=max_command+17 {the equivalent points to a glue specification} +@d shape_ref=max_command+18 {the equivalent points to a parshape specification} +@d box_ref=max_command+19 {the equivalent points to a box node, or is |null|} +@d data=max_command+20 {the equivalent is simply a halfword number} + +@* \[16] The semantic nest. +\TeX\ is typically in the midst of building many lists at once. For example, +when a math formula is being processed, \TeX\ is in math mode and +working on an mlist; this formula has temporarily interrupted \TeX\ from +being in horizontal mode and building the hlist of a paragraph; and this +paragraph has temporarily interrupted \TeX\ from being in vertical mode +and building the vlist for the next page of a document. Similarly, when a +\.{\\vbox} occurs inside of an \.{\\hbox}, \TeX\ is temporarily +interrupted from working in restricted horizontal mode, and it enters +internal vertical mode. The ``semantic nest'' is a stack that +keeps track of what lists and modes are currently suspended. + +At each level of processing we are in one of six modes: + +\yskip\hang|vmode| stands for vertical mode (the page builder); + +\hang|hmode| stands for horizontal mode (the paragraph builder); + +\hang|mmode| stands for displayed formula mode; + +\hang|-vmode| stands for internal vertical mode (e.g., in a \.{\\vbox}); + +\hang|-hmode| stands for restricted horizontal mode (e.g., in an \.{\\hbox}); + +\hang|-mmode| stands for math formula mode (not displayed). + +\yskip\noindent The mode is temporarily set to zero while processing \.{\\write} +texts in the |ship_out| routine. + +Numeric values are assigned to |vmode|, |hmode|, and |mmode| so that +\TeX's ``big semantic switch'' can select the appropriate thing to +do by computing the value |abs(mode)+cur_cmd|, where |mode| is the current +mode and |cur_cmd| is the current command code. + +@d vmode=1 {vertical mode} +@d hmode=vmode+max_command+1 {horizontal mode} +@d mmode=hmode+max_command+1 {math mode} + +@p procedure print_mode(@!m:integer); {prints the mode represented by |m|} +begin if m>0 then + case m div (max_command+1) of + 0:print("vertical"); + 1:print("horizontal"); + 2:print("display math"); + end +else if m=0 then print("no") +else case (-m) div (max_command+1) of + 0:print("internal vertical"); + 1:print("restricted horizontal"); + 2:print("math"); + end; +print(" mode"); +end; + +@ The state of affairs at any semantic level can be represented by +five values: + +\yskip\hang|mode| is the number representing the semantic mode, as +just explained. + +\yskip\hang|head| is a |pointer| to a list head for the list being built; +|link(head)| therefore points to the first element of the list, or +to |null| if the list is empty. + +\yskip\hang|tail| is a |pointer| to the final node of the list being +built; thus, |tail=head| if and only if the list is empty. + +\yskip\hang|prev_graf| is the number of lines of the current paragraph that +have already been put into the present vertical list. + +\yskip\hang|aux| is an auxiliary |memory_word| that gives further information +that is needed to characterize the situation. + +\yskip\noindent +In vertical mode, |aux| is also known as |prev_depth|; it is the scaled +value representing the depth of the previous box, for use in baseline +calculations, or it is |<=-1000|pt if the next box on the vertical list is to +be exempt from baseline calculations. In horizontal mode, |aux| is also +known as |space_factor| and |clang|; it holds the current space factor used in +spacing calculations, and the current language used for hyphenation. +(The value of |clang| is undefined in restricted horizontal mode.) +In math mode, |aux| is also known as |incompleat_noad|; if +not |null|, it points to a record that represents the numerator of a +generalized fraction for which the denominator is currently being formed +in the current list. + +There is also a sixth quantity, |mode_line|, which correlates +the semantic nest with the user's input; |mode_line| contains the source +line number at which the current level of nesting was entered. The negative +of this line number is the |mode_line| at the level of the +user's output routine. + +A seventh quantity, |eTeX_aux|, is used by the extended features \eTeX. +In vertical modes it is known as |LR_save| and holds the LR stack when a +paragraph is interrupted by a displayed formula. In display math mode +it is known as |LR_box| and holds a pointer to a prototype box for the +display. In math mode it is known as |delim_ptr| and points to the most +recent |left_noad| or |middle_noad| of a |math_left_group|. + +In horizontal mode, the |prev_graf| field is used for initial language data. + +The semantic nest is an array called |nest| that holds the |mode|, |head|, +|tail|, |prev_graf|, |aux|, and |mode_line| values for all semantic levels +below the currently active one. Information about the currently active +level is kept in the global quantities |mode|, |head|, |tail|, |prev_graf|, +|aux|, and |mode_line|, which live in a \PASCAL\ record that is ready to +be pushed onto |nest| if necessary. + +@d ignore_depth==-65536000 {|prev_depth| value that is ignored} + +@= +@!list_state_record=record@!mode_field:-mmode..mmode;@+ + @!head_field,@!tail_field: pointer; + @!eTeX_aux_field: pointer; + @!pg_field,@!ml_field: integer;@+ + @!aux_field: memory_word; + end; + +@ @d mode==cur_list.mode_field {current mode} +@d head==cur_list.head_field {header node of current list} +@d tail==cur_list.tail_field {final node on current list} +@d eTeX_aux==cur_list.eTeX_aux_field {auxiliary data for \eTeX} +@d LR_save==eTeX_aux {LR stack when a paragraph is interrupted} +@d LR_box==eTeX_aux {prototype box for display} +@d delim_ptr==eTeX_aux {most recent left or right noad of a math left group} +@d prev_graf==cur_list.pg_field {number of paragraph lines accumulated} +@d aux==cur_list.aux_field {auxiliary data about the current list} +@d prev_depth==aux.sc {the name of |aux| in vertical mode} +@d space_factor==aux.hh.lh {part of |aux| in horizontal mode} +@d clang==aux.hh.rh {the other part of |aux| in horizontal mode} +@d incompleat_noad==aux.int {the name of |aux| in math mode} +@d mode_line==cur_list.ml_field {source file line number at beginning of list} + +@= +@!nest:array[0..nest_size] of list_state_record; +@!nest_ptr:0..nest_size; {first unused location of |nest|} +@!max_nest_stack:0..nest_size; {maximum of |nest_ptr| when pushing} +@!cur_list:list_state_record; {the ``top'' semantic state} +@!shown_mode:-mmode..mmode; {most recent mode shown by \.{\\tracingcommands}} + +@ Here is a common way to make the current list grow: + +@d tail_append(#)==begin link(tail):=#; tail:=link(tail); + end + +@ We will see later that the vertical list at the bottom semantic level is split +into two parts; the ``current page'' runs from |page_head| to |page_tail|, +and the ``contribution list'' runs from |contrib_head| to |tail| of +semantic level zero. The idea is that contributions are first formed in +vertical mode, then ``contributed'' to the current page (during which time +the page-breaking decisions are made). For now, we don't need to know +any more details about the page-building process. + +@= +nest_ptr:=0; max_nest_stack:=0; +mode:=vmode; head:=contrib_head; tail:=contrib_head; +eTeX_aux:=null; +prev_depth:=ignore_depth; mode_line:=0; +prev_graf:=0; shown_mode:=0; +@; + +@ When \TeX's work on one level is interrupted, the state is saved by +calling |push_nest|. This routine changes |head| and |tail| so that +a new (empty) list is begun; it does not change |mode| or |aux|. + +@p procedure push_nest; {enter a new semantic level, save the old} +begin if nest_ptr>max_nest_stack then + begin max_nest_stack:=nest_ptr; + if nest_ptr=nest_size then overflow("semantic nest size",nest_size); +@:TeX capacity exceeded semantic nest size}{\quad semantic nest size@> + end; +nest[nest_ptr]:=cur_list; {stack the record} +incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line; +eTeX_aux:=null; +end; + +@ Conversely, when \TeX\ is finished on the current level, the former +state is restored by calling |pop_nest|. This routine will never be +called at the lowest semantic level, nor will it be called unless |head| +is a node that should be returned to free memory. + +@p procedure pop_nest; {leave a semantic level, re-enter the old} +begin free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr]; +end; + +@ Here is a procedure that displays what \TeX\ is working on, at all levels. + +@p procedure@?print_totals; forward;@t\2@> +procedure show_activities; +var p:0..nest_size; {index into |nest|} +@!m:-mmode..mmode; {mode} +@!a:memory_word; {auxiliary} +@!q,@!r:pointer; {for showing the current page} +@!t:integer; {ditto} +begin nest[nest_ptr]:=cur_list; {put the top level into the array} +print_nl(""); print_ln; +for p:=nest_ptr downto 0 do + begin m:=nest[p].mode_field; a:=nest[p].aux_field; + print_nl("### "); print_mode(m); + print(" entered at line "); print_int(abs(nest[p].ml_field)); + if m=hmode then if nest[p].pg_field <> @'40600000 then + begin print(" (language"); print_int(nest[p].pg_field mod @'200000); + print(":hyphenmin"); print_int(nest[p].pg_field div @'20000000); + print_char(","); print_int((nest[p].pg_field div @'200000) mod @'100); + print_char(")"); + end; + if nest[p].ml_field<0 then print(" (\output routine)"); + if p=0 then + begin @; + if link(contrib_head)<>null then + print_nl("### recent contributions:"); + end; + show_box(link(nest[p].head_field)); + @; + end; +end; + +@ @= +case abs(m) div (max_command+1) of +0: begin print_nl("prevdepth "); + if a.sc<=ignore_depth then print("ignored") + else print_scaled(a.sc); + if nest[p].pg_field<>0 then + begin print(", prevgraf "); + print_int(nest[p].pg_field); print(" line"); + if nest[p].pg_field<>1 then print_char("s"); + end; + end; +1: begin print_nl("spacefactor "); print_int(a.hh.lh); + if m>0 then@+ if a.hh.rh>0 then + begin print(", current language "); print_int(a.hh.rh);@+ + end; + end; +2: if a.int<>null then + begin print("this will be denominator of:"); show_box(a.int);@+ + end; +end {there are no other cases} + +@* \[17] The table of equivalents. +Now that we have studied the data structures for \TeX's semantic routines, +we ought to consider the data structures used by its syntactic routines. In +other words, our next concern will be +the tables that \TeX\ looks at when it is scanning +what the user has written. + +The biggest and most important such table is called |eqtb|. It holds the +current ``equivalents'' of things; i.e., it explains what things mean +or what their current values are, for all quantities that are subject to +the nesting structure provided by \TeX's grouping mechanism. There are six +parts to |eqtb|: + +\yskip\hangg 1) |eqtb[active_base..(hash_base-1)]| holds the current +equivalents of single-character control sequences. + +\yskip\hangg 2) |eqtb[hash_base..(glue_base-1)]| holds the current +equivalents of multiletter control sequences. + +\yskip\hangg 3) |eqtb[glue_base..(local_base-1)]| holds the current +equivalents of glue parameters like the current baselineskip. + +\yskip\hangg 4) |eqtb[local_base..(int_base-1)]| holds the current +equivalents of local halfword quantities like the current box registers, +the current ``catcodes,'' the current font, and a pointer to the current +paragraph shape. + +\yskip\hangg 5) |eqtb[int_base..(dimen_base-1)]| holds the current +equivalents of fullword integer parameters like the current hyphenation +penalty. + +\yskip\hangg 6) |eqtb[dimen_base..eqtb_size]| holds the current equivalents +of fullword dimension parameters like the current hsize or amount of +hanging indentation. + +\yskip\noindent Note that, for example, the current amount of +baselineskip glue is determined by the setting of a particular location +in region~3 of |eqtb|, while the current meaning of the control sequence +`\.{\\baselineskip}' (which might have been changed by \.{\\def} or +\.{\\let}) appears in region~2. + +@ Each entry in |eqtb| is a |memory_word|. Most of these words are of type +|two_halves|, and subdivided into three fields: + +\yskip\hangg 1) The |eq_level| (a quarterword) is the level of grouping at +which this equivalent was defined. If the level is |level_zero|, the +equivalent has never been defined; |level_one| refers to the outer level +(outside of all groups), and this level is also used for global +definitions that never go away. Higher levels are for equivalents that +will disappear at the end of their group. @^global definitions@> + +\yskip\hangg 2) The |eq_type| (another quarterword) specifies what kind of +entry this is. There are many types, since each \TeX\ primitive like +\.{\\hbox}, \.{\\def}, etc., has its own special code. The list of +command codes above includes all possible settings of the |eq_type| field. + +\yskip\hangg 3) The |equiv| (a halfword) is the current equivalent value. +This may be a font number, a pointer into |mem|, or a variety of other +things. + +@d eq_level_field(#)==#.hh.b1 +@d eq_type_field(#)==#.hh.b0 +@d equiv_field(#)==#.hh.rh +@d eq_level(#)==eq_level_field(eqtb[#]) {level of definition} +@d eq_type(#)==eq_type_field(eqtb[#]) {command code for equivalent} +@d equiv(#)==equiv_field(eqtb[#]) {equivalent value} +@d level_zero=min_quarterword {level for undefined quantities} +@d level_one=level_zero+1 {outermost level for defined quantities} + +@ Many locations in |eqtb| have symbolic names. The purpose of the next +paragraphs is to define these names, and to set up the initial values of the +equivalents. + +In the first region we have |number_chars| equivalents for ``active characters'' +that act as control sequences, followed by |number_chars| equivalents for +single-character control sequences. + +Then comes region~2, which corresponds to the hash table that we will +define later. The maximum address in this region is used for a dummy +control sequence that is perpetually undefined. There also are several +locations for control sequences that are perpetually defined +(since they are used in error recovery). + +@d active_base=1 {beginning of region 1, for active character equivalents} +@d single_base=active_base+number_usvs + {equivalents of one-character control sequences} +@d null_cs=single_base+number_usvs {equivalent of \.{\\csname\\endcsname}} +@d hash_base=null_cs+1 {beginning of region 2, for the hash table} +@d frozen_control_sequence=hash_base+hash_size {for error recovery} +@d frozen_protection=frozen_control_sequence {inaccessible but definable} +@d frozen_cr=frozen_control_sequence+1 {permanent `\.{\\cr}'} +@d frozen_end_group=frozen_control_sequence+2 {permanent `\.{\\endgroup}'} +@d frozen_right=frozen_control_sequence+3 {permanent `\.{\\right}'} +@d frozen_fi=frozen_control_sequence+4 {permanent `\.{\\fi}'} +@d frozen_end_template=frozen_control_sequence+5 {permanent `\.{\\endtemplate}'} +@d frozen_endv=frozen_control_sequence+6 {second permanent `\.{\\endtemplate}'} +@d frozen_relax=frozen_control_sequence+7 {permanent `\.{\\relax}'} +@d end_write=frozen_control_sequence+8 {permanent `\.{\\endwrite}'} +@d frozen_dont_expand=frozen_control_sequence+9 + {permanent `\.{\\notexpanded:}'} +@d frozen_null_font=frozen_control_sequence+10 + {permanent `\.{\\nullfont}'} +@d font_id_base=frozen_null_font-font_base + {begins table of 257 permanent font identifiers} +@d undefined_control_sequence=frozen_null_font+257 {dummy location} +@d glue_base=undefined_control_sequence+1 {beginning of region 3} + +@= +eq_type(undefined_control_sequence):=undefined_cs; +equiv(undefined_control_sequence):=null; +eq_level(undefined_control_sequence):=level_zero; +for k:=active_base to undefined_control_sequence-1 do + eqtb[k]:=eqtb[undefined_control_sequence]; + +@ Here is a routine that displays the current meaning of an |eqtb| entry +in region 1 or~2. (Similar routines for the other regions will appear +below.) + +@= +begin sprint_cs(n); print_char("="); print_cmd_chr(eq_type(n),equiv(n)); +if eq_type(n)>=call then + begin print_char(":"); show_token_list(link(equiv(n)),null,32); + end; +end + +@ Region 3 of |eqtb| contains the |number_regs| \.{\\skip} registers, +as well as the glue parameters defined here. It is important that the +``muskip'' parameters have larger numbers than the others. + +@d line_skip_code=0 {interline glue if |baseline_skip| is infeasible} +@d baseline_skip_code=1 {desired glue between baselines} +@d par_skip_code=2 {extra glue just above a paragraph} +@d above_display_skip_code=3 {extra glue just above displayed math} +@d below_display_skip_code=4 {extra glue just below displayed math} +@d above_display_short_skip_code=5 + {glue above displayed math following short lines} +@d below_display_short_skip_code=6 + {glue below displayed math following short lines} +@d left_skip_code=7 {glue at left of justified lines} +@d right_skip_code=8 {glue at right of justified lines} +@d top_skip_code=9 {glue at top of main pages} +@d split_top_skip_code=10 {glue at top of split pages} +@d tab_skip_code=11 {glue between aligned entries} +@d space_skip_code=12 {glue between words (if not |zero_glue|)} +@d xspace_skip_code=13 {glue after sentences (if not |zero_glue|)} +@d par_fill_skip_code=14 {glue on last line of paragraph} +@d 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} +@d skip_base=glue_base+glue_pars {table of |number_regs| ``skip'' registers} +@d mu_skip_base=skip_base+number_regs + {table of |number_regs| ``muskip'' registers} +@d local_base=mu_skip_base+number_regs {beginning of region 4} +@# +@d skip(#)==equiv(skip_base+#) {|mem| location of glue specification} +@d mu_skip(#)==equiv(mu_skip_base+#) {|mem| location of math glue spec} +@d glue_par(#)==equiv(glue_base+#) {|mem| location of glue specification} +@d line_skip==glue_par(line_skip_code) +@d baseline_skip==glue_par(baseline_skip_code) +@d par_skip==glue_par(par_skip_code) +@d above_display_skip==glue_par(above_display_skip_code) +@d below_display_skip==glue_par(below_display_skip_code) +@d above_display_short_skip==glue_par(above_display_short_skip_code) +@d below_display_short_skip==glue_par(below_display_short_skip_code) +@d left_skip==glue_par(left_skip_code) +@d right_skip==glue_par(right_skip_code) +@d top_skip==glue_par(top_skip_code) +@d split_top_skip==glue_par(split_top_skip_code) +@d tab_skip==glue_par(tab_skip_code) +@d space_skip==glue_par(space_skip_code) +@d xspace_skip==glue_par(xspace_skip_code) +@d par_fill_skip==glue_par(par_fill_skip_code) +@d XeTeX_linebreak_skip==glue_par(XeTeX_linebreak_skip_code) +@d thin_mu_skip==glue_par(thin_mu_skip_code) +@d med_mu_skip==glue_par(med_mu_skip_code) +@d thick_mu_skip==glue_par(thick_mu_skip_code) + +@=glue_par(n) + +@ Sometimes we need to convert \TeX's internal code numbers into symbolic +form. The |print_skip_param| routine gives the symbolic name of a glue +parameter. + +@= +procedure print_skip_param(@!n:integer); +begin case n of +line_skip_code: print_esc("lineskip"); +baseline_skip_code: print_esc("baselineskip"); +par_skip_code: print_esc("parskip"); +above_display_skip_code: print_esc("abovedisplayskip"); +below_display_skip_code: print_esc("belowdisplayskip"); +above_display_short_skip_code: print_esc("abovedisplayshortskip"); +below_display_short_skip_code: print_esc("belowdisplayshortskip"); +left_skip_code: print_esc("leftskip"); +right_skip_code: print_esc("rightskip"); +top_skip_code: print_esc("topskip"); +split_top_skip_code: print_esc("splittopskip"); +tab_skip_code: print_esc("tabskip"); +space_skip_code: print_esc("spaceskip"); +xspace_skip_code: print_esc("xspaceskip"); +par_fill_skip_code: print_esc("parfillskip"); +XeTeX_linebreak_skip_code: print_esc("XeTeXlinebreakskip"); +thin_mu_skip_code: print_esc("thinmuskip"); +med_mu_skip_code: print_esc("medmuskip"); +thick_mu_skip_code: print_esc("thickmuskip"); +othercases print("[unknown glue parameter!]") +endcases; +end; + +@ The symbolic names for glue parameters are put into \TeX's hash table +by using the routine called |primitive|, defined below. Let us enter them +now, so that we don't have to list all those parameter names anywhere else. + +@= +primitive("lineskip",assign_glue,glue_base+line_skip_code);@/ +@!@:line_skip_}{\.{\\lineskip} primitive@> +primitive("baselineskip",assign_glue,glue_base+baseline_skip_code);@/ +@!@:baseline_skip_}{\.{\\baselineskip} primitive@> +primitive("parskip",assign_glue,glue_base+par_skip_code);@/ +@!@:par_skip_}{\.{\\parskip} primitive@> +primitive("abovedisplayskip",assign_glue,glue_base+above_display_skip_code);@/ +@!@:above_display_skip_}{\.{\\abovedisplayskip} primitive@> +primitive("belowdisplayskip",assign_glue,glue_base+below_display_skip_code);@/ +@!@:below_display_skip_}{\.{\\belowdisplayskip} primitive@> +primitive("abovedisplayshortskip", + assign_glue,glue_base+above_display_short_skip_code);@/ +@!@:above_display_short_skip_}{\.{\\abovedisplayshortskip} primitive@> +primitive("belowdisplayshortskip", + assign_glue,glue_base+below_display_short_skip_code);@/ +@!@:below_display_short_skip_}{\.{\\belowdisplayshortskip} primitive@> +primitive("leftskip",assign_glue,glue_base+left_skip_code);@/ +@!@:left_skip_}{\.{\\leftskip} primitive@> +primitive("rightskip",assign_glue,glue_base+right_skip_code);@/ +@!@:right_skip_}{\.{\\rightskip} primitive@> +primitive("topskip",assign_glue,glue_base+top_skip_code);@/ +@!@:top_skip_}{\.{\\topskip} primitive@> +primitive("splittopskip",assign_glue,glue_base+split_top_skip_code);@/ +@!@:split_top_skip_}{\.{\\splittopskip} primitive@> +primitive("tabskip",assign_glue,glue_base+tab_skip_code);@/ +@!@:tab_skip_}{\.{\\tabskip} primitive@> +primitive("spaceskip",assign_glue,glue_base+space_skip_code);@/ +@!@:space_skip_}{\.{\\spaceskip} primitive@> +primitive("xspaceskip",assign_glue,glue_base+xspace_skip_code);@/ +@!@:xspace_skip_}{\.{\\xspaceskip} primitive@> +primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/ +@!@:par_fill_skip_}{\.{\\parfillskip} primitive@> +primitive("XeTeXlinebreakskip",assign_glue,glue_base+XeTeX_linebreak_skip_code);@/ +@!@:XeTeX_linebreak_skip_}{\.{\\XeTeXlinebreakskip} primitive@> +primitive("thinmuskip",assign_mu_glue,glue_base+thin_mu_skip_code);@/ +@!@:thin_mu_skip_}{\.{\\thinmuskip} primitive@> +primitive("medmuskip",assign_mu_glue,glue_base+med_mu_skip_code);@/ +@!@:med_mu_skip_}{\.{\\medmuskip} primitive@> +primitive("thickmuskip",assign_mu_glue,glue_base+thick_mu_skip_code);@/ +@!@:thick_mu_skip_}{\.{\\thickmuskip} primitive@> + +@ @= +assign_glue,assign_mu_glue: if chr_code= +equiv(glue_base):=zero_glue; eq_level(glue_base):=level_one; +eq_type(glue_base):=glue_ref; +for k:=glue_base+1 to local_base-1 do eqtb[k]:=eqtb[glue_base]; +glue_ref_count(zero_glue):=glue_ref_count(zero_glue)+local_base-glue_base; + +@ @= +if n= +primitive("output",assign_toks,output_routine_loc); +@!@:output_}{\.{\\output} primitive@> +primitive("everypar",assign_toks,every_par_loc); +@!@:every_par_}{\.{\\everypar} primitive@> +primitive("everymath",assign_toks,every_math_loc); +@!@:every_math_}{\.{\\everymath} primitive@> +primitive("everydisplay",assign_toks,every_display_loc); +@!@:every_display_}{\.{\\everydisplay} primitive@> +primitive("everyhbox",assign_toks,every_hbox_loc); +@!@:every_hbox_}{\.{\\everyhbox} primitive@> +primitive("everyvbox",assign_toks,every_vbox_loc); +@!@:every_vbox_}{\.{\\everyvbox} primitive@> +primitive("everyjob",assign_toks,every_job_loc); +@!@:every_job_}{\.{\\everyjob} primitive@> +primitive("everycr",assign_toks,every_cr_loc); +@!@:every_cr_}{\.{\\everycr} primitive@> +primitive("errhelp",assign_toks,err_help_loc); +@!@:err_help_}{\.{\\errhelp} primitive@> + +@ @= +assign_toks: if chr_code>=toks_base then + begin print_esc("toks"); print_int(chr_code-toks_base); + end +else case chr_code of + output_routine_loc: print_esc("output"); + every_par_loc: print_esc("everypar"); + every_math_loc: print_esc("everymath"); + every_display_loc: print_esc("everydisplay"); + every_hbox_loc: print_esc("everyhbox"); + every_vbox_loc: print_esc("everyvbox"); + every_job_loc: print_esc("everyjob"); + every_cr_loc: print_esc("everycr"); + @/@@/ + othercases print_esc("errhelp") + endcases; + +@ We initialize most things to null or undefined values. An undefined font +is represented by the internal code |font_base|. + +However, the character code tables are given initial values based on the +conventional interpretation of ASCII code. These initial values should +not be changed when \TeX\ is adapted for use with non-English languages; +all changes to the initialization conventions should be made in format +packages, not in \TeX\ itself, so that global interchange of formats is +possible. + +@d null_font==font_base +@d var_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 + +@= +par_shape_ptr:=null; eq_type(par_shape_loc):=shape_ref; +eq_level(par_shape_loc):=level_one;@/ +for k:=etex_pen_base to etex_pens-1 do + eqtb[k]:=eqtb[par_shape_loc]; +for k:=output_routine_loc to toks_base+number_regs-1 do + eqtb[k]:=eqtb[undefined_control_sequence]; +box(0):=null; eq_type(box_base):=box_ref; eq_level(box_base):=level_one; +for k:=box_base+1 to box_base+number_regs-1 do eqtb[k]:=eqtb[box_base]; +cur_font:=null_font; eq_type(cur_font_loc):=data; +eq_level(cur_font_loc):=level_one;@/ +for k:=math_font_base to math_font_base+number_math_fonts-1 do eqtb[k]:=eqtb[cur_font_loc]; +equiv(cat_code_base):=0; eq_type(cat_code_base):=data; +eq_level(cat_code_base):=level_one;@/ +for k:=cat_code_base+1 to int_base-1 do eqtb[k]:=eqtb[cat_code_base]; +for k:=0 to number_usvs-1 do + begin cat_code(k):=other_char; math_code(k):=hi(k); sf_code(k):=1000; + end; +cat_code(carriage_return):=car_ret; cat_code(" "):=spacer; +cat_code("\"):=escape; cat_code("%"):=comment; +cat_code(invalid_code):=invalid_char; cat_code(null_code):=ignore; +for k:="0" to "9" do math_code(k):=hi(k + set_class_field(var_fam_class)); +for k:="A" to "Z" do + begin cat_code(k):=letter; cat_code(k+"a"-"A"):=letter;@/ + 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));@/ + lc_code(k):=k+"a"-"A"; lc_code(k+"a"-"A"):=k+"a"-"A";@/ + uc_code(k):=k; uc_code(k+"a"-"A"):=k;@/ + sf_code(k):=999; + end; + +@ @= +if (n=par_shape_loc) or ((n>=etex_pen_base) and (npar_shape_loc then + begin print_int(penalty(equiv(n))); print_char(" "); + print_int(penalty(equiv(n)+1)); + if penalty(equiv(n))>1 then print_esc("ETC."); + end + else print_int(info(par_shape_ptr)); + end +else if n +else @ + +@ @= +begin if n=cur_font_loc then print("current font") +else if n@/ +othercases print("[unknown integer parameter!]") +endcases; +end; + +@ The integer parameter names must be entered into the hash table. + +@= +primitive("pretolerance",assign_int,int_base+pretolerance_code);@/ +@!@:pretolerance_}{\.{\\pretolerance} primitive@> +primitive("tolerance",assign_int,int_base+tolerance_code);@/ +@!@:tolerance_}{\.{\\tolerance} primitive@> +primitive("linepenalty",assign_int,int_base+line_penalty_code);@/ +@!@:line_penalty_}{\.{\\linepenalty} primitive@> +primitive("hyphenpenalty",assign_int,int_base+hyphen_penalty_code);@/ +@!@:hyphen_penalty_}{\.{\\hyphenpenalty} primitive@> +primitive("exhyphenpenalty",assign_int,int_base+ex_hyphen_penalty_code);@/ +@!@:ex_hyphen_penalty_}{\.{\\exhyphenpenalty} primitive@> +primitive("clubpenalty",assign_int,int_base+club_penalty_code);@/ +@!@:club_penalty_}{\.{\\clubpenalty} primitive@> +primitive("widowpenalty",assign_int,int_base+widow_penalty_code);@/ +@!@:widow_penalty_}{\.{\\widowpenalty} primitive@> +primitive("displaywidowpenalty", + assign_int,int_base+display_widow_penalty_code);@/ +@!@:display_widow_penalty_}{\.{\\displaywidowpenalty} primitive@> +primitive("brokenpenalty",assign_int,int_base+broken_penalty_code);@/ +@!@:broken_penalty_}{\.{\\brokenpenalty} primitive@> +primitive("binoppenalty",assign_int,int_base+bin_op_penalty_code);@/ +@!@:bin_op_penalty_}{\.{\\binoppenalty} primitive@> +primitive("relpenalty",assign_int,int_base+rel_penalty_code);@/ +@!@:rel_penalty_}{\.{\\relpenalty} primitive@> +primitive("predisplaypenalty",assign_int,int_base+pre_display_penalty_code);@/ +@!@:pre_display_penalty_}{\.{\\predisplaypenalty} primitive@> +primitive("postdisplaypenalty",assign_int,int_base+post_display_penalty_code);@/ +@!@:post_display_penalty_}{\.{\\postdisplaypenalty} primitive@> +primitive("interlinepenalty",assign_int,int_base+inter_line_penalty_code);@/ +@!@:inter_line_penalty_}{\.{\\interlinepenalty} primitive@> +primitive("doublehyphendemerits", + assign_int,int_base+double_hyphen_demerits_code);@/ +@!@:double_hyphen_demerits_}{\.{\\doublehyphendemerits} primitive@> +primitive("finalhyphendemerits", + assign_int,int_base+final_hyphen_demerits_code);@/ +@!@:final_hyphen_demerits_}{\.{\\finalhyphendemerits} primitive@> +primitive("adjdemerits",assign_int,int_base+adj_demerits_code);@/ +@!@:adj_demerits_}{\.{\\adjdemerits} primitive@> +primitive("mag",assign_int,int_base+mag_code);@/ +@!@:mag_}{\.{\\mag} primitive@> +primitive("delimiterfactor",assign_int,int_base+delimiter_factor_code);@/ +@!@:delimiter_factor_}{\.{\\delimiterfactor} primitive@> +primitive("looseness",assign_int,int_base+looseness_code);@/ +@!@:looseness_}{\.{\\looseness} primitive@> +primitive("time",assign_int,int_base+time_code);@/ +@!@:time_}{\.{\\time} primitive@> +primitive("day",assign_int,int_base+day_code);@/ +@!@:day_}{\.{\\day} primitive@> +primitive("month",assign_int,int_base+month_code);@/ +@!@:month_}{\.{\\month} primitive@> +primitive("year",assign_int,int_base+year_code);@/ +@!@:year_}{\.{\\year} primitive@> +primitive("showboxbreadth",assign_int,int_base+show_box_breadth_code);@/ +@!@:show_box_breadth_}{\.{\\showboxbreadth} primitive@> +primitive("showboxdepth",assign_int,int_base+show_box_depth_code);@/ +@!@:show_box_depth_}{\.{\\showboxdepth} primitive@> +primitive("hbadness",assign_int,int_base+hbadness_code);@/ +@!@:hbadness_}{\.{\\hbadness} primitive@> +primitive("vbadness",assign_int,int_base+vbadness_code);@/ +@!@:vbadness_}{\.{\\vbadness} primitive@> +primitive("pausing",assign_int,int_base+pausing_code);@/ +@!@:pausing_}{\.{\\pausing} primitive@> +primitive("tracingonline",assign_int,int_base+tracing_online_code);@/ +@!@:tracing_online_}{\.{\\tracingonline} primitive@> +primitive("tracingmacros",assign_int,int_base+tracing_macros_code);@/ +@!@:tracing_macros_}{\.{\\tracingmacros} primitive@> +primitive("tracingstats",assign_int,int_base+tracing_stats_code);@/ +@!@:tracing_stats_}{\.{\\tracingstats} primitive@> +primitive("tracingparagraphs",assign_int,int_base+tracing_paragraphs_code);@/ +@!@:tracing_paragraphs_}{\.{\\tracingparagraphs} primitive@> +primitive("tracingpages",assign_int,int_base+tracing_pages_code);@/ +@!@:tracing_pages_}{\.{\\tracingpages} primitive@> +primitive("tracingoutput",assign_int,int_base+tracing_output_code);@/ +@!@:tracing_output_}{\.{\\tracingoutput} primitive@> +primitive("tracinglostchars",assign_int,int_base+tracing_lost_chars_code);@/ +@!@:tracing_lost_chars_}{\.{\\tracinglostchars} primitive@> +primitive("tracingcommands",assign_int,int_base+tracing_commands_code);@/ +@!@:tracing_commands_}{\.{\\tracingcommands} primitive@> +primitive("tracingrestores",assign_int,int_base+tracing_restores_code);@/ +@!@:tracing_restores_}{\.{\\tracingrestores} primitive@> +primitive("uchyph",assign_int,int_base+uc_hyph_code);@/ +@!@:uc_hyph_}{\.{\\uchyph} primitive@> +primitive("outputpenalty",assign_int,int_base+output_penalty_code);@/ +@!@:output_penalty_}{\.{\\outputpenalty} primitive@> +primitive("maxdeadcycles",assign_int,int_base+max_dead_cycles_code);@/ +@!@:max_dead_cycles_}{\.{\\maxdeadcycles} primitive@> +primitive("hangafter",assign_int,int_base+hang_after_code);@/ +@!@:hang_after_}{\.{\\hangafter} primitive@> +primitive("floatingpenalty",assign_int,int_base+floating_penalty_code);@/ +@!@:floating_penalty_}{\.{\\floatingpenalty} primitive@> +primitive("globaldefs",assign_int,int_base+global_defs_code);@/ +@!@:global_defs_}{\.{\\globaldefs} primitive@> +primitive("fam",assign_int,int_base+cur_fam_code);@/ +@!@:fam_}{\.{\\fam} primitive@> +primitive("escapechar",assign_int,int_base+escape_char_code);@/ +@!@:escape_char_}{\.{\\escapechar} primitive@> +primitive("defaulthyphenchar",assign_int,int_base+default_hyphen_char_code);@/ +@!@:default_hyphen_char_}{\.{\\defaulthyphenchar} primitive@> +primitive("defaultskewchar",assign_int,int_base+default_skew_char_code);@/ +@!@:default_skew_char_}{\.{\\defaultskewchar} primitive@> +primitive("endlinechar",assign_int,int_base+end_line_char_code);@/ +@!@:end_line_char_}{\.{\\endlinechar} primitive@> +primitive("newlinechar",assign_int,int_base+new_line_char_code);@/ +@!@:new_line_char_}{\.{\\newlinechar} primitive@> +primitive("language",assign_int,int_base+language_code);@/ +@!@:language_}{\.{\\language} primitive@> +primitive("lefthyphenmin",assign_int,int_base+left_hyphen_min_code);@/ +@!@:left_hyphen_min_}{\.{\\lefthyphenmin} primitive@> +primitive("righthyphenmin",assign_int,int_base+right_hyphen_min_code);@/ +@!@:right_hyphen_min_}{\.{\\righthyphenmin} primitive@> +primitive("holdinginserts",assign_int,int_base+holding_inserts_code);@/ +@!@:holding_inserts_}{\.{\\holdinginserts} primitive@> +primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/ +@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@> +primitive("XeTeXlinebreakpenalty",assign_int,int_base+XeTeX_linebreak_penalty_code);@/ +@!@:XeTeX_linebreak_penalty_}{\.{\\XeTeXlinebreakpenalty} primitive@> +primitive("XeTeXprotrudechars",assign_int,int_base+XeTeX_protrude_chars_code);@/ +@!@:XeTeX_protrude_chars_}{\.{\\XeTeXprotrudechars} primitive@> +@{ @} @{ @} @{ @} + +@ @= +assign_int: if chr_code + +@= +for k:=int_base to del_code_base-1 do eqtb[k].int:=0; +mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25; +escape_char:="\"; end_line_char:=carriage_return; +for k:=0 to number_chars-1 do del_code(k):=-1; +del_code("."):=0; {this null delimiter is used in error recovery} + +@ The following procedure, which is called just before \TeX\ initializes its +input and output, establishes the initial values of the date and time. +@^system dependencies@> +Since standard \PASCAL\ cannot provide such information, something special +is needed. The program here simply specifies July 4, 1776, at noon; but +users probably want a better approximation to the truth. + +@p procedure fix_date_and_time; +begin time:=12*60; {minutes since midnight} +day:=4; {fourth day of the month} +month:=7; {seventh month of the year} +year:=1776; {Anno Domini} +end; + +@ @= +begin if n= +@!old_setting:0..max_selector; + +@ The final region of |eqtb| contains the dimension parameters defined +here, and the |number_regs| \.{\\dimen} registers. + +@d par_indent_code=0 {indentation of paragraphs} +@d math_surround_code=1 {space around math in text} +@d line_skip_limit_code=2 {threshold for |line_skip| instead of |baseline_skip|} +@d hsize_code=3 {line width in horizontal mode} +@d vsize_code=4 {page height in vertical mode} +@d max_depth_code=5 {maximum depth of boxes on main pages} +@d split_max_depth_code=6 {maximum depth of boxes on split pages} +@d box_max_depth_code=7 {maximum depth of explicit vboxes} +@d hfuzz_code=8 {tolerance for overfull hbox messages} +@d vfuzz_code=9 {tolerance for overfull vbox messages} +@d delimiter_shortfall_code=10 {maximum amount uncovered by variable delimiters} +@d null_delimiter_space_code=11 {blank space in null delimiters} +@d script_space_code=12 {extra space after subscript or superscript} +@d pre_display_size_code=13 {length of text preceding a display} +@d display_width_code=14 {length of line for displayed equation} +@d display_indent_code=15 {indentation of line for displayed equation} +@d overfull_rule_code=16 {width of rule that identifies overfull hboxes} +@d hang_indent_code=17 {amount of hanging indentation} +@d h_offset_code=18 {amount of horizontal offset when shipping pages out} +@d v_offset_code=19 {amount of vertical offset when shipping pages out} +@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking} +@d 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} +@d scaled_base=dimen_base+dimen_pars + {table of |number_regs| user-defined \.{\\dimen} registers} +@d eqtb_size=scaled_base+biggest_reg {largest subscript of |eqtb|} +@# +@d dimen(#)==eqtb[scaled_base+#].sc +@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity} +@d par_indent==dimen_par(par_indent_code) +@d math_surround==dimen_par(math_surround_code) +@d line_skip_limit==dimen_par(line_skip_limit_code) +@d hsize==dimen_par(hsize_code) +@d vsize==dimen_par(vsize_code) +@d max_depth==dimen_par(max_depth_code) +@d split_max_depth==dimen_par(split_max_depth_code) +@d box_max_depth==dimen_par(box_max_depth_code) +@d hfuzz==dimen_par(hfuzz_code) +@d vfuzz==dimen_par(vfuzz_code) +@d delimiter_shortfall==dimen_par(delimiter_shortfall_code) +@d null_delimiter_space==dimen_par(null_delimiter_space_code) +@d script_space==dimen_par(script_space_code) +@d pre_display_size==dimen_par(pre_display_size_code) +@d display_width==dimen_par(display_width_code) +@d display_indent==dimen_par(display_indent_code) +@d overfull_rule==dimen_par(overfull_rule_code) +@d hang_indent==dimen_par(hang_indent_code) +@d h_offset==dimen_par(h_offset_code) +@d v_offset==dimen_par(v_offset_code) +@d emergency_stretch==dimen_par(emergency_stretch_code) +@d pdf_page_width == dimen_par(pdf_page_width_code) +@d pdf_page_height == dimen_par(pdf_page_height_code) + +@p procedure print_length_param(@!n:integer); +begin case n of +par_indent_code:print_esc("parindent"); +math_surround_code:print_esc("mathsurround"); +line_skip_limit_code:print_esc("lineskiplimit"); +hsize_code:print_esc("hsize"); +vsize_code:print_esc("vsize"); +max_depth_code:print_esc("maxdepth"); +split_max_depth_code:print_esc("splitmaxdepth"); +box_max_depth_code:print_esc("boxmaxdepth"); +hfuzz_code:print_esc("hfuzz"); +vfuzz_code:print_esc("vfuzz"); +delimiter_shortfall_code:print_esc("delimitershortfall"); +null_delimiter_space_code:print_esc("nulldelimiterspace"); +script_space_code:print_esc("scriptspace"); +pre_display_size_code:print_esc("predisplaysize"); +display_width_code:print_esc("displaywidth"); +display_indent_code:print_esc("displayindent"); +overfull_rule_code:print_esc("overfullrule"); +hang_indent_code:print_esc("hangindent"); +h_offset_code:print_esc("hoffset"); +v_offset_code:print_esc("voffset"); +emergency_stretch_code:print_esc("emergencystretch"); +pdf_page_width_code: print_esc("pdfpagewidth"); +pdf_page_height_code: print_esc("pdfpageheight"); +othercases print("[unknown dimen parameter!]") +endcases; +end; + +@ @= +primitive("parindent",assign_dimen,dimen_base+par_indent_code);@/ +@!@:par_indent_}{\.{\\parindent} primitive@> +primitive("mathsurround",assign_dimen,dimen_base+math_surround_code);@/ +@!@:math_surround_}{\.{\\mathsurround} primitive@> +primitive("lineskiplimit",assign_dimen,dimen_base+line_skip_limit_code);@/ +@!@:line_skip_limit_}{\.{\\lineskiplimit} primitive@> +primitive("hsize",assign_dimen,dimen_base+hsize_code);@/ +@!@:hsize_}{\.{\\hsize} primitive@> +primitive("vsize",assign_dimen,dimen_base+vsize_code);@/ +@!@:vsize_}{\.{\\vsize} primitive@> +primitive("maxdepth",assign_dimen,dimen_base+max_depth_code);@/ +@!@:max_depth_}{\.{\\maxdepth} primitive@> +primitive("splitmaxdepth",assign_dimen,dimen_base+split_max_depth_code);@/ +@!@:split_max_depth_}{\.{\\splitmaxdepth} primitive@> +primitive("boxmaxdepth",assign_dimen,dimen_base+box_max_depth_code);@/ +@!@:box_max_depth_}{\.{\\boxmaxdepth} primitive@> +primitive("hfuzz",assign_dimen,dimen_base+hfuzz_code);@/ +@!@:hfuzz_}{\.{\\hfuzz} primitive@> +primitive("vfuzz",assign_dimen,dimen_base+vfuzz_code);@/ +@!@:vfuzz_}{\.{\\vfuzz} primitive@> +primitive("delimitershortfall", + assign_dimen,dimen_base+delimiter_shortfall_code);@/ +@!@:delimiter_shortfall_}{\.{\\delimitershortfall} primitive@> +primitive("nulldelimiterspace", + assign_dimen,dimen_base+null_delimiter_space_code);@/ +@!@:null_delimiter_space_}{\.{\\nulldelimiterspace} primitive@> +primitive("scriptspace",assign_dimen,dimen_base+script_space_code);@/ +@!@:script_space_}{\.{\\scriptspace} primitive@> +primitive("predisplaysize",assign_dimen,dimen_base+pre_display_size_code);@/ +@!@:pre_display_size_}{\.{\\predisplaysize} primitive@> +primitive("displaywidth",assign_dimen,dimen_base+display_width_code);@/ +@!@:display_width_}{\.{\\displaywidth} primitive@> +primitive("displayindent",assign_dimen,dimen_base+display_indent_code);@/ +@!@:display_indent_}{\.{\\displayindent} primitive@> +primitive("overfullrule",assign_dimen,dimen_base+overfull_rule_code);@/ +@!@:overfull_rule_}{\.{\\overfullrule} primitive@> +primitive("hangindent",assign_dimen,dimen_base+hang_indent_code);@/ +@!@:hang_indent_}{\.{\\hangindent} primitive@> +primitive("hoffset",assign_dimen,dimen_base+h_offset_code);@/ +@!@:h_offset_}{\.{\\hoffset} primitive@> +primitive("voffset",assign_dimen,dimen_base+v_offset_code);@/ +@!@:v_offset_}{\.{\\voffset} primitive@> +primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/ +@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@> + +primitive("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@> + +@ @= +assign_dimen: if chr_code= +for k:=dimen_base to eqtb_size do eqtb[k].sc:=0; + +@ @= +begin if n@@;@/ +@!stat procedure show_eqtb(@!n:pointer); +begin if n +else if n +else if n +else if n +else if n<=eqtb_size then @ +else print_char("?"); {this can't happen either} +end; +tats + +@ The last two regions of |eqtb| have fullword values instead of the +three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary, +but \TeX\ needs to store the |eq_level| information in another array +called |xeq_level|. + +@= +@!eqtb:array[active_base..eqtb_size] of memory_word; +@!xeq_level:array[int_base..eqtb_size] of quarterword; + +@ @= +for k:=int_base to eqtb_size do xeq_level[k]:=level_one; + +@ When the debugging routine |search_mem| is looking for pointers having a +given value, it is interested only in regions 1 to~3 of~|eqtb|, and in the +first part of region~4. + +@= +for q:=active_base to box_base+biggest_reg do + begin if equiv(q)=p then + begin print_nl("EQUIV("); print_int(q); print_char(")"); + end; + end + +@* \[18] The hash table. +Control sequences are stored and retrieved by means of a fairly standard hash +table algorithm called the method of ``coalescing lists'' (cf.\ Algorithm 6.4C +in {\sl The Art of Computer Programming\/}). Once a control sequence enters the +table, it is never removed, because there are complicated situations +involving \.{\\gdef} where the removal of a control sequence at the end of +a group would be a mistake preventable only by the introduction of a +complicated reference-count mechanism. + +The actual sequence of letters forming a control sequence identifier is +stored in the |str_pool| array together with all the other strings. An +auxiliary array |hash| consists of items with two halfword fields per +word. The first of these, called |next(p)|, points to the next identifier +belonging to the same coalesced list as the identifier corresponding to~|p|; +and the other, called |text(p)|, points to the |str_start| entry for +|p|'s identifier. If position~|p| of the hash table is empty, we have +|text(p)=0|; if position |p| is either empty or the end of a coalesced +hash list, we have |next(p)=0|. An auxiliary pointer variable called +|hash_used| is maintained in such a way that all locations |p>=hash_used| +are nonempty. The global variable |cs_count| tells how many multiletter +control sequences have been defined, if statistics are being kept. + +A global boolean variable called |no_new_control_sequence| is set to +|true| during the time that new hash table entries are forbidden. + +@d next(#) == hash[#].lh {link for coalesced lists} +@d text(#) == hash[#].rh {string number for control sequence name} +@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied} +@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name} + +@= +@!hash: array[hash_base..undefined_control_sequence-1] of two_halves; + {the hash table} +@!hash_used:pointer; {allocation pointer for |hash|} +@!no_new_control_sequence:boolean; {are new identifiers legal?} +@!cs_count:integer; {total number of known identifiers} + +@ @= +no_new_control_sequence:=true; {new identifiers are usually forbidden} +next(hash_base):=0; text(hash_base):=0; +for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base]; + +@ @= +hash_used:=frozen_control_sequence; {nothing is used} +cs_count:=0; +eq_type(frozen_dont_expand):=dont_expand; +text(frozen_dont_expand):="notexpanded:"; +@.notexpanded:@> + +@ Here is the subroutine that searches the hash table for an identifier +that matches a given string of length |l>1| appearing in |buffer[j.. +(j+l-1)]|. If the identifier is found, the corresponding hash table address +is returned. Otherwise, if the global variable |no_new_control_sequence| +is |true|, the dummy address |undefined_control_sequence| is returned. +Otherwise the identifier is inserted into the hash table and its location +is returned. + +@p function id_lookup(@!j,@!l:integer):pointer; {search the hash table} +label found; {go here if you found it} +var h:integer; {hash code} +@!d:integer; {number of characters in incomplete current string} +@!p:pointer; {index in |hash| array} +@!k:pointer; {index in |buffer| array} +@!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 + if str_eq_buf(text(p),j) then goto found; + if next(p)=0 then + begin if no_new_control_sequence then + p:=undefined_control_sequence + else @; + goto found; + end; + p:=next(p); + end; +found: id_lookup:=p; +end; + +@ @= +begin if text(p)>0 then + begin repeat if hash_is_full then overflow("hash size",hash_size); +@:TeX capacity exceeded hash size}{\quad hash size@> + decr(hash_used); + until text(hash_used)=0; {search for an empty location in |hash|} + next(p):=hash_used; p:=hash_used; + end; +str_room(ll); d:=cur_length; +while pool_ptr>str_start_macro(str_ptr) do + begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr]; + end; {move current string up to make room for another} +for k:=j to j+l-1 do 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; +text(p):=make_string; pool_ptr:=pool_ptr+d; +@!stat incr(cs_count);@+tats@;@/ +end + +@ The value of |hash_prime| should be roughly 85\pct! of |hash_size|, and it +should be a prime number. The theory of hashing tells us to expect fewer +than two table probes, on the average, when the search is successful. +[See J.~S. Vitter, {\sl Journal of the ACM\/ \bf30} (1983), 231--258.] +@^Vitter, Jeffrey Scott@> + +@= +h:=buffer[j]; +for k:=j+1 to j+l-1 do + begin h:=h+h+buffer[k]; + while h>=hash_prime do h:=h-hash_prime; + end + +@ Single-character control sequences do not need to be looked up in a hash +table, since we can use the character code itself as a direct address. +The procedure |print_cs| prints the name of a control sequence, given +a pointer to its address in |eqtb|. A space is printed after the name +unless it is a single nonletter or an active character. This procedure +might be invoked with invalid data, so it is ``extra robust.'' The +individual characters must be printed one at a time using |print|, since +they may be unprintable. + +@= +procedure print_cs(@!p:integer); {prints a purported control sequence} +begin if p=single_base then + if p=null_cs then + begin print_esc("csname"); print_esc("endcsname"); + end + else begin print_esc(p-single_base); + if cat_code(p-single_base)=letter then print_char(" "); + end + else if p + else print_char(p-active_base) +else if p>=undefined_control_sequence then print_esc("IMPOSSIBLE.") +else if (text(p)<0)or(text(p)>=str_ptr) then print_esc("NONEXISTENT.") +@.NONEXISTENT@> +else begin print_esc(text(p)); + print_char(" "); + end; +end; + +@ Here is a similar procedure; it avoids the error checks, and it never +prints a space after the control sequence. + +@= +procedure sprint_cs(@!p:pointer); {prints a control sequence} +begin if pbuf_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; +tini + +@ Many of \TeX's primitives need no |equiv|, since they are identifiable +by their |eq_type| alone. These primitives are loaded into the hash table +as follows: + +@= +primitive(" ",ex_space,0);@/ +@!@:Single-character primitives /}{\quad\.{\\\ }@> +primitive("/",ital_corr,0);@/ +@!@:Single-character primitives /}{\quad\.{\\/}@> +primitive("accent",accent,0);@/ +@!@:accent_}{\.{\\accent} primitive@> +primitive("advance",advance,0);@/ +@!@:advance_}{\.{\\advance} primitive@> +primitive("afterassignment",after_assignment,0);@/ +@!@:after_assignment_}{\.{\\afterassignment} primitive@> +primitive("aftergroup",after_group,0);@/ +@!@:after_group_}{\.{\\aftergroup} primitive@> +primitive("begingroup",begin_group,0);@/ +@!@:begin_group_}{\.{\\begingroup} primitive@> +primitive("char",char_num,0);@/ +@!@:char_}{\.{\\char} primitive@> +primitive("csname",cs_name,0);@/ +@!@:cs_name_}{\.{\\csname} primitive@> +primitive("delimiter",delim_num,0);@/ +@!@:delimiter_}{\.{\\delimiter} primitive@> +primitive("XeTeXdelimiter",delim_num,1);@/ +@!@:XeTeX_delimiter_}{\.{\\XeTeXdelimiter} primitive@> +primitive("divide",divide,0);@/ +@!@:divide_}{\.{\\divide} primitive@> +primitive("endcsname",end_cs_name,0);@/ +@!@:end_cs_name_}{\.{\\endcsname} primitive@> +primitive("endgroup",end_group,0); +@!@:end_group_}{\.{\\endgroup} primitive@> +text(frozen_end_group):="endgroup"; eqtb[frozen_end_group]:=eqtb[cur_val];@/ +primitive("expandafter",expand_after,0);@/ +@!@:expand_after_}{\.{\\expandafter} primitive@> +primitive("font",def_font,0);@/ +@!@:font_}{\.{\\font} primitive@> +primitive("fontdimen",assign_font_dimen,0);@/ +@!@:font_dimen_}{\.{\\fontdimen} primitive@> +primitive("halign",halign,0);@/ +@!@:halign_}{\.{\\halign} primitive@> +primitive("hrule",hrule,0);@/ +@!@:hrule_}{\.{\\hrule} primitive@> +primitive("ignorespaces",ignore_spaces,0);@/ +@!@:ignore_spaces_}{\.{\\ignorespaces} primitive@> +primitive("insert",insert,0);@/ +@!@:insert_}{\.{\\insert} primitive@> +primitive("mark",mark,0);@/ +@!@:mark_}{\.{\\mark} primitive@> +primitive("mathaccent",math_accent,0);@/ +@!@:math_accent_}{\.{\\mathaccent} primitive@> +primitive("XeTeXmathaccent",math_accent,1);@/ +@!@:XeTeX_math_accent_}{\.{\\XeTeXmathaccent} primitive@> +primitive("mathchar",math_char_num,0);@/ +@!@:math_char_}{\.{\\mathchar} primitive@> +primitive("XeTeXmathcharnum",math_char_num,1);@/ +@!@:XeTeX_math_char_num_}{\.{\\XeTeXmathcharnum} primitive@> +primitive("XeTeXmathchar",math_char_num,2);@/ +@!@:XeTeX_math_char_}{\.{\\XeTeXmathchar} primitive@> +primitive("mathchoice",math_choice,0);@/ +@!@:math_choice_}{\.{\\mathchoice} primitive@> +primitive("multiply",multiply,0);@/ +@!@:multiply_}{\.{\\multiply} primitive@> +primitive("noalign",no_align,0);@/ +@!@:no_align_}{\.{\\noalign} primitive@> +primitive("noboundary",no_boundary,0);@/ +@!@:no_boundary_}{\.{\\noboundary} primitive@> +primitive("noexpand",no_expand,0);@/ +@!@:no_expand_}{\.{\\noexpand} primitive@> +primitive("nonscript",non_script,0);@/ +@!@:non_script_}{\.{\\nonscript} primitive@> +primitive("omit",omit,0);@/ +@!@:omit_}{\.{\\omit} primitive@> +primitive("parshape",set_shape,par_shape_loc);@/ +@!@:par_shape_}{\.{\\parshape} primitive@> +primitive("penalty",break_penalty,0);@/ +@!@:penalty_}{\.{\\penalty} primitive@> +primitive("prevgraf",set_prev_graf,0);@/ +@!@:prev_graf_}{\.{\\prevgraf} primitive@> +primitive("radical",radical,0);@/ +@!@:radical_}{\.{\\radical} primitive@> +primitive("XeTeXradical",radical,1);@/ +@!@:XeTeX_radical_}{\.{\\XeTeXradical} primitive@> +primitive("read",read_to_cs,0);@/ +@!@:read_}{\.{\\read} primitive@> +primitive("relax",relax,too_big_usv); {cf.\ |scan_file_name|} +@!@:relax_}{\.{\\relax} primitive@> +text(frozen_relax):="relax"; eqtb[frozen_relax]:=eqtb[cur_val];@/ +primitive("setbox",set_box,0);@/ +@!@:set_box_}{\.{\\setbox} primitive@> +primitive("the",the,0);@/ +@!@:the_}{\.{\\the} primitive@> +primitive("toks",toks_register,mem_bot);@/ +@!@:toks_}{\.{\\toks} primitive@> +primitive("vadjust",vadjust,0);@/ +@!@:vadjust_}{\.{\\vadjust} primitive@> +primitive("valign",valign,0);@/ +@!@:valign_}{\.{\\valign} primitive@> +primitive("vcenter",vcenter,0);@/ +@!@:vcenter_}{\.{\\vcenter} primitive@> +primitive("vrule",vrule,0);@/ +@!@:vrule_}{\.{\\vrule} primitive@> + +@ Each primitive has a corresponding inverse, so that it is possible to +display the cryptic numeric contents of |eqtb| in symbolic form. +Every call of |primitive| in this program is therefore accompanied by some +straightforward code that forms part of the |print_cmd_chr| routine +below. + +@= +accent: print_esc("accent"); +advance: print_esc("advance"); +after_assignment: print_esc("afterassignment"); +after_group: print_esc("aftergroup"); +assign_font_dimen: print_esc("fontdimen"); +begin_group: print_esc("begingroup"); +break_penalty: print_esc("penalty"); +char_num: print_esc("char"); +cs_name: print_esc("csname"); +def_font: print_esc("font"); +delim_num: if chr_code=1 then print_esc("XeTeXdelimiter") + else print_esc("delimiter"); +divide: print_esc("divide"); +end_cs_name: print_esc("endcsname"); +end_group: print_esc("endgroup"); +ex_space: print_esc(" "); +expand_after: if chr_code=0 then print_esc("expandafter") + @; +halign: print_esc("halign"); +hrule: print_esc("hrule"); +ignore_spaces: print_esc("ignorespaces"); +insert: print_esc("insert"); +ital_corr: print_esc("/"); +mark: begin print_esc("mark"); + if chr_code>0 then print_char("s"); + end; +math_accent: if chr_code=1 then print_esc("XeTeXmathaccent") + else print_esc("mathaccent"); +math_char_num: if chr_code=2 then print_esc("XeTeXmathchar") + else if chr_code=1 then print_esc("XeTeXmathcharnum") + else print_esc("mathchar"); +math_choice: print_esc("mathchoice"); +multiply: print_esc("multiply"); +no_align: print_esc("noalign"); +no_boundary:print_esc("noboundary"); +no_expand: print_esc("noexpand"); +non_script: print_esc("nonscript"); +omit: print_esc("omit"); +radical: if chr_code=1 then print_esc("XeTeXradical") else print_esc("radical"); +read_to_cs: if chr_code=0 then print_esc("read") + @; +relax: print_esc("relax"); +set_box: print_esc("setbox"); +set_prev_graf: print_esc("prevgraf"); +set_shape: case chr_code of + par_shape_loc: print_esc("parshape"); + @@;@/ + end; {there are no other cases} +the: if chr_code=0 then print_esc("the") + @; +toks_register: @; +vadjust: print_esc("vadjust"); +valign: if chr_code=0 then print_esc("valign")@/ + @; +vcenter: print_esc("vcenter"); +vrule: print_esc("vrule"); + +@ We will deal with the other primitives later, at some point in the program +where their |eq_type| and |equiv| values are more meaningful. For example, +the primitives for math mode will be loaded when we consider the routines +that deal with formulas. It is easy to find where each particular +primitive was treated by looking in the index at the end; for example, the +section where |"radical"| entered |eqtb| is listed under `\.{\\radical} +primitive'. (Primitives consisting of a single nonalphabetic character, +@!like `\.{\\/}', are listed under `Single-character primitives'.) +@!@^Single-character primitives@> + +Meanwhile, this is a convenient place to catch up on something we were unable +to do before the hash table was defined: + +@= +print_esc(font_id_text(font(p))) + +@* \[19] Saving and restoring equivalents. +The nested structure provided by `$\.{\char'173}\ldots\.{\char'175}$' groups +in \TeX\ means that |eqtb| entries valid in outer groups should be saved +and restored later if they are overridden inside the braces. When a new |eqtb| +value is being assigned, the program therefore checks to see if the previous +entry belongs to an outer level. In such a case, the old value is placed +on the |save_stack| just before the new value enters |eqtb|. At the +end of a grouping level, i.e., when the right brace is sensed, the +|save_stack| is used to restore the outer values, and the inner ones are +destroyed. + +Entries on the |save_stack| are of type |memory_word|. The top item on +this stack is |save_stack[p]|, where |p=save_ptr-1|; it contains three +fields called |save_type|, |save_level|, and |save_index|, and it is +interpreted in one of five ways: + +\yskip\hangg 1) If |save_type(p)=restore_old_value|, then +|save_index(p)| is a location in |eqtb| whose current value should +be destroyed at the end of the current group and replaced by |save_stack[p-1]|. +Furthermore if |save_index(p)>=int_base|, then |save_level(p)| +should replace the corresponding entry in |xeq_level|. + +\yskip\hangg 2) If |save_type(p)=restore_zero|, then |save_index(p)| +is a location in |eqtb| whose current value should be destroyed at the end +of the current group, when it should be +replaced by the current value of |eqtb[undefined_control_sequence]|. + +\yskip\hangg 3) If |save_type(p)=insert_token|, then |save_index(p)| +is a token that should be inserted into \TeX's input when the current +group ends. + +\yskip\hangg 4) If |save_type(p)=level_boundary|, then |save_level(p)| +is a code explaining what kind of group we were previously in, and +|save_index(p)| points to the level boundary word at the bottom of +the entries for that group. +Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the +source line number at which the current level of grouping was entered. + +\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a +chain of sparse array entries to be restored at the end of the current +group. Furthermore |save_index(p)| and |save_level(p)| should replace +the values of |sa_chain| and |sa_level| respectively. + +@d save_type(#)==save_stack[#].hh.b0 {classifies a |save_stack| entry} +@d save_level(#)==save_stack[#].hh.b1 + {saved level for regions 5 and 6, or group code} +@d save_index(#)==save_stack[#].hh.rh + {|eqtb| location or token or |save_stack| location} +@d restore_old_value=0 {|save_type| when a value should be restored later} +@d restore_zero=1 {|save_type| when an undefined entry should be restored} +@d insert_token=2 {|save_type| when a token is being saved for later use} +@d level_boundary=3 {|save_type| corresponding to beginning of group} +@d restore_sa=4 {|save_type| when sparse array entries should be restored} + +@p@t\4@>@ + +@ Here are the group codes that are used to discriminate between different +kinds of groups. They allow \TeX\ to decide what special actions, if any, +should be performed when a group ends. +\def\grp{\.{\char'173...\char'175}} + +Some groups are not supposed to be ended by right braces. For example, +the `\.\$' that begins a math formula causes a |math_shift_group| to +be started, and this should be terminated by a matching `\.\$'. Similarly, +a group that starts with \.{\\left} should end with \.{\\right}, and +one that starts with \.{\\begingroup} should end with \.{\\endgroup}. + +@d bottom_level=0 {group code for the outside world} +@d simple_group=1 {group code for local structure only} +@d hbox_group=2 {code for `\.{\\hbox}\grp'} +@d adjusted_hbox_group=3 {code for `\.{\\hbox}\grp' in vertical mode} +@d vbox_group=4 {code for `\.{\\vbox}\grp'} +@d vtop_group=5 {code for `\.{\\vtop}\grp'} +@d align_group=6 {code for `\.{\\halign}\grp', `\.{\\valign}\grp'} +@d no_align_group=7 {code for `\.{\\noalign}\grp'} +@d output_group=8 {code for output routine} +@d math_group=9 {code for, e.g., `\.{\char'136}\grp'} +@d disc_group=10 {code for `\.{\\discretionary}\grp\grp\grp'} +@d insert_group=11 {code for `\.{\\insert}\grp', `\.{\\vadjust}\grp'} +@d vcenter_group=12 {code for `\.{\\vcenter}\grp'} +@d math_choice_group=13 {code for `\.{\\mathchoice}\grp\grp\grp\grp'} +@d semi_simple_group=14 {code for `\.{\\begingroup...\\endgroup}'} +@d math_shift_group=15 {code for `\.{\$...\$}'} +@d math_left_group=16 {code for `\.{\\left...\\right}'} +@d max_group_code=16 + +@= +@!group_code=0..max_group_code; {|save_level| for a level boundary} + +@ The global variable |cur_group| keeps track of what sort of group we are +currently in. Another global variable, |cur_boundary|, points to the +topmost |level_boundary| word. And |cur_level| is the current depth of +nesting. The routines are designed to preserve the condition that no entry +in the |save_stack| or in |eqtb| ever has a level greater than |cur_level|. + +@ @= +@!save_stack : array[0..save_size] of memory_word; +@!save_ptr : 0..save_size; {first unused entry on |save_stack|} +@!max_save_stack:0..save_size; {maximum usage of save stack} +@!cur_level: quarterword; {current nesting level for groups} +@!cur_group: group_code; {current group type} +@!cur_boundary: 0..save_size; {where the current level begins} + +@ At this time it might be a good idea for the reader to review the introduction +to |eqtb| that was given above just before the long lists of parameter names. +Recall that the ``outer level'' of the program is |level_one|, since +undefined control sequences are assumed to be ``defined'' at |level_zero|. + +@= +save_ptr:=0; cur_level:=level_one; cur_group:=bottom_level; cur_boundary:=0; +max_save_stack:=0; + +@ The following macro is used to test if there is room for up to seven more +entries on |save_stack|. By making a conservative test like this, we can +get by with testing for overflow in only a few places. + +@d check_full_save_stack==if save_ptr>max_save_stack then + begin max_save_stack:=save_ptr; + if max_save_stack>save_size-7 then overflow("save size",save_size); +@:TeX capacity exceeded save size}{\quad save size@> + end + +@ Procedure |new_save_level| is called when a group begins. The +argument is a group identification code like `|hbox_group|'. After +calling this routine, it is safe to put five more entries on |save_stack|. + +In some cases integer-valued items are placed onto the +|save_stack| just below a |level_boundary| word, because this is a +convenient place to keep information that is supposed to ``pop up'' just +when the group has finished. +For example, when `\.{\\hbox to 100pt}\grp' is being treated, the 100pt +dimension is stored on |save_stack| just before |new_save_level| is +called. + +We use the notation |saved(k)| to stand for an integer item that +appears in location |save_ptr+k| of the save stack. + +@d saved(#)==save_stack[save_ptr+#].int + +@p procedure new_save_level(@!c:group_code); {begin a new level of grouping} +begin check_full_save_stack; +if eTeX_ex then + begin saved(0):=line; incr(save_ptr); + end; +save_type(save_ptr):=level_boundary; save_level(save_ptr):=cur_group; +save_index(save_ptr):=cur_boundary; +if cur_level=max_quarterword then overflow("grouping levels", +@:TeX capacity exceeded grouping levels}{\quad grouping levels@> + max_quarterword-min_quarterword); + {quit if |(cur_level+1)| is too big to be stored in |eqtb|} +cur_boundary:=save_ptr; cur_group:=c; +@!stat if tracing_groups>0 then group_trace(false);@+tats@;@/ +incr(cur_level); incr(save_ptr); +end; + +@ Just before an entry of |eqtb| is changed, the following procedure should +be called to update the other data structures properly. It is important +to keep in mind that reference counts in |mem| include references from +within |save_stack|, so these counts must be handled carefully. +@^reference counts@> + +@p procedure eq_destroy(@!w:memory_word); {gets ready to forget |w|} +var q:pointer; {|equiv| field of |w|} +begin case eq_type_field(w) of +call,long_call,outer_call,long_outer_call: delete_token_ref(equiv_field(w)); +glue_ref: delete_glue_ref(equiv_field(w)); +shape_ref: begin q:=equiv_field(w); {we need to free a \.{\\parshape} block} + if q<>null then free_node(q,info(q)+info(q)+1); + end; {such a block is |2n+1| words long, where |n=info(q)|} +box_ref: flush_node_list(equiv_field(w)); +@/@@/ +othercases do_nothing +endcases; +end; + +@ To save a value of |eqtb[p]| that was established at level |l|, we +can use the following subroutine. + +@p procedure eq_save(@!p:pointer;@!l:quarterword); {saves |eqtb[p]|} +begin check_full_save_stack; +if l=level_zero then save_type(save_ptr):=restore_zero +else begin save_stack[save_ptr]:=eqtb[p]; incr(save_ptr); + save_type(save_ptr):=restore_old_value; + end; +save_level(save_ptr):=l; save_index(save_ptr):=p; incr(save_ptr); +end; + +@ The procedure |eq_define| defines an |eqtb| entry having specified +|eq_type| and |equiv| fields, and saves the former value if appropriate. +This procedure is used only for entries in the first four regions of |eqtb|, +i.e., only for entries that have |eq_type| and |equiv| fields. +After calling this routine, it is safe to put four more entries on +|save_stack|, provided that there was room for four more entries before +the call, since |eq_save| makes the necessary test. + +@d assign_trace(#)==@!stat if tracing_assigns>0 then restore_trace(#); + tats + +@p procedure eq_define(@!p:pointer;@!t:quarterword;@!e:halfword); + {new data for |eqtb|} +label exit; +begin if eTeX_ex and(eq_type(p)=t)and(equiv(p)=e) then + begin assign_trace(p,"reassigning")@;@/ + eq_destroy(eqtb[p]); return; + end; +assign_trace(p,"changing")@;@/ +if eq_level(p)=cur_level then eq_destroy(eqtb[p]) +else if cur_level>level_one then eq_save(p,eq_level(p)); +eq_level(p):=cur_level; eq_type(p):=t; equiv(p):=e; +assign_trace(p,"into")@;@/ +exit:end; + +@ The counterpart of |eq_define| for the remaining (fullword) positions in +|eqtb| is called |eq_word_define|. Since |xeq_level[p]>=level_one| for all +|p|, a `|restore_zero|' will never be used in this case. + +@p procedure eq_word_define(@!p:pointer;@!w:integer); +label exit; +begin if eTeX_ex and(eqtb[p].int=w) then + begin assign_trace(p,"reassigning")@;@/ + return; + end; +assign_trace(p,"changing")@;@/ +if xeq_level[p]<>cur_level then + begin eq_save(p,xeq_level[p]); xeq_level[p]:=cur_level; + end; +eqtb[p].int:=w; +assign_trace(p,"into")@;@/ +exit:end; + +@ The |eq_define| and |eq_word_define| routines take care of local definitions. +@^global definitions@> +Global definitions are done in almost the same way, but there is no need +to save old values, and the new value is associated with |level_one|. + +@p procedure geq_define(@!p:pointer;@!t:quarterword;@!e:halfword); + {global |eq_define|} +begin assign_trace(p,"globally changing")@;@/ +begin eq_destroy(eqtb[p]); +eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e; +end; +assign_trace(p,"into")@;@/ +end; +@# +procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|} +begin assign_trace(p,"globally changing")@;@/ +begin eqtb[p].int:=w; xeq_level[p]:=level_one; +end; +assign_trace(p,"into")@;@/ +end; + +@ Subroutine |save_for_after| puts a token on the stack for save-keeping. + +@p procedure save_for_after(@!t:halfword); +begin if cur_level>level_one then + begin check_full_save_stack; + save_type(save_ptr):=insert_token; save_level(save_ptr):=level_zero; + save_index(save_ptr):=t; incr(save_ptr); + end; +end; + +@ The |unsave| routine goes the other way, taking items off of |save_stack|. +This routine takes care of restoration when a level ends; everything +belonging to the topmost group is cleared off of the save stack. + +@p +procedure@?back_input; forward; @t\2@> +procedure unsave; {pops the top level off the save stack} +label done; +var p:pointer; {position to be restored} +@!l:quarterword; {saved level, if in fullword regions of |eqtb|} +@!t:halfword; {saved value of |cur_tok|} +@!a:boolean; {have we already processed an \.{\\aftergroup} ?} +begin a:=false; +if cur_level>level_one then + begin decr(cur_level); + @; + end +else confusion("curlevel"); {|unsave| is not used when |cur_group=bottom_level|} +@:this can't happen curlevel}{\quad curlevel@> +end; + +@ @= +loop@+begin decr(save_ptr); + if save_type(save_ptr)=level_boundary then goto done; + p:=save_index(save_ptr); + if save_type(save_ptr)=insert_token then + @ + else if save_type(save_ptr)=restore_sa then + begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr); + end + else begin if save_type(save_ptr)=restore_old_value then + begin l:=save_level(save_ptr); decr(save_ptr); + end + else save_stack[save_ptr]:=eqtb[undefined_control_sequence]; + @; + end; + end; +done: @!stat if tracing_groups>0 then group_trace(true);@+tats@;@/ +if grp_stack[in_open]=cur_boundary then group_warning; + {groups possibly not properly nested with files} +cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr); +if eTeX_ex then decr(save_ptr) + +@ A global definition, which sets the level to |level_one|, +@^global definitions@> +will not be undone by |unsave|. If at least one global definition of +|eqtb[p]| has been carried out within the group that just ended, the +last such definition will therefore survive. + +@= +if p0 then restore_trace(p,"retaining");@+tats@;@/ + end + else begin eq_destroy(eqtb[p]); {destroy the current value} + eqtb[p]:=save_stack[save_ptr]; {restore the saved value} + @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/ + end +else if xeq_level[p]<>level_one then + begin eqtb[p]:=save_stack[save_ptr]; xeq_level[p]:=l; + @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/ + end +else begin + @!stat if tracing_restores>0 then restore_trace(p,"retaining");@+tats@;@/ + end + +@ @= +@!stat procedure restore_trace(@!p:pointer;@!s:str_number); + {|eqtb[p]| has just been restored or retained} +begin begin_diagnostic; print_char("{"); print(s); print_char(" "); +show_eqtb(p); print_char("}"); +end_diagnostic(false); +end; +tats + +@ When looking for possible pointers to a memory location, it is helpful +to look for references from |eqtb| that might be waiting on the +save stack. Of course, we might find spurious pointers too; but this +routine is merely an aid when debugging, and at such times we are +grateful for any scraps of information, even if they prove to be irrelevant. +@^dirty \PASCAL@> + +@= +if save_ptr>0 then for q:=0 to save_ptr-1 do + begin if equiv_field(save_stack[q])=p then + begin print_nl("SAVE("); print_int(q); print_char(")"); + end; + end + +@ Most of the parameters kept in |eqtb| can be changed freely, but there's +an exception: The magnification should not be used with two different +values during any \TeX\ job, since a single magnification is applied to an +entire run. The global variable |mag_set| is set to the current magnification +whenever it becomes necessary to ``freeze'' it at a particular value. + +@= +@!mag_set:integer; {if nonzero, this magnification should be used henceforth} + +@ @= +mag_set:=0; + +@ The |prepare_mag| subroutine is called whenever \TeX\ wants to use |mag| +for magnification. + +@p procedure prepare_mag; +begin if (mag_set>0)and(mag<>mag_set) then + begin print_err("Incompatible magnification ("); print_int(mag); +@.Incompatible magnification@> + print(");"); print_nl(" the previous value will be retained"); + help2("I can handle only one magnification ratio per job. So I've")@/ + ("reverted to the magnification you used earlier on this run.");@/ + int_error(mag_set); + geq_word_define(int_base+mag_code,mag_set); {|mag:=mag_set|} + end; +if (mag<=0)or(mag>32768) then + begin print_err("Illegal magnification has been changed to 1000");@/ +@.Illegal magnification...@> + help1("The magnification ratio must be between 1 and 32768."); + int_error(mag); geq_word_define(int_base+mag_code,1000); + end; +mag_set:=mag; +end; + +@* \[20] Token lists. +A \TeX\ token is either a character or a control sequence, and it is +@^token@> +represented internally in one of two ways: (1)~A character whose ASCII +code number is |c| and whose command code is |m| is represented as the +number $2^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. + +A token |t| represents a |left_brace| command if and only if +|t= +if cs_token_flag+undefined_control_sequence>max_halfword then bad:=21; + +@ A token list is a singly linked list of one-word nodes in |mem|, where +each word contains a token and a link. Macro definitions, output-routine +definitions, marks, \.{\\write} texts, and a few other things +are remembered by \TeX\ in the form +of token lists, usually preceded by a node with a reference count in its +|token_ref_count| field. The token stored in location |p| is called +|info(p)|. + +Three special commands appear in the token lists of macro definitions. +When |m=match|, it means that \TeX\ should scan a parameter +for the current macro; when |m=end_match|, it means that parameter +matching should end and \TeX\ should start reading the macro text; and +when |m=out_param|, it means that \TeX\ should insert parameter +number |c| into the text at this point. + +The enclosing \.{\char'173} and \.{\char'175} characters of a macro +definition are omitted, but the final right brace of an output routine +is included at the end of its token list. + +Here is an example macro definition that illustrates these conventions. +After \TeX\ processes the text +$$\.{\\def\\mac a\#1\#2 \\b \{\#1\\-a \#\#1\#2 \#2\}}$$ +the definition of \.{\\mac} is represented as a token list containing +$$\def\,{\hskip2pt} +\vbox{\halign{\hfil#\hfil\cr +(reference count), |letter|\,\.a, |match|\,\#, |match|\,\#, |spacer|\,\.\ , +\.{\\b}, |end_match|,\cr +|out_param|\,1, \.{\\-}, |letter|\,\.a, |spacer|\,\.\ , |mac_param|\,\#, +|other_char|\,\.1,\cr +|out_param|\,2, |spacer|\,\.\ , |out_param|\,2.\cr}}$$ +The procedure |scan_toks| builds such token lists, and |macro_call| +does the parameter matching. +@^reference counts@> + +Examples such as +$$\.{\\def\\m\{\\def\\m\{a\}\ b\}}$$ +explain why reference counts would be needed even if \TeX\ had no \.{\\let} +operation: When the token list for \.{\\m} is being read, the redefinition of +\.{\\m} changes the |eqtb| entry before the token list has been fully +consumed, so we dare not simply destroy a token list when its +control sequence is being redefined. + +If the parameter-matching part of a definition ends with `\.{\#\{}', +the corresponding token list will have `\.\{' just before the `|end_match|' +and also at the very end. The first `\.\{' is used to delimit the parameter; the +second one keeps the first from disappearing. + +@ The procedure |show_token_list|, which prints a symbolic form of +the token list that starts at a given node |p|, illustrates these +conventions. The token list being displayed should not begin with a reference +count. However, the procedure is intended to be robust, so that if the +memory links are awry or if |p| is not really a pointer to a token list, +nothing catastrophic will happen. + +An additional parameter |q| is also given; this parameter is either null +or it points to a node in the token list where a certain magic computation +takes place that will be explained later. (Basically, |q| is non-null when +we are printing the two-line context information at the time of an error +message; |q| marks the place corresponding to where the second line +should begin.) + +For example, if |p| points to the node containing the first \.a in the +token list above, then |show_token_list| will print the string +$$\hbox{`\.{a\#1\#2\ \\b\ ->\#1\\-a\ \#\#1\#2\ \#2}';}$$ +and if |q| points to the node containing the second \.a, +the magic computation will be performed just before the second \.a is printed. + +The generation will stop, and `\.{\\ETC.}' will be printed, if the length +of printing exceeds a given limit~|l|. Anomalous entries are printed in the +form of control sequences that are not followed by a blank space, e.g., +`\.{\\BAD.}'; this cannot be confused with actual control sequences because +a real control sequence named \.{BAD} would come out `\.{\\BAD\ }'. + +@= +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|'} +@!n:ASCII_code; {the highest parameter number, as an ASCII digit} +begin match_chr:="#"; n:="0"; tally:=0; +while (p<>null) and (tally; + @; + p:=link(p); + end; +if p<>null then print_esc("ETC."); +@.ETC@> +exit: +end; + +@ @= +if (pmem_end) then + begin print_esc("CLOBBERED."); return; +@.CLOBBERED@> + end; +if info(p)>=cs_token_flag then print_cs(info(p)-cs_token_flag) +else begin m:=info(p) div max_char_val; c:=info(p) mod max_char_val; + if info(p)<0 then print_esc("BAD.") +@.BAD@> + else @; + end + +@ The procedure usually ``learns'' the character code used for macro +parameters by seeing one in a |match| command before it runs into any +|out_param| commands. + +@= +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); + if n>"9" then return; + end; +end_match: if c=0 then print("->"); +@.->@> +othercases print_esc("BAD.") +@.BAD@> +endcases + +@ Here's the way we sometimes want to display a token list, given a pointer +to its reference count; the pointer may be null. + +@p procedure token_show(@!p:pointer); +begin if p<>null then show_token_list(link(p),null,10000000); +end; + +@ The |print_meaning| subroutine displays |cur_cmd| and |cur_chr| in +symbolic form, including the expansion of a macro or mark. + +@p procedure print_meaning; +begin print_cmd_chr(cur_cmd,cur_chr); +if cur_cmd>=call then + begin print_char(":"); print_ln; token_show(cur_chr); + end +else if (cur_cmd=top_bot_mark)and(cur_chr= +@!cur_cmd: eight_bits; {current command set by |get_next|} +@!cur_chr: halfword; {operand of current command} +@!cur_cs: pointer; {control sequence found here, zero if none found} +@!cur_tok: halfword; {packed representative of |cur_cmd| and |cur_chr|} + +@ The |print_cmd_chr| routine prints a symbolic interpretation of a +command code and its modifier. This is used in certain `\.{You can\'t}' +error messages, and in the implementation of diagnostic routines like +\.{\\show}. + +The body of |print_cmd_chr| is a rather tedious listing of print +commands, and most of it is essentially an inverse to the |primitive| +routine that enters a \TeX\ primitive into |eqtb|. Therefore much of +this procedure appears elsewhere in the program, +together with the corresponding |primitive| calls. + +@d chr_cmd(#)==begin print(#); + 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 + +@= +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; +begin case cmd of +left_brace: chr_cmd("begin-group character "); +right_brace: chr_cmd("end-group character "); +math_shift: chr_cmd("math shift character "); +mac_param: chr_cmd("macro parameter character "); +sup_mark: chr_cmd("superscript character "); +sub_mark: chr_cmd("subscript character "); +endv: print("end of alignment template"); +spacer: chr_cmd("blank space "); +letter: chr_cmd("the letter "); +other_char: chr_cmd("the character "); +@t\4@>@@/ +othercases print("[unknown command code!]") +endcases; +end; + +@ Here is a procedure that displays the current command. + +@p procedure show_cur_cmd_chr; +var n:integer; {level of \.{\\if...\\fi} nesting} +@!l:integer; {line where \.{\\if} started} +@!p:pointer; +begin begin_diagnostic; print_nl("{"); +if mode<>shown_mode then + begin print_mode(mode); print(": "); shown_mode:=mode; + end; +print_cmd_chr(cur_cmd,cur_chr); +if tracing_ifs>0 then + if cur_cmd>=if_test then if cur_cmd<=fi_or_else then + begin print(": "); + if cur_cmd=fi_or_else then + begin print_cmd_chr(if_test,cur_if); print_char(" "); + n:=0; l:=if_line; + end + else begin n:=1; l:=line; + end; + p:=cond_ptr; + while p<>null do + begin incr(n); p:=link(p); + end; + print("(level "); print_int(n); print_char(")"); print_if_line(l); + end; +print_char("}"); +end_diagnostic(false); +end; + +@* \[22] Input stacks and states. +This implementation of +\TeX\ uses two different conventions for representing sequential stacks. +@^stack conventions@>@^conventions for representing stacks@> + +\yskip\hangg 1) If there is frequent access to the top entry, and if the +stack is essentially never empty, then the top entry is kept in a global +variable (even better would be a machine register), and the other entries +appear in the array $\\{stack}[0\to(\\{ptr}-1)]$. For example, the +semantic stack described above is handled this way, and so is the input +stack that we are about to study. + +\yskip\hangg 2) If there is infrequent top access, the entire stack contents +are in the array $\\{stack}[0\to(\\{ptr}-1)]$. For example, the |save_stack| +is treated this way, as we have seen. + +\yskip\noindent +The state of \TeX's input mechanism appears in the input stack, whose +entries are records with six fields, called |state|, |index|, |start|, |loc|, +|limit|, and |name|. This stack is maintained with +convention~(1), so it is declared in the following way: + +@= +@!in_state_record = record + @!state_field, @!index_field: quarterword; + @!start_field,@!loc_field, @!limit_field, @!name_field: halfword; + end; + +@ @= +@!input_stack : array[0..stack_size] of in_state_record; +@!input_ptr : 0..stack_size; {first unused location of |input_stack|} +@!max_in_stack: 0..stack_size; {largest value of |input_ptr| when pushing} +@!cur_input : in_state_record; + {the ``top'' input state, according to convention (1)} + +@ We've already defined the special variable |loc==cur_input.loc_field| +in our discussion of basic input-output routines. The other components of +|cur_input| are defined in the same way: + +@d state==cur_input.state_field {current scanner state} +@d index==cur_input.index_field {reference for buffer information} +@d start==cur_input.start_field {starting position in |buffer|} +@d limit==cur_input.limit_field {end of current line in |buffer|} +@d name==cur_input.name_field {name of the current file} + +@ Let's look more closely now at the control variables +(|state|,~|index|,~|start|,~|loc|,~|limit|,~|name|), +assuming that \TeX\ is reading a line of characters that have been input +from some file or from the user's terminal. There is an array called +|buffer| that acts as a stack of all lines of characters that are +currently being read from files, including all lines on subsidiary +levels of the input stack that are not yet completed. \TeX\ will return to +the other lines when it is finished with the present input file. + +(Incidentally, on a machine with byte-oriented addressing, it might be +appropriate to combine |buffer| with the |str_pool| array, +letting the buffer entries grow downward from the top of the string pool +and checking that these two tables don't bump into each other.) + +The line we are currently working on begins in position |start| of the +buffer; the next character we are about to read is |buffer[loc]|; and +|limit| is the location of the last character present. If |loc>limit|, +the line has been completely read. Usually |buffer[limit]| is the +|end_line_char|, denoting the end of a line, but this is not +true if the current line is an insertion that was entered on the user's +terminal in response to an error message. + +The |name| variable is a string number that designates the name of +the current file, if we are reading a text file. It is zero if we +are reading from the terminal; it is |n+1| if we are reading from +input stream |n|, where |0<=n<=16|. (Input stream 16 stands for +an invalid stream number; in such cases the input is actually from +the terminal, under control of the procedure |read_toks|.) +Finally |18<=name<=19| indicates that we are reading a pseudo file +created by the \.{\\scantokens} command. + +The |state| variable has one of three values, when we are scanning such +files: +$$\baselineskip 15pt\vbox{\halign{#\hfil\cr +1) |state=mid_line| is the normal state.\cr +2) |state=skip_blanks| is like |mid_line|, but blanks are ignored.\cr +3) |state=new_line| is the state at the beginning of a line.\cr}}$$ +These state values are assigned numeric codes so that if we add the state +code to the next character's command code, we get distinct values. For +example, `|mid_line+spacer|' stands for the case that a blank +space character occurs in the middle of a line when it is not being +ignored; after this case is processed, the next value of |state| will +be |skip_blanks|. + +@d mid_line=1 {|state| code when scanning a line of characters} +@d skip_blanks=2+max_char_code {|state| code when ignoring blanks} +@d new_line=3+max_char_code+max_char_code {|state| code at start of line} + +@ Additional information about the current line is available via the +|index| variable, which counts how many lines of characters are present +in the buffer below the current level. We have |index=0| when reading +from the terminal and prompting the user for each line; then if the user types, +e.g., `\.{\\input paper}', we will have |index=1| while reading +the file \.{paper.tex}. However, it does not follow that |index| is the +same as the input stack pointer, since many of the levels on the input +stack may come from token lists. For example, the instruction `\.{\\input +paper}' might occur in a token list. + +The global variable |in_open| is equal to the |index| +value of the highest non-token-list level. Thus, the number of partially read +lines in the buffer is |in_open+1|, and we have |in_open=index| +when we are not reading a token list. + +If we are not currently reading from the terminal, or from an input +stream, we are reading from the file variable |input_file[index]|. We use +the notation |terminal_input| as a convenient abbreviation for |name=0|, +and |cur_file| as an abbreviation for |input_file[index]|. + +The global variable |line| contains the line number in the topmost +open file, for use in error messages. If we are not reading from +the terminal, |line_stack[index]| holds the line number for the +enclosing level, so that |line| can be restored when the current +file has been read. Line numbers should never be negative, since the +negative of the current line number is used to identify the user's output +routine in the |mode_line| field of the semantic nest entries. + +If more information about the input state is needed, it can be +included in small arrays like those shown here. For example, +the current page or segment number in the input file might be +put into a variable |@!page|, maintained for enclosing levels in +`\ignorespaces|@!page_stack:array[1..max_in_open] of integer|\unskip' +by analogy with |line_stack|. +@^system dependencies@> + +@d terminal_input==(name=0) {are we reading from the terminal?} +@d cur_file==input_file[index] {the current |alpha_file| variable} + +@= +@!in_open : 0..max_in_open; {the number of lines in the buffer, less one} +@!open_parens : 0..max_in_open; {the number of open text files} +@!input_file : array[1..max_in_open] of alpha_file; +@!line : integer; {current line number in the current source file} +@!line_stack : array[1..max_in_open] of integer; + +@ Users of \TeX\ sometimes forget to balance left and right braces properly, +and one of the ways \TeX\ tries to spot such errors is by considering an +input file as broken into subfiles by control sequences that +are declared to be \.{\\outer}. + +A variable called |scanner_status| tells \TeX\ whether or not to complain +when a subfile ends. This variable has six possible values: + +\yskip\hang|normal|, means that a subfile can safely end here without incident. + +\yskip\hang|skipping|, means that a subfile can safely end here, but not a file, +because we're reading past some conditional text that was not selected. + +\yskip\hang|defining|, means that a subfile shouldn't end now because a +macro is being defined. + +\yskip\hang|matching|, means that a subfile shouldn't end now because a +macro is being used and we are searching for the end of its arguments. + +\yskip\hang|aligning|, means that a subfile shouldn't end now because we are +not finished with the preamble of an \.{\\halign} or \.{\\valign}. + +\yskip\hang|absorbing|, means that a subfile shouldn't end now because we are +reading a balanced token list for \.{\\message}, \.{\\write}, etc. + +\yskip\noindent +If the |scanner_status| is not |normal|, the variable |warning_index| points +to the |eqtb| location for the relevant control sequence name to print +in an error message. + +@d skipping=1 {|scanner_status| when passing conditional text} +@d defining=2 {|scanner_status| when reading a macro definition} +@d matching=3 {|scanner_status| when reading macro arguments} +@d aligning=4 {|scanner_status| when reading an alignment preamble} +@d absorbing=5 {|scanner_status| when reading a balanced text} + +@= +@!scanner_status : normal..absorbing; {can a subfile end now?} +@!warning_index : pointer; {identifier relevant to non-|normal| scanner status} +@!def_ref : pointer; {reference count of token list being defined} + +@ Here is a procedure that uses |scanner_status| to print a warning message +when a subfile has ended, and at certain other crucial times: + +@= +procedure runaway; +var p:pointer; {head of runaway list} +begin if scanner_status>skipping then + begin print_nl("Runaway "); +@.Runaway...@> + case scanner_status of + defining: begin print("definition"); p:=def_ref; + end; + matching: begin print("argument"); p:=temp_head; + end; + aligning: begin print("preamble"); p:=hold_head; + end; + absorbing: begin print("text"); p:=def_ref; + end; + end; {there are no other cases} + print_char("?");print_ln; show_token_list(link(p),null,error_line-10); + end; +end; + +@ However, all this discussion about input state really applies only to the +case that we are inputting from a file. There is another important case, +namely when we are currently getting input from a token list. In this case +|state=token_list|, and the conventions about the other state variables +are different: + +\yskip\hang|loc| is a pointer to the current node in the token list, i.e., +the node that will be read next. If |loc=null|, the token list has been +fully read. + +\yskip\hang|start| points to the first node of the token list; this node +may or may not contain a reference count, depending on the type of token +list involved. + +\yskip\hang|token_type|, which takes the place of |index| in the +discussion above, is a code number that explains what kind of token list +is being scanned. + +\yskip\hang|name| points to the |eqtb| address of the control sequence +being expanded, if the current token list is a macro. + +\yskip\hang|param_start|, which takes the place of |limit|, tells where +the parameters of the current macro begin in the |param_stack|, if the +current token list is a macro. + +\yskip\noindent The |token_type| can take several values, depending on +where the current token list came from: + +\yskip\hang|parameter|, if a parameter is being scanned; + +\hang|u_template|, if the \ part of an alignment +template is being scanned; + +\hang|v_template|, if the \ part of an alignment +template is being scanned; + +\hang|backed_up|, if the token list being scanned has been inserted as +`to be read again'. + +\hang|inserted|, if the token list being scanned has been inserted as +the text expansion of a \.{\\count} or similar variable; + +\hang|macro|, if a user-defined control sequence is being scanned; + +\hang|output_text|, if an \.{\\output} routine is being scanned; + +\hang|every_par_text|, if the text of \.{\\everypar} is being scanned; + +\hang|every_math_text|, if the text of \.{\\everymath} is being scanned; + +\hang|every_display_text|, if the text of \.{\\everydisplay} is being scanned; + +\hang|every_hbox_text|, if the text of \.{\\everyhbox} is being scanned; + +\hang|every_vbox_text|, if the text of \.{\\everyvbox} is being scanned; + +\hang|every_job_text|, if the text of \.{\\everyjob} is being scanned; + +\hang|every_cr_text|, if the text of \.{\\everycr} is being scanned; + +\hang|mark_text|, if the text of a \.{\\mark} is being scanned; + +\hang|write_text|, if the text of a \.{\\write} is being scanned. + +\yskip\noindent +The codes for |output_text|, |every_par_text|, etc., are equal to a constant +plus the corresponding codes for token list parameters |output_routine_loc|, +|every_par_loc|, etc. The token list begins with a reference count if and +only if |token_type>=macro|. +@^reference counts@> + +Since \eTeX's additional token list parameters precede |toks_base|, the +corresponding token types must precede |write_text|. + +@d token_list=0 {|state| code when scanning a token list} +@d token_type==index {type of current token list} +@d param_start==limit {base of macro parameters in |param_stack|} +@d parameter=0 {|token_type| code for parameter} +@d u_template=1 {|token_type| code for \ template} +@d v_template=2 {|token_type| code for \ template} +@d backed_up=3 {|token_type| code for text to be reread} +@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|} +@d every_eof_text=every_eof_loc-eTeX_text_offset + {|token_type| code for \.{\\everyeof}} +@# +@d write_text=toks_base-eTeX_text_offset {|token_type| code for \.{\\write}} + +@ The |param_stack| is an auxiliary array used to hold pointers to the token +lists for parameters at the current level and subsidiary levels of input. +This stack is maintained with convention (2), and it grows at a different +rate from the others. + +@= +@!param_stack:array [0..param_size] of pointer; + {token list pointers for parameters} +@!param_ptr:0..param_size; {first unused entry in |param_stack|} +@!max_param_stack:integer; + {largest value of |param_ptr|, will be |<=param_size+9|} + +@ The input routines must also interact with the processing of +\.{\\halign} and \.{\\valign}, since the appearance of tab marks and +\.{\\cr} in certain places is supposed to trigger the beginning of special +\ template text in the scanner. This magic is accomplished by an +|align_state| variable that is increased by~1 when a `\.{\char'173}' is +scanned and decreased by~1 when a `\.{\char'175}' is scanned. The |align_state| +is nonzero during the \ template, after which it is set to zero; the +\ template begins when a tab mark or \.{\\cr} occurs at a time that +|align_state=0|. + +@= +@!align_state:integer; {group level with respect to current alignment} + +@ Thus, the ``current input state'' can be very complicated indeed; there +can be many levels and each level can arise in a variety of ways. The +|show_context| procedure, which is used by \TeX's error-reporting routine to +print out the current input state on all levels down to the most recent +line of characters from an input file, illustrates most of these conventions. +The global variable |base_ptr| contains the lowest level that was +displayed by this procedure. + +@= +@!base_ptr:0..stack_size; {shallowest level shown by |show_context|} + +@ The status at each level is indicated by printing two lines, where the first +line indicates what was read so far and the second line shows what remains +to be read. The context is cropped, if necessary, so that the first line +contains at most |half_error_line| characters, and the second contains +at most |error_line|. Non-current input levels whose |token_type| is +`|backed_up|' are shown only if they have not been fully read. + +@p procedure show_context; {prints where the scanner is} +label done; +var old_setting:0..max_selector; {saved |selector| setting} +@!nn:integer; {number of contexts shown so far, less one} +@!bottom_line:boolean; {have we reached the final context to be shown?} +@@/ +begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input; + {store current state} +nn:=-1; bottom_line:=false; +loop@+begin cur_input:=input_stack[base_ptr]; {enter into the context} + if (state<>token_list) then + if (name>19) or (base_ptr=0) then bottom_line:=true; + if (base_ptr=input_ptr)or bottom_line or(nn + else if nn=error_context_lines then + begin print_nl("..."); incr(nn); {omitted if |error_context_lines<0|} + end; + if bottom_line then goto done; + decr(base_ptr); + end; +done: cur_input:=input_stack[input_ptr]; {restore original state} +end; + +@ @= +begin if (base_ptr=input_ptr) or (state<>token_list) or + (token_type<>backed_up) or (loc<>null) then + {we omit backed-up token lists that have already been read} + begin tally:=0; {get ready to count characters} + old_setting:=selector; + if state<>token_list then + begin @; + @; + end + else begin @; + @; + end; + selector:=old_setting; {stop pseudoprinting} + @; + incr(nn); + end; +end + +@ This routine should be changed, if necessary, to give the best possible +indication of where the current line resides in the input file. +For example, on some systems it is best to print both a page and line number. +@^system dependencies@> + +@= +if name<=17 then + if terminal_input then + if base_ptr=0 then print_nl("<*>") else print_nl(" ") + else begin print_nl(" + print_char(">"); + end +else begin print_nl("l."); + if index=in_open then print_int(line) + else print_int(line_stack[index+1]); {input from a pseudo file} + end; +print_char(" ") + +@ @= +case token_type of +parameter: print_nl(" "); +u_template,v_template: print_nl("