summaryrefslogtreecommitdiff
path: root/Build
diff options
context:
space:
mode:
Diffstat (limited to 'Build')
-rw-r--r--Build/source/texk/web2c/luatexdir/ChangeLog8
-rw-r--r--Build/source/texk/web2c/luatexdir/lua/lnodelib.c32
-rw-r--r--Build/source/texk/web2c/luatexdir/lua/ltexlib.c13
-rw-r--r--Build/source/texk/web2c/luatexdir/lua/luanode.w829
-rw-r--r--Build/source/texk/web2c/luatexdir/luafontloader/fontforge/fontforge/parsettf.c8
-rw-r--r--Build/source/texk/web2c/luatexdir/luafontloader/src/luafflib.c20
-rw-r--r--Build/source/texk/web2c/luatexdir/luapeg/lpeg.c4085
-rw-r--r--Build/source/texk/web2c/luatexdir/luapeg/lpeg.h407
-rw-r--r--Build/source/texk/web2c/luatexdir/luatex_svnversion.h2
-rw-r--r--Build/source/texk/web2c/luatexdir/tex/linebreak.w4422
-rw-r--r--Build/source/texk/web2c/luatexdir/tex/mlist.w7206
-rw-r--r--Build/source/texk/web2c/luatexdir/tex/texnodes.w6809
-rw-r--r--Build/source/texk/web2c/luatexdir/tex/textoken.w4825
13 files changed, 15016 insertions, 13650 deletions
diff --git a/Build/source/texk/web2c/luatexdir/ChangeLog b/Build/source/texk/web2c/luatexdir/ChangeLog
index 96ac3a00e78..35fea59915a 100644
--- a/Build/source/texk/web2c/luatexdir/ChangeLog
+++ b/Build/source/texk/web2c/luatexdir/ChangeLog
@@ -1,3 +1,11 @@
+2014-02-11 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * lua/lnodelib.c, lua/ltexlib.c, lua/luanode.w,
+ luafontloader/fontforge/fontforge/parsettf.c,
+ luafontloader/src/luafflib.c, luapeg/lpeg.c, luapeg/lpeg.h
+ tex/linebreak.w, tex/mlist.w, tex/texnodes.w, tex/textoken.w:
+ Import from r4794.
+
2014-02-10 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
* lua/luatex-api.h: MSC version has luaopen_bit32() in dll.
diff --git a/Build/source/texk/web2c/luatexdir/lua/lnodelib.c b/Build/source/texk/web2c/luatexdir/lua/lnodelib.c
index 78a468a7f1c..0a62151427d 100644
--- a/Build/source/texk/web2c/luatexdir/lua/lnodelib.c
+++ b/Build/source/texk/web2c/luatexdir/lua/lnodelib.c
@@ -96,7 +96,7 @@
*/
static const char _svn_version[] =
- "$Id: lnodelib.c 4740 2014-01-09 17:22:45Z luigi $ "
+ "$Id: lnodelib.c 4775 2014-02-07 12:36:34Z luigi $ "
"$URL: https://foundry.supelec.fr/svn/luatex/trunk/source/texk/web2c/luatexdir/lua/lnodelib.c $";
#include "ptexlib.h"
@@ -1347,12 +1347,16 @@ static int lua_nodelib_remove(lua_State * L)
if (lua_isnil(L, 2))
return 2; /* the arguments, as they are */
current = *(check_isnode(L, 2));
-
if (head == current) {
- if (alink(head) != null && vlink(current) != null)
- alink(vlink(current)) = alink(head);
- head = vlink(current);
- current = head;
+ if (alink(current)){
+ vlink(alink(current)) = vlink(current); // vlink(prev) = next
+ }
+ if (vlink(current)){
+ alink( vlink(current)) = alink(current); // alink(next) = prev
+ }
+
+ head = vlink(current); //head = next
+ current = vlink(current); //current = next
} else { /* head != current */
t = alink(current);
if (t == null || vlink(t) != current) {
@@ -1396,10 +1400,14 @@ static int lua_nodelib_direct_remove(lua_State * L)
return 2 ;
}
if (head == current) {
- if (alink(head) != null && vlink(current) != null)
- alink(vlink(current)) = alink(head);
- head = vlink(current);
- current = head;
+ if (alink(current)){
+ vlink( alink(current) ) = vlink(current); // vlink(prev) = next
+ }
+ if (vlink(current)){
+ alink( vlink(current) ) = alink(current); // alink(next) = prev
+ }
+ head = vlink(current); //head = next
+ current = vlink(current); //current = next
} else {
t = alink(current);
if (t == null || vlink(t) != current) {
@@ -2003,6 +2011,7 @@ static int lua_nodelib_mlist_to_hlist(lua_State * L)
luaL_checkany(L, 3);
m = lua_toboolean(L, 3);
mlist_to_hlist_args(n, w, m);
+ alink(vlink(temp_head)) = null; /*hh-ls */
lua_nodelib_push_fast(L, vlink(temp_head));
return 1;
}
@@ -4194,6 +4203,7 @@ static int font_tex_ligaturing(lua_State * L)
couple_nodes(tmp_head, *h);
tlink(tmp_head) = t;
t = handle_ligaturing(tmp_head, t);
+ alink(vlink(tmp_head)) = null ; /* hh-ls */
lua_pushnumber(L, vlink(tmp_head));
/* can be: lua_nodelib_push_fast(L, head); */
flush_node(tmp_head);
@@ -4227,6 +4237,7 @@ static int font_tex_kerning(lua_State * L)
couple_nodes(tmp_head, *h);
tlink(tmp_head) = t;
t = handle_kerning(tmp_head, t);
+ alink(vlink(tmp_head)) = null ; /* hh-ls */
lua_pushnumber(L, vlink(tmp_head));
/* can be: lua_nodelib_push_fast(L, head); */
flush_node(tmp_head);
@@ -4238,6 +4249,7 @@ static int font_tex_kerning(lua_State * L)
return 3;
}
+
/* node.protect_glyphs (returns also boolean because that signals callback) */
static int lua_nodelib_protect_glyphs(lua_State * L)
diff --git a/Build/source/texk/web2c/luatexdir/lua/ltexlib.c b/Build/source/texk/web2c/luatexdir/lua/ltexlib.c
index d448bd1aab3..cbc01ed4763 100644
--- a/Build/source/texk/web2c/luatexdir/lua/ltexlib.c
+++ b/Build/source/texk/web2c/luatexdir/lua/ltexlib.c
@@ -17,13 +17,17 @@
You should have received a copy of the GNU General Public License along
with LuaTeX; if not, see <http://www.gnu.org/licenses/>. */
+/* hh-ls: Because the lists start with a temp node, we have to set the prev link
+to nil because otherwise at the lua end we expose temp which can create havoc. In the
+setter no prev link is created so we can presume that it's not used later on. */
+
#include "ptexlib.h"
#include "lua/luatex-api.h"
static const char _svn_version[] =
- "$Id: ltexlib.c 4569 2013-01-30 10:08:33Z taco $ $URL: https://foundry.supelec.fr/svn/luatex/branches/ex-glyph/source/texk/web2c/luatexdir/lua/ltexlib.c $";
+ "$Id: ltexlib.c 4775 2014-02-07 12:36:34Z luigi $ $URL: https://foundry.supelec.fr/svn/luatex/trunk/source/texk/web2c/luatexdir/lua/ltexlib.c $";
#define attribute(A) eqtb[attribute_base+(A)].hh.rh
#define dimen(A) eqtb[scaled_base+(A)].hh.rh
@@ -1603,18 +1607,23 @@ static int getlist(lua_State * L)
lua_pushnumber(L, vlink(page_ins_head));
lua_nodelib_push(L);
} else if (strcmp(str, "contrib_head") == 0) {
+ alink(vlink(contrib_head)) = null ;
lua_pushnumber(L, vlink(contrib_head));
lua_nodelib_push(L);
} else if (strcmp(str, "page_head") == 0) {
+ alink(vlink(page_head)) = null ;/*hh-ls */
lua_pushnumber(L, vlink(page_head));
lua_nodelib_push(L);
} else if (strcmp(str, "temp_head") == 0) {
+ alink(vlink(temp_head)) = null ;/*hh-ls */
lua_pushnumber(L, vlink(temp_head));
lua_nodelib_push(L);
} else if (strcmp(str, "hold_head") == 0) {
+ alink(vlink(hold_head)) = null ;/*hh-ls */
lua_pushnumber(L, vlink(hold_head));
lua_nodelib_push(L);
} else if (strcmp(str, "adjust_head") == 0) {
+ alink(vlink(adjust_head)) = null ;/*hh-ls */
lua_pushnumber(L, vlink(adjust_head));
lua_nodelib_push(L);
} else if (strcmp(str, "best_page_break") == 0) {
@@ -1625,9 +1634,11 @@ static int getlist(lua_State * L)
} else if (strcmp(str, "best_size") == 0) {
lua_pushnumber(L, best_size);
} else if (strcmp(str, "pre_adjust_head") == 0) {
+ alink(vlink(pre_adjust_head)) = null ;/*hh-ls */
lua_pushnumber(L, vlink(pre_adjust_head));
lua_nodelib_push(L);
} else if (strcmp(str, "align_head") == 0) {
+ alink(vlink(align_head)) = null ;/*hh-ls */
lua_pushnumber(L, vlink(align_head));
lua_nodelib_push(L);
} else {
diff --git a/Build/source/texk/web2c/luatexdir/lua/luanode.w b/Build/source/texk/web2c/luatexdir/lua/luanode.w
index b7ed9fcd396..65f4c8a6310 100644
--- a/Build/source/texk/web2c/luatexdir/lua/luanode.w
+++ b/Build/source/texk/web2c/luatexdir/lua/luanode.w
@@ -1,411 +1,418 @@
-% luanode.w
-%
-% Copyright 2006-2008 Taco Hoekwater <taco@@luatex.org>
-%
-% This file is part of LuaTeX.
-%
-% LuaTeX is free software; you can redistribute it and/or modify it under
-% the terms of the GNU General Public License as published by the Free
-% Software Foundation; either version 2 of the License, or (at your
-% option) any later version.
-%
-% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
-% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
-% License for more details.
-%
-% You should have received a copy of the GNU General Public License along
-% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
-
-@ @c
-static const char _svn_version[] =
- "$Id: luanode.w 4442 2012-05-25 22:40:34Z hhenkel $"
- "$URL: https://foundry.supelec.fr/svn/luatex/branches/ex-glyph/source/texk/web2c/luatexdir/lua/luanode.w $";
-
-#include "ptexlib.h"
-#include "lua/luatex-api.h"
-
-@ @c
-static const char *group_code_names[] = {
- "",
- "simple",
- "hbox",
- "adjusted_hbox",
- "vbox",
- "vtop",
- "align",
- "no_align",
- "output",
- "math",
- "disc",
- "insert",
- "vcenter",
- "math_choice",
- "semi_simple",
- "math_shift",
- "math_left",
- "local_box",
- "split_off",
- "split_keep",
- "preamble",
- "align_set",
- "fin_row"
-};
-
-const char *pack_type_name[] = { "exactly", "additional" };
-
-
-@ @c
-void lua_node_filter_s(int filterid, const char *extrainfo)
-{
- lua_State *L = Luas;
- int callback_id = callback_defined(filterid);
- int s_top = lua_gettop(L);
- if (callback_id <= 0) {
- lua_settop(L, s_top);
- return;
- }
- if (!get_callback(L, callback_id)) {
- lua_settop(L, s_top);
- return;
- }
- lua_pushstring(L, extrainfo); /* arg 1 */
- if (lua_pcall(L, 1, 0, 0) != 0) {
- fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
- lua_settop(L, s_top);
- error();
- return;
- }
- lua_settop(L, s_top);
- return;
-}
-
-@ @c
-void
-lua_node_filter(int filterid, int xextrainfo, halfword head_node,
- halfword * tail_node)
-{
- halfword ret;
- int a;
- lua_State *L = Luas;
- int s_top = lua_gettop(L);
- const char *extrainfo = group_code_names[xextrainfo];
- int callback_id = callback_defined(filterid);
- if (head_node == null || vlink(head_node) == null || callback_id <= 0) {
- lua_settop(L, s_top);
- return;
- }
- if (!get_callback(L, callback_id)) {
- lua_settop(L, s_top);
- return;
- }
- nodelist_to_lua(L, vlink(head_node)); /* arg 1 */
- lua_pushstring(L, extrainfo); /* arg 2 */
- if (lua_pcall(L, 2, 1, 0) != 0) { /* no arg, 1 result */
- fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
- lua_settop(L, s_top);
- error();
- return;
- }
- if (lua_isboolean(L, -1)) {
- if (lua_toboolean(L, -1) != 1) {
- flush_node_list(vlink(head_node));
- vlink(head_node) = null;
- }
- } else {
- a = nodelist_from_lua(L);
- try_couple_nodes(head_node,a);
- }
- lua_pop(L, 2); /* result and callback container table */
- if (fix_node_lists)
- fix_node_list(head_node);
- ret = vlink(head_node);
- if (ret != null) {
- while (vlink(ret) != null)
- ret = vlink(ret);
- *tail_node = ret;
- } else {
- *tail_node = head_node;
- }
- lua_settop(L, s_top);
- return;
-}
-
-
-@ @c
-int
-lua_linebreak_callback(int is_broken, halfword head_node, halfword * new_head)
-{
- int a;
- register halfword *p;
- int ret = 0; /* failure */
- lua_State *L = Luas;
- int s_top = lua_gettop(L);
- int callback_id = callback_defined(linebreak_filter_callback);
- if (head_node == null || vlink(head_node) == null || callback_id <= 0) {
- lua_settop(L, s_top);
- return ret;
- }
- if (!get_callback(L, callback_id)) {
- lua_settop(L, s_top);
- return ret;
- }
- nodelist_to_lua(L, vlink(head_node)); /* arg 1 */
- lua_pushboolean(L, is_broken); /* arg 2 */
- if (lua_pcall(L, 2, 1, 0) != 0) { /* no arg, 1 result */
- fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
- lua_settop(L, s_top);
- error();
- return ret;
- }
-
- p = lua_touserdata(L, -1);
- if (p != NULL) {
- a = nodelist_from_lua(L);
- try_couple_nodes(*new_head,a);
- ret = 1;
- }
- lua_settop(L, s_top);
- return ret;
-}
-
-
-
-@ @c
-halfword
-lua_hpack_filter(halfword head_node, scaled size, int pack_type, int extrainfo,
- int pack_direction)
-{
- halfword ret;
- lua_State *L = Luas;
- int s_top = lua_gettop(L);
- int callback_id = callback_defined(hpack_filter_callback);
- if (head_node == null || callback_id <= 0) {
- lua_settop(L, s_top);
- return head_node;
- }
- if (!get_callback(L, callback_id)) {
- lua_settop(L, s_top);
- return head_node;
- }
- nodelist_to_lua(L, head_node);
- lua_pushstring(L, group_code_names[extrainfo]);
- lua_pushnumber(L, size);
- lua_pushstring(L, pack_type_name[pack_type]);
- if (pack_direction >= 0)
- lua_pushstring(L, string_dir(pack_direction));
- else
- lua_pushnil(L);
- if (lua_pcall(L, 5, 1, 0) != 0) { /* no arg, 1 result */
- fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
- lua_settop(L, s_top);
- error();
- return head_node;
- }
- ret = head_node;
- if (lua_isboolean(L, -1)) {
- if (lua_toboolean(L, -1) != 1) {
- flush_node_list(head_node);
- ret = null;
- }
- } else {
- ret = nodelist_from_lua(L);
- }
- lua_settop(L, s_top);
-#if 0
- lua_gc(L,LUA_GCSTEP, LUA_GC_STEP_SIZE);
-#endif
- if (fix_node_lists)
- fix_node_list(ret);
- return ret;
-}
-
-@ @c
-halfword
-lua_vpack_filter(halfword head_node, scaled size, int pack_type, scaled maxd,
- int extrainfo, int pack_direction)
-{
- halfword ret;
- int callback_id;
- lua_State *L = Luas;
- int s_top = lua_gettop(L);
- if (head_node == null) {
- lua_settop(L, s_top);
- return head_node;
- }
- if (strcmp("output", group_code_names[extrainfo]) == 0) {
- callback_id = callback_defined(pre_output_filter_callback);
- } else {
- callback_id = callback_defined(vpack_filter_callback);
- }
- if (callback_id <= 0) {
- lua_settop(L, s_top);
- return head_node;
- }
- if (!get_callback(L, callback_id)) {
- lua_settop(L, s_top);
- return head_node;
- }
- nodelist_to_lua(L, head_node);
- lua_pushstring(L, group_code_names[extrainfo]);
- lua_pushnumber(L, size);
- lua_pushstring(L, pack_type_name[pack_type]);
- lua_pushnumber(L, maxd);
- if (pack_direction >= 0)
- lua_pushstring(L, string_dir(pack_direction));
- else
- lua_pushnil(L);
- if (lua_pcall(L, 6, 1, 0) != 0) { /* no arg, 1 result */
- fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
- lua_settop(L, s_top);
- error();
- return head_node;
- }
- ret = head_node;
- if (lua_isboolean(L, -1)) {
- if (lua_toboolean(L, -1) != 1) {
- flush_node_list(head_node);
- ret = null;
- }
- } else {
- ret = nodelist_from_lua(L);
- }
- lua_settop(L, s_top);
-#if 0
- lua_gc(L,LUA_GCSTEP, LUA_GC_STEP_SIZE);
-#endif
- if (fix_node_lists)
- fix_node_list(ret);
- return ret;
-}
-
-
-@ This is a quick hack to fix etex's \.{\\lastnodetype} now that
- there are many more visible node types. TODO: check the
- eTeX manual for the expected return values.
-
-@c
-int visible_last_node_type(int n)
-{
- int i = type(n);
- if (i == whatsit_node && subtype(n) == local_par_node)
- return -1;
- if (i == glyph_node) {
- if (is_ligature(n))
- return 7; /* old ligature value */
- else
- return 0; /* old character value */
- }
- if (i <= unset_node) {
- return i + 1;
- } else if (i <= delim_node) {
- return 15; /* so-called math nodes */
- } else {
- return -1;
- }
-}
-
-@ @c
-void lua_pdf_literal(PDF pdf, int i)
-{
- const char *s = NULL;
- size_t l = 0;
- lua_rawgeti(Luas, LUA_REGISTRYINDEX, i);
- s = lua_tolstring(Luas, -1, &l);
- pdf_out_block(pdf, s, l);
- pdf_out(pdf, 10); /* |pdf_print_nl| */
- lua_pop(Luas, 1);
-}
-
-@ @c
-void copy_pdf_literal(pointer r, pointer p)
-{
- pdf_literal_type(r) = pdf_literal_type(p);
- pdf_literal_mode(r) = pdf_literal_mode(p);
- if (pdf_literal_type(p) == normal) {
- pdf_literal_data(r) = pdf_literal_data(p);
- add_token_ref(pdf_literal_data(p));
- } else {
- lua_rawgeti(Luas, LUA_REGISTRYINDEX, pdf_literal_data(p));
- pdf_literal_data(r) = luaL_ref(Luas, LUA_REGISTRYINDEX);
- }
-}
-
-void copy_late_lua(pointer r, pointer p)
-{
- late_lua_type(r) = late_lua_type(p);
- if (late_lua_name(p) > 0)
- add_token_ref(late_lua_name(p));
- if (late_lua_type(p) == normal) {
- late_lua_data(r) = late_lua_data(p);
- add_token_ref(late_lua_data(p));
- } else {
- lua_rawgeti(Luas, LUA_REGISTRYINDEX, late_lua_data(p));
- late_lua_data(r) = luaL_ref(Luas, LUA_REGISTRYINDEX);
- }
-}
-
-
-@ @c
-void free_pdf_literal(pointer p)
-{
- if (pdf_literal_type(p) == normal) {
- delete_token_ref(pdf_literal_data(p));
- } else {
- luaL_unref(Luas, LUA_REGISTRYINDEX, pdf_literal_data(p));
- }
-}
-
-void free_late_lua(pointer p)
-{
- if (late_lua_name(p) > 0)
- delete_token_ref(late_lua_name(p));
- if (late_lua_type(p) == normal) {
- delete_token_ref(late_lua_data(p));
- } else {
- luaL_unref(Luas, LUA_REGISTRYINDEX, late_lua_data(p));
- }
-}
-
-@ @c
-void show_pdf_literal(pointer p)
-{
- tprint_esc("pdfliteral");
- switch (pdf_literal_mode(p)) {
- case set_origin:
- break;
- case direct_page:
- tprint(" page");
- break;
- case direct_always:
- tprint(" direct");
- break;
- default:
- confusion("literal2");
- break;
- }
- if (pdf_literal_type(p) == normal) {
- print_mark(pdf_literal_data(p));
- } else {
- lua_rawgeti(Luas, LUA_REGISTRYINDEX, pdf_literal_data(p));
- tprint("\"");
- tprint(lua_tostring(Luas, -1));
- tprint("\"");
- lua_pop(Luas, 1);
- }
-}
-
-void show_late_lua(pointer p)
-{
- tprint_esc("latelua");
- print_int(late_lua_reg(p));
- if (late_lua_type(p) == normal) {
- print_mark(late_lua_data(p));
- } else {
- lua_rawgeti(Luas, LUA_REGISTRYINDEX, late_lua_data(p));
- tprint("\"");
- tprint(lua_tostring(Luas, -1));
- tprint("\"");
- lua_pop(Luas, 1);
- }
-}
+% luanode.w
+%
+% Copyright 2006-2008 Taco Hoekwater <taco@@luatex.org>
+%
+% This file is part of LuaTeX.
+%
+% LuaTeX is free software; you can redistribute it and/or modify it under
+% the terms of the GNU General Public License as published by the Free
+% Software Foundation; either version 2 of the License, or (at your
+% option) any later version.
+%
+% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
+% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
+% License for more details.
+%
+% You should have received a copy of the GNU General Public License along
+% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
+
+/* hh-ls: we make sure that lua never sees prev of head but also that when
+nodes are removedor inserted, temp nodes don't interfere */
+
+@ @c
+static const char _svn_version[] =
+ "$Id: luanode.w 4775 2014-02-07 12:36:34Z luigi $"
+ "$URL: https://foundry.supelec.fr/svn/luatex/trunk/source/texk/web2c/luatexdir/lua/luanode.w $";
+
+#include "ptexlib.h"
+#include "lua/luatex-api.h"
+
+@ @c
+static const char *group_code_names[] = {
+ "",
+ "simple",
+ "hbox",
+ "adjusted_hbox",
+ "vbox",
+ "vtop",
+ "align",
+ "no_align",
+ "output",
+ "math",
+ "disc",
+ "insert",
+ "vcenter",
+ "math_choice",
+ "semi_simple",
+ "math_shift",
+ "math_left",
+ "local_box",
+ "split_off",
+ "split_keep",
+ "preamble",
+ "align_set",
+ "fin_row"
+};
+
+const char *pack_type_name[] = { "exactly", "additional" };
+
+
+@ @c
+void lua_node_filter_s(int filterid, const char *extrainfo)
+{
+ lua_State *L = Luas;
+ int callback_id = callback_defined(filterid);
+ int s_top = lua_gettop(L);
+ if (callback_id <= 0) {
+ lua_settop(L, s_top);
+ return;
+ }
+ if (!get_callback(L, callback_id)) {
+ lua_settop(L, s_top);
+ return;
+ }
+ lua_pushstring(L, extrainfo); /* arg 1 */
+ if (lua_pcall(L, 1, 0, 0) != 0) {
+ fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
+ lua_settop(L, s_top);
+ error();
+ return;
+ }
+ lua_settop(L, s_top);
+ return;
+}
+
+@ @c
+void
+lua_node_filter(int filterid, int xextrainfo, halfword head_node,
+ halfword * tail_node)
+{
+ halfword ret;
+ int a;
+ lua_State *L = Luas;
+ int s_top = lua_gettop(L);
+ const char *extrainfo = group_code_names[xextrainfo];
+ int callback_id = callback_defined(filterid);
+ if (head_node == null || vlink(head_node) == null || callback_id <= 0) {
+ lua_settop(L, s_top);
+ return;
+ }
+ if (!get_callback(L, callback_id)) {
+ lua_settop(L, s_top);
+ return;
+ }
+ alink(vlink(head_node)) = null ; /* hh-ls */
+ nodelist_to_lua(L, vlink(head_node)); /* arg 1 */
+ lua_pushstring(L, extrainfo); /* arg 2 */
+ if (lua_pcall(L, 2, 1, 0) != 0) { /* no arg, 1 result */
+ fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
+ lua_settop(L, s_top);
+ error();
+ return;
+ }
+ if (lua_isboolean(L, -1)) {
+ if (lua_toboolean(L, -1) != 1) {
+ flush_node_list(vlink(head_node));
+ vlink(head_node) = null;
+ }
+ } else {
+ a = nodelist_from_lua(L);
+ try_couple_nodes(head_node,a);
+ }
+ lua_pop(L, 2); /* result and callback container table */
+ if (fix_node_lists)
+ fix_node_list(head_node);
+ ret = vlink(head_node);
+ if (ret != null) {
+ while (vlink(ret) != null)
+ ret = vlink(ret);
+ *tail_node = ret;
+ } else {
+ *tail_node = head_node;
+ }
+ lua_settop(L, s_top);
+ return;
+}
+
+
+@ @c
+int
+lua_linebreak_callback(int is_broken, halfword head_node, halfword * new_head)
+{
+ int a;
+ register halfword *p;
+ int ret = 0; /* failure */
+ lua_State *L = Luas;
+ int s_top = lua_gettop(L);
+ int callback_id = callback_defined(linebreak_filter_callback);
+ if (head_node == null || vlink(head_node) == null || callback_id <= 0) {
+ lua_settop(L, s_top);
+ return ret;
+ }
+ if (!get_callback(L, callback_id)) {
+ lua_settop(L, s_top);
+ return ret;
+ }
+ alink(vlink(head_node)) = null ; /* hh-ls */
+ nodelist_to_lua(L, vlink(head_node)); /* arg 1 */
+ lua_pushboolean(L, is_broken); /* arg 2 */
+ if (lua_pcall(L, 2, 1, 0) != 0) { /* no arg, 1 result */
+ fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
+ lua_settop(L, s_top);
+ error();
+ return ret;
+ }
+
+ p = lua_touserdata(L, -1);
+ if (p != NULL) {
+ a = nodelist_from_lua(L);
+ try_couple_nodes(*new_head,a);
+ ret = 1;
+ }
+ lua_settop(L, s_top);
+ return ret;
+}
+
+
+
+@ @c
+halfword
+lua_hpack_filter(halfword head_node, scaled size, int pack_type, int extrainfo,
+ int pack_direction)
+{
+ halfword ret;
+ lua_State *L = Luas;
+ int s_top = lua_gettop(L);
+ int callback_id = callback_defined(hpack_filter_callback);
+ if (head_node == null || callback_id <= 0) {
+ lua_settop(L, s_top);
+ return head_node;
+ }
+ if (!get_callback(L, callback_id)) {
+ lua_settop(L, s_top);
+ return head_node;
+ }
+ alink(head_node) = null ; /* hh-ls */
+ nodelist_to_lua(L, head_node);
+ lua_pushstring(L, group_code_names[extrainfo]);
+ lua_pushnumber(L, size);
+ lua_pushstring(L, pack_type_name[pack_type]);
+ if (pack_direction >= 0)
+ lua_pushstring(L, string_dir(pack_direction));
+ else
+ lua_pushnil(L);
+ if (lua_pcall(L, 5, 1, 0) != 0) { /* no arg, 1 result */
+ fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
+ lua_settop(L, s_top);
+ error();
+ return head_node;
+ }
+ ret = head_node;
+ if (lua_isboolean(L, -1)) {
+ if (lua_toboolean(L, -1) != 1) {
+ flush_node_list(head_node);
+ ret = null;
+ }
+ } else {
+ ret = nodelist_from_lua(L);
+ }
+ lua_settop(L, s_top);
+#if 0
+ lua_gc(L,LUA_GCSTEP, LUA_GC_STEP_SIZE);
+#endif
+ if (fix_node_lists)
+ fix_node_list(ret);
+ return ret;
+}
+
+@ @c
+halfword
+lua_vpack_filter(halfword head_node, scaled size, int pack_type, scaled maxd,
+ int extrainfo, int pack_direction)
+{
+ halfword ret;
+ int callback_id;
+ lua_State *L = Luas;
+ int s_top = lua_gettop(L);
+ if (head_node == null) {
+ lua_settop(L, s_top);
+ return head_node;
+ }
+ if (strcmp("output", group_code_names[extrainfo]) == 0) {
+ callback_id = callback_defined(pre_output_filter_callback);
+ } else {
+ callback_id = callback_defined(vpack_filter_callback);
+ }
+ if (callback_id <= 0) {
+ lua_settop(L, s_top);
+ return head_node;
+ }
+ if (!get_callback(L, callback_id)) {
+ lua_settop(L, s_top);
+ return head_node;
+ }
+ alink(head_node) = null ; /* hh-ls */
+ nodelist_to_lua(L, head_node);
+ lua_pushstring(L, group_code_names[extrainfo]);
+ lua_pushnumber(L, size);
+ lua_pushstring(L, pack_type_name[pack_type]);
+ lua_pushnumber(L, maxd);
+ if (pack_direction >= 0)
+ lua_pushstring(L, string_dir(pack_direction));
+ else
+ lua_pushnil(L);
+ if (lua_pcall(L, 6, 1, 0) != 0) { /* no arg, 1 result */
+ fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
+ lua_settop(L, s_top);
+ error();
+ return head_node;
+ }
+ ret = head_node;
+ if (lua_isboolean(L, -1)) {
+ if (lua_toboolean(L, -1) != 1) {
+ flush_node_list(head_node);
+ ret = null;
+ }
+ } else {
+ ret = nodelist_from_lua(L);
+ }
+ lua_settop(L, s_top);
+#if 0
+ lua_gc(L,LUA_GCSTEP, LUA_GC_STEP_SIZE);
+#endif
+ if (fix_node_lists)
+ fix_node_list(ret);
+ return ret;
+}
+
+
+@ This is a quick hack to fix etex's \.{\\lastnodetype} now that
+ there are many more visible node types. TODO: check the
+ eTeX manual for the expected return values.
+
+@c
+int visible_last_node_type(int n)
+{
+ int i = type(n);
+ if (i == whatsit_node && subtype(n) == local_par_node)
+ return -1;
+ if (i == glyph_node) {
+ if (is_ligature(n))
+ return 7; /* old ligature value */
+ else
+ return 0; /* old character value */
+ }
+ if (i <= unset_node) {
+ return i + 1;
+ } else if (i <= delim_node) {
+ return 15; /* so-called math nodes */
+ } else {
+ return -1;
+ }
+}
+
+@ @c
+void lua_pdf_literal(PDF pdf, int i)
+{
+ const char *s = NULL;
+ size_t l = 0;
+ lua_rawgeti(Luas, LUA_REGISTRYINDEX, i);
+ s = lua_tolstring(Luas, -1, &l);
+ pdf_out_block(pdf, s, l);
+ pdf_out(pdf, 10); /* |pdf_print_nl| */
+ lua_pop(Luas, 1);
+}
+
+@ @c
+void copy_pdf_literal(pointer r, pointer p)
+{
+ pdf_literal_type(r) = pdf_literal_type(p);
+ pdf_literal_mode(r) = pdf_literal_mode(p);
+ if (pdf_literal_type(p) == normal) {
+ pdf_literal_data(r) = pdf_literal_data(p);
+ add_token_ref(pdf_literal_data(p));
+ } else {
+ lua_rawgeti(Luas, LUA_REGISTRYINDEX, pdf_literal_data(p));
+ pdf_literal_data(r) = luaL_ref(Luas, LUA_REGISTRYINDEX);
+ }
+}
+
+void copy_late_lua(pointer r, pointer p)
+{
+ late_lua_type(r) = late_lua_type(p);
+ if (late_lua_name(p) > 0)
+ add_token_ref(late_lua_name(p));
+ if (late_lua_type(p) == normal) {
+ late_lua_data(r) = late_lua_data(p);
+ add_token_ref(late_lua_data(p));
+ } else {
+ lua_rawgeti(Luas, LUA_REGISTRYINDEX, late_lua_data(p));
+ late_lua_data(r) = luaL_ref(Luas, LUA_REGISTRYINDEX);
+ }
+}
+
+
+@ @c
+void free_pdf_literal(pointer p)
+{
+ if (pdf_literal_type(p) == normal) {
+ delete_token_ref(pdf_literal_data(p));
+ } else {
+ luaL_unref(Luas, LUA_REGISTRYINDEX, pdf_literal_data(p));
+ }
+}
+
+void free_late_lua(pointer p)
+{
+ if (late_lua_name(p) > 0)
+ delete_token_ref(late_lua_name(p));
+ if (late_lua_type(p) == normal) {
+ delete_token_ref(late_lua_data(p));
+ } else {
+ luaL_unref(Luas, LUA_REGISTRYINDEX, late_lua_data(p));
+ }
+}
+
+@ @c
+void show_pdf_literal(pointer p)
+{
+ tprint_esc("pdfliteral");
+ switch (pdf_literal_mode(p)) {
+ case set_origin:
+ break;
+ case direct_page:
+ tprint(" page");
+ break;
+ case direct_always:
+ tprint(" direct");
+ break;
+ default:
+ confusion("literal2");
+ break;
+ }
+ if (pdf_literal_type(p) == normal) {
+ print_mark(pdf_literal_data(p));
+ } else {
+ lua_rawgeti(Luas, LUA_REGISTRYINDEX, pdf_literal_data(p));
+ tprint("\"");
+ tprint(lua_tostring(Luas, -1));
+ tprint("\"");
+ lua_pop(Luas, 1);
+ }
+}
+
+void show_late_lua(pointer p)
+{
+ tprint_esc("latelua");
+ print_int(late_lua_reg(p));
+ if (late_lua_type(p) == normal) {
+ print_mark(late_lua_data(p));
+ } else {
+ lua_rawgeti(Luas, LUA_REGISTRYINDEX, late_lua_data(p));
+ tprint("\"");
+ tprint(lua_tostring(Luas, -1));
+ tprint("\"");
+ lua_pop(Luas, 1);
+ }
+}
diff --git a/Build/source/texk/web2c/luatexdir/luafontloader/fontforge/fontforge/parsettf.c b/Build/source/texk/web2c/luatexdir/luafontloader/fontforge/fontforge/parsettf.c
index c682146b352..339f99ffc29 100644
--- a/Build/source/texk/web2c/luatexdir/luafontloader/fontforge/fontforge/parsettf.c
+++ b/Build/source/texk/web2c/luatexdir/luafontloader/fontforge/fontforge/parsettf.c
@@ -5899,6 +5899,11 @@ static SplineFont *SFFillFromTTF(struct ttfinfo *info) {
++k;
} while ( k<sf->subfontcnt );
}
+ /* more info */
+ sf->units_per_em = info->emsize ;
+ sf->pfminfo = info->pfminfo ;
+ sf->names = info->names ;
+
SFRelativeWinAsDs(sf);
free(info->savetab);
sf->loadvalidation_state =
@@ -6041,6 +6046,9 @@ static SplineFont *SFFillFromTTFInfo(struct ttfinfo *info) {
free( info->weight );
sf->version = info->version;
sf->italicangle = info->italicAngle;
+ sf->names = info->names;
+ sf->units_per_em = info->emsize ;
+ sf->pfminfo = info->pfminfo ;
return( sf );
}
diff --git a/Build/source/texk/web2c/luatexdir/luafontloader/src/luafflib.c b/Build/source/texk/web2c/luatexdir/luafontloader/src/luafflib.c
index 7edd93fd6b3..7163fb2f026 100644
--- a/Build/source/texk/web2c/luatexdir/luafontloader/src/luafflib.c
+++ b/Build/source/texk/web2c/luatexdir/luafontloader/src/luafflib.c
@@ -33,7 +33,7 @@
#include <locale.h>
static const char _svn_version[] =
- "$Id: luafflib.c 4744 2014-01-11 11:42:36Z luigi $ "
+ "$Id: luafflib.c 4768 2014-01-28 15:38:54Z luigi $ "
"$URL: https://foundry.supelec.fr/svn/luatex/trunk/source/texk/web2c/luatexdir/luafontloader/src/luafflib.c $";
extern char **gww_errors;
@@ -2306,19 +2306,21 @@ void do_ff_info(lua_State * L, SplineFont * sf)
dump_stringfield(L, "weight", sf->weight);
dump_intfield(L, "units_per_em", sf->units_per_em);
- dump_intfield(L, "design_range_bottom", sf->design_range_bottom);
- dump_intfield(L, "design_range_top", sf->design_range_top);
- dump_intfield(L, "design_size", sf->design_size);
+ /* These are not assigned in info... */
+ /*dump_intfield(L, "design_range_bottom", sf->design_range_bottom);*/
+ /*dump_intfield(L, "design_range_top", sf->design_range_top);*/
+ /*dump_intfield(L, "design_size", sf->design_size);*/
lua_createtable(L, 0, 40);
handle_pfminfo(L, sf->pfminfo);
lua_setfield(L, -2, "pfminfo");
- if (sf->names != NULL) {
- lua_newtable(L);
- handle_ttflangname(L, sf->names);
- lua_setfield(L, -2, "names");
- }
+ /* Do we need this ? */
+ if (sf->names != NULL) {
+ lua_newtable(L);
+ handle_ttflangname(L, sf->names);
+ lua_setfield(L, -2, "names");
+ }
}
typedef enum {
diff --git a/Build/source/texk/web2c/luatexdir/luapeg/lpeg.c b/Build/source/texk/web2c/luatexdir/luapeg/lpeg.c
index d46d4638abd..3e64950fb98 100644
--- a/Build/source/texk/web2c/luatexdir/luapeg/lpeg.c
+++ b/Build/source/texk/web2c/luatexdir/luapeg/lpeg.c
@@ -1,249 +1,23 @@
-/*
-** $Id: lpeg.c,v 1.114 2011/02/16 15:02:20 roberto Exp $
-** LPeg - PEG pattern matching for Lua
-** Copyright 2007, Lua.org & PUC-Rio (see 'lpeg.html' for license)
-** written by Roberto Ierusalimschy
-*/
-
-
-#include <assert.h>
-#include <ctype.h>
-#include <limits.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "lua.h"
-#include "lauxlib.h"
#include "lpeg.h"
-#define VERSION "0.10"
-#define PATTERN_T "lpeg-pattern"
-#define MAXSTACKIDX "lpeg-maxstack"
-
-
/*
-** compatibility with Lua 5.2
+** $Id: lpprint.c,v 1.7 2013/04/12 16:29:49 roberto Exp $
+** Copyright 2007, Lua.org & PUC-Rio (see 'lpeg.html' for license)
*/
-#if (LUA_VERSION_NUM == 502)
-
-#undef lua_equal
-#define lua_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ)
-
-#undef lua_getfenv
-#define lua_getfenv lua_getuservalue
-#undef lua_setfenv
-#define lua_setfenv lua_setuservalue
-
-#undef lua_objlen
-#define lua_objlen lua_rawlen
-
-#undef luaL_register
-#define luaL_register(L,n,f) \
- { if ((n) == NULL) luaL_setfuncs(L,f,0); else luaL_newlib(L,f); }
-
-#endif
-
-
-
-/* initial size for call/backtrack stack */
-#define INITBACK 100
-
-/* default maximum size for call/backtrack stack */
-#define MAXBACK INITBACK
-
-/* size for call/backtrack stack for verifier */
-#define MAXBACKVER 200
-
-/* initial size for capture's list */
-#define INITCAPSIZE 32
-
-
-/* index, on Lua stack, for subject */
-#define SUBJIDX 2
-
-/* number of fixed arguments to 'match' (before capture arguments) */
-#define FIXEDARGS 3
-
-/* index, on Lua stack, for substitution value cache */
-#define subscache(cs) ((cs)->ptop + 1)
-
-/* index, on Lua stack, for capture list */
-#define caplistidx(ptop) ((ptop) + 2)
-
-/* index, on Lua stack, for pattern's fenv */
-#define penvidx(ptop) ((ptop) + 3)
-
-/* index, on Lua stack, for backtracking stack */
-#define stackidx(ptop) ((ptop) + 4)
-
-
-
-typedef unsigned char byte;
-
-
-#define CHARSETSIZE ((UCHAR_MAX/CHAR_BIT) + 1)
-
-
-typedef byte Charset[CHARSETSIZE];
-
-
-/* Virtual Machine's instructions */
-typedef enum Opcode {
- IAny, IChar, ISet, ISpan,
- IBack,
- IRet, IEnd,
- IChoice, IJmp, ICall, IOpenCall,
- ICommit, IPartialCommit, IBackCommit, IFailTwice, IFail, IGiveup,
- IFunc,
- IFullCapture, IEmptyCapture, IEmptyCaptureIdx,
- IOpenCapture, ICloseCapture, ICloseRunTime
-} Opcode;
+/* #include <ctype.h> */
+/* #include <limits.h> */
+/* #include <stdio.h> */
-#define ISJMP 0x1
-#define ISCHECK 0x2
-#define ISFIXCHECK 0x4
-#define ISNOFAIL 0x8
-#define ISCAPTURE 0x10
-#define ISMOVABLE 0x20
-#define ISFENVOFF 0x40
-
-static const int opproperties[] = {
- /* IAny */ ISCHECK | ISFIXCHECK | ISJMP,
- /* IChar */ ISCHECK | ISFIXCHECK | ISJMP,
- /* ISet */ ISCHECK | ISFIXCHECK | ISJMP,
- /* ISpan */ ISNOFAIL,
- /* IBack */ 0,
- /* IRet */ 0,
- /* IEnd */ 0,
- /* IChoice */ ISJMP,
- /* IJmp */ ISJMP | ISNOFAIL,
- /* ICall */ ISJMP,
- /* IOpenCall */ ISFENVOFF,
- /* ICommit */ ISJMP,
- /* IPartialCommit */ ISJMP,
- /* IBackCommit */ ISJMP,
- /* IFailTwice */ 0,
- /* IFail */ 0,
- /* IGiveup */ 0,
- /* IFunc */ ISCHECK | ISJMP,
- /* IFullCapture */ ISCAPTURE | ISNOFAIL | ISFENVOFF,
- /* IEmptyCapture */ ISCAPTURE | ISNOFAIL | ISMOVABLE,
- /* IEmptyCaptureIdx */ISCAPTURE | ISNOFAIL | ISMOVABLE | ISFENVOFF,
- /* IOpenCapture */ ISCAPTURE | ISNOFAIL | ISMOVABLE | ISFENVOFF,
- /* ICloseCapture */ ISCAPTURE | ISNOFAIL | ISMOVABLE | ISFENVOFF,
- /* ICloseRunTime */ ISCAPTURE | ISFENVOFF
-};
-
-
-typedef union Instruction {
- struct Inst {
- byte code;
- byte aux;
- short offset;
- } i;
- PattFunc f;
- int iv;
- byte buff[1];
-} Instruction;
-
-static const Instruction giveup = {{IGiveup, 0, 0}};
-
-#define getkind(op) ((op)->i.aux & 0xF)
-#define getoff(op) (((op)->i.aux >> 4) & 0xF)
-
-#define dest(p,x) ((x) + ((p)+(x))->i.offset)
-
-#define MAXOFF 0xF
-#define MAXAUX 0xFF
-
-/* maximum size (in elements) for a pattern */
-#define MAXPATTSIZE (SHRT_MAX - 10)
-
-
-#define isprop(op,p) (opproperties[(op)->i.code] & (p))
-#define isjmp(op) (isprop(op, ISJMP) && (op)->i.offset != 0)
-#define iscapture(op) isprop(op, ISCAPTURE)
-#define ischeck(op) (isprop(op, ISCHECK) && (op)->i.offset == 0)
-#define isfixcheck(op) (isprop(op, ISFIXCHECK) && (op)->i.offset == 0)
-#define istest(op) (isprop(op, ISCHECK) && (op)->i.offset != 0)
-#define isnofail(op) isprop(op, ISNOFAIL)
-#define ismovable(op) isprop(op, ISMOVABLE)
-#define isfenvoff(op) isprop(op, ISFENVOFF)
-
-
-/* kinds of captures */
-typedef enum CapKind {
- Cclose, Cposition, Cconst, Cbackref, Carg, Csimple, Ctable, Cfunction,
- Cquery, Cstring, Csubst, Cfold, Cruntime, Cgroup
-} CapKind;
-
-#define iscapnosize(k) ((k) == Cposition || (k) == Cconst)
-
-
-typedef struct Capture {
- const char *s; /* position */
- short idx;
- byte kind;
- byte siz;
-} Capture;
-
-
-/* size (in elements) for an instruction plus extra l bytes */
-#define instsize(l) (((l) + sizeof(Instruction) - 1)/sizeof(Instruction) + 1)
-
-
-/* size (in elements) for a ISet instruction */
-#define CHARSETINSTSIZE instsize(CHARSETSIZE)
-
-/* size (in elements) for a IFunc instruction */
-#define funcinstsize(p) ((p)->i.aux + 2)
-
-
-#define loopset(v,b) { int v; for (v = 0; v < CHARSETSIZE; v++) b; }
-
-
-#define testchar(st,c) (((int)(st)[((c) >> 3)] & (1 << ((c) & 7))))
-#define setchar(st,c) ((st)[(c) >> 3] |= (1 << ((c) & 7)))
-
-
-static int target (Instruction *p, int i);
-
-
-static int sizei (const Instruction *i) {
- switch((Opcode)i->i.code) {
- case ISet: case ISpan: return CHARSETINSTSIZE;
- case IFunc: return funcinstsize(i);
- default: return 1;
- }
-}
-
-
-static const char *val2str (lua_State *L, int idx) {
- const char *k = lua_tostring(L, idx);
- if (k != NULL)
- return lua_pushfstring(L, "rule '%s'", k);
- else
- return lua_pushfstring(L, "rule <a %s>", luaL_typename(L, idx));
-}
+/* #include "lptypes.h" */
+/* #include "lpprint.h" */
+/* #include "lpcode.h" */
-static int getposition (lua_State *L, int t, int i) {
- int res;
- lua_getfenv(L, -1);
- lua_rawgeti(L, -1, i); /* get key from pattern's environment */
- lua_gettable(L, t); /* get position from positions table */
- res = lua_tointeger(L, -1);
- if (res == 0) { /* key has no registered position? */
- lua_rawgeti(L, -2, i); /* get key again */
- return luaL_error(L, "%s is not defined in given grammar", val2str(L, -1));
- }
- lua_pop(L, 2); /* remove environment and position */
- return res;
-}
+#if defined(LPEG_DEBUG)
/*
** {======================================================
@@ -252,7 +26,7 @@ static int getposition (lua_State *L, int t, int i) {
*/
-static void printcharset (const Charset st) {
+void printcharset (const byte *st) {
int i;
printf("[");
for (i = 0; i <= UCHAR_MAX; i++) {
@@ -271,51 +45,53 @@ static void printcapkind (int kind) {
const char *const modes[] = {
"close", "position", "constant", "backref",
"argument", "simple", "table", "function",
- "query", "string", "substitution", "fold",
+ "query", "string", "num", "substitution", "fold",
"runtime", "group"};
printf("%s", modes[kind]);
}
static void printjmp (const Instruction *op, const Instruction *p) {
- printf("-> ");
- if (p->i.offset == 0) printf("FAIL");
- else printf("%d", (int)(dest(0, p) - op));
+ printf("-> %d", (int)(p + (p + 1)->offset - op));
}
static void printinst (const Instruction *op, const Instruction *p) {
const char *const names[] = {
- "any", "char", "set", "span", "back",
+ "any", "char", "set",
+ "testany", "testchar", "testset",
+ "span", "behind",
"ret", "end",
"choice", "jmp", "call", "open_call",
"commit", "partial_commit", "back_commit", "failtwice", "fail", "giveup",
- "func",
- "fullcapture", "emptycapture", "emptycaptureidx", "opencapture",
- "closecapture", "closeruntime"
+ "fullcapture", "opencapture", "closecapture", "closeruntime"
};
printf("%02ld: %s ", (long)(p - op), names[p->i.code]);
switch ((Opcode)p->i.code) {
case IChar: {
printf("'%c'", p->i.aux);
- printjmp(op, p);
break;
}
- case IAny: {
- printf("* %d", p->i.aux);
- printjmp(op, p);
+ case ITestChar: {
+ printf("'%c'", p->i.aux); printjmp(op, p);
+ break;
+ }
+ case IFullCapture: {
+ printcapkind(getkind(p));
+ printf(" (size = %d) (idx = %d)", getoff(p), p->i.key);
break;
}
- case IFullCapture: case IOpenCapture:
- case IEmptyCapture: case IEmptyCaptureIdx:
- case ICloseCapture: case ICloseRunTime: {
+ case IOpenCapture: {
printcapkind(getkind(p));
- printf("(n = %d) (off = %d)", getoff(p), p->i.offset);
+ printf(" (idx = %d)", p->i.key);
break;
}
case ISet: {
printcharset((p+1)->buff);
- printjmp(op, p);
+ break;
+ }
+ case ITestSet: {
+ printcharset((p+2)->buff); printjmp(op, p);
break;
}
case ISpan: {
@@ -323,16 +99,15 @@ static void printinst (const Instruction *op, const Instruction *p) {
break;
}
case IOpenCall: {
- printf("-> %d", p->i.offset);
+ printf("-> %d", (p + 1)->offset);
break;
}
- case IChoice: {
- printjmp(op, p);
- printf(" (%d)", p->i.aux);
+ case IBehind: {
+ printf("%d", p->i.aux);
break;
}
- case IJmp: case ICall: case ICommit:
- case IPartialCommit: case IBackCommit: {
+ case IJmp: case ICall: case ICommit: case IChoice:
+ case IPartialCommit: case IBackCommit: case ITestAny: {
printjmp(op, p);
break;
}
@@ -342,25 +117,27 @@ static void printinst (const Instruction *op, const Instruction *p) {
}
-static void printpatt (Instruction *p) {
+void printpatt (Instruction *p, int n) {
Instruction *op = p;
- for (;;) {
+ while (p < op + n) {
printinst(op, p);
- if ((Opcode)p->i.code == IEnd) break;
p += sizei(p);
}
}
-#if 0
+#if defined(LPEG_DEBUG)
static void printcap (Capture *cap) {
printcapkind(cap->kind);
printf(" (idx: %d - size: %d) -> %p\n", cap->idx, cap->siz, cap->s);
}
-static void printcaplist (Capture *cap) {
- for (; cap->s; cap++) printcap(cap);
+void printcaplist (Capture *cap, Capture *limit) {
+ printf(">======\n");
+ for (; cap->s && (limit == NULL || cap < limit); cap++)
+ printcap(cap);
+ printf("=======\n");
}
#endif
@@ -369,14 +146,147 @@ static void printcaplist (Capture *cap) {
/*
** {======================================================
+** Printing trees (for debugging)
+** =======================================================
+*/
+
+static const char *tagnames[] = {
+ "char", "set", "any",
+ "true", "false",
+ "rep",
+ "seq", "choice",
+ "not", "and",
+ "call", "opencall", "rule", "grammar",
+ "behind",
+ "capture", "run-time"
+};
+
+
+void printtree (TTree *tree, int ident) {
+ int i;
+ for (i = 0; i < ident; i++) printf(" ");
+ printf("%s", tagnames[tree->tag]);
+ switch (tree->tag) {
+ case TChar: {
+ int c = tree->u.n;
+ if (isprint(c))
+ printf(" '%c'\n", c);
+ else
+ printf(" (%02X)\n", c);
+ break;
+ }
+ case TSet: {
+ printcharset(treebuffer(tree));
+ printf("\n");
+ break;
+ }
+ case TOpenCall: case TCall: {
+ printf(" key: %d\n", tree->key);
+ break;
+ }
+ case TBehind: {
+ printf(" %d\n", tree->u.n);
+ printtree(sib1(tree), ident + 2);
+ break;
+ }
+ case TCapture: {
+ printf(" cap: %d key: %d n: %d\n", tree->cap, tree->key, tree->u.n);
+ printtree(sib1(tree), ident + 2);
+ break;
+ }
+ case TRule: {
+ printf(" n: %d key: %d\n", tree->cap, tree->key);
+ printtree(sib1(tree), ident + 2);
+ break; /* do not print next rule as a sibling */
+ }
+ case TGrammar: {
+ TTree *rule = sib1(tree);
+ printf(" %d\n", tree->u.n); /* number of rules */
+ for (i = 0; i < tree->u.n; i++) {
+ printtree(rule, ident + 2);
+ rule = sib2(rule);
+ }
+ assert(rule->tag == TTrue); /* sentinel */
+ break;
+ }
+ default: {
+ int sibs = numsiblings[tree->tag];
+ printf("\n");
+ if (sibs >= 1) {
+ printtree(sib1(tree), ident + 2);
+ if (sibs >= 2)
+ printtree(sib2(tree), ident + 2);
+ }
+ break;
+ }
+ }
+}
+
+
+void printktable (lua_State *L, int idx) {
+ int n, i;
+ lua_getfenv(L, idx);
+ if (lua_isnil(L, -1)) /* no ktable? */
+ return;
+ n = lua_objlen(L, -1);
+ printf("[");
+ for (i = 1; i <= n; i++) {
+ printf("%d = ", i);
+ lua_rawgeti(L, -1, i);
+ if (lua_isstring(L, -1))
+ printf("%s ", lua_tostring(L, -1));
+ else
+ printf("%s ", lua_typename(L, lua_type(L, -1)));
+ lua_pop(L, 1);
+ }
+ printf("]\n");
+ /* leave ktable at the stack */
+}
+
+/* }====================================================== */
+
+#endif
+
+
+/*
+** $Id: lpvm.c,v 1.5 2013/04/12 16:29:49 roberto Exp $
+** Copyright 2007, Lua.org & PUC-Rio (see 'lpeg.html' for license)
+*/
+
+/* #include <limits.h> */
+/* #include <string.h> */
+
+
+/* #include "lua.h" */
+/* #include "lauxlib.h" */
+
+/* #include "lpcap.h" */
+/* #include "lptypes.h" */
+/* #include "lpvm.h" */
+/* #include "lpprint.h" */
+
+
+/* initial size for call/backtrack stack */
+#if !defined(INITBACK)
+#define INITBACK 100
+#endif
+
+
+#define getoffset(p) (((p) + 1)->offset)
+
+static const Instruction giveup = {{IGiveup, 0, 0}};
+
+
+/*
+** {======================================================
** Virtual Machine
** =======================================================
*/
typedef struct Stack {
- const char *s;
- const Instruction *p;
+ const char *s; /* saved position (or NULL for calls) */
+ const Instruction *p; /* next instruction */
int caplevel;
} Stack;
@@ -384,10 +294,9 @@ typedef struct Stack {
#define getstackbase(L, ptop) ((Stack *)lua_touserdata(L, stackidx(ptop)))
-static int runtimecap (lua_State *L, Capture *close, Capture *ocap,
- const char *o, const char *s, int ptop);
-
-
+/*
+** Double the size of the array of captures
+*/
static Capture *doublecap (lua_State *L, Capture *cap, int captop, int ptop) {
Capture *newc;
if (captop >= INT_MAX/((int)sizeof(Capture) * 2))
@@ -399,61 +308,111 @@ static Capture *doublecap (lua_State *L, Capture *cap, int captop, int ptop) {
}
+/*
+** Double the size of the stack
+*/
static Stack *doublestack (lua_State *L, Stack **stacklimit, int ptop) {
Stack *stack = getstackbase(L, ptop);
Stack *newstack;
- int n = *stacklimit - stack;
+ int n = *stacklimit - stack; /* current stack size */
int max, newn;
lua_getfield(L, LUA_REGISTRYINDEX, MAXSTACKIDX);
- max = lua_tointeger(L, -1);
+ max = lua_tointeger(L, -1); /* maximum allowed size */
lua_pop(L, 1);
- if (n >= max)
+ if (n >= max) /* already at maximum size? */
luaL_error(L, "too many pending calls/choices");
- newn = 2*n; if (newn > max) newn = max;
+ newn = 2 * n; /* new size */
+ if (newn > max) newn = max;
newstack = (Stack *)lua_newuserdata(L, newn * sizeof(Stack));
memcpy(newstack, stack, n * sizeof(Stack));
lua_replace(L, stackidx(ptop));
*stacklimit = newstack + newn;
- return newstack + n;
+ return newstack + n; /* return next position */
+}
+
+/*
+** Interpret the result of a dynamic capture: false -> fail;
+** true -> keep current position; number -> next position.
+** Return new subject position. 'fr' is stack index where
+** is the result; 'curr' is current subject position; 'limit'
+** is subject's size.
+*/
+static int resdyncaptures (lua_State *L, int fr, int curr, int limit) {
+ lua_Integer res;
+ if (!lua_toboolean(L, fr)) { /* false value? */
+ lua_settop(L, fr - 1); /* remove results */
+ return -1; /* and fail */
+ }
+ else if (lua_isboolean(L, fr)) /* true? */
+ res = curr; /* keep current position */
+ else {
+ res = lua_tointeger(L, fr) - 1; /* new position */
+ if (res < curr || res > limit)
+ luaL_error(L, "invalid position returned by match-time capture");
+ }
+ lua_remove(L, fr); /* remove first result (offset) */
+ return res;
}
+/*
+** Add capture values returned by a dynamic capture to the capture list
+** 'base', nested inside a group capture. 'fd' indexes the first capture
+** value, 'n' is the number of values (at least 1).
+*/
static void adddyncaptures (const char *s, Capture *base, int n, int fd) {
int i;
- assert(base[0].kind == Cruntime && base[0].siz == 0);
- base[0].idx = fd; /* first returned capture */
- for (i = 1; i < n; i++) { /* add extra captures */
+ /* Cgroup capture is already there */
+ assert(base[0].kind == Cgroup && base[0].siz == 0);
+ base[0].idx = 0; /* make it an anonymous group */
+ for (i = 1; i <= n; i++) { /* add runtime captures */
+ base[i].kind = Cruntime;
base[i].siz = 1; /* mark it as closed */
+ base[i].idx = fd + i - 1; /* stack index of capture value */
base[i].s = s;
- base[i].kind = Cruntime;
- base[i].idx = fd + i; /* stack index */
}
- base[n].kind = Cclose; /* add closing entry */
- base[n].siz = 1;
- base[n].s = s;
+ base[i].kind = Cclose; /* close group */
+ base[i].siz = 1;
+ base[i].s = s;
}
-#define condfailed(p) { int f = p->i.offset; if (f) p+=f; else goto fail; }
+/*
+** Remove dynamic captures from the Lua stack (called in case of failure)
+*/
+static int removedyncap (lua_State *L, Capture *capture,
+ int level, int last) {
+ int id = finddyncap(capture + level, capture + last); /* index of 1st cap. */
+ int top = lua_gettop(L);
+ if (id == 0) return 0; /* no dynamic captures? */
+ lua_settop(L, id - 1); /* remove captures */
+ return top - id + 1; /* number of values removed */
+}
+
-static const char *match (lua_State *L,
- const char *o, const char *s, const char *e,
- Instruction *op, Capture *capture, int ptop) {
+/*
+** Opcode interpreter
+*/
+const char *match (lua_State *L, const char *o, const char *s, const char *e,
+ Instruction *op, Capture *capture, int ptop) {
Stack stackbase[INITBACK];
Stack *stacklimit = stackbase + INITBACK;
Stack *stack = stackbase; /* point to first empty slot in stack */
int capsize = INITCAPSIZE;
int captop = 0; /* point to first empty slot in captures */
- const Instruction *p = op;
+ int ndyncap = 0; /* number of dynamic captures (in Lua stack) */
+ const Instruction *p = op; /* current instruction */
stack->p = &giveup; stack->s = s; stack->caplevel = 0; stack++;
lua_pushlightuserdata(L, stackbase);
for (;;) {
#if defined(DEBUG)
- printf("s: |%s| stck: %d c: %d ",
- s, stack - getstackbase(L, ptop), captop);
+ printf("s: |%s| stck:%d, dyncaps:%d, caps:%d ",
+ s, stack - getstackbase(L, ptop), ndyncap, captop);
printinst(op, p);
+ printcaplist(capture, capture + captop);
#endif
+ assert(stackidx(ptop) + ndyncap == lua_gettop(L) && ndyncap <= captop);
switch ((Opcode)p->i.code) {
case IEnd: {
assert(stack == getstackbase(L, ptop) + 1);
@@ -471,24 +430,40 @@ static const char *match (lua_State *L,
continue;
}
case IAny: {
- int n = p->i.aux;
- if (n <= e - s) { p++; s += n; }
- else condfailed(p);
+ if (s < e) { p++; s++; }
+ else goto fail;
+ continue;
+ }
+ case ITestAny: {
+ if (s < e) p += 2;
+ else p += getoffset(p);
continue;
}
case IChar: {
if ((byte)*s == p->i.aux && s < e) { p++; s++; }
- else condfailed(p);
+ else goto fail;
+ continue;
+ }
+ case ITestChar: {
+ if ((byte)*s == p->i.aux && s < e) p += 2;
+ else p += getoffset(p);
continue;
}
case ISet: {
int c = (byte)*s;
if (testchar((p+1)->buff, c) && s < e)
{ p += CHARSETINSTSIZE; s++; }
- else condfailed(p);
+ else goto fail;
+ continue;
+ }
+ case ITestSet: {
+ int c = (byte)*s;
+ if (testchar((p + 2)->buff, c) && s < e)
+ p += 1 + CHARSETINSTSIZE;
+ else p += getoffset(p);
continue;
}
- case IBack: {
+ case IBehind: {
int n = p->i.aux;
if (n > s - o) goto fail;
s -= n; p++;
@@ -502,53 +477,47 @@ static const char *match (lua_State *L,
p += CHARSETINSTSIZE;
continue;
}
- case IFunc: {
- const char *r = (p+1)->f(s, e, o, (p+2)->buff);
- if (r != NULL) { s = r; p += funcinstsize(p); }
- else condfailed(p);
- continue;
- }
case IJmp: {
- p += p->i.offset;
+ p += getoffset(p);
continue;
}
case IChoice: {
if (stack == stacklimit)
stack = doublestack(L, &stacklimit, ptop);
- stack->p = dest(0, p);
- stack->s = s - p->i.aux;
+ stack->p = p + getoffset(p);
+ stack->s = s;
stack->caplevel = captop;
stack++;
- p++;
+ p += 2;
continue;
}
case ICall: {
if (stack == stacklimit)
stack = doublestack(L, &stacklimit, ptop);
stack->s = NULL;
- stack->p = p + 1; /* save return address */
+ stack->p = p + 2; /* save return address */
stack++;
- p += p->i.offset;
+ p += getoffset(p);
continue;
}
case ICommit: {
assert(stack > getstackbase(L, ptop) && (stack - 1)->s != NULL);
stack--;
- p += p->i.offset;
+ p += getoffset(p);
continue;
}
case IPartialCommit: {
assert(stack > getstackbase(L, ptop) && (stack - 1)->s != NULL);
(stack - 1)->s = s;
(stack - 1)->caplevel = captop;
- p += p->i.offset;
+ p += getoffset(p);
continue;
}
case IBackCommit: {
assert(stack > getstackbase(L, ptop) && (stack - 1)->s != NULL);
s = (--stack)->s;
captop = stack->caplevel;
- p += p->i.offset;
+ p += getoffset(p);
continue;
}
case IFailTwice:
@@ -561,41 +530,41 @@ static const char *match (lua_State *L,
assert(stack > getstackbase(L, ptop));
s = (--stack)->s;
} while (s == NULL);
+ if (ndyncap > 0) /* is there matchtime captures? */
+ ndyncap -= removedyncap(L, capture, stack->caplevel, captop);
captop = stack->caplevel;
p = stack->p;
continue;
}
case ICloseRunTime: {
+ CapState cs;
+ int rem, res, n;
int fr = lua_gettop(L) + 1; /* stack index of first result */
- int ncap = runtimecap(L, capture + captop, capture, o, s, ptop);
- lua_Integer res = lua_tointeger(L, fr) - 1; /* offset */
- int n = lua_gettop(L) - fr; /* number of new captures */
- if (res == -1) { /* may not be a number */
- if (!lua_toboolean(L, fr)) { /* false value? */
- lua_settop(L, fr - 1); /* remove results */
- goto fail; /* and fail */
- }
- else if (lua_isboolean(L, fr)) /* true? */
- res = s - o; /* keep current position */
- }
- if (res < s - o || res > e - o)
- luaL_error(L, "invalid position returned by match-time capture");
- s = o + res; /* update current position */
- captop -= ncap; /* remove nested captures */
- lua_remove(L, fr); /* remove first result (offset) */
- if (n > 0) { /* captures? */
- if ((captop += n + 1) >= capsize) {
+ cs.s = o; cs.L = L; cs.ocap = capture; cs.ptop = ptop;
+ n = runtimecap(&cs, capture + captop, s, &rem); /* call function */
+ captop -= n; /* remove nested captures */
+ fr -= rem; /* 'rem' items were popped from Lua stack */
+ res = resdyncaptures(L, fr, s - o, e - o); /* get result */
+ if (res == -1) /* fail? */
+ goto fail;
+ s = o + res; /* else update current position */
+ n = lua_gettop(L) - fr + 1; /* number of new captures */
+ ndyncap += n - rem; /* update number of dynamic captures */
+ if (n > 0) { /* any new capture? */
+ if ((captop += n + 2) >= capsize) {
capture = doublecap(L, capture, captop, ptop);
capsize = 2 * captop;
}
- adddyncaptures(s, capture + captop - n - 1, n, fr);
+ /* add new captures to 'capture' list */
+ adddyncaptures(s, capture + captop - n - 2, n, fr);
}
p++;
continue;
}
case ICloseCapture: {
- const char *s1 = s - getoff(p);
+ const char *s1 = s;
assert(captop > 0);
+ /* if possible, turn capture into a full capture */
if (capture[captop - 1].siz == 0 &&
s1 - capture[captop - 1].s < UCHAR_MAX) {
capture[captop - 1].siz = s1 - capture[captop - 1].s + 1;
@@ -604,20 +573,20 @@ static const char *match (lua_State *L,
}
else {
capture[captop].siz = 1; /* mark entry as closed */
- goto capture;
+ capture[captop].s = s;
+ goto pushcapture;
}
}
- case IEmptyCapture: case IEmptyCaptureIdx:
- capture[captop].siz = 1; /* mark entry as closed */
- goto capture;
case IOpenCapture:
capture[captop].siz = 0; /* mark entry as open */
- goto capture;
+ capture[captop].s = s;
+ goto pushcapture;
case IFullCapture:
capture[captop].siz = getoff(p) + 1; /* save capture size */
- capture: {
capture[captop].s = s - getoff(p);
- capture[captop].idx = p->i.offset;
+ /* goto pushcapture; */
+ pushcapture: {
+ capture[captop].idx = p->i.key;
capture[captop].kind = getkind(p);
if (++captop >= capsize) {
capture = doublecap(L, capture, captop, ptop);
@@ -626,10 +595,6 @@ static const char *match (lua_State *L,
p++;
continue;
}
- case IOpenCall: {
- lua_rawgeti(L, penvidx(ptop), p->i.offset);
- luaL_error(L, "reference to %s outside a grammar", val2str(L, -1));
- }
default: assert(0); return NULL;
}
}
@@ -638,1207 +603,982 @@ static const char *match (lua_State *L,
/* }====================================================== */
-/*
-** {======================================================
-** Verifier
-** =======================================================
-*/
/*
-** check whether pattern may go from 'p' to 'e' without consuming any
-** input. Raises an error if it detects a left recursion. 'op' points
-** the beginning of the pattern. If pattern belongs to a grammar,
-** 'rule' is the stack index where is its corresponding key (only for
-** error messages) and 'posttable' is the stack index with a table
-** mapping rule keys to the position of their code in the pattern.
+** $Id: lpcode.c,v 1.18 2013/04/12 16:30:33 roberto Exp $
+** Copyright 2007, Lua.org & PUC-Rio (see 'lpeg.html' for license)
*/
-static int verify (lua_State *L, Instruction *op, const Instruction *p,
- Instruction *e, int postable, int rule) {
- static const char dummy[] = "";
- Stack back[MAXBACKVER];
- int backtop = 0; /* point to first empty slot in back */
- while (p != e) {
- switch ((Opcode)p->i.code) {
- case IRet: {
- p = back[--backtop].p;
- continue;
- }
- case IChoice: {
- if (backtop >= MAXBACKVER)
- return luaL_error(L, "too many pending calls/choices");
- back[backtop].p = dest(0, p);
- back[backtop++].s = dummy;
- p++;
- continue;
- }
- case ICall: {
- assert((p + 1)->i.code != IRet); /* no tail call */
- if (backtop >= MAXBACKVER)
- return luaL_error(L, "too many pending calls/choices");
- back[backtop].s = NULL;
- back[backtop++].p = p + 1;
- goto dojmp;
- }
- case IOpenCall: {
- int i;
- if (postable == 0) /* grammar still not fixed? */
- goto fail; /* to be verified later */
- for (i = 0; i < backtop; i++) {
- if (back[i].s == NULL && back[i].p == p + 1)
- return luaL_error(L, "%s is left recursive", val2str(L, rule));
- }
- if (backtop >= MAXBACKVER)
- return luaL_error(L, "too many pending calls/choices");
- back[backtop].s = NULL;
- back[backtop++].p = p + 1;
- p = op + getposition(L, postable, p->i.offset);
- continue;
- }
- case IBackCommit:
- case ICommit: {
- assert(backtop > 0 && p->i.offset > 0);
- backtop--;
- goto dojmp;
- }
- case IPartialCommit: {
- assert(backtop > 0);
- if (p->i.offset > 0) goto dojmp; /* forward jump */
- else { /* loop will be detected when checking corresponding rule */
- assert(postable != 0);
- backtop--;
- p++; /* just go on now */
- continue;
- }
- }
- case IBack: {
- if (p->i.aux == 1 && isfixcheck(p + 1)) { /* char test? */
- p++; /* skip back instruction */
- p += sizei(p); /* skip char test */
- }
- else { /* standard lookbehind code */
- assert((Opcode)(p - 1)->i.code == IChoice); /* look behind */
- backtop--;
- p += (p - 1)->i.offset;
- assert((Opcode)(p - 1)->i.code == IFail); /* look behind */
- }
- continue;
- }
- case IAny:
- case IChar:
- case ISet: {
- const Instruction *next = p + sizei(p);
- if ((Opcode)next->i.code == IBack)
- p = next + 1; /* continue after the back instruction */
- else if (p->i.offset == 0) goto fail;
- else /* jump */
- p += p->i.offset;
- continue;
- }
- case IJmp:
- dojmp: {
- p += p->i.offset;
- continue;
- }
- case IFailTwice: /* 'not' predicate */
- goto fail; /* body could have failed; try to backtrack it */
- case IFail: {
- if (p > op && (p - 1)->i.code == IBackCommit) { /* 'and' predicate? */
- p++; /* pretend it succeeded and go ahead */
- continue;
- }
- /* else failed: go through */
- }
- fail: { /* pattern failed: try to backtrack */
- do {
- if (backtop-- == 0)
- return 1; /* no more backtracking */
- } while (back[backtop].s == NULL);
- p = back[backtop].p;
- continue;
- }
- case ISpan:
- case IOpenCapture: case ICloseCapture:
- case IEmptyCapture: case IEmptyCaptureIdx:
- case IFullCapture: {
- p += sizei(p);
- continue;
- }
- case ICloseRunTime: {
- goto fail; /* be liberal in this case */
- }
- case IFunc: {
- const char *r = (p+1)->f(dummy, dummy, dummy, (p+2)->buff);
- if (r != NULL) { p += funcinstsize(p); }
- else condfailed(p);
- continue;
- }
- case IEnd: /* cannot happen (should stop before it) */
- default: assert(0); return 0;
- }
- }
- assert(backtop == 0);
- return 0;
-}
-
-
-static void checkrule (lua_State *L, Instruction *op, int from, int to,
- int postable, int rule) {
- int i;
- int lastopen = 0; /* more recent OpenCall seen in the code */
- for (i = from; i < to; i += sizei(op + i)) {
- if (op[i].i.code == IPartialCommit && op[i].i.offset < 0) { /* loop? */
- int start = dest(op, i);
- assert(op[start - 1].i.code == IChoice &&
- dest(op, start - 1) == target(op, i + 1));
- if (start <= lastopen) { /* loop does contain an open call? */
- if (!verify(L, op, op + start, op + i, postable, rule)) /* check body */
- luaL_error(L, "possible infinite loop in %s", val2str(L, rule));
- }
- }
- else if (op[i].i.code == IOpenCall)
- lastopen = i;
- }
- assert(op[i - 1].i.code == IRet);
- verify(L, op, op + from, op + to - 1, postable, rule);
-}
-
+/* #include <limits.h> */
-/* }====================================================== */
+/* #include "lua.h" */
+/* #include "lauxlib.h" */
+/* #include "lptypes.h" */
+/* #include "lpcode.h" */
-/*
-** {======================================================
-** Building Patterns
-** =======================================================
-*/
-enum charsetanswer { NOINFO, ISCHARSET, VALIDSTARTS };
+/* signals a "no-instruction */
+#define NOINST -1
-typedef struct CharsetTag {
- enum charsetanswer tag;
- Charset cs;
-} CharsetTag;
-static Instruction *getpatt (lua_State *L, int idx, int *size);
-
-
-static void check2test (Instruction *p, int n) {
- assert(ischeck(p) && n != 0);
- p->i.offset = n;
-}
+static const Charset fullset_ =
+ {{0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF,
+ 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF,
+ 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF,
+ 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF}};
+static const Charset *fullset = &fullset_;
/*
-** invert array slice p[0]-p[e] (both inclusive)
+** {======================================================
+** Analysis and some optimizations
+** =======================================================
*/
-static void invert (Instruction *p, int e) {
- int i;
- for (i = 0; i < e; i++, e--) {
- Instruction temp = p[i];
- p[i] = p[e];
- p[e] = temp;
- }
-}
-
/*
-** rotate array slice p[0]-p[e] (both inclusive) 'n' steps
-** to the 'left'
+** Check whether a charset is empty (IFail), singleton (IChar),
+** full (IAny), or none of those (ISet).
*/
-static void rotate (Instruction *p, int e, int n) {
- invert(p, n - 1);
- invert(p + n, e - n);
- invert(p, e);
-}
-
-
-#define op_step(p) ((p)->i.code == IAny ? (p)->i.aux : 1)
-
-
-static int skipchecks (Instruction *p, int up, int *pn) {
- int i, n = 0;
- for (i = 0; isfixcheck(p + i); i += sizei(p + i)) {
- int st = op_step(p + i);
- if (n + st > MAXOFF - up) break;
- n += st;
- }
- *pn = n;
- return i;
-}
-
-
-#define ismovablecap(op) (ismovable(op) && getoff(op) < MAXOFF)
-
-static void optimizecaptures (Instruction *p) {
+static Opcode charsettype (const byte *cs, int *c) {
+ int count = 0;
int i;
- int limit = 0;
- for (i = 0; p[i].i.code != IEnd; i += sizei(p + i)) {
- if (isjmp(p + i) && dest(p, i) >= limit)
- limit = dest(p, i) + 1; /* do not optimize jump targets */
- else if (i >= limit && ismovablecap(p + i) && isfixcheck(p + i + 1)) {
- int end, n, j; /* found a border capture|check */
- int maxoff = getoff(p + i);
- int start = i;
- /* find first capture in the group */
- while (start > limit && ismovablecap(p + start - 1)) {
- start--;
- if (getoff(p + start) > maxoff) maxoff = getoff(p + start);
+ int candidate = -1; /* candidate position for a char */
+ for (i = 0; i < CHARSETSIZE; i++) {
+ int b = cs[i];
+ if (b == 0) {
+ if (count > 1) return ISet; /* else set is still empty */
+ }
+ else if (b == 0xFF) {
+ if (count < (i * BITSPERCHAR))
+ return ISet;
+ else count += BITSPERCHAR; /* set is still full */
+ }
+ else if ((b & (b - 1)) == 0) { /* byte has only one bit? */
+ if (count > 0)
+ return ISet; /* set is neither full nor empty */
+ else { /* set has only one char till now; track it */
+ count++;
+ candidate = i;
}
- end = skipchecks(p + i + 1, maxoff, &n) + i; /* find last check */
- if (n == 0) continue; /* first check is too big to move across */
- assert(n <= MAXOFF && start <= i && i < end);
- for (j = start; j <= i; j++)
- p[j].i.aux += (n << 4); /* correct offset of captures to be moved */
- rotate(p + start, end - start, i - start + 1); /* move them up */
- i = end;
- assert(isfixcheck(p + start) && iscapture(p + i));
+ }
+ else return ISet; /* byte is neither empty, full, nor singleton */
+ }
+ switch (count) {
+ case 0: return IFail; /* empty set */
+ case 1: { /* singleton; find character bit inside byte */
+ int b = cs[candidate];
+ *c = candidate * BITSPERCHAR;
+ if ((b & 0xF0) != 0) { *c += 4; b >>= 4; }
+ if ((b & 0x0C) != 0) { *c += 2; b >>= 2; }
+ if ((b & 0x02) != 0) { *c += 1; }
+ return IChar;
+ }
+ default: {
+ assert(count == CHARSETSIZE * BITSPERCHAR); /* full set */
+ return IAny;
}
}
}
-
-static int target (Instruction *p, int i) {
- while (p[i].i.code == IJmp) i += p[i].i.offset;
- return i;
-}
-
-
-static void optimizejumps (Instruction *p) {
- int i;
- for (i = 0; p[i].i.code != IEnd; i += sizei(p + i)) {
- if (isjmp(p + i))
- p[i].i.offset = target(p, dest(p, i)) - i;
- }
+/*
+** A few basic operations on Charsets
+*/
+static void cs_complement (Charset *cs) {
+ loopset(i, cs->cs[i] = ~cs->cs[i]);
}
-static void optimizechoice (Instruction *p) {
- assert(p->i.code == IChoice);
- if (isfixcheck(p + 1)) {
- int lc = sizei(p + 1);
- rotate(p, lc, 1);
- assert(isfixcheck(p) && (p + lc)->i.code == IChoice);
- (p + lc)->i.aux = op_step(p);
- check2test(p, (p + lc)->i.offset);
- (p + lc)->i.offset -= lc;
- }
+static int cs_equal (const byte *cs1, const byte *cs2) {
+ loopset(i, if (cs1[i] != cs2[i]) return 0);
+ return 1;
}
/*
-** A 'headfail' pattern is a pattern that can only fails in its first
-** instruction, which must be a check.
+** computes whether sets cs1 and cs2 are disjoint
*/
-static int isheadfail (Instruction *p) {
- if (!ischeck(p)) return 0;
- /* check that other operations cannot fail */
- for (p += sizei(p); p->i.code != IEnd; p += sizei(p))
- if (!isnofail(p)) return 0;
+static int cs_disjoint (const Charset *cs1, const Charset *cs2) {
+ loopset(i, if ((cs1->cs[i] & cs2->cs[i]) != 0) return 0;)
return 1;
}
-#define checkpattern(L, idx) ((Instruction *)luaL_checkudata(L, idx, PATTERN_T))
-
-
/*
-** Return the number of elements in the ktable of a pattern.
-** in Lua 5.2, default "environment" for patterns is nil, not
-** a table. Treat it as an empty table.
+** Convert a 'char' pattern (TSet, TChar, TAny) to a charset
*/
-static int ktablelen (lua_State *L, int idx) {
- if (!lua_istable(L, idx)) return 0;
- else return lua_objlen(L, idx);
-}
-
-
-/*
-** join the elements of the ktable from pattern 'p1' into the ktable of
-** the pattern at the top of the stack ('p'). If 'p1' has no elements,
-** 'p' keeps its original ktable. If 'p' has no elements, it shares
-** 'p1' ktable. Otherwise, this function creates a new ktable for 'p'.
-** Return the offset of original 'p' elements in the new ktable.
-*/
-static int jointable (lua_State *L, int p1) {
- int n, n1, i;
- lua_getfenv(L, p1);
- n1 = ktablelen(L, -1); /* number of elements in p1's env */
- lua_getfenv(L, -2);
- if (n1 == 0 || lua_equal(L, -2, -1)) {
- lua_pop(L, 2);
- return 0; /* no need to change anything */
- }
- n = ktablelen(L, -1); /* number of elements in p's env */
- if (n == 0) {
- lua_pop(L, 1); /* removes p env */
- lua_setfenv(L, -2); /* p now shares p1's env */
- return 0; /* no need to correct anything */
- }
- lua_createtable(L, n + n1, 0);
- /* stack: p; p1 env; p env; new p env */
- for (i = 1; i <= n; i++) {
- lua_rawgeti(L, -2, i);
- lua_rawseti(L, -2, i);
- }
- for (i = 1; i <= n1; i++) {
- lua_rawgeti(L, -3, i);
- lua_rawseti(L, -2, n + i);
+int tocharset (TTree *tree, Charset *cs) {
+ switch (tree->tag) {
+ case TSet: { /* copy set */
+ loopset(i, cs->cs[i] = treebuffer(tree)[i]);
+ return 1;
+ }
+ case TChar: { /* only one char */
+ assert(0 <= tree->u.n && tree->u.n <= UCHAR_MAX);
+ loopset(i, cs->cs[i] = 0); /* erase all chars */
+ setchar(cs->cs, tree->u.n); /* add that one */
+ return 1;
+ }
+ case TAny: {
+ loopset(i, cs->cs[i] = 0xFF); /* add all to the set */
+ return 1;
+ }
+ default: return 0;
}
- lua_setfenv(L, -4); /* new table becomes p env */
- lua_pop(L, 2); /* remove p1 env and old p env */
- return n;
}
-#define copypatt(p1,p2,sz) memcpy(p1, p2, (sz) * sizeof(Instruction));
-
-#define pattsize(L,idx) (lua_objlen(L, idx)/sizeof(Instruction) - 1)
-
-
-static int addpatt (lua_State *L, Instruction *p, int p1idx) {
- Instruction *p1 = (Instruction *)lua_touserdata(L, p1idx);
- int sz = pattsize(L, p1idx);
- int corr = jointable(L, p1idx);
- copypatt(p, p1, sz + 1);
- if (corr != 0) {
- Instruction *px;
- for (px = p; px < p + sz; px += sizei(px)) {
- if (isfenvoff(px) && px->i.offset != 0)
- px->i.offset += corr;
+/*
+** Checks whether a pattern has captures
+*/
+int hascaptures (TTree *tree) {
+ tailcall:
+ switch (tree->tag) {
+ case TCapture: case TRunTime:
+ return 1;
+ default: {
+ switch (numsiblings[tree->tag]) {
+ case 1: /* return hascaptures(sib1(tree)); */
+ tree = sib1(tree); goto tailcall;
+ case 2:
+ if (hascaptures(sib1(tree))) return 1;
+ /* else return hascaptures(sib2(tree)); */
+ tree = sib2(tree); goto tailcall;
+ default: assert(numsiblings[tree->tag] == 0); return 0;
+ }
}
}
- return sz;
-}
-
-
-static void setinstaux (Instruction *i, Opcode op, int offset, int aux) {
- assert(aux <= MAXAUX);
- i->i.code = op;
- i->i.offset = offset;
- i->i.aux = aux;
}
-#define setinst(i,op,off) setinstaux(i,op,off,0)
-
-#define setinstcap(i,op,idx,k,n) setinstaux(i,op,idx,((k) | ((n) << 4)))
-
/*
-** create a new ktable for pattern at the stack top, mapping
-** '1' to the value at stack position 'vidx'.
+** Checks how a pattern behaves regarding the empty string,
+** in one of two different ways:
+** A pattern is *nullable* if it can match without consuming any character;
+** A pattern is *nofail* if it never fails for any string
+** (including the empty string).
+** The difference is only for predicates and run-time captures;
+** for other patterns, the two properties are equivalent.
+** (With predicates, &'a' is nullable but not nofail. Of course,
+** nofail => nullable.)
+** These functions are all convervative in the following way:
+** p is nullable => nullable(p)
+** nofail(p) => p cannot fail
+** The function assumes that TOpenCall is not nullable;
+** this will be checked again when the grammar is fixed.)
+** Run-time captures can do whatever they want, so the result
+** is conservative.
*/
-static int value2fenv (lua_State *L, int vidx) {
- lua_createtable(L, 1, 0);
- lua_pushvalue(L, vidx);
- lua_rawseti(L, -2, 1);
- lua_setfenv(L, -2);
- return 1;
+int checkaux (TTree *tree, int pred) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny:
+ case TFalse: case TOpenCall:
+ return 0; /* not nullable */
+ case TRep: case TTrue:
+ return 1; /* no fail */
+ case TNot: case TBehind: /* can match empty, but can fail */
+ if (pred == PEnofail) return 0;
+ else return 1; /* PEnullable */
+ case TAnd: /* can match empty; fail iff body does */
+ if (pred == PEnullable) return 1;
+ /* else return checkaux(sib1(tree), pred); */
+ tree = sib1(tree); goto tailcall;
+ case TRunTime: /* can fail; match empty iff body does */
+ if (pred == PEnofail) return 0;
+ /* else return checkaux(sib1(tree), pred); */
+ tree = sib1(tree); goto tailcall;
+ case TSeq:
+ if (!checkaux(sib1(tree), pred)) return 0;
+ /* else return checkaux(sib2(tree), pred); */
+ tree = sib2(tree); goto tailcall;
+ case TChoice:
+ if (checkaux(sib2(tree), pred)) return 1;
+ /* else return checkaux(sib1(tree), pred); */
+ tree = sib1(tree); goto tailcall;
+ case TCapture: case TGrammar: case TRule:
+ /* return checkaux(sib1(tree), pred); */
+ tree = sib1(tree); goto tailcall;
+ case TCall: /* return checkaux(sib2(tree), pred); */
+ tree = sib2(tree); goto tailcall;
+ default: assert(0); return 0;
+ };
}
-static Instruction *newpatt (lua_State *L, size_t n) {
- Instruction *p;
- if (n >= MAXPATTSIZE - 1)
- luaL_error(L, "pattern too big");
- p = (Instruction *)lua_newuserdata(L, (n + 1) * sizeof(Instruction));
- luaL_getmetatable(L, PATTERN_T);
- lua_setmetatable(L, -2);
- setinst(p + n, IEnd, 0);
- return p;
+/*
+** number of characters to match a pattern (or -1 if variable)
+** ('count' avoids infinite loops for grammars)
+*/
+int fixedlenx (TTree *tree, int count, int len) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny:
+ return len + 1;
+ case TFalse: case TTrue: case TNot: case TAnd: case TBehind:
+ return len;
+ case TRep: case TRunTime: case TOpenCall:
+ return -1;
+ case TCapture: case TRule: case TGrammar:
+ /* return fixedlenx(sib1(tree), count); */
+ tree = sib1(tree); goto tailcall;
+ case TCall:
+ if (count++ >= MAXRULES)
+ return -1; /* may be a loop */
+ /* else return fixedlenx(sib2(tree), count); */
+ tree = sib2(tree); goto tailcall;
+ case TSeq: {
+ len = fixedlenx(sib1(tree), count, len);
+ if (len < 0) return -1;
+ /* else return fixedlenx(sib2(tree), count, len); */
+ tree = sib2(tree); goto tailcall;
+ }
+ case TChoice: {
+ int n1, n2;
+ n1 = fixedlenx(sib1(tree), count, len);
+ if (n1 < 0) return -1;
+ n2 = fixedlenx(sib2(tree), count, len);
+ if (n1 == n2) return n1;
+ else return -1;
+ }
+ default: assert(0); return 0;
+ };
}
-static void fillcharset (Instruction *p, Charset cs) {
- switch (p[0].i.code) {
- case ISet: {
- loopset(i, cs[i] = p[1].buff[i]);
- break;
+/*
+** Computes the 'first set' of a pattern.
+** The result is a conservative aproximation:
+** match p ax -> x' for some x ==> a in first(p).
+** The set 'follow' is the first set of what follows the
+** pattern (full set if nothing follows it).
+** The function returns 0 when this set can be used for
+** tests that avoid the pattern altogether.
+** A non-zero return can happen for two reasons:
+** 1) match p '' -> '' ==> returns 1.
+** (tests cannot be used because they always fail for an empty input)
+** 2) there is a match-time capture ==> returns 2.
+** (match-time captures should not be avoided by optimizations)
+*/
+static int getfirst (TTree *tree, const Charset *follow, Charset *firstset) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny: {
+ tocharset(tree, firstset);
+ return 0;
}
- case IChar: {
- loopset(i, cs[i] = 0);
- setchar(cs, p[0].i.aux);
- break;
+ case TTrue: {
+ loopset(i, firstset->cs[i] = follow->cs[i]);
+ return 1;
}
- default: { /* any char may start unhandled instructions */
- loopset(i, cs[i] = 0xff);
- break;
+ case TFalse: {
+ loopset(i, firstset->cs[i] = 0);
+ return 0;
+ }
+ case TChoice: {
+ Charset csaux;
+ int e1 = getfirst(sib1(tree), follow, firstset);
+ int e2 = getfirst(sib2(tree), follow, &csaux);
+ loopset(i, firstset->cs[i] |= csaux.cs[i]);
+ return e1 | e2;
+ }
+ case TSeq: {
+ if (!nullable(sib1(tree))) {
+ /* return getfirst(sib1(tree), fullset, firstset); */
+ tree = sib1(tree); follow = fullset; goto tailcall;
+ }
+ else { /* FIRST(p1 p2, fl) = FIRST(p1, FIRST(p2, fl)) */
+ Charset csaux;
+ int e2 = getfirst(sib2(tree), follow, &csaux);
+ int e1 = getfirst(sib1(tree), &csaux, firstset);
+ if (e1 == 0) return 0; /* 'e1' ensures that first can be used */
+ else if ((e1 | e2) & 2) /* one of the children has a matchtime? */
+ return 2; /* pattern has a matchtime capture */
+ else return e2; /* else depends on 'e2' */
+ }
+ }
+ case TRep: {
+ getfirst(sib1(tree), follow, firstset);
+ loopset(i, firstset->cs[i] |= follow->cs[i]);
+ return 1; /* accept the empty string */
+ }
+ case TCapture: case TGrammar: case TRule: {
+ /* return getfirst(sib1(tree), follow, firstset); */
+ tree = sib1(tree); goto tailcall;
+ }
+ case TRunTime: { /* function invalidates any follow info. */
+ int e = getfirst(sib1(tree), fullset, firstset);
+ if (e) return 2; /* function is not "protected"? */
+ else return 0; /* pattern inside capture ensures first can be used */
}
+ case TCall: {
+ /* return getfirst(sib2(tree), follow, firstset); */
+ tree = sib2(tree); goto tailcall;
+ }
+ case TAnd: {
+ int e = getfirst(sib1(tree), follow, firstset);
+ loopset(i, firstset->cs[i] &= follow->cs[i]);
+ return e;
+ }
+ case TNot: {
+ if (tocharset(sib1(tree), firstset)) {
+ cs_complement(firstset);
+ return 1;
+ }
+ /* else go through */
+ }
+ case TBehind: { /* instruction gives no new information */
+ /* call 'getfirst' to check for math-time captures */
+ int e = getfirst(sib1(tree), follow, firstset);
+ loopset(i, firstset->cs[i] = follow->cs[i]); /* uses follow */
+ return e | 1; /* always can accept the empty string */
+ }
+ default: assert(0); return 0;
}
}
/*
-** Function 'tocharset' gets information about which chars may be a
-** valid start for a pattern.
+** If it returns true, then pattern can fail only depending on the next
+** character of the subject
*/
-
-static enum charsetanswer tocharset (Instruction *p, CharsetTag *c) {
- if (isfixcheck(p)) {
- fillcharset(p, c->cs);
- if ((p + sizei(p))->i.code == IEnd && op_step(p) == 1)
- c->tag = ISCHARSET;
- else
- c->tag = VALIDSTARTS;
+static int headfail (TTree *tree) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny: case TFalse:
+ return 1;
+ case TTrue: case TRep: case TRunTime: case TNot:
+ case TBehind:
+ return 0;
+ case TCapture: case TGrammar: case TRule: case TAnd:
+ tree = sib1(tree); goto tailcall; /* return headfail(sib1(tree)); */
+ case TCall:
+ tree = sib2(tree); goto tailcall; /* return headfail(sib2(tree)); */
+ case TSeq:
+ if (!nofail(sib2(tree))) return 0;
+ /* else return headfail(sib1(tree)); */
+ tree = sib1(tree); goto tailcall;
+ case TChoice:
+ if (!headfail(sib1(tree))) return 0;
+ /* else return headfail(sib2(tree)); */
+ tree = sib2(tree); goto tailcall;
+ default: assert(0); return 0;
}
- else
- c->tag = NOINFO;
- return c->tag;
}
-static int exclusiveset (Charset c1, Charset c2) {
- /* non-empty intersection? */
- loopset(i, {if ((c1[i] & c2[i]) != 0) return 0;});
- return 1; /* no intersection */
+/*
+** Check whether the code generation for the given tree can benefit
+** from a follow set (to avoid computing the follow set when it is
+** not needed)
+*/
+static int needfollow (TTree *tree) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny:
+ case TFalse: case TTrue: case TAnd: case TNot:
+ case TRunTime: case TGrammar: case TCall: case TBehind:
+ return 0;
+ case TChoice: case TRep:
+ return 1;
+ case TCapture:
+ tree = sib1(tree); goto tailcall;
+ case TSeq:
+ tree = sib2(tree); goto tailcall;
+ default: assert(0); return 0;
+ }
}
-
-static int exclusive (CharsetTag *c1, CharsetTag *c2) {
- if (c1->tag == NOINFO || c2->tag == NOINFO)
- return 0; /* one of them is not filled */
- else return exclusiveset(c1->cs, c2->cs);
-}
+/* }====================================================== */
-static Instruction *newcharset (lua_State *L) {
- Instruction *p = newpatt(L, CHARSETINSTSIZE);
- p[0].i.code = ISet;
- p[0].i.offset = 0;
- loopset(i, p[1].buff[i] = 0);
- return p;
-}
-
-static int set_l (lua_State *L) {
- size_t l;
- const char *s = luaL_checklstring(L, 1, &l);
- if (l == 1)
- getpatt(L, 1, NULL); /* a unit set is equivalent to a literal */
- else {
- Instruction *p = newcharset(L);
- while (l--) {
- setchar(p[1].buff, (byte)(*s));
- s++;
- }
- }
- return 1;
-}
+/*
+** {======================================================
+** Code generation
+** =======================================================
+*/
-static int range_l (lua_State *L) {
- int arg;
- int top = lua_gettop(L);
- Instruction *p = newcharset(L);
- for (arg = 1; arg <= top; arg++) {
- int c;
- size_t l;
- const char *r = luaL_checklstring(L, arg, &l);
- luaL_argcheck(L, l == 2, arg, "range must have two characters");
- for (c = (byte)r[0]; c <= (byte)r[1]; c++)
- setchar(p[1].buff, c);
+/*
+** size of an instruction
+*/
+int sizei (const Instruction *i) {
+ switch((Opcode)i->i.code) {
+ case ISet: case ISpan: return CHARSETINSTSIZE;
+ case ITestSet: return CHARSETINSTSIZE + 1;
+ case ITestChar: case ITestAny: case IChoice: case IJmp:
+ case ICall: case IOpenCall: case ICommit: case IPartialCommit:
+ case IBackCommit: return 2;
+ default: return 1;
}
- return 1;
}
-static int nter_l (lua_State *L) {
- Instruction *p;
- luaL_argcheck(L, !lua_isnoneornil(L, 1), 1, "non-nil value expected");
- p = newpatt(L, 1);
- setinst(p, IOpenCall, value2fenv(L, 1));
- return 1;
-}
-
-
-
-static int testpattern (lua_State *L, int idx) {
- if (lua_touserdata(L, idx)) { /* value is a userdata? */
- if (lua_getmetatable(L, idx)) { /* does it have a metatable? */
- luaL_getmetatable(L, PATTERN_T);
- if (lua_rawequal(L, -1, -2)) { /* does it have the correct mt? */
- lua_pop(L, 2); /* remove both metatables */
- return 1;
- }
- }
- }
- return 0;
-}
+/*
+** state for the compiler
+*/
+typedef struct CompileState {
+ Pattern *p; /* pattern being compiled */
+ int ncode; /* next position in p->code to be filled */
+ lua_State *L;
+} CompileState;
-static Instruction *fix_l (lua_State *L, int t) {
- Instruction *p;
- int i;
- int totalsize = 2; /* include initial call and jump */
- int n = 0; /* number of rules */
- int base = lua_gettop(L);
- lua_newtable(L); /* to store relative positions of each rule */
- lua_pushinteger(L, 1); /* default initial rule */
- /* collect patterns and compute sizes */
- lua_pushnil(L);
- while (lua_next(L, t) != 0) {
- int l;
- if (lua_tonumber(L, -2) == 1 && lua_isstring(L, -1)) {
- lua_replace(L, base + 2); /* use this value as initial rule */
- continue;
- }
- if (!testpattern(L, -1))
- luaL_error(L, "%s is not a pattern", val2str(L, -2));
- l = pattsize(L, -1) + 1; /* space for pattern + ret */
- if (totalsize >= MAXPATTSIZE - l)
- luaL_error(L, "grammar too large");
- luaL_checkstack(L, LUA_MINSTACK, "grammar has too many rules");
- lua_insert(L, -2); /* put key on top */
- lua_pushvalue(L, -1); /* duplicate key (for lua_next) */
- lua_pushvalue(L, -1); /* duplicate key (to index positions table)) */
- lua_pushinteger(L, totalsize); /* position for this rule */
- lua_settable(L, base + 1); /* store key=>position in positions table */
- totalsize += l;
- n++;
- }
- luaL_argcheck(L, n > 0, t, "empty grammar");
- p = newpatt(L, totalsize); /* create new pattern */
- p++; /* save space for call */
- setinst(p++, IJmp, totalsize - 1); /* after call, jumps to the end */
- for (i = 1; i <= n; i++) { /* copy all rules into new pattern */
- p += addpatt(L, p, base + 1 + i*2);
- setinst(p++, IRet, 0);
- }
- p -= totalsize; /* back to first position */
- totalsize = 2; /* go through each rule's position */
- for (i = 1; i <= n; i++) { /* check all rules */
- int l = pattsize(L, base + 1 + i*2) + 1;
- checkrule(L, p, totalsize, totalsize + l, base + 1, base + 2 + i*2);
- totalsize += l;
- }
- lua_pushvalue(L, base + 2); /* get initial rule */
- lua_gettable(L, base + 1); /* get its position in postions table */
- i = lua_tonumber(L, -1); /* convert to number */
- lua_pop(L, 1);
- if (i == 0) /* is it defined? */
- luaL_error(L, "initial rule not defined in given grammar");
- setinst(p, ICall, i); /* first instruction calls initial rule */
- /* correct calls */
- for (i = 0; i < totalsize; i += sizei(p + i)) {
- if (p[i].i.code == IOpenCall) {
- int pos = getposition(L, base + 1, p[i].i.offset);
- p[i].i.code = (p[target(p, i + 1)].i.code == IRet) ? IJmp : ICall;
- p[i].i.offset = pos - i;
- }
- }
- optimizejumps(p);
- lua_replace(L, t); /* put new pattern in old's position */
- lua_settop(L, base); /* remove rules and positions table */
- return p;
-}
+/*
+** code generation is recursive; 'opt' indicates that the code is
+** being generated under a 'IChoice' operator jumping to its end.
+** 'tt' points to a previous test protecting this code. 'fl' is
+** the follow set of the pattern.
+*/
+static void codegen (CompileState *compst, TTree *tree, int opt, int tt,
+ const Charset *fl);
-static Instruction *any (lua_State *L, int n, int extra, int *offsetp) {
- int offset = offsetp ? *offsetp : 0;
- Instruction *p = newpatt(L, (n - 1)/UCHAR_MAX + extra + 1);
- Instruction *p1 = p + offset;
- for (; n > UCHAR_MAX; n -= UCHAR_MAX)
- setinstaux(p1++, IAny, 0, UCHAR_MAX);
- setinstaux(p1++, IAny, 0, n);
- if (offsetp) *offsetp = p1 - p;
- return p;
+void reallocprog (lua_State *L, Pattern *p, int nsize) {
+ void *ud;
+ lua_Alloc f = lua_getallocf(L, &ud);
+ void *newblock = f(ud, p->code, p->codesize * sizeof(Instruction),
+ nsize * sizeof(Instruction));
+ if (newblock == NULL && nsize > 0)
+ luaL_error(L, "not enough memory");
+ p->code = (Instruction *)newblock;
+ p->codesize = nsize;
}
-static Instruction *getpatt (lua_State *L, int idx, int *size) {
- Instruction *p;
- switch (lua_type(L, idx)) {
- case LUA_TSTRING: {
- size_t i, len;
- const char *s = lua_tolstring(L, idx, &len);
- p = newpatt(L, len);
- for (i = 0; i < len; i++)
- setinstaux(p + i, IChar, 0, (byte)s[i]);
- lua_replace(L, idx);
- break;
- }
- case LUA_TNUMBER: {
- int n = lua_tointeger(L, idx);
- if (n == 0) /* empty pattern? */
- p = newpatt(L, 0);
- else if (n > 0)
- p = any(L, n, 0, NULL);
- else if (-n <= UCHAR_MAX) {
- p = newpatt(L, 2);
- setinstaux(p, IAny, 2, -n);
- setinst(p + 1, IFail, 0);
- }
- else {
- int offset = 2; /* space for ITestAny & IChoice */
- p = any(L, -n - UCHAR_MAX, 3, &offset);
- setinstaux(p, IAny, offset + 1, UCHAR_MAX);
- setinstaux(p + 1, IChoice, offset, UCHAR_MAX);
- setinst(p + offset, IFailTwice, 0);
- }
- lua_replace(L, idx);
- break;
- }
- case LUA_TBOOLEAN: {
- if (lua_toboolean(L, idx)) /* true? */
- p = newpatt(L, 0); /* empty pattern (always succeeds) */
- else {
- p = newpatt(L, 1);
- setinst(p, IFail, 0);
- }
- lua_replace(L, idx);
- break;
- }
- case LUA_TTABLE: {
- p = fix_l(L, idx);
- break;
- }
- case LUA_TFUNCTION: {
- p = newpatt(L, 2);
- setinstcap(p, IOpenCapture, value2fenv(L, idx), Cruntime, 0);
- setinstcap(p + 1, ICloseRunTime, 0, Cclose, 0);
- lua_replace(L, idx);
- break;
- }
- default: {
- p = checkpattern(L, idx);
- break;
- }
- }
- if (size) *size = pattsize(L, idx);
- return p;
+static int nextinstruction (CompileState *compst) {
+ int size = compst->p->codesize;
+ if (compst->ncode >= size)
+ reallocprog(compst->L, compst->p, size * 2);
+ return compst->ncode++;
}
-static int getpattl (lua_State *L, int idx) {
- int size;
- getpatt(L, idx, &size);
- return size;
-}
+#define getinstr(cs,i) ((cs)->p->code[i])
-static int pattern_l (lua_State *L) {
- lua_settop(L, 1);
- getpatt(L, 1, NULL);
- return 1;
+static int addinstruction (CompileState *compst, Opcode op, int aux) {
+ int i = nextinstruction(compst);
+ getinstr(compst, i).i.code = op;
+ getinstr(compst, i).i.aux = aux;
+ return i;
}
-#define isany(p) ((p)->i.code == IAny && ((p) + 1)->i.code == IEnd)
-#define isfail(p) ((p)->i.code == IFail)
-#define issucc(p) ((p)->i.code == IEnd)
-
-static int concat_l (lua_State *L) {
- /* p1; p2; */
- int l1, l2;
- Instruction *p1 = getpatt(L, 1, &l1);
- Instruction *p2 = getpatt(L, 2, &l2);
- if (isfail(p1) || issucc(p2))
- lua_pushvalue(L, 1); /* fail * x == fail; x * true == x */
- else if (isfail(p2) || issucc(p1))
- lua_pushvalue(L, 2); /* x * fail == fail; true * x == x */
- else if (isany(p1) && isany(p2))
- any(L, p1->i.aux + p2->i.aux, 0, NULL);
- else {
- Instruction *op = newpatt(L, l1 + l2);
- Instruction *p = op + addpatt(L, op, 1);
- addpatt(L, p, 2);
- optimizecaptures(op);
- }
- return 1;
+static int addoffsetinst (CompileState *compst, Opcode op) {
+ int i = addinstruction(compst, op, 0); /* instruction */
+ addinstruction(compst, (Opcode)0, 0); /* open space for offset */
+ assert(op == ITestSet || sizei(&getinstr(compst, i)) == 2);
+ return i;
}
-static int diff_l (lua_State *L) {
- int l1, l2;
- Instruction *p1 = getpatt(L, 1, &l1);
- Instruction *p2 = getpatt(L, 2, &l2);
- CharsetTag st1, st2;
- if (tocharset(p1, &st1) == ISCHARSET && tocharset(p2, &st2) == ISCHARSET) {
- Instruction *p = newcharset(L);
- loopset(i, p[1].buff[i] = st1.cs[i] & ~st2.cs[i]);
- }
- else if (isheadfail(p2)) {
- Instruction *p = newpatt(L, l2 + 1 + l1);
- p += addpatt(L, p, 2);
- check2test(p - l2, l2 + 1);
- setinst(p++, IFail, 0);
- addpatt(L, p, 1);
- }
- else { /* !e2 . e1 */
- /* !e -> choice L1; e; failtwice; L1: ... */
- Instruction *p = newpatt(L, 1 + l2 + 1 + l1);
- Instruction *pi = p;
- setinst(p++, IChoice, 1 + l2 + 1);
- p += addpatt(L, p, 2);
- setinst(p++, IFailTwice, 0);
- addpatt(L, p, 1);
- optimizechoice(pi);
- }
- return 1;
+static void setoffset (CompileState *compst, int instruction, int offset) {
+ getinstr(compst, instruction + 1).offset = offset;
}
-static int unm_l (lua_State *L) {
- Instruction *p = getpatt(L, 1, NULL);
- if (isfail(p)) { /* -false? */
- newpatt(L, 0); /* true */
- return 1;
- }
- else if (issucc(p)) { /* -true? */
- Instruction *p1 = newpatt(L, 1); /* false */
- setinst(p1, IFail, 0);
- return 1;
- }
- else { /* -A == '' - A */
- lua_pushliteral(L, "");
- lua_insert(L, 1);
- return diff_l(L);
- }
+/*
+** Add a capture instruction:
+** 'op' is the capture instruction; 'cap' the capture kind;
+** 'key' the key into ktable; 'aux' is optional offset
+**
+*/
+static int addinstcap (CompileState *compst, Opcode op, int cap, int key,
+ int aux) {
+ int i = addinstruction(compst, op, joinkindoff(cap, aux));
+ getinstr(compst, i).i.key = key;
+ return i;
}
-static int pattand_l (lua_State *L) {
- int l1;
- CharsetTag st1;
- Instruction *p1 = getpatt(L, 1, &l1);
- if (isfail(p1) || issucc(p1))
- lua_pushvalue(L, 1); /* &fail == fail; &true == true */
- else if (tocharset(p1, &st1) == ISCHARSET) {
- Instruction *p = newpatt(L, l1 + 1);
- copypatt(p, p1, l1); p += l1;
- setinstaux(p, IBack, 0, 1);
- }
- else { /* Choice L1; p1; BackCommit L2; L1: Fail; L2: */
- Instruction *p = newpatt(L, 1 + l1 + 2);
- setinst(p++, IChoice, 1 + l1 + 1);
- p += addpatt(L, p, 1);
- setinst(p++, IBackCommit, 2);
- setinst(p, IFail, 0);
- }
- return 1;
-}
-
+#define gethere(compst) ((compst)->ncode)
-static int nocalls (const Instruction *p) {
- for (; (Opcode)p->i.code != IEnd; p += sizei(p))
- if ((Opcode)p->i.code == IOpenCall) return 0;
- return 1;
-}
+#define target(code,i) ((i) + code[i + 1].offset)
-static int pattbehind (lua_State *L) {
- int l1;
- CharsetTag st1;
- Instruction *p1 = getpatt(L, 1, &l1);
- int n = luaL_optint(L, 2, 1);
- luaL_argcheck(L, n <= MAXAUX, 2, "lookbehind delta too large");
- if (!nocalls(p1))
- luaL_error(L, "lookbehind pattern cannot contain non terminals");
- if (isfail(p1) || issucc(p1))
- lua_pushvalue(L, 1); /* <fail == fail; <true == true */
- else if (n == 1 && tocharset(p1, &st1) == ISCHARSET) {
- Instruction *p = newpatt(L, 1 + l1);
- setinstaux(p, IBack, 0, 1); p++;
- copypatt(p, p1, l1);
- }
- else { /* Choice L1; Back; p1; BackCommit L2; L1: fail; L2: */
- Instruction *p = newpatt(L, 2 + l1 + 2);
- setinst(p++, IChoice, 2 + l1 + 1);
- setinstaux(p++, IBack, 0, n);
- p += addpatt(L, p, 1);
- setinst(p++, IBackCommit, 2);
- setinst(p, IFail, 0);
- }
- return 1;
+static void jumptothere (CompileState *compst, int instruction, int target) {
+ if (instruction >= 0)
+ setoffset(compst, instruction, target - instruction);
}
-
-static int firstpart (Instruction *p, int l) {
- if (istest(p)) {
- int e = p[0].i.offset - 1;
- if ((p[e].i.code == IJmp || p[e].i.code == ICommit) &&
- e + p[e].i.offset == l)
- return e + 1;
- }
- else if (p[0].i.code == IChoice) {
- int e = p[0].i.offset - 1;
- if (p[e].i.code == ICommit && e + p[e].i.offset == l)
- return e + 1;
- }
- return 0;
+static void jumptohere (CompileState *compst, int instruction) {
+ jumptothere(compst, instruction, gethere(compst));
}
-static Instruction *auxnew (lua_State *L, Instruction **op, int *size,
- int extra) {
- *op = newpatt(L, *size + extra);
- jointable(L, 1);
- *size += extra;
- return *op + *size - extra;
+/*
+** Code an IChar instruction, or IAny if there is an equivalent
+** test dominating it
+*/
+static void codechar (CompileState *compst, int c, int tt) {
+ if (tt >= 0 && getinstr(compst, tt).i.code == ITestChar &&
+ getinstr(compst, tt).i.aux == c)
+ addinstruction(compst, IAny, 0);
+ else
+ addinstruction(compst, IChar, c);
}
-static int nofail (Instruction *p, int l) {
+/*
+** Add a charset posfix to an instruction
+*/
+static void addcharset (CompileState *compst, const byte *cs) {
+ int p = gethere(compst);
int i;
- for (i = 0; i < l; i += sizei(p + i)) {
- if (!isnofail(p + i)) return 0;
- }
- return 1;
+ for (i = 0; i < (int)CHARSETINSTSIZE - 1; i++)
+ nextinstruction(compst); /* space for buffer */
+ /* fill buffer with charset */
+ loopset(j, getinstr(compst, p).buff[j] = cs[j]);
}
-static int interfere (Instruction *p1, int l1, CharsetTag *st2) {
- if (nofail(p1, l1)) /* p1 cannot fail? */
- return 0; /* nothing can intefere with it */
- if (st2->tag == NOINFO) return 1;
- assert(p1->i.offset != 0);
- switch (p1->i.code) {
- case IChar: return testchar(st2->cs, p1->i.aux);
- case ISet: return !exclusiveset(st2->cs, (p1 + 1)->buff);
- default: assert(p1->i.code == IAny); return 1;
+/*
+** code a char set, optimizing unit sets for IChar, "complete"
+** sets for IAny, and empty sets for IFail; also use an IAny
+** when instruction is dominated by an equivalent test.
+*/
+static void codecharset (CompileState *compst, const byte *cs, int tt) {
+ int c = 0; /* (=) to avoid warnings */
+ Opcode op = charsettype(cs, &c);
+ switch (op) {
+ case IChar: codechar(compst, c, tt); break;
+ case ISet: { /* non-trivial set? */
+ if (tt >= 0 && getinstr(compst, tt).i.code == ITestSet &&
+ cs_equal(cs, getinstr(compst, tt + 2).buff))
+ addinstruction(compst, IAny, 0);
+ else {
+ addinstruction(compst, ISet, 0);
+ addcharset(compst, cs);
+ }
+ break;
+ }
+ default: addinstruction(compst, op, c); break;
}
}
-static Instruction *basicUnion (lua_State *L, Instruction *p1, int l1,
- int l2, int *size, CharsetTag *st2) {
- Instruction *op;
- CharsetTag st1;
- tocharset(p1, &st1);
- if (st1.tag == ISCHARSET && st2->tag == ISCHARSET) {
- Instruction *p = auxnew(L, &op, size, CHARSETINSTSIZE);
- setinst(p, ISet, 0);
- loopset(i, p[1].buff[i] = st1.cs[i] | st2->cs[i]);
- }
- else if (exclusive(&st1, st2) || isheadfail(p1)) {
- Instruction *p = auxnew(L, &op, size, l1 + 1 + l2);
- copypatt(p, p1, l1);
- check2test(p, l1 + 1);
- p += l1;
- setinst(p++, IJmp, l2 + 1);
- addpatt(L, p, 2);
- }
- else {
- /* choice L1; e1; commit L2; L1: e2; L2: ... */
- Instruction *p = auxnew(L, &op, size, 1 + l1 + 1 + l2);
- setinst(p++, IChoice, 1 + l1 + 1);
- copypatt(p, p1, l1); p += l1;
- setinst(p++, ICommit, 1 + l2);
- addpatt(L, p, 2);
- optimizechoice(p - (1 + l1 + 1));
- }
- return op;
-}
-
-
-static Instruction *separateparts (lua_State *L, Instruction *p1, int l1,
- int l2, int *size, CharsetTag *st2) {
- int sp = firstpart(p1, l1);
- if (sp == 0) /* first part is entire p1? */
- return basicUnion(L, p1, l1, l2, size, st2);
- else if ((p1 + sp - 1)->i.code == ICommit || !interfere(p1, sp, st2)) {
- Instruction *p;
- int init = *size;
- int end = init + sp;
- *size = end;
- p = separateparts(L, p1 + sp, l1 - sp, l2, size, st2);
- copypatt(p + init, p1, sp);
- (p + end - 1)->i.offset = *size - (end - 1);
- return p;
- }
- else { /* must change back to non-optimized choice */
- Instruction *p;
- int init = *size;
- int end = init + sp + 1; /* needs one extra instruction (choice) */
- int sizefirst = sizei(p1); /* size of p1's first instruction (the test) */
- *size = end;
- p = separateparts(L, p1 + sp, l1 - sp, l2, size, st2);
- copypatt(p + init, p1, sizefirst); /* copy the test */
- (p + init)->i.offset++; /* correct jump (because of new instruction) */
- init += sizefirst;
- setinstaux(p + init, IChoice, sp - sizefirst + 1, 1); init++;
- copypatt(p + init, p1 + sizefirst, sp - sizefirst - 1);
- init += sp - sizefirst - 1;
- setinst(p + init, ICommit, *size - (end - 1));
- return p;
- }
-}
-
-
-static int union_l (lua_State *L) {
- int l1, l2;
- int size = 0;
- Instruction *p1 = getpatt(L, 1, &l1);
- Instruction *p2 = getpatt(L, 2, &l2);
- CharsetTag st2;
- if (isfail(p1)) /* check for simple identities */
- lua_pushvalue(L, 2); /* fail / a == a */
- else if (isfail(p2) || issucc(p1))
- lua_pushvalue(L, 1); /* a / fail == a; true / a == true */
+/*
+** code a test set, optimizing unit sets for ITestChar, "complete"
+** sets for ITestAny, and empty sets for IJmp (always fails).
+** 'e' is true iff test should accept the empty string. (Test
+** instructions in the current VM never accept the empty string.)
+*/
+static int codetestset (CompileState *compst, Charset *cs, int e) {
+ if (e) return NOINST; /* no test */
else {
- tocharset(p2, &st2);
- separateparts(L, p1, l1, l2, &size, &st2);
+ int c = 0;
+ Opcode op = charsettype(cs->cs, &c);
+ switch (op) {
+ case IFail: return addoffsetinst(compst, IJmp); /* always jump */
+ case IAny: return addoffsetinst(compst, ITestAny);
+ case IChar: {
+ int i = addoffsetinst(compst, ITestChar);
+ getinstr(compst, i).i.aux = c;
+ return i;
+ }
+ case ISet: {
+ int i = addoffsetinst(compst, ITestSet);
+ addcharset(compst, cs->cs);
+ return i;
+ }
+ default: assert(0); return 0;
+ }
}
- return 1;
}
-static int repeatcharset (lua_State *L, Charset cs, int l1, int n) {
- /* e; ...; e; span; */
- int i;
- Instruction *p = newpatt(L, n*l1 + CHARSETINSTSIZE);
- for (i = 0; i < n; i++) {
- p += addpatt(L, p, 1);
- }
- setinst(p, ISpan, 0);
- loopset(k, p[1].buff[k] = cs[k]);
- return 1;
+/*
+** Find the final destination of a sequence of jumps
+*/
+static int finaltarget (Instruction *code, int i) {
+ while (code[i].i.code == IJmp)
+ i = target(code, i);
+ return i;
}
-static Instruction *repeatheadfail (lua_State *L, int l1, int n) {
- /* e; ...; e; L2: e'(L1); jump L2; L1: ... */
- int i;
- Instruction *p = newpatt(L, (n + 1)*l1 + 1);
- Instruction *op = p;
- for (i = 0; i < n; i++) {
- p += addpatt(L, p, 1);
- }
- p += addpatt(L, p, 1);
- check2test(p - l1, l1 + 1);
- setinst(p, IJmp, -l1);
- return op;
+/*
+** final label (after traversing any jumps)
+*/
+static int finallabel (Instruction *code, int i) {
+ return finaltarget(code, target(code, i));
}
-static Instruction *repeats (lua_State *L, Instruction *p1, int l1, int n) {
- /* e; ...; e; choice L1; L2: e; partialcommit L2; L1: ... */
- int i;
- Instruction *op = newpatt(L, (n + 1)*l1 + 2);
- Instruction *p = op;
- if (!verify(L, p1, p1, p1 + l1, 0, 0))
- luaL_error(L, "loop body may accept empty string");
- for (i = 0; i < n; i++) {
- p += addpatt(L, p, 1);
- }
- setinst(p++, IChoice, 1 + l1 + 1);
- p += addpatt(L, p, 1);
- setinst(p, IPartialCommit, -l1);
- return op;
+/*
+** <behind(p)> == behind n; <p> (where n = fixedlen(p))
+*/
+static void codebehind (CompileState *compst, TTree *tree) {
+ if (tree->u.n > 0)
+ addinstruction(compst, IBehind, tree->u.n);
+ codegen(compst, sib1(tree), 0, NOINST, fullset);
}
-static void optionalheadfail (lua_State *L, int l1, int n) {
- Instruction *op = newpatt(L, n * l1);
- Instruction *p = op;
- int i;
- for (i = 0; i < n; i++) {
- p += addpatt(L, p, 1);
- check2test(p - l1, (n - i)*l1);
+/*
+** Choice; optimizations:
+** - when p1 is headfail
+** - when first(p1) and first(p2) are disjoint; than
+** a character not in first(p1) cannot go to p1, and a character
+** in first(p1) cannot go to p2 (at it is not in first(p2)).
+** (The optimization is not valid if p1 accepts the empty string,
+** as then there is no character at all...)
+** - when p2 is empty and opt is true; a IPartialCommit can resuse
+** the Choice already active in the stack.
+*/
+static void codechoice (CompileState *compst, TTree *p1, TTree *p2, int opt,
+ const Charset *fl) {
+ int emptyp2 = (p2->tag == TTrue);
+ Charset cs1, cs2;
+ int e1 = getfirst(p1, fullset, &cs1);
+ if (headfail(p1) ||
+ (!e1 && (getfirst(p2, fl, &cs2), cs_disjoint(&cs1, &cs2)))) {
+ /* <p1 / p2> == test (fail(p1)) -> L1 ; p1 ; jmp L2; L1: p2; L2: */
+ int test = codetestset(compst, &cs1, 0);
+ int jmp = NOINST;
+ codegen(compst, p1, 0, test, fl);
+ if (!emptyp2)
+ jmp = addoffsetinst(compst, IJmp);
+ jumptohere(compst, test);
+ codegen(compst, p2, opt, NOINST, fl);
+ jumptohere(compst, jmp);
+ }
+ else if (opt && emptyp2) {
+ /* p1? == IPartialCommit; p1 */
+ jumptohere(compst, addoffsetinst(compst, IPartialCommit));
+ codegen(compst, p1, 1, NOINST, fullset);
+ }
+ else {
+ /* <p1 / p2> ==
+ test(fail(p1)) -> L1; choice L1; <p1>; commit L2; L1: <p2>; L2: */
+ int pcommit;
+ int test = codetestset(compst, &cs1, e1);
+ int pchoice = addoffsetinst(compst, IChoice);
+ codegen(compst, p1, emptyp2, test, fullset);
+ pcommit = addoffsetinst(compst, ICommit);
+ jumptohere(compst, pchoice);
+ jumptohere(compst, test);
+ codegen(compst, p2, opt, NOINST, fl);
+ jumptohere(compst, pcommit);
}
}
-static void optionals (lua_State *L, int l1, int n) {
- /* choice L1; e; partialcommit L2; L2: ... e; L1: commit L3; L3: ... */
- int i;
- Instruction *op = newpatt(L, n*(l1 + 1) + 1);
- Instruction *p = op;
- setinst(p++, IChoice, 1 + n*(l1 + 1));
- for (i = 0; i < n; i++) {
- p += addpatt(L, p, 1);
- setinst(p++, IPartialCommit, 1);
+/*
+** And predicate
+** optimization: fixedlen(p) = n ==> <&p> == <p>; behind n
+** (valid only when 'p' has no captures)
+*/
+static void codeand (CompileState *compst, TTree *tree, int tt) {
+ int n = fixedlen(tree);
+ if (n >= 0 && n <= MAXBEHIND && !hascaptures(tree)) {
+ codegen(compst, tree, 0, tt, fullset);
+ if (n > 0)
+ addinstruction(compst, IBehind, n);
+ }
+ else { /* default: Choice L1; p1; BackCommit L2; L1: Fail; L2: */
+ int pcommit;
+ int pchoice = addoffsetinst(compst, IChoice);
+ codegen(compst, tree, 0, tt, fullset);
+ pcommit = addoffsetinst(compst, IBackCommit);
+ jumptohere(compst, pchoice);
+ addinstruction(compst, IFail, 0);
+ jumptohere(compst, pcommit);
}
- setinst(p - 1, ICommit, 1); /* correct last commit */
- optimizechoice(op);
}
-static int star_l (lua_State *L) {
- int l1;
- int n = luaL_checkint(L, 2);
- Instruction *p1 = getpatt(L, 1, &l1);
- if (n >= 0) {
- CharsetTag st;
- Instruction *op;
- if (tocharset(p1, &st) == ISCHARSET)
- return repeatcharset(L, st.cs, l1, n);
- if (isheadfail(p1))
- op = repeatheadfail(L, l1, n);
- else
- op = repeats(L, p1, l1, n);
- optimizecaptures(op);
- optimizejumps(op);
+/*
+** Captures: if pattern has fixed (and not too big) length, use
+** a single IFullCapture instruction after the match; otherwise,
+** enclose the pattern with OpenCapture - CloseCapture.
+*/
+static void codecapture (CompileState *compst, TTree *tree, int tt,
+ const Charset *fl) {
+ int len = fixedlen(sib1(tree));
+ if (len >= 0 && len <= MAXOFF && !hascaptures(sib1(tree))) {
+ codegen(compst, sib1(tree), 0, tt, fl);
+ addinstcap(compst, IFullCapture, tree->cap, tree->key, len);
}
else {
- if (isheadfail(p1))
- optionalheadfail(L, l1, -n);
- else
- optionals(L, l1, -n);
+ addinstcap(compst, IOpenCapture, tree->cap, tree->key, 0);
+ codegen(compst, sib1(tree), 0, tt, fl);
+ addinstcap(compst, ICloseCapture, Cclose, 0, 0);
}
- return 1;
}
-static int getlabel (lua_State *L, int labelidx) {
- if (labelidx == 0) return 0;
- else return value2fenv(L, labelidx);
+static void coderuntime (CompileState *compst, TTree *tree, int tt) {
+ addinstcap(compst, IOpenCapture, Cgroup, tree->key, 0);
+ codegen(compst, sib1(tree), 0, tt, fullset);
+ addinstcap(compst, ICloseRunTime, Cclose, 0, 0);
}
-static int capture_aux (lua_State *L, int kind, int labelidx) {
- int l1, n;
- Instruction *p1 = getpatt(L, 1, &l1);
- int lc = skipchecks(p1, 0, &n);
- if (lc == l1) { /* got whole pattern? */
- /* may use a IFullCapture instruction at its end */
- Instruction *p = newpatt(L, l1 + 1);
- int label = getlabel(L, labelidx);
- p += addpatt(L, p, 1);
- setinstcap(p, IFullCapture, label, kind, n);
+/*
+** Repetion; optimizations:
+** When pattern is a charset, can use special instruction ISpan.
+** When pattern is head fail, or if it starts with characters that
+** are disjoint from what follows the repetions, a simple test
+** is enough (a fail inside the repetition would backtrack to fail
+** again in the following pattern, so there is no need for a choice).
+** When 'opt' is true, the repetion can reuse the Choice already
+** active in the stack.
+*/
+static void coderep (CompileState *compst, TTree *tree, int opt,
+ const Charset *fl) {
+ Charset st;
+ if (tocharset(tree, &st)) {
+ addinstruction(compst, ISpan, 0);
+ addcharset(compst, st.cs);
}
- else { /* must use open-close pair */
- Instruction *op = newpatt(L, 1 + l1 + 1);
- Instruction *p = op;
- setinstcap(p++, IOpenCapture, getlabel(L, labelidx), kind, 0);
- p += addpatt(L, p, 1);
- setinstcap(p, ICloseCapture, 0, Cclose, 0);
- optimizecaptures(op);
+ else {
+ int e1 = getfirst(tree, fullset, &st);
+ if (headfail(tree) || (!e1 && cs_disjoint(&st, fl))) {
+ /* L1: test (fail(p1)) -> L2; <p>; jmp L1; L2: */
+ int jmp;
+ int test = codetestset(compst, &st, 0);
+ codegen(compst, tree, opt, test, fullset);
+ jmp = addoffsetinst(compst, IJmp);
+ jumptohere(compst, test);
+ jumptothere(compst, jmp, test);
+ }
+ else {
+ /* test(fail(p1)) -> L2; choice L2; L1: <p>; partialcommit L1; L2: */
+ /* or (if 'opt'): partialcommit L1; L1: <p>; partialcommit L1; */
+ int commit, l2;
+ int test = codetestset(compst, &st, e1);
+ int pchoice = NOINST;
+ if (opt)
+ jumptohere(compst, addoffsetinst(compst, IPartialCommit));
+ else
+ pchoice = addoffsetinst(compst, IChoice);
+ l2 = gethere(compst);
+ codegen(compst, tree, 0, NOINST, fullset);
+ commit = addoffsetinst(compst, IPartialCommit);
+ jumptothere(compst, commit, l2);
+ jumptohere(compst, pchoice);
+ jumptohere(compst, test);
+ }
}
- return 1;
}
-static int capture_l (lua_State *L) { return capture_aux(L, Csimple, 0); }
-static int tcapture_l (lua_State *L) { return capture_aux(L, Ctable, 0); }
-static int capsubst_l (lua_State *L) { return capture_aux(L, Csubst, 0); }
-
-static int rcapture_l (lua_State *L) {
- switch (lua_type(L, 2)) {
- case LUA_TFUNCTION: return capture_aux(L, Cfunction, 2);
- case LUA_TTABLE: return capture_aux(L, Cquery, 2);
- case LUA_TSTRING: return capture_aux(L, Cstring, 2);
- default: return luaL_argerror(L, 2, "invalid replacement value");
+/*
+** Not predicate; optimizations:
+** In any case, if first test fails, 'not' succeeds, so it can jump to
+** the end. If pattern is headfail, that is all (it cannot fail
+** in other parts); this case includes 'not' of simple sets. Otherwise,
+** use the default code (a choice plus a failtwice).
+*/
+static void codenot (CompileState *compst, TTree *tree) {
+ Charset st;
+ int e = getfirst(tree, fullset, &st);
+ int test = codetestset(compst, &st, e);
+ if (headfail(tree)) /* test (fail(p1)) -> L1; fail; L1: */
+ addinstruction(compst, IFail, 0);
+ else {
+ /* test(fail(p))-> L1; choice L1; <p>; failtwice; L1: */
+ int pchoice = addoffsetinst(compst, IChoice);
+ codegen(compst, tree, 0, NOINST, fullset);
+ addinstruction(compst, IFailTwice, 0);
+ jumptohere(compst, pchoice);
}
+ jumptohere(compst, test);
}
-static int fold_l (lua_State *L) {
- luaL_checktype(L, 2, LUA_TFUNCTION);
- return capture_aux(L, Cfold, 2);
-}
-
-
-static int group_l (lua_State *L) {
- if (lua_isnoneornil(L, 2))
- return capture_aux(L, Cgroup, 0);
- else {
- luaL_checkstring(L, 2);
- return capture_aux(L, Cgroup, 2);
+/*
+** change open calls to calls, using list 'positions' to find
+** correct offsets; also optimize tail calls
+*/
+static void correctcalls (CompileState *compst, int *positions,
+ int from, int to) {
+ int i;
+ Instruction *code = compst->p->code;
+ for (i = from; i < to; i += sizei(&code[i])) {
+ if (code[i].i.code == IOpenCall) {
+ int n = code[i].i.key; /* rule number */
+ int rule = positions[n]; /* rule position */
+ assert(rule == from || code[rule - 1].i.code == IRet);
+ if (code[finaltarget(code, i + 2)].i.code == IRet) /* call; ret ? */
+ code[i].i.code = IJmp; /* tail call */
+ else
+ code[i].i.code = ICall;
+ jumptothere(compst, i, rule); /* call jumps to respective rule */
+ }
}
+ assert(i == to);
}
-static int position_l (lua_State *L) {
- Instruction *p = newpatt(L, 1);
- setinstcap(p, IEmptyCapture, 0, Cposition, 0);
- return 1;
+/*
+** Code for a grammar:
+** call L1; jmp L2; L1: rule 1; ret; rule 2; ret; ...; L2:
+*/
+static void codegrammar (CompileState *compst, TTree *grammar) {
+ int positions[MAXRULES];
+ int rulenumber = 0;
+ TTree *rule;
+ int firstcall = addoffsetinst(compst, ICall); /* call initial rule */
+ int jumptoend = addoffsetinst(compst, IJmp); /* jump to the end */
+ int start = gethere(compst); /* here starts the initial rule */
+ jumptohere(compst, firstcall);
+ for (rule = sib1(grammar); rule->tag == TRule; rule = sib2(rule)) {
+ positions[rulenumber++] = gethere(compst); /* save rule position */
+ codegen(compst, sib1(rule), 0, NOINST, fullset); /* code rule */
+ addinstruction(compst, IRet, 0);
+ }
+ assert(rule->tag == TTrue);
+ jumptohere(compst, jumptoend);
+ correctcalls(compst, positions, start, gethere(compst));
}
-static int backref_l (lua_State *L) {
- Instruction *p = newpatt(L, 1);
- int n = getlabel(L, 1);
- setinstcap(p, IEmptyCaptureIdx, n, Cbackref, 0);
- return 1;
+static void codecall (CompileState *compst, TTree *call) {
+ int c = addoffsetinst(compst, IOpenCall); /* to be corrected later */
+ getinstr(compst, c).i.key = sib2(call)->cap; /* rule number */
+ assert(sib2(call)->tag == TRule);
}
-static int argcap_l (lua_State *L) {
- int n = luaL_checkint(L, 1);
- Instruction *p = newpatt(L, 1);
- luaL_argcheck(L, 0 < n && n <= SHRT_MAX, 1, "invalid argument index");
- setinstcap(p, IEmptyCapture, n, Carg, 0);
- return 1;
+/*
+** Code first child of a sequence
+** (second child is called in-place to allow tail call)
+** Return 'tt' for second child
+*/
+static int codeseq1 (CompileState *compst, TTree *p1, TTree *p2,
+ int tt, const Charset *fl) {
+ if (needfollow(p1)) {
+ Charset fl1;
+ getfirst(p2, fl, &fl1); /* p1 follow is p2 first */
+ codegen(compst, p1, 0, tt, &fl1);
+ }
+ else /* use 'fullset' as follow */
+ codegen(compst, p1, 0, tt, fullset);
+ if (fixedlen(p1) != 0) /* can 'p1' consume anything? */
+ return NOINST; /* invalidate test */
+ else return tt; /* else 'tt' still protects sib2 */
}
-static int matchtime_l (lua_State *L) {
- int l1 = getpattl(L, 1);
- Instruction *op = newpatt(L, 1 + l1 + 1);
- Instruction *p = op;
- luaL_checktype(L, 2, LUA_TFUNCTION);
- setinstcap(p++, IOpenCapture, value2fenv(L, 2), Cruntime, 0);
- p += addpatt(L, p, 1);
- setinstcap(p, ICloseRunTime, 0, Cclose, 0);
- optimizecaptures(op);
- return 1;
+/*
+** Main code-generation function: dispatch to auxiliar functions
+** according to kind of tree
+*/
+static void codegen (CompileState *compst, TTree *tree, int opt, int tt,
+ const Charset *fl) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: codechar(compst, tree->u.n, tt); break;
+ case TAny: addinstruction(compst, IAny, 0); break;
+ case TSet: codecharset(compst, treebuffer(tree), tt); break;
+ case TTrue: break;
+ case TFalse: addinstruction(compst, IFail, 0); break;
+ case TChoice: codechoice(compst, sib1(tree), sib2(tree), opt, fl); break;
+ case TRep: coderep(compst, sib1(tree), opt, fl); break;
+ case TBehind: codebehind(compst, tree); break;
+ case TNot: codenot(compst, sib1(tree)); break;
+ case TAnd: codeand(compst, sib1(tree), tt); break;
+ case TCapture: codecapture(compst, tree, tt, fl); break;
+ case TRunTime: coderuntime(compst, tree, tt); break;
+ case TGrammar: codegrammar(compst, tree); break;
+ case TCall: codecall(compst, tree); break;
+ case TSeq: {
+ tt = codeseq1(compst, sib1(tree), sib2(tree), tt, fl); /* code 'p1' */
+ /* codegen(compst, p2, opt, tt, fl); */
+ tree = sib2(tree); goto tailcall;
+ }
+ default: assert(0);
+ }
}
-static int capconst_l (lua_State *L) {
- int i, j;
- int n = lua_gettop(L);
- Instruction *p = newpatt(L, n > 1 ? n + 2 : n);
- lua_createtable(L, n, 0); /* new environment for the new pattern */
- if (n > 1) setinstcap(p++, IOpenCapture, 0, Cgroup, 0);
- for (i = j = 1; i <= n; i++) {
- if (lua_isnil(L, i))
- setinstcap(p++, IEmptyCaptureIdx, 0, Cconst, 0);
- else {
- setinstcap(p++, IEmptyCaptureIdx, j, Cconst, 0);
- lua_pushvalue(L, i);
- lua_rawseti(L, -2, j++);
+/*
+** Optimize jumps and other jump-like instructions.
+** * Update labels of instructions with labels to their final
+** destinations (e.g., choice L1; ... L1: jmp L2: becomes
+** choice L2)
+** * Jumps to other instructions that do jumps become those
+** instructions (e.g., jump to return becomes a return; jump
+** to commit becomes a commit)
+*/
+static void peephole (CompileState *compst) {
+ Instruction *code = compst->p->code;
+ int i;
+ for (i = 0; i < compst->ncode; i += sizei(&code[i])) {
+ switch (code[i].i.code) {
+ case IChoice: case ICall: case ICommit: case IPartialCommit:
+ case IBackCommit: case ITestChar: case ITestSet:
+ case ITestAny: { /* instructions with labels */
+ jumptothere(compst, i, finallabel(code, i)); /* optimize label */
+ break;
+ }
+ case IJmp: {
+ int ft = finaltarget(code, i);
+ switch (code[ft].i.code) { /* jumping to what? */
+ case IRet: case IFail: case IFailTwice:
+ case IEnd: { /* instructions with unconditional implicit jumps */
+ code[i] = code[ft]; /* jump becomes that instruction */
+ code[i + 1].i.code = IAny; /* 'no-op' for target position */
+ break;
+ }
+ case ICommit: case IPartialCommit:
+ case IBackCommit: { /* inst. with unconditional explicit jumps */
+ int fft = finallabel(code, ft);
+ code[i] = code[ft]; /* jump becomes that instruction... */
+ jumptothere(compst, i, fft); /* but must correct its offset */
+ i--; /* reoptimize its label */
+ break;
+ }
+ default: {
+ jumptothere(compst, i, ft); /* optimize label */
+ break;
+ }
+ }
+ break;
+ }
+ default: break;
}
}
- if (n > 1) setinstcap(p++, ICloseCapture, 0, Cclose, 0);
- lua_setfenv(L, -2); /* set environment */
- return 1;
+ assert(code[i - 1].i.code == IEnd);
}
-/* }====================================================== */
-
-
/*
-** {======================================================
-** User-Defined Patterns
-** =======================================================
+** Compile a pattern
*/
-
-static void l_newpf (lua_State *L, PattFunc f, const void *ud, size_t l) {
- int n = instsize(l) + 1;
- Instruction *p = newpatt(L, n);
- if (n > MAXAUX) luaL_error(L, "pattern data too long");
- p[0].i.code = IFunc;
- p[0].i.aux = n - 2;
- p[0].i.offset = 0;
- p[1].f = f;
- memcpy(p[2].buff, ud, l);
+Instruction *compile (lua_State *L, Pattern *p) {
+ CompileState compst;
+ compst.p = p; compst.ncode = 0; compst.L = L;
+ reallocprog(L, p, 2); /* minimum initial size */
+ codegen(&compst, p->tree, 0, NOINST, fullset);
+ addinstruction(&compst, IEnd, 0);
+ reallocprog(L, p, compst.ncode); /* set final size */
+ peephole(&compst);
+ return p->code;
}
+
/* }====================================================== */
/*
-** {======================================================
-** Captures
-** =======================================================
+** $Id: lpcap.c,v 1.4 2013/03/21 20:25:12 roberto Exp $
+** Copyright 2007, Lua.org & PUC-Rio (see 'lpeg.html' for license)
*/
+/* #include "lua.h" */
+/* #include "lauxlib.h" */
-typedef struct CapState {
- Capture *cap; /* current capture */
- Capture *ocap; /* (original) capture list */
- lua_State *L;
- int ptop; /* index of last argument to 'match' */
- const char *s; /* original string */
- int valuecached; /* value stored in cache slot */
-} CapState;
+/* #include "lpcap.h" */
+/* #include "lptypes.h" */
#define captype(cap) ((cap)->kind)
@@ -1849,84 +1589,114 @@ typedef struct CapState {
#define isfullcap(cap) ((cap)->siz != 0)
-#define getfromenv(cs,v) lua_rawgeti((cs)->L, penvidx((cs)->ptop), v)
-#define pushluaval(cs) getfromenv(cs, (cs)->cap->idx)
-
-#define pushsubject(cs, c) lua_pushlstring((cs)->L, (c)->s, (c)->siz - 1)
+#define getfromktable(cs,v) lua_rawgeti((cs)->L, ktableidx((cs)->ptop), v)
+#define pushluaval(cs) getfromktable(cs, (cs)->cap->idx)
-#define updatecache(cs,v) { if ((v) != (cs)->valuecached) updatecache_(cs,v); }
-static void updatecache_ (CapState *cs, int v) {
- getfromenv(cs, v);
- lua_replace(cs->L, subscache(cs));
- cs->valuecached = v;
+/*
+** Put at the cache for Lua values the value indexed by 'v' in ktable
+** of the running pattern (if it is not there yet); returns its index.
+*/
+static int updatecache (CapState *cs, int v) {
+ int idx = cs->ptop + 1; /* stack index of cache for Lua values */
+ if (v != cs->valuecached) { /* not there? */
+ getfromktable(cs, v); /* get value from 'ktable' */
+ lua_replace(cs->L, idx); /* put it at reserved stack position */
+ cs->valuecached = v; /* keep track of what is there */
+ }
+ return idx;
}
static int pushcapture (CapState *cs);
+/*
+** Goes back in a list of captures looking for an open capture
+** corresponding to a close
+*/
static Capture *findopen (Capture *cap) {
- int n = 0;
+ int n = 0; /* number of closes waiting an open */
for (;;) {
cap--;
- if (isclosecap(cap)) n++;
+ if (isclosecap(cap)) n++; /* one more open to skip */
else if (!isfullcap(cap))
if (n-- == 0) return cap;
}
}
-static Capture *nextcap (Capture *cap) {
- if (isfullcap(cap)) return cap + 1;
- else {
- int n = 0;
- for (;;) {
+/*
+** Go to the next capture
+*/
+static void nextcap (CapState *cs) {
+ Capture *cap = cs->cap;
+ if (!isfullcap(cap)) { /* not a single capture? */
+ int n = 0; /* number of opens waiting a close */
+ for (;;) { /* look for corresponding close */
cap++;
if (isclosecap(cap)) {
- if (n-- == 0) return cap + 1;
+ if (n-- == 0) break;
}
else if (!isfullcap(cap)) n++;
}
}
+ cs->cap = cap + 1; /* + 1 to skip last close (or entire single capture) */
}
-static int pushallvalues (CapState *cs, int addextra) {
+/*
+** Push on the Lua stack all values generated by nested captures inside
+** the current capture. Returns number of values pushed. 'addextra'
+** makes it push the entire match after all captured values. The
+** entire match is pushed also if there are no other nested values,
+** so the function never returns zero.
+*/
+static int pushnestedvalues (CapState *cs, int addextra) {
Capture *co = cs->cap;
- int n = 0;
- if (isfullcap(cs->cap++)) {
- pushsubject(cs, co); /* push whole match */
- return 1;
+ if (isfullcap(cs->cap++)) { /* no nested captures? */
+ lua_pushlstring(cs->L, co->s, co->siz - 1); /* push whole match */
+ return 1; /* that is it */
}
- while (!isclosecap(cs->cap))
- n += pushcapture(cs);
- if (addextra || n == 0) { /* need extra? */
- lua_pushlstring(cs->L, co->s, cs->cap->s - co->s); /* push whole match */
- n++;
+ else {
+ int n = 0;
+ while (!isclosecap(cs->cap)) /* repeat for all nested patterns */
+ n += pushcapture(cs);
+ if (addextra || n == 0) { /* need extra? */
+ lua_pushlstring(cs->L, co->s, cs->cap->s - co->s); /* push whole match */
+ n++;
+ }
+ cs->cap++; /* skip close entry */
+ return n;
}
- cs->cap++; /* skip close entry */
- return n;
}
+/*
+** Push only the first value generated by nested captures
+*/
+static void pushonenestedvalue (CapState *cs) {
+ int n = pushnestedvalues(cs, 0);
+ if (n > 1)
+ lua_pop(cs->L, n - 1); /* pop extra values */
+}
+
+
+/*
+** Try to find a named group capture with the name given at the top of
+** the stack; goes backward from 'cap'.
+*/
static Capture *findback (CapState *cs, Capture *cap) {
lua_State *L = cs->L;
- for (;;) {
- if (cap == cs->ocap) { /* not found */
- const char *s = lua_tostring(L, -1);
- if (s == NULL) s = lua_pushfstring(L, "(a %s)", luaL_typename(L, -1));
- luaL_error(L, "back reference '%s' not found", s);
- }
- cap--;
+ while (cap-- > cs->ocap) { /* repeat until end of list */
if (isclosecap(cap))
- cap = findopen(cap);
+ cap = findopen(cap); /* skip nested captures */
else if (!isfullcap(cap))
continue; /* opening an enclosing capture: skip and get previous */
if (captype(cap) == Cgroup) {
- getfromenv(cs, cap->idx); /* get group name */
+ getfromktable(cs, cap->idx); /* get group name */
if (lua_equal(L, -2, -1)) { /* right group? */
lua_pop(L, 2); /* remove reference name and group name */
return cap;
@@ -1934,20 +1704,29 @@ static Capture *findback (CapState *cs, Capture *cap) {
else lua_pop(L, 1); /* remove group name */
}
}
+ luaL_error(L, "back reference '%s' not found", lua_tostring(L, -1));
+ return NULL; /* to avoid warnings */
}
+/*
+** Back-reference capture. Return number of values pushed.
+*/
static int backrefcap (CapState *cs) {
int n;
Capture *curr = cs->cap;
pushluaval(cs); /* reference name */
- cs->cap = findback(cs, curr);
- n = pushallvalues(cs, 0);
+ cs->cap = findback(cs, curr); /* find corresponding group */
+ n = pushnestedvalues(cs, 0); /* push group's values */
cs->cap = curr + 1;
return n;
}
+/*
+** Table capture: creates a new table and populates it with nested
+** captures.
+*/
static int tablecap (CapState *cs) {
lua_State *L = cs->L;
int n = 0;
@@ -1956,182 +1735,249 @@ static int tablecap (CapState *cs) {
return 1; /* table is empty */
while (!isclosecap(cs->cap)) {
if (captype(cs->cap) == Cgroup && cs->cap->idx != 0) { /* named group? */
- int k;
pushluaval(cs); /* push group name */
- k = pushallvalues(cs, 0);
- if (k == 0) { /* no value? */
- lua_pop(L, 1); /* remove group name */
- continue; /* and go on */
- }
- else if (k > 1)
- lua_pop(L, k - 1); /* keep just one value */
+ pushonenestedvalue(cs);
lua_settable(L, -3);
}
- else {
+ else { /* not a named group */
int i;
int k = pushcapture(cs);
- for (i = k; i > 0; i--)
+ for (i = k; i > 0; i--) /* store all values into table */
lua_rawseti(L, -(i + 1), n + i);
n += k;
}
}
cs->cap++; /* skip close entry */
- return 1;
+ return 1; /* number of values pushed (only the table) */
}
+/*
+** Table-query capture
+*/
static int querycap (CapState *cs) {
int idx = cs->cap->idx;
- int n = pushallvalues(cs, 0);
- if (n > 1) /* extra captures? */
- lua_pop(cs->L, n - 1); /* throw them away */
- updatecache(cs, idx);
- lua_gettable(cs->L, subscache(cs));
+ pushonenestedvalue(cs); /* get nested capture */
+ lua_gettable(cs->L, updatecache(cs, idx)); /* query cap. value at table */
if (!lua_isnil(cs->L, -1))
return 1;
- else {
- lua_pop(cs->L, 1); /* remove value */
+ else { /* no value */
+ lua_pop(cs->L, 1); /* remove nil */
return 0;
}
}
+/*
+** Fold capture
+*/
static int foldcap (CapState *cs) {
int n;
lua_State *L = cs->L;
int idx = cs->cap->idx;
- if (isfullcap(cs->cap++) || isclosecap(cs->cap) || (n = pushcapture(cs)) == 0)
+ if (isfullcap(cs->cap++) || /* no nested captures? */
+ isclosecap(cs->cap) || /* no nested captures (large subject)? */
+ (n = pushcapture(cs)) == 0) /* nested captures with no values? */
return luaL_error(L, "no initial value for fold capture");
if (n > 1)
- lua_pop(L, n - 1); /* leave only one result */
+ lua_pop(L, n - 1); /* leave only one result for accumulator */
while (!isclosecap(cs->cap)) {
- updatecache(cs, idx);
- lua_pushvalue(L, subscache(cs)); /* get folding function */
+ lua_pushvalue(L, updatecache(cs, idx)); /* get folding function */
lua_insert(L, -2); /* put it before accumulator */
- n = pushcapture(cs); /* get other captures */
+ n = pushcapture(cs); /* get next capture's values */
lua_call(L, n + 1, 1); /* call folding function */
}
cs->cap++; /* skip close entry */
- return 1;
+ return 1; /* only accumulator left on the stack */
}
+/*
+** Function capture
+*/
static int functioncap (CapState *cs) {
int n;
int top = lua_gettop(cs->L);
- pushluaval(cs);
- n = pushallvalues(cs, 0);
- lua_call(cs->L, n, LUA_MULTRET);
- return lua_gettop(cs->L) - top;
+ pushluaval(cs); /* push function */
+ n = pushnestedvalues(cs, 0); /* push nested captures */
+ lua_call(cs->L, n, LUA_MULTRET); /* call function */
+ return lua_gettop(cs->L) - top; /* return function's results */
}
-static int runtimecap (lua_State *L, Capture *close, Capture *ocap,
- const char *o, const char *s, int ptop) {
- CapState cs;
- int n;
+/*
+** Select capture
+*/
+static int numcap (CapState *cs) {
+ int idx = cs->cap->idx; /* value to select */
+ if (idx == 0) { /* no values? */
+ nextcap(cs); /* skip entire capture */
+ return 0; /* no value produced */
+ }
+ else {
+ int n = pushnestedvalues(cs, 0);
+ if (n < idx) /* invalid index? */
+ return luaL_error(cs->L, "no capture '%d'", idx);
+ else {
+ lua_pushvalue(cs->L, -(n - idx + 1)); /* get selected capture */
+ lua_replace(cs->L, -(n + 1)); /* put it in place of 1st capture */
+ lua_pop(cs->L, n - 1); /* remove other captures */
+ return 1;
+ }
+ }
+}
+
+
+/*
+** Return the stack index of the first runtime capture in the given
+** list of captures (or zero if no runtime captures)
+*/
+int finddyncap (Capture *cap, Capture *last) {
+ for (; cap < last; cap++) {
+ if (cap->kind == Cruntime)
+ return cap->idx; /* stack position of first capture */
+ }
+ return 0; /* no dynamic captures in this segment */
+}
+
+
+/*
+** Calls a runtime capture. Returns number of captures removed by
+** the call, including the initial Cgroup. (Captures to be added are
+** on the Lua stack.)
+*/
+int runtimecap (CapState *cs, Capture *close, const char *s, int *rem) {
+ int n, id;
+ lua_State *L = cs->L;
+ int otop = lua_gettop(L);
Capture *open = findopen(close);
- assert(captype(open) == Cruntime);
- close->kind = Cclose;
+ assert(captype(open) == Cgroup);
+ id = finddyncap(open, close); /* get first dynamic capture argument */
+ close->kind = Cclose; /* closes the group */
close->s = s;
- cs.ocap = ocap; cs.cap = open; cs.L = L;
- cs.s = o; cs.valuecached = 0; cs.ptop = ptop;
+ cs->cap = open; cs->valuecached = 0; /* prepare capture state */
luaL_checkstack(L, 4, "too many runtime captures");
- pushluaval(&cs);
+ pushluaval(cs); /* push function to be called */
lua_pushvalue(L, SUBJIDX); /* push original subject */
- lua_pushinteger(L, s - o + 1); /* current position */
- n = pushallvalues(&cs, 0);
- lua_call(L, n + 2, LUA_MULTRET);
- return close - open;
+ lua_pushinteger(L, s - cs->s + 1); /* push current position */
+ n = pushnestedvalues(cs, 0); /* push nested captures */
+ lua_call(L, n + 2, LUA_MULTRET); /* call dynamic function */
+ if (id > 0) { /* are there old dynamic captures to be removed? */
+ int i;
+ for (i = id; i <= otop; i++)
+ lua_remove(L, id); /* remove old dynamic captures */
+ *rem = otop - id + 1; /* total number of dynamic captures removed */
+ }
+ else
+ *rem = 0; /* no dynamic captures removed */
+ return close - open; /* number of captures of all kinds removed */
}
-
+/*
+** Auxiliary structure for substitution and string captures: keep
+** information about nested captures for future use, avoiding to push
+** string results into Lua
+*/
typedef struct StrAux {
- int isstring;
+ int isstring; /* whether capture is a string */
union {
- Capture *cp;
- struct {
- const char *s;
- const char *e;
+ Capture *cp; /* if not a string, respective capture */
+ struct { /* if it is a string... */
+ const char *s; /* ... starts here */
+ const char *e; /* ... ends here */
} s;
} u;
} StrAux;
#define MAXSTRCAPS 10
+/*
+** Collect values from current capture into array 'cps'. Current
+** capture must be Cstring (first call) or Csimple (recursive calls).
+** (In first call, fills %0 with whole match for Cstring.)
+** Returns number of elements in the array that were filled.
+*/
static int getstrcaps (CapState *cs, StrAux *cps, int n) {
int k = n++;
- cps[k].isstring = 1;
- cps[k].u.s.s = cs->cap->s;
- if (!isfullcap(cs->cap++)) {
- while (!isclosecap(cs->cap)) {
+ cps[k].isstring = 1; /* get string value */
+ cps[k].u.s.s = cs->cap->s; /* starts here */
+ if (!isfullcap(cs->cap++)) { /* nested captures? */
+ while (!isclosecap(cs->cap)) { /* traverse them */
if (n >= MAXSTRCAPS) /* too many captures? */
- cs->cap = nextcap(cs->cap); /* skip it */
- else if (captype(cs->cap) == Csimple)
- n = getstrcaps(cs, cps, n);
+ nextcap(cs); /* skip extra captures (will not need them) */
+ else if (captype(cs->cap) == Csimple) /* string? */
+ n = getstrcaps(cs, cps, n); /* put info. into array */
else {
- cps[n].isstring = 0;
- cps[n].u.cp = cs->cap;
- cs->cap = nextcap(cs->cap);
+ cps[n].isstring = 0; /* not a string */
+ cps[n].u.cp = cs->cap; /* keep original capture */
+ nextcap(cs);
n++;
}
}
cs->cap++; /* skip close */
}
- cps[k].u.s.e = closeaddr(cs->cap - 1);
+ cps[k].u.s.e = closeaddr(cs->cap - 1); /* ends here */
return n;
}
/*
-** add next capture (which should be a string) to buffer
+** add next capture value (which should be a string) to buffer 'b'
*/
static int addonestring (luaL_Buffer *b, CapState *cs, const char *what);
+/*
+** String capture: add result to buffer 'b' (instead of pushing
+** it into the stack)
+*/
static void stringcap (luaL_Buffer *b, CapState *cs) {
StrAux cps[MAXSTRCAPS];
int n;
size_t len, i;
- const char *c;
- updatecache(cs, cs->cap->idx);
- c = lua_tolstring(cs->L, subscache(cs), &len);
- n = getstrcaps(cs, cps, 0) - 1;
- for (i = 0; i < len; i++) {
- if (c[i] != '%' || c[++i] < '0' || c[i] > '9')
- luaL_addchar(b, c[i]);
+ const char *fmt; /* format string */
+ fmt = lua_tolstring(cs->L, updatecache(cs, cs->cap->idx), &len);
+ n = getstrcaps(cs, cps, 0) - 1; /* collect nested captures */
+ for (i = 0; i < len; i++) { /* traverse them */
+ if (fmt[i] != '%') /* not an escape? */
+ luaL_addchar(b, fmt[i]); /* add it to buffer */
+ else if (fmt[++i] < '0' || fmt[i] > '9') /* not followed by a digit? */
+ luaL_addchar(b, fmt[i]); /* add to buffer */
else {
- int l = c[i] - '0';
+ int l = fmt[i] - '0'; /* capture index */
if (l > n)
luaL_error(cs->L, "invalid capture index (%d)", l);
else if (cps[l].isstring)
luaL_addlstring(b, cps[l].u.s.s, cps[l].u.s.e - cps[l].u.s.s);
else {
Capture *curr = cs->cap;
- cs->cap = cps[l].u.cp;
- if (addonestring(b, cs, "capture") == 0)
+ cs->cap = cps[l].u.cp; /* go back to evaluate that nested capture */
+ if (!addonestring(b, cs, "capture"))
luaL_error(cs->L, "no values in capture index %d", l);
- cs->cap = curr;
+ cs->cap = curr; /* continue from where it stopped */
}
}
}
}
+/*
+** Substitution capture: add result to buffer 'b'
+*/
static void substcap (luaL_Buffer *b, CapState *cs) {
const char *curr = cs->cap->s;
if (isfullcap(cs->cap)) /* no nested captures? */
luaL_addlstring(b, curr, cs->cap->siz - 1); /* keep original text */
else {
- cs->cap++;
- while (!isclosecap(cs->cap)) {
+ cs->cap++; /* skip open entry */
+ while (!isclosecap(cs->cap)) { /* traverse nested captures */
const char *next = cs->cap->s;
luaL_addlstring(b, curr, next - curr); /* add text up to capture */
- if (addonestring(b, cs, "replacement") == 0) /* no capture value? */
- curr = next; /* keep original text in final result */
- else
+ if (addonestring(b, cs, "replacement"))
curr = closeaddr(cs->cap - 1); /* continue after match */
+ else /* no capture value */
+ curr = next; /* keep original text in final result */
}
luaL_addlstring(b, curr, cs->cap->s - curr); /* add last piece of text */
}
@@ -2139,6 +1985,10 @@ static void substcap (luaL_Buffer *b, CapState *cs) {
}
+/*
+** Evaluates a capture and adds its first value to buffer 'b'; returns
+** whether there was a value
+*/
static int addonestring (luaL_Buffer *b, CapState *cs, const char *what) {
switch (captype(cs->cap)) {
case Cstring:
@@ -2162,11 +2012,16 @@ static int addonestring (luaL_Buffer *b, CapState *cs, const char *what) {
}
+/*
+** Push all values of the current capture into the stack; returns
+** number of values pushed
+*/
static int pushcapture (CapState *cs) {
- luaL_checkstack(cs->L, 4, "too many captures");
+ lua_State *L = cs->L;
+ luaL_checkstack(L, 4, "too many captures");
switch (captype(cs->cap)) {
case Cposition: {
- lua_pushinteger(cs->L, cs->cap->s - cs->s + 1);
+ lua_pushinteger(L, cs->cap->s - cs->s + 1);
cs->cap++;
return 1;
}
@@ -2178,50 +2033,45 @@ static int pushcapture (CapState *cs) {
case Carg: {
int arg = (cs->cap++)->idx;
if (arg + FIXEDARGS > cs->ptop)
- return luaL_error(cs->L, "reference to absent argument #%d", arg);
- lua_pushvalue(cs->L, arg + FIXEDARGS);
+ return luaL_error(L, "reference to absent argument #%d", arg);
+ lua_pushvalue(L, arg + FIXEDARGS);
return 1;
}
case Csimple: {
- int k = pushallvalues(cs, 1);
- if (k > 1)
- lua_insert(cs->L, -k); /* whole match is first result */
+ int k = pushnestedvalues(cs, 1);
+ lua_insert(L, -k); /* make whole match be first result */
return k;
}
case Cruntime: {
- int n = 0;
- while (!isclosecap(cs->cap++)) {
- luaL_checkstack(cs->L, 4, "too many captures");
- lua_pushvalue(cs->L, (cs->cap - 1)->idx);
- n++;
- }
- return n;
+ lua_pushvalue(L, (cs->cap++)->idx); /* value is in the stack */
+ return 1;
}
case Cstring: {
luaL_Buffer b;
- luaL_buffinit(cs->L, &b);
+ luaL_buffinit(L, &b);
stringcap(&b, cs);
luaL_pushresult(&b);
return 1;
}
case Csubst: {
luaL_Buffer b;
- luaL_buffinit(cs->L, &b);
+ luaL_buffinit(L, &b);
substcap(&b, cs);
luaL_pushresult(&b);
return 1;
}
case Cgroup: {
if (cs->cap->idx == 0) /* anonymous group? */
- return pushallvalues(cs, 0); /* add all nested values */
+ return pushnestedvalues(cs, 0); /* add all nested values */
else { /* named group: add no values */
- cs->cap = nextcap(cs->cap); /* skip capture */
+ nextcap(cs); /* skip capture */
return 0;
}
}
case Cbackref: return backrefcap(cs);
case Ctable: return tablecap(cs);
case Cfunction: return functioncap(cs);
+ case Cnum: return numcap(cs);
case Cquery: return querycap(cs);
case Cfold: return foldcap(cs);
default: assert(0); return 0;
@@ -2229,7 +2079,15 @@ static int pushcapture (CapState *cs) {
}
-static int getcaptures (lua_State *L, const char *s, const char *r, int ptop) {
+/*
+** Prepare a CapState structure and traverse the entire list of
+** captures in the stack pushing its results. 's' is the subject
+** string, 'r' is the final position of the match, and 'ptop'
+** the index in the stack where some useful values were pushed.
+** Returns the number of results pushed. (If the list produces no
+** results, push the final position of the match.)
+*/
+int getcaptures (lua_State *L, const char *s, const char *r, int ptop) {
Capture *capture = (Capture *)lua_touserdata(L, caplistidx(ptop));
int n = 0;
if (!isclosecap(capture)) { /* is there any capture? */
@@ -2247,16 +2105,1137 @@ static int getcaptures (lua_State *L, const char *s, const char *r, int ptop) {
return n;
}
+
+/*
+** $Id: lptree.c,v 1.10 2013/04/12 16:30:33 roberto Exp $
+** Copyright 2013, Lua.org & PUC-Rio (see 'lpeg.html' for license)
+*/
+
+/* #include <ctype.h> */
+/* #include <limits.h> */
+/* #include <string.h> */
+
+
+/* #include "lua.h" */
+/* #include "lauxlib.h" */
+
+/* #include "lptypes.h" */
+/* #include "lpcap.h" */
+/* #include "lpcode.h" */
+/* #include "lpprint.h" */
+/* #include "lptree.h" */
+
+
+/* number of siblings for each tree */
+const byte numsiblings[] = {
+ 0, 0, 0, /* char, set, any */
+ 0, 0, /* true, false */
+ 1, /* rep */
+ 2, 2, /* seq, choice */
+ 1, 1, /* not, and */
+ 0, 0, 2, 1, /* call, opencall, rule, grammar */
+ 1, /* behind */
+ 1, 1 /* capture, runtime capture */
+};
+
+
+static TTree *newgrammar (lua_State *L, int arg);
+
+
+/*
+** returns a reasonable name for value at index 'idx' on the stack
+*/
+static const char *val2str (lua_State *L, int idx) {
+ const char *k = lua_tostring(L, idx);
+ if (k != NULL)
+ return lua_pushfstring(L, "%s", k);
+ else
+ return lua_pushfstring(L, "(a %s)", luaL_typename(L, idx));
+}
+
+
+/*
+** Fix a TOpenCall into a TCall node, using table 'postable' to
+** translate a key to its rule address in the tree. Raises an
+** error if key does not exist.
+*/
+static void fixonecall (lua_State *L, int postable, TTree *g, TTree *t) {
+ int n;
+ lua_rawgeti(L, -1, t->key); /* get rule's name */
+ lua_gettable(L, postable); /* query name in position table */
+ n = lua_tonumber(L, -1); /* get (absolute) position */
+ lua_pop(L, 1); /* remove position */
+ if (n == 0) { /* no position? */
+ lua_rawgeti(L, -1, t->key); /* get rule's name again */
+ luaL_error(L, "rule '%s' undefined in given grammar", val2str(L, -1));
+ }
+ t->tag = TCall;
+ t->u.ps = n - (t - g); /* position relative to node */
+ assert(sib2(t)->tag == TRule);
+ sib2(t)->key = t->key;
+}
+
+
+/*
+** Transform left associative constructions into right
+** associative ones, for sequence and choice; that is:
+** (t11 + t12) + t2 => t11 + (t12 + t2)
+** (t11 * t12) * t2 => t11 * (t12 * t2)
+** (that is, Op (Op t11 t12) t2 => Op t11 (Op t12 t2))
+*/
+static void correctassociativity (TTree *tree) {
+ TTree *t1 = sib1(tree);
+ assert(tree->tag == TChoice || tree->tag == TSeq);
+ while (t1->tag == tree->tag) {
+ int n1size = tree->u.ps - 1; /* t1 == Op t11 t12 */
+ int n11size = t1->u.ps - 1;
+ int n12size = n1size - n11size - 1;
+ memmove(sib1(tree), sib1(t1), n11size * sizeof(TTree)); /* move t11 */
+ tree->u.ps = n11size + 1;
+ sib2(tree)->tag = tree->tag;
+ sib2(tree)->u.ps = n12size + 1;
+ }
+}
+
+
+/*
+** Make final adjustments in a tree. Fix open calls in tree 't',
+** making them refer to their respective rules or raising appropriate
+** errors (if not inside a grammar). Correct associativity of associative
+** constructions (making them right associative). Assume that tree's
+** ktable is at the top of the stack (for error messages).
+*/
+static void finalfix (lua_State *L, int postable, TTree *g, TTree *t) {
+ tailcall:
+ switch (t->tag) {
+ case TGrammar: /* subgrammars were already fixed */
+ return;
+ case TOpenCall: {
+ if (g != NULL) /* inside a grammar? */
+ fixonecall(L, postable, g, t);
+ else { /* open call outside grammar */
+ lua_rawgeti(L, -1, t->key);
+ luaL_error(L, "rule '%s' used outside a grammar", val2str(L, -1));
+ }
+ break;
+ }
+ case TSeq: case TChoice:
+ correctassociativity(t);
+ break;
+ }
+ switch (numsiblings[t->tag]) {
+ case 1: /* finalfix(L, postable, g, sib1(t)); */
+ t = sib1(t); goto tailcall;
+ case 2:
+ finalfix(L, postable, g, sib1(t));
+ t = sib2(t); goto tailcall; /* finalfix(L, postable, g, sib2(t)); */
+ default: assert(numsiblings[t->tag] == 0); break;
+ }
+}
+
+
+/*
+** {======================================================
+** Tree generation
+** =======================================================
+*/
+
+/*
+** In 5.2, could use 'luaL_testudata'...
+*/
+static int testpattern (lua_State *L, int idx) {
+ if (lua_touserdata(L, idx)) { /* value is a userdata? */
+ if (lua_getmetatable(L, idx)) { /* does it have a metatable? */
+ luaL_getmetatable(L, PATTERN_T);
+ if (lua_rawequal(L, -1, -2)) { /* does it have the correct mt? */
+ lua_pop(L, 2); /* remove both metatables */
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+
+static Pattern *getpattern (lua_State *L, int idx) {
+ return (Pattern *)luaL_checkudata(L, idx, PATTERN_T);
+}
+
+
+static int getsize (lua_State *L, int idx) {
+ return (lua_objlen(L, idx) - sizeof(Pattern)) / sizeof(TTree) + 1;
+}
+
+
+static TTree *gettree (lua_State *L, int idx, int *len) {
+ Pattern *p = getpattern(L, idx);
+ if (len)
+ *len = getsize(L, idx);
+ return p->tree;
+}
+
+
+/*
+** create a pattern
+*/
+static TTree *newtree (lua_State *L, int len) {
+ size_t size = (len - 1) * sizeof(TTree) + sizeof(Pattern);
+ Pattern *p = (Pattern *)lua_newuserdata(L, size);
+ luaL_getmetatable(L, PATTERN_T);
+ lua_setmetatable(L, -2);
+ p->code = NULL; p->codesize = 0;
+ return p->tree;
+}
+
+
+static TTree *newleaf (lua_State *L, int tag) {
+ TTree *tree = newtree(L, 1);
+ tree->tag = tag;
+ return tree;
+}
+
+
+static TTree *newcharset (lua_State *L) {
+ TTree *tree = newtree(L, bytes2slots(CHARSETSIZE) + 1);
+ tree->tag = TSet;
+ loopset(i, treebuffer(tree)[i] = 0);
+ return tree;
+}
+
+
+/*
+** add to tree a sequence where first sibling is 'sib' (with size
+** 'sibsize'); returns position for second sibling
+*/
+static TTree *seqaux (TTree *tree, TTree *sib, int sibsize) {
+ tree->tag = TSeq; tree->u.ps = sibsize + 1;
+ memcpy(sib1(tree), sib, sibsize * sizeof(TTree));
+ return sib2(tree);
+}
+
+
+/*
+** Add element 'idx' to 'ktable' of pattern at the top of the stack;
+** create new 'ktable' if necessary. Return index of new element.
+*/
+static int addtoktable (lua_State *L, int idx) {
+ if (idx == 0 || lua_isnil(L, idx)) /* no actual value to insert? */
+ return 0;
+ else {
+ int n;
+ lua_getfenv(L, -1); /* get ktable from pattern */
+ n = lua_objlen(L, -1);
+ if (n == 0) { /* is it empty/non-existent? */
+ lua_pop(L, 1); /* remove it */
+ lua_createtable(L, 1, 0); /* create a fresh table */
+ }
+ lua_pushvalue(L, idx); /* element to be added */
+ lua_rawseti(L, -2, n + 1);
+ lua_setfenv(L, -2); /* set it as ktable for pattern */
+ return n + 1;
+ }
+}
+
+
+/*
+** Build a sequence of 'n' nodes, each with tag 'tag' and 'u.n' got
+** from the array 's' (or 0 if array is NULL). (TSeq is binary, so it
+** must build a sequence of sequence of sequence...)
+*/
+static void fillseq (TTree *tree, int tag, int n, const char *s) {
+ int i;
+ for (i = 0; i < n - 1; i++) { /* initial n-1 copies of Seq tag; Seq ... */
+ tree->tag = TSeq; tree->u.ps = 2;
+ sib1(tree)->tag = tag;
+ sib1(tree)->u.n = s ? (byte)s[i] : 0;
+ tree = sib2(tree);
+ }
+ tree->tag = tag; /* last one does not need TSeq */
+ tree->u.n = s ? (byte)s[i] : 0;
+}
+
+
+/*
+** Numbers as patterns:
+** 0 == true (always match); n == TAny repeated 'n' times;
+** -n == not (TAny repeated 'n' times)
+*/
+static TTree *numtree (lua_State *L, int n) {
+ if (n == 0)
+ return newleaf(L, TTrue);
+ else {
+ TTree *tree, *nd;
+ if (n > 0)
+ tree = nd = newtree(L, 2 * n - 1);
+ else { /* negative: code it as !(-n) */
+ n = -n;
+ tree = newtree(L, 2 * n);
+ tree->tag = TNot;
+ nd = sib1(tree);
+ }
+ fillseq(nd, TAny, n, NULL); /* sequence of 'n' any's */
+ return tree;
+ }
+}
+
+
+/*
+** Convert value at index 'idx' to a pattern
+*/
+static TTree *getpatt (lua_State *L, int idx, int *len) {
+ TTree *tree;
+ switch (lua_type(L, idx)) {
+ case LUA_TSTRING: {
+ size_t slen;
+ const char *s = lua_tolstring(L, idx, &slen); /* get string */
+ if (slen == 0) /* empty? */
+ tree = newleaf(L, TTrue); /* always match */
+ else {
+ tree = newtree(L, 2 * (slen - 1) + 1);
+ fillseq(tree, TChar, slen, s); /* sequence of 'slen' chars */
+ }
+ break;
+ }
+ case LUA_TNUMBER: {
+ int n = lua_tointeger(L, idx);
+ tree = numtree(L, n);
+ break;
+ }
+ case LUA_TBOOLEAN: {
+ tree = (lua_toboolean(L, idx) ? newleaf(L, TTrue) : newleaf(L, TFalse));
+ break;
+ }
+ case LUA_TTABLE: {
+ tree = newgrammar(L, idx);
+ break;
+ }
+ case LUA_TFUNCTION: {
+ tree = newtree(L, 2);
+ tree->tag = TRunTime;
+ tree->key = addtoktable(L, idx);
+ sib1(tree)->tag = TTrue;
+ break;
+ }
+ default: {
+ return gettree(L, idx, len);
+ }
+ }
+ lua_replace(L, idx); /* put new tree into 'idx' slot */
+ if (len)
+ *len = getsize(L, idx);
+ return tree;
+}
+
+
+/*
+** Return the number of elements in the ktable of pattern at 'idx'.
+** In Lua 5.2, default "environment" for patterns is nil, not
+** a table. Treat it as an empty table. In Lua 5.1, assumes that
+** the environment has no numeric indices (len == 0)
+*/
+static int ktablelen (lua_State *L, int idx) {
+ if (!lua_istable(L, idx)) return 0;
+ else return lua_objlen(L, idx);
+}
+
+
+/*
+** Concatentate the contents of table 'idx1' into table 'idx2'.
+** (Assume that both indices are negative.)
+** Return the original length of table 'idx2'
+*/
+static int concattable (lua_State *L, int idx1, int idx2) {
+ int i;
+ int n1 = ktablelen(L, idx1);
+ int n2 = ktablelen(L, idx2);
+ if (n1 == 0) return 0; /* nothing to correct */
+ for (i = 1; i <= n1; i++) {
+ lua_rawgeti(L, idx1, i);
+ lua_rawseti(L, idx2 - 1, n2 + i); /* correct 'idx2' */
+ }
+ return n2;
+}
+
+
+/*
+** Make a merge of ktables from p1 and p2 the ktable for the new
+** pattern at the top of the stack.
+*/
+static int joinktables (lua_State *L, int p1, int p2) {
+ int n1, n2;
+ lua_getfenv(L, p1); /* get ktables */
+ lua_getfenv(L, p2);
+ n1 = ktablelen(L, -2);
+ n2 = ktablelen(L, -1);
+ if (n1 == 0 && n2 == 0) { /* are both tables empty? */
+ lua_pop(L, 2); /* nothing to be done; pop tables */
+ return 0; /* nothing to correct */
+ }
+ if (n2 == 0 || lua_equal(L, -2, -1)) { /* second table is empty or equal? */
+ lua_pop(L, 1); /* pop 2nd table */
+ lua_setfenv(L, -2); /* set 1st ktable into new pattern */
+ return 0; /* nothing to correct */
+ }
+ if (n1 == 0) { /* first table is empty? */
+ lua_setfenv(L, -3); /* set 2nd table into new pattern */
+ lua_pop(L, 1); /* pop 1st table */
+ return 0; /* nothing to correct */
+ }
+ else {
+ lua_createtable(L, n1 + n2, 0); /* create ktable for new pattern */
+ /* stack: new p; ktable p1; ktable p2; new ktable */
+ concattable(L, -3, -1); /* from p1 into new ktable */
+ concattable(L, -2, -1); /* from p2 into new ktable */
+ lua_setfenv(L, -4); /* new ktable becomes p env */
+ lua_pop(L, 2); /* pop other ktables */
+ return n1; /* correction for indices from p2 */
+ }
+}
+
+
+static void correctkeys (TTree *tree, int n) {
+ if (n == 0) return; /* no correction? */
+ tailcall:
+ switch (tree->tag) {
+ case TOpenCall: case TCall: case TRunTime: case TRule: {
+ if (tree->key > 0)
+ tree->key += n;
+ break;
+ }
+ case TCapture: {
+ if (tree->key > 0 && tree->cap != Carg && tree->cap != Cnum)
+ tree->key += n;
+ break;
+ }
+ default: break;
+ }
+ switch (numsiblings[tree->tag]) {
+ case 1: /* correctkeys(sib1(tree), n); */
+ tree = sib1(tree); goto tailcall;
+ case 2:
+ correctkeys(sib1(tree), n);
+ tree = sib2(tree); goto tailcall; /* correctkeys(sib2(tree), n); */
+ default: assert(numsiblings[tree->tag] == 0); break;
+ }
+}
+
+
+/*
+** copy 'ktable' of element 'idx' to new tree (on top of stack)
+*/
+static void copyktable (lua_State *L, int idx) {
+ lua_getfenv(L, idx);
+ lua_setfenv(L, -2);
+}
+
+
+/*
+** merge 'ktable' from rule at stack index 'idx' into 'ktable'
+** from tree at the top of the stack, and correct corresponding
+** tree.
+*/
+static void mergektable (lua_State *L, int idx, TTree *rule) {
+ int n;
+ lua_getfenv(L, -1); /* get ktables */
+ lua_getfenv(L, idx);
+ n = concattable(L, -1, -2);
+ lua_pop(L, 2); /* remove both ktables */
+ correctkeys(rule, n);
+}
+
+
+/*
+** create a new tree, whith a new root and one sibling.
+** Sibling must be on the Lua stack, at index 1.
+*/
+static TTree *newroot1sib (lua_State *L, int tag) {
+ int s1;
+ TTree *tree1 = getpatt(L, 1, &s1);
+ TTree *tree = newtree(L, 1 + s1); /* create new tree */
+ tree->tag = tag;
+ memcpy(sib1(tree), tree1, s1 * sizeof(TTree));
+ copyktable(L, 1);
+ return tree;
+}
+
+
+/*
+** create a new tree, whith a new root and 2 siblings.
+** Siblings must be on the Lua stack, first one at index 1.
+*/
+static TTree *newroot2sib (lua_State *L, int tag) {
+ int s1, s2;
+ TTree *tree1 = getpatt(L, 1, &s1);
+ TTree *tree2 = getpatt(L, 2, &s2);
+ TTree *tree = newtree(L, 1 + s1 + s2); /* create new tree */
+ tree->tag = tag;
+ tree->u.ps = 1 + s1;
+ memcpy(sib1(tree), tree1, s1 * sizeof(TTree));
+ memcpy(sib2(tree), tree2, s2 * sizeof(TTree));
+ correctkeys(sib2(tree), joinktables(L, 1, 2));
+ return tree;
+}
+
+
+static int lp_P (lua_State *L) {
+ luaL_checkany(L, 1);
+ getpatt(L, 1, NULL);
+ lua_settop(L, 1);
+ return 1;
+}
+
+
+/*
+** sequence operator; optimizations:
+** false x => false, x true => x, true x => x
+** (cannot do x . false => false because x may have runtime captures)
+*/
+static int lp_seq (lua_State *L) {
+ TTree *tree1 = getpatt(L, 1, NULL);
+ TTree *tree2 = getpatt(L, 2, NULL);
+ if (tree1->tag == TFalse || tree2->tag == TTrue)
+ lua_pushvalue(L, 1); /* false . x == false, x . true = x */
+ else if (tree1->tag == TTrue)
+ lua_pushvalue(L, 2); /* true . x = x */
+ else
+ newroot2sib(L, TSeq);
+ return 1;
+}
+
+
+/*
+** choice operator; optimizations:
+** charset / charset => charset
+** true / x => true, x / false => x, false / x => x
+** (x / true is not equivalent to true)
+*/
+static int lp_choice (lua_State *L) {
+ Charset st1, st2;
+ TTree *t1 = getpatt(L, 1, NULL);
+ TTree *t2 = getpatt(L, 2, NULL);
+ if (tocharset(t1, &st1) && tocharset(t2, &st2)) {
+ TTree *t = newcharset(L);
+ loopset(i, treebuffer(t)[i] = st1.cs[i] | st2.cs[i]);
+ }
+ else if (nofail(t1) || t2->tag == TFalse)
+ lua_pushvalue(L, 1); /* true / x => true, x / false => x */
+ else if (t1->tag == TFalse)
+ lua_pushvalue(L, 2); /* false / x => x */
+ else
+ newroot2sib(L, TChoice);
+ return 1;
+}
+
+
+/*
+** p^n
+*/
+static int lp_star (lua_State *L) {
+ int size1;
+ int n = luaL_checkint(L, 2);
+ TTree *tree1 = gettree(L, 1, &size1);
+ if (n >= 0) { /* seq tree1 (seq tree1 ... (seq tree1 (rep tree1))) */
+ TTree *tree = newtree(L, (n + 1) * (size1 + 1));
+ if (nullable(tree1))
+ luaL_error(L, "loop body may accept empty string");
+ while (n--) /* repeat 'n' times */
+ tree = seqaux(tree, tree1, size1);
+ tree->tag = TRep;
+ memcpy(sib1(tree), tree1, size1 * sizeof(TTree));
+ }
+ else { /* choice (seq tree1 ... choice tree1 true ...) true */
+ TTree *tree;
+ n = -n;
+ /* size = (choice + seq + tree1 + true) * n, but the last has no seq */
+ tree = newtree(L, n * (size1 + 3) - 1);
+ for (; n > 1; n--) { /* repeat (n - 1) times */
+ tree->tag = TChoice; tree->u.ps = n * (size1 + 3) - 2;
+ sib2(tree)->tag = TTrue;
+ tree = sib1(tree);
+ tree = seqaux(tree, tree1, size1);
+ }
+ tree->tag = TChoice; tree->u.ps = size1 + 1;
+ sib2(tree)->tag = TTrue;
+ memcpy(sib1(tree), tree1, size1 * sizeof(TTree));
+ }
+ copyktable(L, 1);
+ return 1;
+}
+
+
+/*
+** #p == &p
+*/
+static int lp_and (lua_State *L) {
+ newroot1sib(L, TAnd);
+ return 1;
+}
+
+
+/*
+** -p == !p
+*/
+static int lp_not (lua_State *L) {
+ newroot1sib(L, TNot);
+ return 1;
+}
+
+
+/*
+** [t1 - t2] == Seq (Not t2) t1
+** If t1 and t2 are charsets, make their difference.
+*/
+static int lp_sub (lua_State *L) {
+ Charset st1, st2;
+ int s1, s2;
+ TTree *t1 = getpatt(L, 1, &s1);
+ TTree *t2 = getpatt(L, 2, &s2);
+ if (tocharset(t1, &st1) && tocharset(t2, &st2)) {
+ TTree *t = newcharset(L);
+ loopset(i, treebuffer(t)[i] = st1.cs[i] & ~st2.cs[i]);
+ }
+ else {
+ TTree *tree = newtree(L, 2 + s1 + s2);
+ tree->tag = TSeq; /* sequence of... */
+ tree->u.ps = 2 + s2;
+ sib1(tree)->tag = TNot; /* ...not... */
+ memcpy(sib1(sib1(tree)), t2, s2 * sizeof(TTree)); /* ...t2 */
+ memcpy(sib2(tree), t1, s1 * sizeof(TTree)); /* ... and t1 */
+ correctkeys(sib1(tree), joinktables(L, 1, 2));
+ }
+ return 1;
+}
+
+
+static int lp_set (lua_State *L) {
+ size_t l;
+ const char *s = luaL_checklstring(L, 1, &l);
+ TTree *tree = newcharset(L);
+ while (l--) {
+ setchar(treebuffer(tree), (byte)(*s));
+ s++;
+ }
+ return 1;
+}
+
+
+static int lp_range (lua_State *L) {
+ int arg;
+ int top = lua_gettop(L);
+ TTree *tree = newcharset(L);
+ for (arg = 1; arg <= top; arg++) {
+ int c;
+ size_t l;
+ const char *r = luaL_checklstring(L, arg, &l);
+ luaL_argcheck(L, l == 2, arg, "range must have two characters");
+ for (c = (byte)r[0]; c <= (byte)r[1]; c++)
+ setchar(treebuffer(tree), c);
+ }
+ return 1;
+}
+
+
+/*
+** Look-behind predicate
+*/
+static int lp_behind (lua_State *L) {
+ TTree *tree;
+ TTree *tree1 = getpatt(L, 1, NULL);
+ int n = fixedlen(tree1);
+ luaL_argcheck(L, !hascaptures(tree1), 1, "pattern have captures");
+ luaL_argcheck(L, n > 0, 1, "pattern may not have fixed length");
+ luaL_argcheck(L, n <= MAXBEHIND, 1, "pattern too long to look behind");
+ tree = newroot1sib(L, TBehind);
+ tree->u.n = n;
+ return 1;
+}
+
+
+/*
+** Create a non-terminal
+*/
+static int lp_V (lua_State *L) {
+ TTree *tree = newleaf(L, TOpenCall);
+ luaL_argcheck(L, !lua_isnoneornil(L, 1), 1, "non-nil value expected");
+ tree->key = addtoktable(L, 1);
+ return 1;
+}
+
+
+/*
+** Create a tree for a non-empty capture, with a body and
+** optionally with an associated Lua value (at index 'labelidx' in the
+** stack)
+*/
+static int capture_aux (lua_State *L, int cap, int labelidx) {
+ TTree *tree = newroot1sib(L, TCapture);
+ tree->cap = cap;
+ tree->key = addtoktable(L, labelidx);
+ return 1;
+}
+
+
+/*
+** Fill a tree with an empty capture, using an empty (TTrue) sibling.
+*/
+static TTree *auxemptycap (lua_State *L, TTree *tree, int cap, int idx) {
+ tree->tag = TCapture;
+ tree->cap = cap;
+ tree->key = addtoktable(L, idx);
+ sib1(tree)->tag = TTrue;
+ return tree;
+}
+
+
+/*
+** Create a tree for an empty capture
+*/
+static TTree *newemptycap (lua_State *L, int cap, int idx) {
+ return auxemptycap(L, newtree(L, 2), cap, idx);
+}
+
+
+/*
+** Captures with syntax p / v
+** (function capture, query capture, string capture, or number capture)
+*/
+static int lp_divcapture (lua_State *L) {
+ switch (lua_type(L, 2)) {
+ case LUA_TFUNCTION: return capture_aux(L, Cfunction, 2);
+ case LUA_TTABLE: return capture_aux(L, Cquery, 2);
+ case LUA_TSTRING: return capture_aux(L, Cstring, 2);
+ case LUA_TNUMBER: {
+ int n = lua_tointeger(L, 2);
+ TTree *tree = newroot1sib(L, TCapture);
+ luaL_argcheck(L, 0 <= n && n <= SHRT_MAX, 1, "invalid number");
+ tree->cap = Cnum;
+ tree->key = n;
+ return 1;
+ }
+ default: return luaL_argerror(L, 2, "invalid replacement value");
+ }
+}
+
+
+static int lp_substcapture (lua_State *L) {
+ return capture_aux(L, Csubst, 0);
+}
+
+
+static int lp_tablecapture (lua_State *L) {
+ return capture_aux(L, Ctable, 0);
+}
+
+
+static int lp_groupcapture (lua_State *L) {
+ if (lua_isnoneornil(L, 2))
+ return capture_aux(L, Cgroup, 0);
+ else {
+ luaL_checkstring(L, 2);
+ return capture_aux(L, Cgroup, 2);
+ }
+}
+
+
+static int lp_foldcapture (lua_State *L) {
+ luaL_checktype(L, 2, LUA_TFUNCTION);
+ return capture_aux(L, Cfold, 2);
+}
+
+
+static int lp_simplecapture (lua_State *L) {
+ return capture_aux(L, Csimple, 0);
+}
+
+
+static int lp_poscapture (lua_State *L) {
+ newemptycap(L, Cposition, 0);
+ return 1;
+}
+
+
+static int lp_argcapture (lua_State *L) {
+ int n = luaL_checkint(L, 1);
+ TTree *tree = newemptycap(L, Carg, 0);
+ tree->key = n;
+ luaL_argcheck(L, 0 < n && n <= SHRT_MAX, 1, "invalid argument index");
+ return 1;
+}
+
+
+static int lp_backref (lua_State *L) {
+ luaL_checkstring(L, 1);
+ newemptycap(L, Cbackref, 1);
+ return 1;
+}
+
+
+/*
+** Constant capture
+*/
+static int lp_constcapture (lua_State *L) {
+ int i;
+ int n = lua_gettop(L); /* number of values */
+ if (n == 0) /* no values? */
+ newleaf(L, TTrue); /* no capture */
+ else if (n == 1)
+ newemptycap(L, Cconst, 1); /* single constant capture */
+ else { /* create a group capture with all values */
+ TTree *tree = newtree(L, 1 + 3 * (n - 1) + 2);
+ tree->tag = TCapture;
+ tree->cap = Cgroup;
+ tree->key = 0;
+ tree = sib1(tree);
+ for (i = 1; i <= n - 1; i++) {
+ tree->tag = TSeq;
+ tree->u.ps = 3; /* skip TCapture and its sibling */
+ auxemptycap(L, sib1(tree), Cconst, i);
+ tree = sib2(tree);
+ }
+ auxemptycap(L, tree, Cconst, i);
+ }
+ return 1;
+}
+
+
+static int lp_matchtime (lua_State *L) {
+ TTree *tree;
+ luaL_checktype(L, 2, LUA_TFUNCTION);
+ tree = newroot1sib(L, TRunTime);
+ tree->key = addtoktable(L, 2);
+ return 1;
+}
+
/* }====================================================== */
-static int version_l (lua_State *L) {
+/*
+** {======================================================
+** Grammar - Tree generation
+** =======================================================
+*/
+
+/*
+** push on the stack the index and the pattern for the
+** initial rule of grammar at index 'arg' in the stack;
+** also add that index into position table.
+*/
+static void getfirstrule (lua_State *L, int arg, int postab) {
+ lua_rawgeti(L, arg, 1); /* access first element */
+ if (lua_isstring(L, -1)) { /* is it the name of initial rule? */
+ lua_pushvalue(L, -1); /* duplicate it to use as key */
+ lua_gettable(L, arg); /* get associated rule */
+ }
+ else {
+ lua_pushinteger(L, 1); /* key for initial rule */
+ lua_insert(L, -2); /* put it before rule */
+ }
+ if (!testpattern(L, -1)) { /* initial rule not a pattern? */
+ if (lua_isnil(L, -1))
+ luaL_error(L, "grammar has no initial rule");
+ else
+ luaL_error(L, "initial rule '%s' is not a pattern", lua_tostring(L, -2));
+ }
+ lua_pushvalue(L, -2); /* push key */
+ lua_pushinteger(L, 1); /* push rule position (after TGrammar) */
+ lua_settable(L, postab); /* insert pair at position table */
+}
+
+/*
+** traverse grammar at index 'arg', pushing all its keys and patterns
+** into the stack. Create a new table (before all pairs key-pattern) to
+** collect all keys and their associated positions in the final tree
+** (the "position table").
+** Return the number of rules and (in 'totalsize') the total size
+** for the new tree.
+*/
+static int collectrules (lua_State *L, int arg, int *totalsize) {
+ int n = 1; /* to count number of rules */
+ int postab = lua_gettop(L) + 1; /* index of position table */
+ int size; /* accumulator for total size */
+ lua_newtable(L); /* create position table */
+ getfirstrule(L, arg, postab);
+ size = 2 + getsize(L, postab + 2); /* TGrammar + TRule + rule */
+ lua_pushnil(L); /* prepare to traverse grammar table */
+ while (lua_next(L, arg) != 0) {
+ if (lua_tonumber(L, -2) == 1 ||
+ lua_equal(L, -2, postab + 1)) { /* initial rule? */
+ lua_pop(L, 1); /* remove value (keep key for lua_next) */
+ continue;
+ }
+ if (!testpattern(L, -1)) /* value is not a pattern? */
+ luaL_error(L, "rule '%s' is not a pattern", val2str(L, -2));
+ luaL_checkstack(L, LUA_MINSTACK, "grammar has too many rules");
+ lua_pushvalue(L, -2); /* push key (to insert into position table) */
+ lua_pushinteger(L, size);
+ lua_settable(L, postab);
+ size += 1 + getsize(L, -1); /* update size */
+ lua_pushvalue(L, -2); /* push key (for next lua_next) */
+ n++;
+ }
+ *totalsize = size + 1; /* TTrue to finish list of rules */
+ return n;
+}
+
+
+static void buildgrammar (lua_State *L, TTree *grammar, int frule, int n) {
+ int i;
+ TTree *nd = sib1(grammar); /* auxiliary pointer to traverse the tree */
+ for (i = 0; i < n; i++) { /* add each rule into new tree */
+ int ridx = frule + 2*i + 1; /* index of i-th rule */
+ int rulesize;
+ TTree *rn = gettree(L, ridx, &rulesize);
+ nd->tag = TRule;
+ nd->key = 0;
+ nd->cap = i; /* rule number */
+ nd->u.ps = rulesize + 1; /* point to next rule */
+ memcpy(sib1(nd), rn, rulesize * sizeof(TTree)); /* copy rule */
+ mergektable(L, ridx, sib1(nd)); /* merge its ktable into new one */
+ nd = sib2(nd); /* move to next rule */
+ }
+ nd->tag = TTrue; /* finish list of rules */
+}
+
+
+/*
+** Check whether a tree has potential infinite loops
+*/
+static int checkloops (TTree *tree) {
+ tailcall:
+ if (tree->tag == TRep && nullable(sib1(tree)))
+ return 1;
+ else if (tree->tag == TGrammar)
+ return 0; /* sub-grammars already checked */
+ else {
+ switch (numsiblings[tree->tag]) {
+ case 1: /* return checkloops(sib1(tree)); */
+ tree = sib1(tree); goto tailcall;
+ case 2:
+ if (checkloops(sib1(tree))) return 1;
+ /* else return checkloops(sib2(tree)); */
+ tree = sib2(tree); goto tailcall;
+ default: assert(numsiblings[tree->tag] == 0); return 0;
+ }
+ }
+}
+
+
+static int verifyerror (lua_State *L, int *passed, int npassed) {
+ int i, j;
+ for (i = npassed - 1; i >= 0; i--) { /* search for a repetition */
+ for (j = i - 1; j >= 0; j--) {
+ if (passed[i] == passed[j]) {
+ lua_rawgeti(L, -1, passed[i]); /* get rule's key */
+ return luaL_error(L, "rule '%s' may be left recursive", val2str(L, -1));
+ }
+ }
+ }
+ return luaL_error(L, "too many left calls in grammar");
+}
+
+
+/*
+** Check whether a rule can be left recursive; raise an error in that
+** case; otherwise return 1 iff pattern is nullable. Assume ktable at
+** the top of the stack.
+*/
+static int verifyrule (lua_State *L, TTree *tree, int *passed, int npassed,
+ int nullable) {
+ tailcall:
+ switch (tree->tag) {
+ case TChar: case TSet: case TAny:
+ case TFalse:
+ return nullable; /* cannot pass from here */
+ case TTrue:
+ case TBehind: /* look-behind cannot have calls */
+ return 1;
+ case TNot: case TAnd: case TRep:
+ /* return verifyrule(L, sib1(tree), passed, npassed, 1); */
+ tree = sib1(tree); nullable = 1; goto tailcall;
+ case TCapture: case TRunTime:
+ /* return verifyrule(L, sib1(tree), passed, npassed); */
+ tree = sib1(tree); goto tailcall;
+ case TCall:
+ /* return verifyrule(L, sib2(tree), passed, npassed); */
+ tree = sib2(tree); goto tailcall;
+ case TSeq: /* only check 2nd child if first is nullable */
+ if (!verifyrule(L, sib1(tree), passed, npassed, 0))
+ return nullable;
+ /* else return verifyrule(L, sib2(tree), passed, npassed); */
+ tree = sib2(tree); goto tailcall;
+ case TChoice: /* must check both children */
+ nullable = verifyrule(L, sib1(tree), passed, npassed, nullable);
+ /* return verifyrule(L, sib2(tree), passed, npassed, nullable); */
+ tree = sib2(tree); goto tailcall;
+ case TRule:
+ if (npassed >= MAXRULES)
+ return verifyerror(L, passed, npassed);
+ else {
+ passed[npassed++] = tree->key;
+ /* return verifyrule(L, sib1(tree), passed, npassed); */
+ tree = sib1(tree); goto tailcall;
+ }
+ case TGrammar:
+ return nullable(tree); /* sub-grammar cannot be left recursive */
+ default: assert(0); return 0;
+ }
+}
+
+
+static void verifygrammar (lua_State *L, TTree *grammar) {
+ int passed[MAXRULES];
+ TTree *rule;
+ /* check left-recursive rules */
+ for (rule = sib1(grammar); rule->tag == TRule; rule = sib2(rule)) {
+ if (rule->key == 0) continue; /* unused rule */
+ verifyrule(L, sib1(rule), passed, 0, 0);
+ }
+ assert(rule->tag == TTrue);
+ /* check infinite loops inside rules */
+ for (rule = sib1(grammar); rule->tag == TRule; rule = sib2(rule)) {
+ if (rule->key == 0) continue; /* unused rule */
+ if (checkloops(sib1(rule))) {
+ lua_rawgeti(L, -1, rule->key); /* get rule's key */
+ luaL_error(L, "empty loop in rule '%s'", val2str(L, -1));
+ }
+ }
+ assert(rule->tag == TTrue);
+}
+
+
+/*
+** Give a name for the initial rule if it is not referenced
+*/
+static void initialrulename (lua_State *L, TTree *grammar, int frule) {
+ if (sib1(grammar)->key == 0) { /* initial rule is not referenced? */
+ int n = lua_objlen(L, -1) + 1; /* index for name */
+ lua_pushvalue(L, frule); /* rule's name */
+ lua_rawseti(L, -2, n); /* ktable was on the top of the stack */
+ sib1(grammar)->key = n;
+ }
+}
+
+
+static TTree *newgrammar (lua_State *L, int arg) {
+ int treesize;
+ int frule = lua_gettop(L) + 2; /* position of first rule's key */
+ int n = collectrules(L, arg, &treesize);
+ TTree *g = newtree(L, treesize);
+ luaL_argcheck(L, n <= MAXRULES, arg, "grammar has too many rules");
+ g->tag = TGrammar; g->u.n = n;
+ lua_newtable(L); /* create 'ktable' */
+ lua_setfenv(L, -2);
+ buildgrammar(L, g, frule, n);
+ lua_getfenv(L, -1); /* get 'ktable' for new tree */
+ finalfix(L, frule - 1, g, sib1(g));
+ initialrulename(L, g, frule);
+ verifygrammar(L, g);
+ lua_pop(L, 1); /* remove 'ktable' */
+ lua_insert(L, -(n * 2 + 2)); /* move new table to proper position */
+ lua_pop(L, n * 2 + 1); /* remove position table + rule pairs */
+ return g; /* new table at the top of the stack */
+}
+
+/* }====================================================== */
+
+
+static Instruction *prepcompile (lua_State *L, Pattern *p, int idx) {
+ lua_getfenv(L, idx); /* push 'ktable' (may be used by 'finalfix') */
+ finalfix(L, 0, NULL, p->tree);
+ lua_pop(L, 1); /* remove 'ktable' */
+ return compile(L, p);
+}
+
+
+static int lp_printtree (lua_State *L) {
+ TTree *tree = getpatt(L, 1, NULL);
+ int c = lua_toboolean(L, 2);
+ if (c) {
+ lua_getfenv(L, 1); /* push 'ktable' (may be used by 'finalfix') */
+ finalfix(L, 0, NULL, tree);
+ lua_pop(L, 1); /* remove 'ktable' */
+ }
+ printktable(L, 1);
+ printtree(tree, 0);
+ return 0;
+}
+
+
+static int lp_printcode (lua_State *L) {
+ Pattern *p = getpattern(L, 1);
+ printktable(L, 1);
+ if (p->code == NULL) /* not compiled yet? */
+ prepcompile(L, p, 1);
+ printpatt(p->code, p->codesize);
+ return 0;
+}
+
+
+/*
+** Get the initial position for the match, interpreting negative
+** values from the end of the subject
+*/
+static size_t initposition (lua_State *L, size_t len) {
+ lua_Integer ii = luaL_optinteger(L, 3, 1);
+ if (ii > 0) { /* positive index? */
+ if ((size_t)ii <= len) /* inside the string? */
+ return (size_t)ii - 1; /* return it (corrected to 0-base) */
+ else return len; /* crop at the end */
+ }
+ else { /* negative index */
+ if ((size_t)(-ii) <= len) /* inside the string? */
+ return len - ((size_t)(-ii)); /* return position from the end */
+ else return 0; /* crop at the beginning */
+ }
+}
+
+
+/*
+** Main match function
+*/
+static int lp_match (lua_State *L) {
+ Capture capture[INITCAPSIZE];
+ const char *r;
+ size_t l;
+ Pattern *p = (getpatt(L, 1, NULL), getpattern(L, 1));
+ Instruction *code = (p->code != NULL) ? p->code : prepcompile(L, p, 1);
+ const char *s = luaL_checklstring(L, SUBJIDX, &l);
+ size_t i = initposition(L, l);
+ int ptop = lua_gettop(L);
+ lua_pushnil(L); /* initialize subscache */
+ lua_pushlightuserdata(L, capture); /* initialize caplistidx */
+ lua_getfenv(L, 1); /* initialize penvidx */
+ r = match(L, s, s + i, s + l, code, capture, ptop);
+ if (r == NULL) {
+ lua_pushnil(L);
+ return 1;
+ }
+ return getcaptures(L, s, r, ptop);
+}
+
+
+
+/*
+** {======================================================
+** Library creation and functions not related to matching
+** =======================================================
+*/
+
+static int lp_setmax (lua_State *L) {
+ luaL_optinteger(L, 1, -1);
+ lua_settop(L, 1);
+ lua_setfield(L, LUA_REGISTRYINDEX, MAXSTACKIDX);
+ return 0;
+}
+
+
+static int lp_version (lua_State *L) {
lua_pushstring(L, VERSION);
return 1;
}
-static int type_l (lua_State *L) {
+static int lp_type (lua_State *L) {
if (testpattern(L, 1))
lua_pushliteral(L, "pattern");
else
@@ -2265,16 +3244,24 @@ static int type_l (lua_State *L) {
}
+int lp_gc (lua_State *L) {
+ Pattern *p = getpattern(L, 1);
+ if (p->codesize > 0)
+ reallocprog(L, p, 0);
+ return 0;
+}
+
+
static void createcat (lua_State *L, const char *catname, int (catf) (int)) {
- Instruction *p = newcharset(L);
+ TTree *t = newcharset(L);
int i;
- for (i = 0; i < CHAR_MAX; i++)
- if (catf(i)) setchar(p[1].buff, i);
+ for (i = 0; i <= UCHAR_MAX; i++)
+ if (catf(i)) setchar(treebuffer(t), i);
lua_setfield(L, -2, catname);
}
-static int locale_l (lua_State *L) {
+static int lp_locale (lua_State *L) {
if (lua_isnoneornil(L, 1)) {
lua_settop(L, 0);
lua_createtable(L, 0, 12);
@@ -2298,108 +3285,56 @@ static int locale_l (lua_State *L) {
}
-static int setmax (lua_State *L) {
- luaL_optinteger(L, 1, -1);
- lua_settop(L, 1);
- lua_setfield(L, LUA_REGISTRYINDEX, MAXSTACKIDX);
- return 0;
-}
-
-
-static int printpat_l (lua_State *L) {
- Instruction *p = getpatt(L, 1, NULL);
- int n, i;
- lua_getfenv(L, 1);
- n = ktablelen(L, -1);
- printf("[");
- for (i = 1; i <= n; i++) {
- printf("%d = ", i);
- lua_rawgeti(L, -1, i);
- if (lua_isstring(L, -1))
- printf("%s ", lua_tostring(L, -1));
- else
- printf("%s ", lua_typename(L, lua_type(L, -1)));
- lua_pop(L, 1);
- }
- printf("]\n");
- printpatt(p);
- return 0;
-}
-
-
-static int matchl (lua_State *L) {
- Capture capture[INITCAPSIZE];
- const char *r;
- size_t l;
- Instruction *p = getpatt(L, 1, NULL);
- const char *s = luaL_checklstring(L, SUBJIDX, &l);
- int ptop = lua_gettop(L);
- lua_Integer ii = luaL_optinteger(L, 3, 1);
- size_t i = (ii > 0) ?
- (((size_t)ii <= l) ? (size_t)ii - 1 : l) :
- (((size_t)-ii <= l) ? l - ((size_t)-ii) : 0);
- lua_pushnil(L); /* subscache */
- lua_pushlightuserdata(L, capture); /* caplistidx */
- lua_getfenv(L, 1); /* penvidx */
- r = match(L, s, s + i, s + l, p, capture, ptop);
- if (r == NULL) {
- lua_pushnil(L);
- return 1;
- }
- return getcaptures(L, s, r, ptop);
-}
-
-
static struct luaL_Reg pattreg[] = {
- {"match", matchl},
- {"print", printpat_l},
- {"locale", locale_l},
- {"setmaxstack", setmax},
- {"B", pattbehind},
- {"C", capture_l},
- {"Cf", fold_l},
- {"Cc", capconst_l},
- {"Cg", group_l},
- {"Cp", position_l},
- {"Cb", backref_l},
- {"Carg", argcap_l},
- {"Cmt", matchtime_l},
- {"Cs", capsubst_l},
- {"Ct", tcapture_l},
- {"P", pattern_l},
- {"R", range_l},
- {"S", set_l},
- {"V", nter_l},
- {"type", type_l},
- {"version", version_l},
+ {"ptree", lp_printtree},
+ {"pcode", lp_printcode},
+ {"match", lp_match},
+ {"B", lp_behind},
+ {"V", lp_V},
+ {"C", lp_simplecapture},
+ {"Cc", lp_constcapture},
+ {"Cmt", lp_matchtime},
+ {"Cb", lp_backref},
+ {"Carg", lp_argcapture},
+ {"Cp", lp_poscapture},
+ {"Cs", lp_substcapture},
+ {"Ct", lp_tablecapture},
+ {"Cf", lp_foldcapture},
+ {"Cg", lp_groupcapture},
+ {"P", lp_P},
+ {"S", lp_set},
+ {"R", lp_range},
+ {"locale", lp_locale},
+ {"version", lp_version},
+ {"setmaxstack", lp_setmax},
+ {"type", lp_type},
{NULL, NULL}
};
-static struct luaL_Reg metapattreg[] = {
- {"__add", union_l},
- {"__pow", star_l},
- {"__sub", diff_l},
- {"__mul", concat_l},
- {"__div", rcapture_l},
- {"__unm", unm_l},
- {"__len", pattand_l},
+static struct luaL_Reg metareg[] = {
+ {"__mul", lp_seq},
+ {"__add", lp_choice},
+ {"__pow", lp_star},
+ {"__gc", lp_gc},
+ {"__len", lp_and},
+ {"__div", lp_divcapture},
+ {"__unm", lp_not},
+ {"__sub", lp_sub},
{NULL, NULL}
};
int luaopen_lpeg (lua_State *L);
int luaopen_lpeg (lua_State *L) {
- lua_pushcfunction(L, (lua_CFunction)&l_newpf); /* new-pattern function */
- lua_setfield(L, LUA_REGISTRYINDEX, KEYNEWPATT); /* register it */
luaL_newmetatable(L, PATTERN_T);
- lua_pushnumber(L, MAXBACK);
+ lua_pushnumber(L, MAXBACK); /* initialize maximum backtracking */
lua_setfield(L, LUA_REGISTRYINDEX, MAXSTACKIDX);
- luaL_register(L, NULL, metapattreg);
+ luaL_register(L, NULL, metareg);
luaL_register(L, "lpeg", pattreg);
- lua_pushliteral(L, "__index");
- lua_pushvalue(L, -2);
- lua_settable(L, -4);
+ lua_pushvalue(L, -1);
+ lua_setfield(L, -3, "__index");
return 1;
}
+/* }====================================================== */
diff --git a/Build/source/texk/web2c/luatexdir/luapeg/lpeg.h b/Build/source/texk/web2c/luatexdir/luapeg/lpeg.h
index 13d7acefd39..456e8277c7d 100644
--- a/Build/source/texk/web2c/luatexdir/luapeg/lpeg.h
+++ b/Build/source/texk/web2c/luatexdir/luapeg/lpeg.h
@@ -1,38 +1,403 @@
/*
-** $Id: lpeg.h,v 1.1 2009/12/23 16:15:36 roberto Exp $
+** $Id: lptypes.h,v 1.8 2013/04/12 16:26:38 roberto Exp $
** LPeg - PEG pattern matching for Lua
-** Copyright 2009, Lua.org & PUC-Rio (see 'lpeg.html' for license)
+** Copyright 2007, Lua.org & PUC-Rio (see 'lpeg.html' for license)
** written by Roberto Ierusalimschy
*/
-#ifndef lpeg_h
-#define lpeg_h
+#if !defined(lptypes_h)
+#define lptypes_h
-#include "lua.h"
+#if !defined(LPEG_DEBUG)
+#define NDEBUG
+#endif
+
+#include <assert.h>
+#include <limits.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <string.h>
+
+#include "lauxlib.h"
+#include "lua.h"
+
+
+
+
+#define VERSION "0.12"
+
+
+#define PATTERN_T "lpeg-pattern"
+#define MAXSTACKIDX "lpeg-maxstack"
+
+
+/*
+** compatibility with Lua 5.2
+*/
+#if (LUA_VERSION_NUM == 502)
+
+#undef lua_equal
+#define lua_equal(L,idx1,idx2) lua_compare(L,(idx1),(idx2),LUA_OPEQ)
+
+#undef lua_getfenv
+#define lua_getfenv lua_getuservalue
+#undef lua_setfenv
+#define lua_setfenv lua_setuservalue
+
+#undef lua_objlen
+#define lua_objlen lua_rawlen
+
+#undef luaL_register
+#define luaL_register(L,n,f) \
+ { if ((n) == NULL) luaL_setfuncs(L,f,0); else luaL_newlib(L,f); }
+
+#endif
+
+
+/* default maximum size for call/backtrack stack */
+#if !defined(MAXBACK)
+#define MAXBACK 100
+#endif
+
+
+/* maximum number of rules in a grammar */
+#define MAXRULES 200
+
+
+
+/* initial size for capture's list */
+#define INITCAPSIZE 32
+
+
+/* index, on Lua stack, for subject */
+#define SUBJIDX 2
+
+/* number of fixed arguments to 'match' (before capture arguments) */
+#define FIXEDARGS 3
+
+/* index, on Lua stack, for capture list */
+#define caplistidx(ptop) ((ptop) + 2)
+
+/* index, on Lua stack, for pattern's ktable */
+#define ktableidx(ptop) ((ptop) + 3)
+
+/* index, on Lua stack, for backtracking stack */
+#define stackidx(ptop) ((ptop) + 4)
+
+
+
+typedef unsigned char byte;
+
+
+#define BITSPERCHAR 8
+
+#define CHARSETSIZE ((UCHAR_MAX/BITSPERCHAR) + 1)
+
+
+
+typedef struct Charset {
+ byte cs[CHARSETSIZE];
+} Charset;
+
+
+
+#define loopset(v,b) { int v; for (v = 0; v < CHARSETSIZE; v++) {b;} }
+
+/* access to charset */
+#define treebuffer(t) ((byte *)((t) + 1))
+
+/* number of slots needed for 'n' bytes */
+#define bytes2slots(n) (((n) - 1) / sizeof(TTree) + 1)
+
+/* set 'b' bit in charset 'cs' */
+#define setchar(cs,b) ((cs)[(b) >> 3] |= (1 << ((b) & 7)))
+
+
+/*
+** in capture instructions, 'kind' of capture and its offset are
+** packed in field 'aux', 4 bits for each
+*/
+#define getkind(op) ((op)->i.aux & 0xF)
+#define getoff(op) (((op)->i.aux >> 4) & 0xF)
+#define joinkindoff(k,o) ((k) | ((o) << 4))
+
+#define MAXOFF 0xF
+#define MAXAUX 0xFF
+
+
+/* maximum number of bytes to look behind */
+#define MAXBEHIND MAXAUX
+
+
+/* maximum size (in elements) for a pattern */
+#define MAXPATTSIZE (SHRT_MAX - 10)
+
+
+/* size (in elements) for an instruction plus extra l bytes */
+#define instsize(l) (((l) + sizeof(Instruction) - 1)/sizeof(Instruction) + 1)
+
+
+/* size (in elements) for a ISet instruction */
+#define CHARSETINSTSIZE instsize(CHARSETSIZE)
+
+/* size (in elements) for a IFunc instruction */
+#define funcinstsize(p) ((p)->i.aux + 2)
+
+
+
+#define testchar(st,c) (((int)(st)[((c) >> 3)] & (1 << ((c) & 7))))
+
+
+#endif
+
+/*
+** $Id: lpcap.h,v 1.1 2013/03/21 20:25:12 roberto Exp $
+*/
+
+#if !defined(lpcap_h)
+#define lpcap_h
+
+
+/* include "lptypes.h" */
-#define KEYNEWPATT "lpeg.newpf"
+/* kinds of captures */
+typedef enum CapKind {
+ Cclose, Cposition, Cconst, Cbackref, Carg, Csimple, Ctable, Cfunction,
+ Cquery, Cstring, Cnum, Csubst, Cfold, Cruntime, Cgroup
+} CapKind;
+
+
+typedef struct Capture {
+ const char *s; /* subject position */
+ short idx; /* extra info about capture (group name, arg index, etc.) */
+ byte kind; /* kind of capture */
+ byte siz; /* size of full capture + 1 (0 = not a full capture) */
+} Capture;
+
+
+typedef struct CapState {
+ Capture *cap; /* current capture */
+ Capture *ocap; /* (original) capture list */
+ lua_State *L;
+ int ptop; /* index of last argument to 'match' */
+ const char *s; /* original string */
+ int valuecached; /* value stored in cache slot */
+} CapState;
+
+
+int runtimecap (CapState *cs, Capture *close, const char *s, int *rem);
+int getcaptures (lua_State *L, const char *s, const char *r, int ptop);
+int finddyncap (Capture *cap, Capture *last);
+
+#endif
+
+
+/*
+** $Id: lptree.h,v 1.2 2013/03/24 13:51:12 roberto Exp $
+*/
+
+#if !defined(lptree_h)
+#define lptree_h
+
+
+/*#include "lptypes.h" */
+
+
+/*
+** types of trees
+*/
+typedef enum TTag {
+ TChar = 0, TSet, TAny, /* standard PEG elements */
+ TTrue, TFalse,
+ TRep,
+ TSeq, TChoice,
+ TNot, TAnd,
+ TCall,
+ TOpenCall,
+ TRule, /* sib1 is rule's pattern, sib2 is 'next' rule */
+ TGrammar, /* sib1 is initial (and first) rule */
+ TBehind, /* match behind */
+ TCapture, /* regular capture */
+ TRunTime /* run-time capture */
+} TTag;
+
+/* number of siblings for each tree */
+extern const byte numsiblings[];
+
+
+/*
+** Tree trees
+** The first sibling of a tree (if there is one) is immediately after
+** the tree. A reference to a second sibling (ps) is its position
+** relative to the position of the tree itself. A key in ktable
+** uses the (unique) address of the original tree that created that
+** entry. NULL means no data.
+*/
+typedef struct TTree {
+ byte tag;
+ byte cap; /* kind of capture (if it is a capture) */
+ unsigned short key; /* key in ktable for Lua data (0 if no key) */
+ union {
+ int ps; /* occasional second sibling */
+ int n; /* occasional counter */
+ } u;
+} TTree;
+
+
+/*
+** A complete pattern has its tree plus, if already compiled,
+** its corresponding code
+*/
+typedef struct Pattern {
+ union Instruction *code;
+ int codesize;
+ TTree tree[1];
+} Pattern;
+
+
+/* number of siblings for each tree */
+extern const byte numsiblings[];
+
+/* access to siblings */
+#define sib1(t) ((t) + 1)
+#define sib2(t) ((t) + (t)->u.ps)
+
+
+
+
+#endif
+
+/*
+** $Id: lpvm.h,v 1.2 2013/04/03 20:37:18 roberto Exp $
+*/
+
+#if !defined(lpvm_h)
+#define lpvm_h
+
+/*#include "lpcap.h"*/
+
+
+/* Virtual Machine's instructions */
+typedef enum Opcode {
+ IAny, /* if no char, fail */
+ IChar, /* if char != aux, fail */
+ ISet, /* if char not in buff, fail */
+ ITestAny, /* in no char, jump to 'offset' */
+ ITestChar, /* if char != aux, jump to 'offset' */
+ ITestSet, /* if char not in buff, jump to 'offset' */
+ ISpan, /* read a span of chars in buff */
+ IBehind, /* walk back 'aux' characters (fail if not possible) */
+ IRet, /* return from a rule */
+ IEnd, /* end of pattern */
+ IChoice, /* stack a choice; next fail will jump to 'offset' */
+ IJmp, /* jump to 'offset' */
+ ICall, /* call rule at 'offset' */
+ IOpenCall, /* call rule number 'key' (must be closed to a ICall) */
+ ICommit, /* pop choice and jump to 'offset' */
+ IPartialCommit, /* update top choice to current position and jump */
+ IBackCommit, /* "fails" but jump to its own 'offset' */
+ IFailTwice, /* pop one choice and then fail */
+ IFail, /* go back to saved state on choice and jump to saved offset */
+ IGiveup, /* internal use */
+ IFullCapture, /* complete capture of last 'off' chars */
+ IOpenCapture, /* start a capture */
+ ICloseCapture,
+ ICloseRunTime
+} Opcode;
+
+
+
+typedef union Instruction {
+ struct Inst {
+ byte code;
+ byte aux;
+ short key;
+ } i;
+ int offset;
+ byte buff[1];
+} Instruction;
+
+
+int getposition (lua_State *L, int t, int i);
+void printpatt (Instruction *p, int n);
+const char *match (lua_State *L, const char *o, const char *s, const char *e,
+ Instruction *op, Capture *capture, int ptop);
+int verify (lua_State *L, Instruction *op, const Instruction *p,
+ Instruction *e, int postable, int rule);
+void checkrule (lua_State *L, Instruction *op, int from, int to,
+ int postable, int rule);
+
+
+#endif
/*
-** type of extension functions that define new "patterns" for LPEG
-** It should return the new current position or NULL if match fails
+** $Id: lpcode.h,v 1.5 2013/04/04 21:24:45 roberto Exp $
*/
-typedef const char *(*PattFunc) (const char *s, /* current position */
- const char *e, /* string end */
- const char *o, /* string start */
- const void *ud); /* user data */
+#if !defined(lpcode_h)
+#define lpcode_h
+
+/*#include "lua.h"*/
+
+/*#include "lptypes.h"*/
+/*#include "lptree.h"*/
+/*#include "lpvm.h"*/
+
+int tocharset (TTree *tree, Charset *cs);
+int checkaux (TTree *tree, int pred);
+int fixedlenx (TTree *tree, int count, int len);
+int hascaptures (TTree *tree);
+int lp_gc (lua_State *L);
+Instruction *compile (lua_State *L, Pattern *p);
+void reallocprog (lua_State *L, Pattern *p, int nsize);
+int sizei (const Instruction *i);
+
+
+#define PEnullable 0
+#define PEnofail 1
+
+#define nofail(t) checkaux(t, PEnofail)
+#define nullable(t) checkaux(t, PEnullable)
+
+#define fixedlen(t) fixedlenx(t, 0, 0)
+
+
+
+#endif
/*
-** function to create new patterns based on 'PattFunc' functions.
-** This function is available at *registry[KEYNEWPATT]. (Notice
-** the extra indirection; the userdata at the registry points to
-** a variable that points to the function. In ANSI C a void* cannot
-** point to a function.)
+** $Id: lpprint.h,v 1.1 2013/03/21 20:25:12 roberto Exp $
*/
-typedef void (*Newpf) (lua_State *L,
- PattFunc f, /* pattern */
- const void *ud, /* (user) data to be passed to 'f' */
- size_t l); /* size of data to be passed to 'f' */
+
+
+#if !defined(lpprint_h)
+#define lpprint_h
+
+
+/*#include "lptree.h"*/
+/*#include "lpvm.h"*/
+
+
+#if defined(LPEG_DEBUG)
+
+void printpatt (Instruction *p, int n);
+void printtree (TTree *tree, int ident);
+void printktable (lua_State *L, int idx);
+void printcharset (const byte *st);
+void printcaplist (Capture *cap, Capture *limit);
+
+#else
+
+#define printktable(L,idx) \
+ luaL_error(L, "function only implemented in debug mode")
+#define printtree(tree,i) \
+ luaL_error(L, "function only implemented in debug mode")
+#define printpatt(p,n) \
+ luaL_error(L, "function only implemented in debug mode")
#endif
+
+
+#endif
+
diff --git a/Build/source/texk/web2c/luatexdir/luatex_svnversion.h b/Build/source/texk/web2c/luatexdir/luatex_svnversion.h
index 01e985cf641..2fdac934132 100644
--- a/Build/source/texk/web2c/luatexdir/luatex_svnversion.h
+++ b/Build/source/texk/web2c/luatexdir/luatex_svnversion.h
@@ -1 +1 @@
-#define luatex_svn_revision 4772
+#define luatex_svn_revision 4794
diff --git a/Build/source/texk/web2c/luatexdir/tex/linebreak.w b/Build/source/texk/web2c/luatexdir/tex/linebreak.w
index 07017ab1776..0d7b8b2723b 100644
--- a/Build/source/texk/web2c/luatexdir/tex/linebreak.w
+++ b/Build/source/texk/web2c/luatexdir/tex/linebreak.w
@@ -1,2210 +1,2212 @@
-% linebreak.w
-%
-% Copyright 2006-2008 Taco Hoekwater <taco@@luatex.org>
-%
-% This file is part of LuaTeX.
-%
-% LuaTeX is free software; you can redistribute it and/or modify it under
-% the terms of the GNU General Public License as published by the Free
-% Software Foundation; either version 2 of the License, or (at your
-% option) any later version.
-%
-% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
-% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
-% License for more details.
-%
-% You should have received a copy of the GNU General Public License along
-% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
-
-@ @c
-static const char _svn_version[] =
- "$Id: linebreak.w 4679 2013-12-19 15:47:53Z luigi $"
- "$URL: https://foundry.supelec.fr/svn/luatex/trunk/source/texk/web2c/luatexdir/tex/linebreak.w $";
-
-#include "ptexlib.h"
-
-@ We come now to what is probably the most interesting algorithm of \TeX:
-the mechanism for choosing the ``best possible'' breakpoints that yield
-the individual lines of a paragraph. \TeX's line-breaking algorithm takes
-a given horizontal list and converts it to a sequence of boxes that are
-appended to the current vertical list. In the course of doing this, it
-creates a special data structure containing three kinds of records that are
-not used elsewhere in \TeX. Such nodes are created while a paragraph is
-being processed, and they are destroyed afterwards; thus, the other parts
-of \TeX\ do not need to know anything about how line-breaking is done.
-
-The method used here is based on an approach devised by Michael F. Plass and
-@^Plass, Michael Frederick@>
-@^Knuth, Donald Ervin@>
-the author in 1977, subsequently generalized and improved by the same two
-people in 1980. A detailed discussion appears in {\sl SOFTWARE---Practice
-\AM\ Experience \bf11} (1981), 1119--1184, where it is shown that the
-line-breaking problem can be regarded as a special case of the problem of
-computing the shortest path in an acyclic network. The cited paper includes
-numerous examples and describes the history of line breaking as it has been
-practiced by printers through the ages. The present implementation adds two
-new ideas to the algorithm of 1980: Memory space requirements are considerably
-reduced by using smaller records for inactive nodes than for active ones,
-and arithmetic overflow is avoided by using ``delta distances'' instead of
-keeping track of the total distance from the beginning of the paragraph to the
-current point.
-
-The |line_break| procedure should be invoked only in horizontal mode; it
-leaves that mode and places its output into the current vlist of the
-enclosing vertical mode (or internal vertical mode).
-There is one explicit parameter: |d| is true for partial paragraphs
-preceding display math mode; in this case the amount of additional
-penalty inserted before the final line is |display_widow_penalty|
-instead of |widow_penalty|.
-
-There are also a number of implicit parameters: The hlist to be broken
-starts at |vlink(head)|, and it is nonempty. The value of |prev_graf| in the
-enclosing semantic level tells where the paragraph should begin in the
-sequence of line numbers, in case hanging indentation or \.{\\parshape}
-are in use; |prev_graf| is zero unless this paragraph is being continued
-after a displayed formula. Other implicit parameters, such as the
-|par_shape_ptr| and various penalties to use for hyphenation, etc., appear
-in |eqtb|.
-
-After |line_break| has acted, it will have updated the current vlist and the
-value of |prev_graf|. Furthermore, the global variable |just_box| will
-point to the final box created by |line_break|, so that the width of this
-line can be ascertained when it is necessary to decide whether to use
-|above_display_skip| or |above_display_short_skip| before a displayed formula.
-
-@c
-halfword just_box; /* the |hlist_node| for the last line of the new paragraph */
-
-
-@ In it's complete form, |line_break| is a rather lengthy
-procedure---sort of a small world unto itself---we must build it up
-little by little. Below you see only the general outline.
-
-The main task performed here is to move the list from |head| to
-|temp_head| and go into the enclosing semantic level. We also append
-the \.{\\parfillskip} glue to the end of the paragraph, removing a
-space (or other glue node) if it was there, since spaces usually
-precede blank lines and instances of `\.{\$\$}'. The |par_fill_skip|
-is preceded by an infinite penalty, so it will never be considered as
-a potential breakpoint.
-
-That code assumes that a |glue_node| and a |penalty_node| occupy the
-same number of |mem|~words.
-@^data structure assumptions@>
-
-Most other processing is delegated to external functions.
-
-@c
-void line_break(boolean d, int line_break_context)
-{
- int paragraph_dir = 0; /* main direction of paragraph */
- halfword final_par_glue;
- halfword start_of_par;
- int callback_id;
- pack_begin_line = cur_list.ml_field; /* this is for over/underfull box messages */
- vlink(temp_head) = vlink(cur_list.head_field);
- new_hyphenation(temp_head, cur_list.tail_field);
- cur_list.tail_field = new_ligkern(temp_head, cur_list.tail_field);
- if (is_char_node(cur_list.tail_field)) {
- tail_append(new_penalty(inf_penalty));
- } else if (type(cur_list.tail_field) != glue_node) {
- tail_append(new_penalty(inf_penalty));
- } else {
- type(cur_list.tail_field) = penalty_node;
- delete_glue_ref(glue_ptr(cur_list.tail_field));
- if (leader_ptr(cur_list.tail_field) != null)
- flush_node_list(leader_ptr(cur_list.tail_field));
- penalty(cur_list.tail_field) = inf_penalty;
- }
- final_par_glue = new_param_glue(par_fill_skip_code);
- couple_nodes(cur_list.tail_field, final_par_glue);
- cur_list.tail_field = vlink(cur_list.tail_field);
-#ifdef DEBUG
- {
- int n = temp_head;
- fprintf(stdout, "pre_linebreak_filter status:\n");
- while (n) {
- fprintf(stdout, " %s node %d\n",
- get_node_name(type(n), subtype(n)), (int) n);
- n = vlink(n);
- }
- }
-#endif
- lua_node_filter(pre_linebreak_filter_callback,
- line_break_context, temp_head,
- addressof(cur_list.tail_field));
- last_line_fill = cur_list.tail_field;
- pop_nest();
- start_of_par = cur_list.tail_field;
-#ifdef DEBUG
- {
- int n = temp_head;
- fprintf(stdout, "pre_linebreak_filter returned:\n");
- while (n) {
- fprintf(stdout, " %s node %d\n",
- get_node_name(type(n), subtype(n)), (int) n);
- n = vlink(n);
- }
- }
-#endif
- callback_id = callback_defined(linebreak_filter_callback);
- if (callback_id > 0) {
- callback_id =
- lua_linebreak_callback(d, temp_head,
- addressof(cur_list.tail_field));
- if (callback_id > 0) {
- /* find the correct value for the |just_box| */
- halfword box_search = cur_list.tail_field;
- just_box = null;
- if (box_search != null) {
- do {
- if (type(box_search) == hlist_node) {
- just_box = box_search;
- }
- box_search = vlink(box_search);
- } while (box_search != null);
- }
- if (just_box == null) {
- help3
- ("A linebreaking routine should return a non-empty list of nodes",
- "and at least one of those has to be a \\hbox.",
- "Sorry, I cannot recover from this.");
- print_err("Invalid linebreak_filter");
- succumb();
- }
- } else {
- if (int_par(tracing_paragraphs_code) > 0) {
- begin_diagnostic();
- tprint_nl
- ("Lua linebreak_filter failed, reverting to default on line ");
- print_int(line);
- end_diagnostic(true);
- }
- }
- }
- if (callback_id == 0) {
- if ((!is_char_node(vlink(temp_head)))
- && ((type(vlink(temp_head)) == whatsit_node)
- && (subtype(vlink(temp_head)) == local_par_node)))
- paragraph_dir = local_par_dir(vlink(temp_head));
- else
- assert(0); /* |paragraph_dir = 0|; */
- ext_do_line_break(paragraph_dir,
- int_par(pretolerance_code),
- int_par(tracing_paragraphs_code),
- int_par(tolerance_code),
- dimen_par(emergency_stretch_code),
- int_par(looseness_code),
- int_par(hyphen_penalty_code),
- int_par(ex_hyphen_penalty_code),
- int_par(pdf_adjust_spacing_code),
- equiv(par_shape_loc),
- int_par(adj_demerits_code),
- int_par(pdf_protrude_chars_code),
- int_par(line_penalty_code),
- int_par(last_line_fit_code),
- int_par(double_hyphen_demerits_code),
- int_par(final_hyphen_demerits_code),
- dimen_par(hang_indent_code),
- dimen_par(hsize_code),
- int_par(hang_after_code),
- glue_par(left_skip_code),
- glue_par(right_skip_code),
- dimen_par(pdf_each_line_height_code),
- dimen_par(pdf_each_line_depth_code),
- dimen_par(pdf_first_line_height_code),
- dimen_par(pdf_last_line_depth_code),
- equiv(inter_line_penalties_loc),
- int_par(inter_line_penalty_code),
- int_par(club_penalty_code),
- equiv(club_penalties_loc),
- (d ? equiv(display_widow_penalties_loc) : equiv(widow_penalties_loc)),
- (d ? int_par(display_widow_penalty_code) : int_par(widow_penalty_code)),
- int_par(broken_penalty_code),
- final_par_glue, dimen_par(pdf_ignored_dimen_code));
- }
- lua_node_filter(post_linebreak_filter_callback,
- line_break_context, start_of_par,
- addressof(cur_list.tail_field));
- pack_begin_line = 0;
-}
-
-
-@ Glue nodes in a horizontal list that is being paragraphed are not supposed to
- include ``infinite'' shrinkability; that is why the algorithm maintains
- four registers for stretching but only one for shrinking. If the user tries to
- introduce infinite shrinkability, the shrinkability will be reset to finite
- and an error message will be issued. A boolean variable |no_shrink_error_yet|
- prevents this error message from appearing more than once per paragraph.
-
-@c
-#define check_shrinkage(a) \
- if ((shrink_order((a))!=normal)&&(shrink((a))!=0)) \
- a=finite_shrink((a))
-
-static boolean no_shrink_error_yet; /*have we complained about infinite shrinkage? */
-
-static halfword finite_shrink(halfword p)
-{ /* recovers from infinite shrinkage */
- halfword q; /*new glue specification */
- const char *hlp[] = {
- "The paragraph just ended includes some glue that has",
- "infinite shrinkability, e.g., `\\hskip 0pt minus 1fil'.",
- "Such glue doesn't belong there---it allows a paragraph",
- "of any length to fit on one line. But it's safe to proceed,",
- "since the offensive shrinkability has been made finite.",
- NULL
- };
- if (no_shrink_error_yet) {
- no_shrink_error_yet = false;
- tex_error("Infinite glue shrinkage found in a paragraph", hlp);
- }
- q = new_spec(p);
- shrink_order(q) = normal;
- delete_glue_ref(p);
- return q;
-}
-
-@ A pointer variable |cur_p| runs through the given horizontal list as we look
- for breakpoints. This variable is global, since it is used both by |line_break|
- and by its subprocedure |try_break|.
-
- Another global variable called |threshold| is used to determine the feasibility
- of individual lines: breakpoints are feasible if there is a way to reach
- them without creating lines whose badness exceeds |threshold|. (The
- badness is compared to |threshold| before penalties are added, so that
- penalty values do not affect the feasibility of breakpoints, except that
- no break is allowed when the penalty is 10000 or more.) If |threshold|
- is 10000 or more, all legal breaks are considered feasible, since the
- |badness| function specified above never returns a value greater than~10000.
-
- Up to three passes might be made through the paragraph in an attempt to find at
- least one set of feasible breakpoints. On the first pass, we have
- |threshold=pretolerance| and |second_pass=final_pass=false|.
- If this pass fails to find a
- feasible solution, |threshold| is set to |tolerance|, |second_pass| is set
- |true|, and an attempt is made to hyphenate as many words as possible.
- If that fails too, we add |emergency_stretch| to the background
- stretchability and set |final_pass=true|.
-
-@c
-static boolean second_pass; /* is this our second attempt to break this paragraph? */
-static boolean final_pass; /*is this our final attempt to break this paragraph? */
-static int threshold; /* maximum badness on feasible lines */
-
-/* maximum fill level for |hlist_stack|*/
-#define max_hlist_stack 512 /* maybe good if larger than |2 *
- max_quarterword|, so that box nesting
- level would overflow first */
-
-/* stack for |find_protchar_left()| and |find_protchar_right()| */
-static halfword hlist_stack[max_hlist_stack];
-
-/* fill level for |hlist_stack| */
-static short hlist_stack_level = 0;
-
-@ @c
-static void push_node(halfword p)
-{
- if (hlist_stack_level >= max_hlist_stack)
- pdf_error("push_node", "stack overflow");
- hlist_stack[hlist_stack_level++] = p;
-}
-
-static halfword pop_node(void)
-{
- if (hlist_stack_level <= 0) /* would point to some bug */
- pdf_error("pop_node", "stack underflow (internal error)");
- return hlist_stack[--hlist_stack_level];
-}
-
-@ @c
-static int max_stretch_ratio = 0; /*maximal stretch ratio of expanded fonts */
-static int max_shrink_ratio = 0; /*maximal shrink ratio of expanded fonts */
-static int cur_font_step = 0; /*the current step of expanded fonts */
-
-
-static boolean check_expand_pars(internal_font_number f)
-{
- int m;
-
- if ((font_step(f) == 0)
- || ((font_max_stretch(f) == 0) && (font_max_shrink(f) == 0)))
- return false;
- if (cur_font_step < 0)
- cur_font_step = font_step(f);
- else if (cur_font_step != font_step(f))
- pdf_error("font expansion",
- "using fonts with different step of expansion in one paragraph is not allowed");
- m = font_max_stretch(f);
- if (m != 0) {
- if (max_stretch_ratio < 0)
- max_stretch_ratio = m;
- else if (max_stretch_ratio != m)
- pdf_error("font expansion",
- "using fonts with different limit of expansion in one paragraph is not allowed");
- }
- m = font_max_shrink(f);
- if (m != 0) {
- if (max_shrink_ratio < 0)
- max_shrink_ratio = -m;
- else if (max_shrink_ratio != -m)
- pdf_error("font expansion",
- "using fonts with different limit of expansion in one paragraph is not allowed");
- }
- return true;
-}
-
-@ searches left to right from list head |l|, returns 1st non-skipable item
-
-@c
-/*public*/ halfword find_protchar_left(halfword l, boolean d)
-{
- halfword t;
- boolean run;
- if ((vlink(l) != null) && (type(l) == hlist_node) && (width(l) == 0)
- && (height(l) == 0) && (depth(l) == 0) && (list_ptr(l) == null)) {
- l = vlink(l); /*for paragraph start with \.{\\parindent} = 0pt */
- } else if (d) {
- while ((vlink(l) != null) && (!(is_char_node(l) || non_discardable(l)))) {
- l = vlink(l); /* std.\ discardables at line break, \TeX book, p 95 */
- }
- }
- hlist_stack_level = 0;
- run = true;
- do {
- t = l;
- while (run && (type(l) == hlist_node) && (list_ptr(l) != null)) {
- push_node(l);
- l = list_ptr(l);
- }
- while (run && cp_skipable(l)) {
- while ((vlink(l) == null) && (hlist_stack_level > 0)) {
- l = pop_node(); /* don't visit this node again */
- run = false;
- }
- if (vlink(l) != null)
- l = vlink(l);
- else if (hlist_stack_level == 0)
- run = false;
- }
- } while (t != l);
- return l;
-}
-
-
-@ searches right to left from list tail |r| to head |l|, returns 1st non-skipable item
-
-@c
-/*public*/ halfword find_protchar_right(halfword l, halfword r)
-{
- halfword t;
- boolean run;
- if (r == null)
- return null;
- hlist_stack_level = 0;
- run = true;
- do {
- t = r;
- while (run && (type(r) == hlist_node) && (list_ptr(r) != null)) {
- push_node(l);
- push_node(r);
- l = list_ptr(r);
- r = l;
- while (vlink(r) != null) {
- halfword s = r;
- r = vlink(r);
- alink(r) = s;
- }
- }
- while (run && cp_skipable(r)) {
- while ((r == l) && (hlist_stack_level > 0)) {
- r = pop_node(); /* don't visit this node again */
- l = pop_node();
- }
- if ((r != l) && (r != null)) {
- if (alink(r) != null) {
- assert(vlink(alink(r)) == r);
- r = alink(r);
- } else { /* this is the input: \.{\\leavevmode\\penalty-10000\\penalty-10000} (bug \#268) */
- run = false;
- }
- } else if ((r == l) && (hlist_stack_level == 0))
- run = false;
- }
- } while (t != r);
- return r;
-}
-
-@ @c
-#define left_pw(a) char_pw((a), left_side)
-#define right_pw(a) char_pw((a), right_side)
-
-@ When looking for optimal line breaks, \TeX\ creates a ``break node'' for
- each break that is {\sl feasible}, in the sense that there is a way to end
- a line at the given place without requiring any line to stretch more than
- a given tolerance. A break node is characterized by three things: the position
- of the break (which is a pointer to a |glue_node|, |math_node|, |penalty_node|,
- or |disc_node|); the ordinal number of the line that will follow this
- breakpoint; and the fitness classification of the line that has just
- ended, i.e., |tight_fit|, |decent_fit|, |loose_fit|, or |very_loose_fit|.
-
-@c
-typedef enum {
- very_loose_fit = 0, /* fitness classification for lines stretching more than
- their stretchability */
- loose_fit, /* fitness classification for lines stretching 0.5 to 1.0 of their
- stretchability */
- decent_fit, /* fitness classification for all other lines */
- tight_fit /* fitness classification for lines shrinking 0.5 to 1.0 of their
- shrinkability */
-} fitness_value;
-
-
-@ The algorithm essentially determines the best possible way to achieve
- each feasible combination of position, line, and fitness. Thus, it answers
- questions like, ``What is the best way to break the opening part of the
- paragraph so that the fourth line is a tight line ending at such-and-such
- a place?'' However, the fact that all lines are to be the same length
- after a certain point makes it possible to regard all sufficiently large
- line numbers as equivalent, when the looseness parameter is zero, and this
- makes it possible for the algorithm to save space and time.
-
- An ``active node'' and a ``passive node'' are created in |mem| for each
- feasible breakpoint that needs to be considered. Active nodes are three
- words long and passive nodes are two words long. We need active nodes only
- for breakpoints near the place in the paragraph that is currently being
- examined, so they are recycled within a comparatively short time after
- they are created.
-
-@ An active node for a given breakpoint contains six fields:
-
-|vlink| points to the next node in the list of active nodes; the
-last active node has |vlink=active|.
-
-|break_node| points to the passive node associated with this
-breakpoint.
-
-|line_number| is the number of the line that follows this
-breakpoint.
-
-|fitness| is the fitness classification of the line ending at this
-breakpoint.
-
-|type| is either |hyphenated_node| or |unhyphenated_node|, depending on
-whether this breakpoint is a |disc_node|.
-
-|total_demerits| is the minimum possible sum of demerits over all
-lines leading from the beginning of the paragraph to this breakpoint.
-
-The value of |vlink(active)| points to the first active node on a vlinked list
-of all currently active nodes. This list is in order by |line_number|,
-except that nodes with |line_number>easy_line| may be in any order relative
-to each other.
-
-@c
-void initialize_active(void)
-{
- type(active) = hyphenated_node;
- line_number(active) = max_halfword;
- subtype(active) = 0; /* the |subtype| is never examined */
-}
-
-@ The passive node for a given breakpoint contains EIGHT fields:
-
-|vlink| points to the passive node created just before this one,
-if any, otherwise it is |null|.
-
-|cur_break| points to the position of this breakpoint in the
-horizontal list for the paragraph being broken.
-
-|prev_break| points to the passive node that should precede this
-one in an optimal path to this breakpoint.
-
-|serial| is equal to |n| if this passive node is the |n|th
-one created during the current pass. (This field is used only when
-printing out detailed statistics about the line-breaking calculations.)
-
-|passive_pen_inter| holds the current \.{\\localinterlinepenalty}
-
-|passive_pen_broken| holds the current \.{\\localbrokenpenalty}
-
-There is a global variable called |passive| that points to the most
-recently created passive node. Another global variable, |printed_node|,
-is used to help print out the paragraph when detailed information about
-the line-breaking computation is being displayed.
-
-@c
-static halfword passive; /* most recent node on passive list */
-static halfword printed_node; /*most recent node that has been printed */
-static halfword pass_number; /*the number of passive nodes allocated on this pass */
-
-
-@ The active list also contains ``delta'' nodes that help the algorithm
-compute the badness of individual lines. Such nodes appear only between two
-active nodes, and they have |type=delta_node|. If |p| and |r| are active nodes
-and if |q| is a delta node between them, so that |vlink(p)=q| and |vlink(q)=r|,
-then |q| tells the space difference between lines in the horizontal list that
-start after breakpoint |p| and lines that start after breakpoint |r|. In
-other words, if we know the length of the line that starts after |p| and
-ends at our current position, then the corresponding length of the line that
-starts after |r| is obtained by adding the amounts in node~|q|. A delta node
-contains seven scaled numbers, since it must record the net change in glue
-stretchability with respect to all orders of infinity. The natural width
-difference appears in |mem[q+1].sc|; the stretch differences in units of
-pt, sfi, fil, fill, and filll appear in |mem[q+2..q+6].sc|; and the shrink
-difference appears in |mem[q+7].sc|. The |subtype| field of a delta node
-is not used.
-
-Actually, we have two more fields that are used by |pdftex|.
-
-
-As the algorithm runs, it maintains a set of seven delta-like registers
-for the length of the line following the first active breakpoint to the
-current position in the given hlist. When it makes a pass through the
-active list, it also maintains a similar set of seven registers for the
-length following the active breakpoint of current interest. A third set
-holds the length of an empty line (namely, the sum of \.{\\leftskip} and
-\.{\\rightskip}); and a fourth set is used to create new delta nodes.
-
-When we pass a delta node we want to do operations like
-$$\hbox{\ignorespaces|for
-k:=1 to 7 do cur_active_width[k]:=cur_active_width[k]+mem[q+k].sc|};$$ and we
-want to do this without the overhead of |for| loops. The |do_all_six|
-macro makes such six-tuples convenient.
-
-@c
-static scaled active_width[10] = { 0 }; /*distance from first active node to~|cur_p| */
-static scaled background[10] = { 0 }; /*length of an ``empty'' line */
-static scaled break_width[10] = { 0 }; /*length being computed after current break */
-
-static boolean auto_breaking; /*make |auto_breaking| accessible out of |line_break| */
-
-@ Let's state the principles of the delta nodes more precisely and concisely,
- so that the following programs will be less obscure. For each legal
- breakpoint~|p| in the paragraph, we define two quantities $\alpha(p)$ and
- $\beta(p)$ such that the length of material in a line from breakpoint~|p|
- to breakpoint~|q| is $\gamma+\beta(q)-\alpha(p)$, for some fixed $\gamma$.
- Intuitively, $\alpha(p)$ and $\beta(q)$ are the total length of material from
- the beginning of the paragraph to a point ``after'' a break at |p| and to a
- point ``before'' a break at |q|; and $\gamma$ is the width of an empty line,
- namely the length contributed by \.{\\leftskip} and \.{\\rightskip}.
-
- Suppose, for example, that the paragraph consists entirely of alternating
- boxes and glue skips; let the boxes have widths $x_1\ldots x_n$ and
- let the skips have widths $y_1\ldots y_n$, so that the paragraph can be
- represented by $x_1y_1\ldots x_ny_n$. Let $p_i$ be the legal breakpoint
- at $y_i$; then $\alpha(p_i)=x_1+y_1+\cdots+x_i+y_i$, and $\beta(p_i)=
- x_1+y_1+\cdots+x_i$. To check this, note that the length of material from
- $p_2$ to $p_5$, say, is $\gamma+x_3+y_3+x_4+y_4+x_5=\gamma+\beta(p_5)
- -\alpha(p_2)$.
-
- The quantities $\alpha$, $\beta$, $\gamma$ involve glue stretchability and
- shrinkability as well as a natural width. If we were to compute $\alpha(p)$
- and $\beta(p)$ for each |p|, we would need multiple precision arithmetic, and
- the multiprecise numbers would have to be kept in the active nodes.
- \TeX\ avoids this problem by working entirely with relative differences
- or ``deltas.'' Suppose, for example, that the active list contains
- $a_1\,\delta_1\,a_2\,\delta_2\,a_3$, where the |a|'s are active breakpoints
- and the $\delta$'s are delta nodes. Then $\delta_1=\alpha(a_1)-\alpha(a_2)$
- and $\delta_2=\alpha(a_2)-\alpha(a_3)$. If the line breaking algorithm is
- currently positioned at some other breakpoint |p|, the |active_width| array
- contains the value $\gamma+\beta(p)-\alpha(a_1)$. If we are scanning through
- the list of active nodes and considering a tentative line that runs from
- $a_2$ to~|p|, say, the |cur_active_width| array will contain the value
- $\gamma+\beta(p)-\alpha(a_2)$. Thus, when we move from $a_2$ to $a_3$,
- we want to add $\alpha(a_2)-\alpha(a_3)$ to |cur_active_width|; and this
- is just $\delta_2$, which appears in the active list between $a_2$ and
- $a_3$. The |background| array contains $\gamma$. The |break_width| array
- will be used to calculate values of new delta nodes when the active
- list is being updated.
-
-
-@ The heart of the line-breaking procedure is `|try_break|', a subroutine
- that tests if the current breakpoint |cur_p| is feasible, by running
- through the active list to see what lines of text can be made from active
- nodes to~|cur_p|. If feasible breaks are possible, new break nodes are
- created. If |cur_p| is too far from an active node, that node is
- deactivated.
-
- The parameter |pi| to |try_break| is the penalty associated
- with a break at |cur_p|; we have |pi=eject_penalty| if the break is forced,
- and |pi=inf_penalty| if the break is illegal.
-
- The other parameter, |break_type|, is set to |hyphenated_node| or |unhyphenated_node|,
- depending on whether or not the current break is at a |disc_node|. The
- end of a paragraph is also regarded as `|hyphenated_node|'; this case is
- distinguishable by the condition |cur_p=null|.
-
-
-@c
-static int internal_pen_inter; /* running \.{\\localinterlinepenalty} */
-static int internal_pen_broken; /* running \.{\\localbrokenpenalty} */
-static halfword internal_left_box; /* running \.{\\localleftbox} */
-static int internal_left_box_width; /* running \.{\\localleftbox} width */
-static halfword init_internal_left_box; /* running \.{\\localleftbox} */
-static int init_internal_left_box_width; /* running \.{\\localleftbox} width */
-static halfword internal_right_box; /* running \.{\\localrightbox} */
-static int internal_right_box_width; /* running \.{\\localrightbox} width */
-
-static scaled disc_width[10] = { 0 }; /* the length of discretionary material preceding a break */
-
-@ As we consider various ways to end a line at |cur_p|, in a given line number
- class, we keep track of the best total demerits known, in an array with
- one entry for each of the fitness classifications. For example,
- |minimal_demerits[tight_fit]| contains the fewest total demerits of feasible
- line breaks ending at |cur_p| with a |tight_fit| line; |best_place[tight_fit]|
- points to the passive node for the break before~|cur_p| that achieves such
- an optimum; and |best_pl_line[tight_fit]| is the |line_number| field in the
- active node corresponding to |best_place[tight_fit]|. When no feasible break
- sequence is known, the |minimal_demerits| entries will be equal to
- |awful_bad|, which is $2^{30}-1$. Another variable, |minimum_demerits|,
- keeps track of the smallest value in the |minimal_demerits| array.
-
-@c
-static int minimal_demerits[4]; /* best total demerits known for current
- line class and position, given the fitness */
-static int minimum_demerits; /* best total demerits known for current line class
- and position */
-static halfword best_place[4]; /* how to achieve |minimal_demerits| */
-static halfword best_pl_line[4]; /*corresponding line number */
-
-
-
-@ The length of lines depends on whether the user has specified
-\.{\\parshape} or \.{\\hangindent}. If |par_shape_ptr| is not null, it
-points to a $(2n+1)$-word record in |mem|, where the |vinfo| in the first
-word contains the value of |n|, and the other $2n$ words contain the left
-margins and line lengths for the first |n| lines of the paragraph; the
-specifications for line |n| apply to all subsequent lines. If
-|par_shape_ptr=null|, the shape of the paragraph depends on the value of
-|n=hang_after|; if |n>=0|, hanging indentation takes place on lines |n+1|,
-|n+2|, \dots, otherwise it takes place on lines 1, \dots, $\vert
-n\vert$. When hanging indentation is active, the left margin is
-|hang_indent|, if |hang_indent>=0|, else it is 0; the line length is
-$|hsize|-\vert|hang_indent|\vert$. The normal setting is
-|par_shape_ptr=null|, |hang_after=1|, and |hang_indent=0|.
-Note that if |hang_indent=0|, the value of |hang_after| is irrelevant.
-@^length of lines@> @^hanging indentation@>
-
-@c
-static halfword easy_line; /*line numbers |>easy_line| are equivalent in break nodes */
-static halfword last_special_line; /*line numbers |>last_special_line| all have the same width */
-static scaled first_width; /*the width of all lines |<=last_special_line|, if
- no \.{\\parshape} has been specified */
-static scaled second_width; /*the width of all lines |>last_special_line| */
-static scaled first_indent; /*left margin to go with |first_width| */
-static scaled second_indent; /*left margin to go with |second_width| */
-
-static halfword best_bet; /*use this passive node and its predecessors */
-static int fewest_demerits; /*the demerits associated with |best_bet| */
-static halfword best_line; /*line number following the last line of the new paragraph */
-static int actual_looseness; /*the difference between |line_number(best_bet)|
- and the optimum |best_line| */
-static int line_diff; /*the difference between the current line number and
- the optimum |best_line| */
-
-
-
-@ \TeX\ makes use of the fact that |hlist_node|, |vlist_node|,
- |rule_node|, |ins_node|, |mark_node|, |adjust_node|,
- |disc_node|, |whatsit_node|, and |math_node| are at the low end of the
- type codes, by permitting a break at glue in a list if and only if the
- |type| of the previous node is less than |math_node|. Furthermore, a
- node is discarded after a break if its type is |math_node| or~more.
-
-@c
-#define do_all_six(a) a(1);a(2);a(3);a(4);a(5);a(6);a(7)
-#define do_seven_eight(a) if (pdf_adjust_spacing > 1) { a(8);a(9); }
-#define do_all_eight(a) do_all_six(a); do_seven_eight(a)
-#define do_one_seven_eight(a) a(1); do_seven_eight(a)
-
-#define store_background(a) {active_width[a]=background[a];}
-
-#define kern_break() { \
- if ((!is_char_node(vlink(cur_p))) && auto_breaking) \
- if (type(vlink(cur_p))==glue_node) \
- ext_try_break(0,unhyphenated_node, line_break_dir, pdf_adjust_spacing, \
- par_shape_ptr, adj_demerits, \
- tracing_paragraphs, pdf_protrude_chars, \
- line_penalty, last_line_fit, \
- double_hyphen_demerits, final_hyphen_demerits,first_p,cur_p); \
- if (type(cur_p)!=math_node) active_width[1]+=width(cur_p); \
- else active_width[1]+=surround(cur_p); \
- }
-
-#define clean_up_the_memory() { \
- q=vlink(active); \
- while (q!=active) { \
- cur_p=vlink(q); \
- if (type(q)==delta_node) flush_node(q); \
- else flush_node(q); \
- q=cur_p; \
- } \
- q=passive; \
- while (q!=null) { \
- cur_p=vlink(q); \
- flush_node(q); \
- q=cur_p; \
- } \
- }
-
-static boolean do_last_line_fit; /* special algorithm for last line of paragraph? */
-static scaled fill_width[4]; /* infinite stretch components of |par_fill_skip| */
-static scaled best_pl_short[4]; /* |shortfall| corresponding to |minimal_demerits| */
-static scaled best_pl_glue[4]; /*corresponding glue stretch or shrink */
-
-#define reset_disc_width(a) disc_width[(a)] = 0
-
-#define add_disc_width_to_break_width(a) break_width[(a)] += disc_width[(a)]
-#define sub_disc_width_from_active_width(a) active_width[(a)] -= disc_width[(a)]
-
-#define add_char_shrink(a,b) a += char_shrink((b))
-#define add_char_stretch(a,b) a += char_stretch((b))
-#define sub_char_shrink(a,b) a -= char_shrink((b))
-#define sub_char_stretch(a,b) a -= char_stretch((b))
-
-#define add_kern_shrink(a,b) a += kern_shrink((b))
-#define add_kern_stretch(a,b) a += kern_stretch((b))
-#define sub_kern_shrink(a,b) a -= kern_shrink((b))
-#define sub_kern_stretch(a,b) a -= kern_stretch((b))
-
-
-@ This function is used to add the width of a list of nodes
-(from a discretionary) to one of the width arrays.
-
-
-Replacement texts and discretionary texts are supposed to contain
-only character nodes, kern nodes, and box or rule nodes.
-
-@c
-static void add_to_widths(halfword s, int line_break_dir,
- int pdf_adjust_spacing, scaled * widths)
-{
- while (s != null) {
- if (is_char_node(s)) {
- widths[1] += pack_width(line_break_dir, dir_TRT, s, true);
- if ((pdf_adjust_spacing > 1) && check_expand_pars(font(s))) {
- set_prev_char_p(s);
- add_char_stretch(widths[8], s);
- add_char_shrink(widths[9], s);
- };
- } else {
- switch (type(s)) {
- case hlist_node:
- case vlist_node:
- widths[1] += pack_width(line_break_dir, box_dir(s), s, false);
- break;
- case kern_node:
- if ((pdf_adjust_spacing > 1) && (subtype(s) == normal)) {
- add_kern_stretch(widths[8], s);
- add_kern_shrink(widths[9], s);
- }
- /* fall through */
- case rule_node:
- widths[1] += width(s);
- break;
- case disc_node: /* TH temp */
- break;
- default:
- confusion("add_disc_widths");
- }
- }
- s = vlink(s);
- }
-}
-
-@ This function is used to substract the width of a list of nodes
-(from a discretionary) from one of the width arrays.
-It is used only once, but deserves it own function because of orthogonality
-with the |add_to_widths| function.
-
-@c
-static void sub_from_widths(halfword s, int line_break_dir,
- int pdf_adjust_spacing, scaled * widths)
-{
- while (s != null) {
- /* Subtract the width of node |s| from |break_width|; */
- if (is_char_node(s)) {
- widths[1] -= pack_width(line_break_dir, dir_TRT, s, true);
- if ((pdf_adjust_spacing > 1) && check_expand_pars(font(s))) {
- set_prev_char_p(s);
- sub_char_stretch(widths[8], s);
- sub_char_shrink(widths[9], s);
- }
- } else {
- switch (type(s)) {
- case hlist_node:
- case vlist_node:
- widths[1] -= pack_width(line_break_dir, box_dir(s), s, false);
- break;
- case kern_node:
- if ((pdf_adjust_spacing > 1) && (subtype(s) == normal)) {
- sub_kern_stretch(widths[8], s);
- sub_kern_shrink(widths[9], s);
- }
- /* fall through */
- case rule_node:
- widths[1] -= width(s);
- break;
- case disc_node: /* TH temp */
- break;
- default:
- confusion("sub_disc_widths");
- break;
- }
- }
- s = vlink(s);
- }
-}
-
-
-@ When we insert a new active node for a break at |cur_p|, suppose this
- new node is to be placed just before active node |a|; then we essentially
- want to insert `$\delta\,|cur_p|\,\delta^\prime$' before |a|, where
- $\delta=\alpha(a)-\alpha(|cur_p|)$ and $\delta^\prime=\alpha(|cur_p|)-\alpha(a)$
- in the notation explained above. The |cur_active_width| array now holds
- $\gamma+\beta(|cur_p|)-\alpha(a)$; so $\delta$ can be obtained by
- subtracting |cur_active_width| from the quantity $\gamma+\beta(|cur_p|)-
- \alpha(|cur_p|)$. The latter quantity can be regarded as the length of a
- line ``from |cur_p| to |cur_p|''; we call it the |break_width| at |cur_p|.
-
- The |break_width| is usually negative, since it consists of the background
- (which is normally zero) minus the width of nodes following~|cur_p| that are
- eliminated after a break. If, for example, node |cur_p| is a glue node, the
- width of this glue is subtracted from the background; and we also look
- ahead to eliminate all subsequent glue and penalty and kern and math
- nodes, subtracting their widths as well.
-
- Kern nodes do not disappear at a line break unless they are |explicit|.
-
-@c
-static void
-compute_break_width(int break_type, int line_break_dir, int pdf_adjust_spacing,
- halfword p
- /*, halfword s */ )
-{
- halfword s; /* glue and other 'whitespace' to be skipped after a break
- * used if unhyphenated, or |post_break==empty| */
- s = p;
- if (break_type > unhyphenated_node && p != null) {
- /*Compute the discretionary |break_width| values; */
- /* When |p| is a discretionary break, the length of a line
- ``from |p| to |p|'' has to be defined properly so
- that the other calculations work out. Suppose that the
- pre-break text at |p| has length $l_0$, the post-break
- text has length $l_1$, and the replacement text has length
- |l|. Suppose also that |q| is the node following the
- replacement text. Then length of a line from |p| to |q|
- will be computed as $\gamma+\beta(q)-\alpha(|p|)$, where
- $\beta(q)=\beta(|p|)-l_0+l$. The actual length will be
- the background plus $l_1$, so the length from |p| to
- |p| should be $\gamma+l_0+l_1-l$. If the post-break text
- of the discretionary is empty, a break may also discard~|q|;
- in that unusual case we subtract the length of~|q| and any
- other nodes that will be discarded after the discretionary
- break.
-
- TH: I don't quite understand the above remarks.
-
- The value of $l_0$ need not be computed, since |line_break|
- will put it into the global variable |disc_width| before
- calling |try_break|.
- */
- /* In case of nested discretionaries, we always follow the no-break
- path, as we are talking about the breaking on {\it this} position.
- */
-
- sub_from_widths(vlink_no_break(p), line_break_dir, pdf_adjust_spacing,
- break_width);
- add_to_widths(vlink_post_break(p), line_break_dir, pdf_adjust_spacing,
- break_width);
- do_one_seven_eight(add_disc_width_to_break_width);
- if (vlink_post_break(p) == null) {
- s = vlink(p); /* no |post_break|: 'skip' any 'whitespace' following */
- } else {
- s = null;
- }
- }
- while (s != null) {
- switch (type(s)) {
- case glue_node:
- /*Subtract glue from |break_width|; */
- {
- halfword v = glue_ptr(s);
- break_width[1] -= width(v);
- break_width[2 + stretch_order(v)] -= stretch(v);
- break_width[7] -= shrink(v);
- }
- break;
- case penalty_node:
- break;
- case math_node:
- break_width[1] -= surround(s);
- break;
- case kern_node:
- if (subtype(s) != explicit)
- return;
- else
- break_width[1] -= width(s);
- break;
- default:
- return;
- };
- s = vlink(s);
- }
-}
-
-@ @c
-static void
-print_break_node(halfword q, fitness_value fit_class,
- quarterword break_type, halfword cur_p)
-{
- /* Print a symbolic description of the new break node */
- tprint_nl("@@@@");
- print_int(serial(passive));
- tprint(": line ");
- print_int(line_number(q) - 1);
- print_char('.');
- print_int(fit_class);
- if (break_type == hyphenated_node)
- print_char('-');
- tprint(" t=");
- print_int(total_demerits(q));
- if (do_last_line_fit) {
- /*Print additional data in the new active node; */
- tprint(" s=");
- print_scaled(active_short(q));
- if (cur_p == null)
- tprint(" a=");
- else
- tprint(" g=");
- print_scaled(active_glue(q));
- }
- tprint(" -> @@");
- if (prev_break(passive) == null)
- print_char('0');
- else
- print_int(serial(prev_break(passive)));
-}
-
-@ @c
-static void
-print_feasible_break(halfword cur_p, pointer r, halfword b, int pi,
- int d, boolean artificial_demerits)
-{
- /* Print a symbolic description of this feasible break; */
- if (printed_node != cur_p) {
- /* Print the list between |printed_node| and |cur_p|, then
- set |printed_node:=cur_p|; */
- tprint_nl("");
- if (cur_p == null) {
- short_display(vlink(printed_node));
- } else {
- halfword save_link = vlink(cur_p);
- vlink(cur_p) = null;
- tprint_nl("");
- short_display(vlink(printed_node));
- vlink(cur_p) = save_link;
- }
- printed_node = cur_p;
- }
- tprint_nl("@@");
- if (cur_p == null) {
- tprint_esc("par");
- } else if (type(cur_p) != glue_node) {
- if (type(cur_p) == penalty_node)
- tprint_esc("penalty");
- else if (type(cur_p) == disc_node)
- tprint_esc("discretionary");
- else if (type(cur_p) == kern_node)
- tprint_esc("kern");
- else
- tprint_esc("math");
- }
- tprint(" via @@");
- if (break_node(r) == null)
- print_char('0');
- else
- print_int(serial(break_node(r)));
- tprint(" b=");
- if (b > inf_bad)
- print_char('*');
- else
- print_int(b);
- tprint(" p=");
- print_int(pi);
- tprint(" d=");
- if (artificial_demerits)
- print_char('*');
- else
- print_int(d);
-}
-
-@ @c
-#define add_disc_width_to_active_width(a) active_width[a] += disc_width[a]
-#define update_width(a) cur_active_width[a] += varmem[(r+(a))].cint
-
-#define set_break_width_to_background(a) break_width[a]=background[(a)]
-
-#define convert_to_break_width(a) \
- varmem[(prev_r+(a))].cint = varmem[(prev_r+(a))].cint-cur_active_width[(a)]+break_width[(a)]
-
-#define store_break_width(a) active_width[(a)]=break_width[(a)]
-
-#define new_delta_to_break_width(a) \
- varmem[(q+(a))].cint=break_width[(a)]-cur_active_width[(a)]
-
-#define new_delta_from_break_width(a) \
- varmem[(q+(a))].cint=cur_active_width[(a)]-break_width[(a)]
-
-#define copy_to_cur_active(a) cur_active_width[(a)]=active_width[(a)]
-
-#define combine_two_deltas(a) varmem[(prev_r+(a))].cint += varmem[(r+(a))].cint
-#define downdate_width(a) cur_active_width[(a)] -= varmem[(prev_r+(a))].cint
-#define update_active(a) active_width[(a)]+=varmem[(r+(a))].cint
-
-#define total_font_stretch cur_active_width[8]
-#define total_font_shrink cur_active_width[9]
-
-#define cal_margin_kern_var(a) { \
- character(cp) = character((a)); \
- font(cp) = font((a)); \
- do_subst_font(cp, 1000); \
- if (font(cp) != font((a))) \
- margin_kern_stretch += (left_pw((a)) - left_pw(cp)); \
- font(cp) = font((a)); \
- do_subst_font(cp, -1000); \
- if (font(cp) != font((a))) \
- margin_kern_shrink += (left_pw(cp) - left_pw((a))); \
- }
-
-static void
-ext_try_break(int pi,
- quarterword break_type,
- int line_break_dir,
- int pdf_adjust_spacing,
- int par_shape_ptr,
- int adj_demerits,
- int tracing_paragraphs,
- int pdf_protrude_chars,
- int line_penalty,
- int last_line_fit,
- int double_hyphen_demerits,
- int final_hyphen_demerits, halfword first_p, halfword cur_p)
-{
- /* labels: |CONTINUE,DEACTIVATE,FOUND,NOT_FOUND|; */
- pointer r; /* runs through the active list */
- scaled margin_kern_stretch;
- scaled margin_kern_shrink;
- halfword lp, rp, cp;
- halfword prev_r; /* stays a step behind |r| */
- halfword prev_prev_r; /*a step behind |prev_r|, if |type(prev_r)=delta_node| */
- halfword old_l; /* maximum line number in current equivalence class of lines */
- boolean no_break_yet; /* have we found a feasible break at |cur_p|? */
- halfword q; /*points to a new node being created */
- halfword l; /*line number of current active node */
- boolean node_r_stays_active; /*should node |r| remain in the active list? */
- scaled line_width; /*the current line will be justified to this width */
- fitness_value fit_class; /*possible fitness class of test line */
- halfword b; /*badness of test line */
- int d; /*demerits of test line */
- boolean artificial_demerits; /*has |d| been forced to zero? */
-
- scaled shortfall; /*used in badness calculations */
- scaled g; /*glue stretch or shrink of test line, adjustment for last line */
- scaled cur_active_width[10] = { 0 }; /*distance from current active node */
-
- line_width = 0;
- g = 0;
- prev_prev_r = null;
- /*Make sure that |pi| is in the proper range; */
- if (pi >= inf_penalty) {
- return; /* this breakpoint is inhibited by infinite penalty */
- } else if (pi <= -inf_penalty) {
- pi = eject_penalty; /*this breakpoint will be forced */
- }
-
- no_break_yet = true;
- prev_r = active;
- old_l = 0;
- do_all_eight(copy_to_cur_active);
-
- while (1) {
- r = vlink(prev_r);
- /* If node |r| is of type |delta_node|, update |cur_active_width|,
- set |prev_r| and |prev_prev_r|, then |goto continue|; */
- /* The following code uses the fact that |type(active)<>delta_node| */
- if (type(r) == delta_node) {
- do_all_eight(update_width); /* IMPLICIT ,r */
- prev_prev_r = prev_r;
- prev_r = r;
- continue;
- }
- /* If a line number class has ended, create new active nodes for
- the best feasible breaks in that class; then |return|
- if |r=active|, otherwise compute the new |line_width|; */
- /* The first part of the following code is part of \TeX's inner loop, so
- we don't want to waste any time. The current active node, namely node |r|,
- contains the line number that will be considered next. At the end of the
- list we have arranged the data structure so that |r=active| and
- |line_number(active)>old_l|.
- */
- l = line_number(r);
- if (l > old_l) { /* now we are no longer in the inner loop */
- if ((minimum_demerits < awful_bad)
- && ((old_l != easy_line) || (r == active))) {
- /*Create new active nodes for the best feasible breaks just found */
- /* It is not necessary to create new active nodes having |minimal_demerits|
- greater than
- |minimum_demerits+abs(adj_demerits)|, since such active nodes will never
- be chosen in the final paragraph breaks. This observation allows us to
- omit a substantial number of feasible breakpoints from further consideration.
- */
- if (no_break_yet) {
- no_break_yet = false;
- do_all_eight(set_break_width_to_background);
- compute_break_width(break_type, line_break_dir,
- pdf_adjust_spacing, cur_p);
- }
- /* Insert a delta node to prepare for breaks at |cur_p|; */
- /* We use the fact that |type(active)<>delta_node|. */
- if (type(prev_r) == delta_node) { /* modify an existing delta node */
- do_all_eight(convert_to_break_width); /* IMPLICIT |prev_r| */
- } else if (prev_r == active) { /* no delta node needed at the beginning */
- do_all_eight(store_break_width);
- } else {
- q = new_node(delta_node, 0);
- vlink(q) = r;
- do_all_eight(new_delta_to_break_width); /* IMPLICIT q */
- vlink(prev_r) = q;
- prev_prev_r = prev_r;
- prev_r = q;
- }
-
- if (abs(adj_demerits) >= awful_bad - minimum_demerits)
- minimum_demerits = awful_bad - 1;
- else
- minimum_demerits += abs(adj_demerits);
- for (fit_class = very_loose_fit; fit_class <= tight_fit;
- fit_class++) {
- if (minimal_demerits[fit_class] <= minimum_demerits) {
- /* Insert a new active node from |best_place[fit_class]|
- to |cur_p|; */
- /* When we create an active node, we also create the corresponding
- passive node.
- */
- q = new_node(passive_node, 0);
- vlink(q) = passive;
- passive = q;
- cur_break(q) = cur_p;
- incr(pass_number);
- serial(q) = pass_number;
- prev_break(q) = best_place[fit_class];
- /*Here we keep track of the subparagraph penalties in the break nodes */
- passive_pen_inter(q) = internal_pen_inter;
- passive_pen_broken(q) = internal_pen_broken;
- passive_last_left_box(q) = internal_left_box;
- passive_last_left_box_width(q) =
- internal_left_box_width;
- if (prev_break(q) != null) {
- passive_left_box(q) =
- passive_last_left_box(prev_break(q));
- passive_left_box_width(q) =
- passive_last_left_box_width(prev_break(q));
- } else {
- passive_left_box(q) = init_internal_left_box;
- passive_left_box_width(q) =
- init_internal_left_box_width;
- }
- passive_right_box(q) = internal_right_box;
- passive_right_box_width(q) = internal_right_box_width;
- q = new_node(break_type, fit_class);
- break_node(q) = passive;
- line_number(q) = best_pl_line[fit_class] + 1;
- total_demerits(q) = minimal_demerits[fit_class];
- if (do_last_line_fit) {
- /*Store additional data in the new active node */
- /* Here we save these data in the active node
- representing a potential line break. */
- active_short(q) = best_pl_short[fit_class];
- active_glue(q) = best_pl_glue[fit_class];
- }
- vlink(q) = r;
- vlink(prev_r) = q;
- prev_r = q;
- if (tracing_paragraphs > 0)
- print_break_node(q, fit_class, break_type, cur_p);
- }
- minimal_demerits[fit_class] = awful_bad;
- }
- minimum_demerits = awful_bad;
- /* Insert a delta node to prepare for the next active node; */
- /* When the following code is performed, we will have just inserted at
- least one active node before |r|, so |type(prev_r)<>delta_node|.
- */
- if (r != active) {
- q = new_node(delta_node, 0);
- vlink(q) = r;
- do_all_eight(new_delta_from_break_width); /* IMPLICIT q */
- vlink(prev_r) = q;
- prev_prev_r = prev_r;
- prev_r = q;
- }
- }
- if (r == active)
- return;
- /*Compute the new line width; */
- /* When we come to the following code, we have just encountered
- the first active node~|r| whose |line_number| field contains
- |l|. Thus we want to compute the length of the $l\mskip1mu$th
- line of the current paragraph. Furthermore, we want to set
- |old_l| to the last number in the class of line numbers
- equivalent to~|l|.
- */
- if (l > easy_line) {
- old_l = max_halfword - 1;
- line_width = second_width;
- } else {
- old_l = l;
- if (l > last_special_line) {
- line_width = second_width;
- } else if (par_shape_ptr == null) {
- line_width = first_width;
- } else {
- line_width = varmem[(par_shape_ptr + 2 * l + 1)].cint;
- }
- }
- }
- /* /If a line number class has ended, create new active nodes for
- the best feasible breaks in that class; then |return|
- if |r=active|, otherwise compute the new |line_width|; */
-
- /* Consider the demerits for a line from |r| to |cur_p|;
- deactivate node |r| if it should no longer be active;
- then |goto continue| if a line from |r| to |cur_p| is infeasible,
- otherwise record a new feasible break; */
- artificial_demerits = false;
- shortfall = line_width - cur_active_width[1];
- if (break_node(r) == null)
- shortfall -= init_internal_left_box_width;
- else
- shortfall -= passive_last_left_box_width(break_node(r));
- shortfall -= internal_right_box_width;
- if (pdf_protrude_chars > 1) {
- halfword l1, o;
- l1 = (break_node(r) == null) ? first_p : cur_break(break_node(r));
- if (cur_p == null) {
- o = null;
- } else { /* TODO |if (is_character_node(alink(cur_p)))| */
- o = alink(cur_p);
- assert(vlink(o) == cur_p);
- }
- /* MAGIC: the disc could be a SELECT subtype, to we might need
- to get the last character as |pre_break| from either the
- |pre_break| list (if the previous INIT disc was taken), or the
- |no_break| (sic) list (if the previous INIT disc was not taken)
-
- BUT:
- the last characters (hyphenation character) if these two list
- should always be the same anyway, so we just look at |pre_break|.
- */
- /* let's look at the right margin first */
- if ((cur_p != null) && (type(cur_p) == disc_node)
- && (vlink_pre_break(cur_p) != null)) {
- /* a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break| */
- o = tlink_pre_break(cur_p);
- } else {
- o = find_protchar_right(l1, o);
- }
- /* now the left margin */
- if ((l1 != null) && (type(l1) == disc_node)
- && (vlink_post_break(l1) != null)) {
- /* FIXME: first 'char' could be a disc! */
- l1 = vlink_post_break(l1); /* protrude the first char */
- } else {
- l1 = find_protchar_left(l1, true);
- }
- shortfall += (left_pw(l1) + right_pw(o));
- }
- if ((shortfall != 0) && (pdf_adjust_spacing > 1)) {
- margin_kern_stretch = 0;
- margin_kern_shrink = 0;
- if (pdf_protrude_chars > 1) {
- /* Calculate variations of marginal kerns; */
- lp = last_leftmost_char;
- rp = last_rightmost_char;
- cp = raw_glyph_node();
- if (lp != null) {
- cal_margin_kern_var(lp);
- }
- if (rp != null) {
- cal_margin_kern_var(rp);
- }
- flush_node(cp);
- }
- if ((shortfall > 0)
- && ((total_font_stretch + margin_kern_stretch) > 0)) {
- if ((total_font_stretch + margin_kern_stretch) > shortfall)
- shortfall = ((total_font_stretch + margin_kern_stretch) /
- (max_stretch_ratio / cur_font_step)) / 2;
- else
- shortfall -= (total_font_stretch + margin_kern_stretch);
- } else if ((shortfall < 0)
- && ((total_font_shrink + margin_kern_shrink) > 0)) {
- if ((total_font_shrink + margin_kern_shrink) > -shortfall)
- shortfall = -((total_font_shrink + margin_kern_shrink) /
- (max_shrink_ratio / cur_font_step)) / 2;
- else
- shortfall += (total_font_shrink + margin_kern_shrink);
- }
- }
- if (shortfall > 0) {
- /* Set the value of |b| to the badness for stretching the line,
- and compute the corresponding |fit_class| */
-
- /* When a line must stretch, the available stretchability can be
- found in the subarray |cur_active_width[2..6]|, in units of
- points, sfi, fil, fill and filll.
-
- The present section is part of \TeX's inner loop, and it is
- most often performed when the badness is infinite; therefore
- it is worth while to make a quick test for large width excess
- and small stretchability, before calling the |badness|
- subroutine. */
-
- if ((cur_active_width[3] != 0) || (cur_active_width[4] != 0) ||
- (cur_active_width[5] != 0) || (cur_active_width[6] != 0)) {
- if (do_last_line_fit) {
- if (cur_p == null) { /* the last line of a paragraph */
- /* Perform computations for last line and |goto found|; */
-
- /* Here we compute the adjustment |g| and badness |b| for
- a line from |r| to the end of the paragraph. When any
- of the criteria for adjustment is violated we fall
- through to the normal algorithm.
-
- The last line must be too short, and have infinite
- stretch entirely due to |par_fill_skip|. */
- if ((active_short(r) == 0) || (active_glue(r) <= 0))
- /* previous line was neither stretched nor shrunk, or
- was infinitely bad */
- goto NOT_FOUND;
- if ((cur_active_width[3] != fill_width[0]) ||
- (cur_active_width[4] != fill_width[1]) ||
- (cur_active_width[5] != fill_width[2]) ||
- (cur_active_width[6] != fill_width[3]))
- /* infinite stretch of this line not entirely due to
- |par_fill_skip| */
- goto NOT_FOUND;
- if (active_short(r) > 0)
- g = cur_active_width[2];
- else
- g = cur_active_width[7];
- if (g <= 0)
- /*no finite stretch resp.\ no shrink */
- goto NOT_FOUND;
- arith_error = false;
- g = fract(g, active_short(r), active_glue(r),
- max_dimen);
- if (last_line_fit < 1000)
- g = fract(g, last_line_fit, 1000, max_dimen);
- if (arith_error) {
- if (active_short(r) > 0)
- g = max_dimen;
- else
- g = -max_dimen;
- }
- if (g > 0) {
- /*Set the value of |b| to the badness of the last line
- for stretching, compute the corresponding |fit_class,
- and |goto found|| */
- /* These badness computations are rather similar to
- those of the standard algorithm, with the adjustment
- amount |g| replacing the |shortfall|. */
- if (g > shortfall)
- g = shortfall;
- if (g > 7230584) {
- if (cur_active_width[2] < 1663497) {
- b = inf_bad;
- fit_class = very_loose_fit;
- goto FOUND;
- }
- }
- b = badness(g, cur_active_width[2]);
- if (b > 99) {
- fit_class = very_loose_fit;
- } else if (b > 12) {
- fit_class = loose_fit;
- } else {
- fit_class = decent_fit;
- }
- goto FOUND;
- } else if (g < 0) {
- /*Set the value of |b| to the badness of the last line
- for shrinking, compute the corresponding |fit_class,
- and |goto found||; */
- if (-g > cur_active_width[7])
- g = -cur_active_width[7];
- b = badness(-g, cur_active_width[7]);
- if (b > 12)
- fit_class = tight_fit;
- else
- fit_class = decent_fit;
- goto FOUND;
- }
- }
- NOT_FOUND:
- shortfall = 0;
- }
- b = 0;
- fit_class = decent_fit; /* infinite stretch */
- } else {
- if (shortfall > 7230584 && cur_active_width[2] < 1663497) {
- b = inf_bad;
- fit_class = very_loose_fit;
- } else {
- b = badness(shortfall, cur_active_width[2]);
- if (b > 99) {
- fit_class = very_loose_fit;
- } else if (b > 12) {
- fit_class = loose_fit;
- } else {
- fit_class = decent_fit;
- }
- }
- }
- } else {
- /* Set the value of |b| to the badness for shrinking the line,
- and compute the corresponding |fit_class|; */
- /* Shrinkability is never infinite in a paragraph; we can shrink
- the line from |r| to |cur_p| by at most
- |cur_active_width[7]|. */
- if (-shortfall > cur_active_width[7])
- b = inf_bad + 1;
- else
- b = badness(-shortfall, cur_active_width[7]);
- if (b > 12)
- fit_class = tight_fit;
- else
- fit_class = decent_fit;
- }
- if (do_last_line_fit) {
- /* Adjust the additional data for last line; */
- if (cur_p == null)
- shortfall = 0;
- if (shortfall > 0) {
- g = cur_active_width[2];
- } else if (shortfall < 0) {
- g = cur_active_width[7];
- } else {
- g = 0;
- }
- }
- FOUND:
- if ((b > inf_bad) || (pi == eject_penalty)) {
- /* Prepare to deactivate node~|r|, and |goto deactivate| unless
- there is a reason to consider lines of text from |r| to |cur_p| */
- /* During the final pass, we dare not lose all active nodes, lest we lose
- touch with the line breaks already found. The code shown here makes
- sure that such a catastrophe does not happen, by permitting overfull
- boxes as a last resort. This particular part of \TeX\ was a source of
- several subtle bugs before the correct program logic was finally
- discovered; readers who seek to ``improve'' \TeX\ should therefore
- think thrice before daring to make any changes here.
- */
- if (final_pass && (minimum_demerits == awful_bad) &&
- (vlink(r) == active) && (prev_r == active)) {
- artificial_demerits = true; /* set demerits zero, this break is forced */
- } else if (b > threshold) {
- goto DEACTIVATE;
- }
- node_r_stays_active = false;
- } else {
- prev_r = r;
- if (b > threshold)
- continue;
- node_r_stays_active = true;
- }
- /* Record a new feasible break; */
- /* When we get to this part of the code, the line from |r| to |cur_p| is
- feasible, its badness is~|b|, and its fitness classification is
- |fit_class|. We don't want to make an active node for this break yet,
- but we will compute the total demerits and record them in the
- |minimal_demerits| array, if such a break is the current champion among
- all ways to get to |cur_p| in a given line-number class and fitness
- class.
- */
- if (artificial_demerits) {
- d = 0;
- } else {
- /* Compute the demerits, |d|, from |r| to |cur_p|; */
- d = line_penalty + b;
- if (abs(d) >= 10000)
- d = 100000000;
- else
- d = d * d;
- if (pi != 0) {
- if (pi > 0) {
- d += (pi * pi);
- } else if (pi > eject_penalty) {
- d -= (pi * pi);
- }
- }
- if ((break_type == hyphenated_node) && (type(r) == hyphenated_node)) {
- if (cur_p != null)
- d += double_hyphen_demerits;
- else
- d += final_hyphen_demerits;
- }
- if (abs(fit_class - fitness(r)) > 1)
- d = d + adj_demerits;
- }
- if (tracing_paragraphs > 0)
- print_feasible_break(cur_p, r, b, pi, d, artificial_demerits);
- d += total_demerits(r); /*this is the minimum total demerits
- from the beginning to |cur_p| via |r| */
- if (d <= minimal_demerits[fit_class]) {
- minimal_demerits[fit_class] = d;
- best_place[fit_class] = break_node(r);
- best_pl_line[fit_class] = l;
- if (do_last_line_fit) {
- /* Store additional data for this feasible break; */
- /* For each feasible break we record the shortfall and glue stretch or
- shrink (or adjustment). */
- best_pl_short[fit_class] = shortfall;
- best_pl_glue[fit_class] = g;
- }
- if (d < minimum_demerits)
- minimum_demerits = d;
- }
- /* /Record a new feasible break */
- if (node_r_stays_active)
- continue; /*|prev_r| has been set to |r| */
- DEACTIVATE:
- /* Deactivate node |r|; */
- /* When an active node disappears, we must delete an adjacent delta node if
- the active node was at the beginning or the end of the active list, or
- if it was surrounded by delta nodes. We also must preserve the property
- that |cur_active_width| represents the length of material from
- |vlink(prev_r)| to~|cur_p|. */
-
- vlink(prev_r) = vlink(r);
- flush_node(r);
- if (prev_r == active) {
- /*Update the active widths, since the first active node has been
- deleted */
- /* The following code uses the fact that |type(active)<>delta_node|.
- If the active list has just become empty, we do not need to update the
- |active_width| array, since it will be initialized when an active
- node is next inserted.
- */
- r = vlink(active);
- if (type(r) == delta_node) {
- do_all_eight(update_active); /* IMPLICIT r */
- do_all_eight(copy_to_cur_active);
- vlink(active) = vlink(r);
- flush_node(r);
- }
- } else if (type(prev_r) == delta_node) {
- r = vlink(prev_r);
- if (r == active) {
- do_all_eight(downdate_width); /* IMPLICIT |prev_r| */
- vlink(prev_prev_r) = active;
- flush_node(prev_r);
- prev_r = prev_prev_r;
- } else if (type(r) == delta_node) {
- do_all_eight(update_width); /* IMPLICIT ,r */
- do_all_eight(combine_two_deltas); /* IMPLICIT r |prev_r| */
- vlink(prev_r) = vlink(r);
- flush_node(r);
- }
- }
- }
-}
-
-@ @c
-void
-ext_do_line_break(int paragraph_dir,
- int pretolerance,
- int tracing_paragraphs,
- int tolerance,
- scaled emergency_stretch,
- int looseness,
- int hyphen_penalty,
- int ex_hyphen_penalty,
- int pdf_adjust_spacing,
- halfword par_shape_ptr,
- int adj_demerits,
- int pdf_protrude_chars,
- int line_penalty,
- int last_line_fit,
- int double_hyphen_demerits,
- int final_hyphen_demerits,
- int hang_indent,
- int hsize,
- int hang_after,
- halfword left_skip,
- halfword right_skip,
- int pdf_each_line_height,
- int pdf_each_line_depth,
- int pdf_first_line_height,
- int pdf_last_line_depth,
- halfword inter_line_penalties_ptr,
- int inter_line_penalty,
- int club_penalty,
- halfword club_penalties_ptr,
- halfword widow_penalties_ptr,
- int widow_penalty,
- int broken_penalty,
- halfword final_par_glue, halfword pdf_ignored_dimen)
-{
- /* DONE,DONE1,DONE2,DONE3,DONE4,DONE5,CONTINUE; */
- halfword cur_p, q, r, s; /* miscellaneous nodes of temporary interest */
- int line_break_dir = paragraph_dir;
-
- /* Get ready to start ... */
- minimum_demerits = awful_bad;
- minimal_demerits[tight_fit] = awful_bad;
- minimal_demerits[decent_fit] = awful_bad;
- minimal_demerits[loose_fit] = awful_bad;
- minimal_demerits[very_loose_fit] = awful_bad;
-
- /* We compute the values of |easy_line| and the other local variables relating
- to line length when the |line_break| procedure is initializing itself. */
- if (par_shape_ptr == null) {
- if (hang_indent == 0) {
- last_special_line = 0;
- second_width = hsize;
- second_indent = 0;
- } else {
- /* Set line length parameters in preparation for hanging indentation */
- /* We compute the values of |easy_line| and the other local variables relating
- to line length when the |line_break| procedure is initializing itself. */
- last_special_line = abs(hang_after);
- if (hang_after < 0) {
- first_width = hsize - abs(hang_indent);
- if (hang_indent >= 0)
- first_indent = hang_indent;
- else
- first_indent = 0;
- second_width = hsize;
- second_indent = 0;
- } else {
- first_width = hsize;
- first_indent = 0;
- second_width = hsize - abs(hang_indent);
- if (hang_indent >= 0)
- second_indent = hang_indent;
- else
- second_indent = 0;
- }
- }
- } else {
- last_special_line = vinfo(par_shape_ptr + 1) - 1;
- second_indent =
- varmem[(par_shape_ptr + 2 * (last_special_line + 1))].cint;
- second_width =
- varmem[(par_shape_ptr + 2 * (last_special_line + 1) + 1)].cint;
- }
- if (looseness == 0)
- easy_line = last_special_line;
- else
- easy_line = max_halfword;
-
- no_shrink_error_yet = true;
- check_shrinkage(left_skip);
- check_shrinkage(right_skip);
- q = left_skip;
- r = right_skip;
- background[1] = width(q) + width(r);
- background[2] = 0;
- background[3] = 0;
- background[4] = 0;
- background[5] = 0;
- background[6] = 0;
- background[2 + stretch_order(q)] = stretch(q);
- background[2 + stretch_order(r)] += stretch(r);
- background[7] = shrink(q) + shrink(r);
- if (pdf_adjust_spacing > 1) {
- background[8] = 0;
- background[9] = 0;
- max_stretch_ratio = -1;
- max_shrink_ratio = -1;
- cur_font_step = -1;
- set_prev_char_p(null);
- }
- /* Check for special treatment of last line of paragraph; */
- /* The new algorithm for the last line requires that the stretchability
- |par_fill_skip| is infinite and the stretchability of |left_skip| plus
- |right_skip| is finite.
- */
- do_last_line_fit = false;
- if (last_line_fit > 0) {
- q = glue_ptr(last_line_fill);
- if ((stretch(q) > 0) && (stretch_order(q) > normal)) {
- if ((background[3] == 0) && (background[4] == 0) &&
- (background[5] == 0) && (background[6] == 0)) {
- do_last_line_fit = true;
- fill_width[0] = 0;
- fill_width[1] = 0;
- fill_width[2] = 0;
- fill_width[3] = 0;
- fill_width[stretch_order(q) - 1] = stretch(q);
- }
- }
- }
- /* DIR: Initialize |dir_ptr| for |line_break| */
- if (dir_ptr != null) {
- flush_node_list(dir_ptr);
- dir_ptr = null;
- }
-#if 0
- push_dir(paragraph_dir,dir_ptr); /* TODO what was the point of this? */
-#endif
-
- /* Find optimal breakpoints; */
- threshold = pretolerance;
- if (threshold >= 0) {
- if (tracing_paragraphs > 0) {
- begin_diagnostic();
- tprint_nl("@@firstpass");
- }
- second_pass = false;
- final_pass = false;
- } else {
- threshold = tolerance;
- second_pass = true;
- final_pass = (emergency_stretch <= 0);
- if (tracing_paragraphs > 0)
- begin_diagnostic();
- }
-
- while (1) {
- halfword first_p;
- halfword nest_stack[10];
- int nest_index = 0;
- if (threshold > inf_bad)
- threshold = inf_bad;
- /* Create an active breakpoint representing the beginning of the paragraph */
- q = new_node(unhyphenated_node, decent_fit);
- vlink(q) = active;
- break_node(q) = null;
- line_number(q) = cur_list.pg_field + 1;
- total_demerits(q) = 0;
- active_short(q) = 0;
- active_glue(q) = 0;
- vlink(active) = q;
- do_all_eight(store_background);
- passive = null;
- printed_node = temp_head;
- pass_number = 0;
- font_in_short_display = null_font;
- /* /Create an active breakpoint representing the beginning of the paragraph */
- auto_breaking = true;
- cur_p = vlink(temp_head);
- /* LOCAL: Initialize with first |local_paragraph| node */
- if ((cur_p != null) && (type(cur_p) == whatsit_node)
- && (subtype(cur_p) == local_par_node)) {
- alink(cur_p) = temp_head; /* this used to be an assert, but may as well force it */
- internal_pen_inter = local_pen_inter(cur_p);
- internal_pen_broken = local_pen_broken(cur_p);
- init_internal_left_box = local_box_left(cur_p);
- init_internal_left_box_width = local_box_left_width(cur_p);
- internal_left_box = init_internal_left_box;
- internal_left_box_width = init_internal_left_box_width;
- internal_right_box = local_box_right(cur_p);
- internal_right_box_width = local_box_right_width(cur_p);
- } else {
- internal_pen_inter = 0;
- internal_pen_broken = 0;
- init_internal_left_box = null;
- init_internal_left_box_width = 0;
- internal_left_box = init_internal_left_box;
- internal_left_box_width = init_internal_left_box_width;
- internal_right_box = null;
- internal_right_box_width = 0;
- }
- /* /LOCAL: Initialize with first |local_paragraph| node */
- set_prev_char_p(null);
- first_p = cur_p;
- /* to access the first node of paragraph as the first active node
- has |break_node=null| */
- while ((cur_p != null) && (vlink(active) != active)) {
- /* |try_break| if |cur_p| is a legal breakpoint; on the 2nd pass, also look at |disc_node|s. */
-
- while (is_char_node(cur_p)) {
- /* Advance |cur_p| to the node following the present string of characters ; */
- /* 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 |vlink(cur_p)=null| when |cur_p| is a character node.
- */
- active_width[1] +=
- pack_width(line_break_dir, dir_TRT, cur_p, true);
- if ((pdf_adjust_spacing > 1) && check_expand_pars(font(cur_p))) {
- set_prev_char_p(cur_p);
- add_char_stretch(active_width[8], cur_p);
- add_char_shrink(active_width[9], cur_p);
- }
- cur_p = vlink(cur_p);
- while (cur_p == null && nest_index > 0) {
- cur_p = nest_stack[--nest_index];
-#ifdef DEBUG
- fprintf(stderr,"Node Pop %d [%d]\n",nest_index,(int)cur_p);
-#endif
- }
- }
- if (cur_p == null) { /* TODO */
- confusion("linebreak_tail");
- }
- /* Determine legal breaks: As we move through the hlist, we need to keep
- the |active_width| array up to date, so that the badness of individual
- lines is readily calculated by |try_break|. It is convenient to use the
- short name |active_width[1]| for the component of active width that represents
- real width as opposed to glue. */
-
- switch (type(cur_p)) {
- case hlist_node:
- case vlist_node:
- active_width[1] +=
- pack_width(line_break_dir, box_dir(cur_p), cur_p, false);
- break;
- case rule_node:
- active_width[1] += width(cur_p);
- break;
- case whatsit_node:
- /* Advance past a whatsit node in the |line_break| loop; */
- switch (subtype(cur_p)) {
- case local_par_node: /* LOCAL: Advance past a |local_paragraph| node; */
- internal_pen_inter = local_pen_inter(cur_p);
- internal_pen_broken = local_pen_broken(cur_p);
- internal_left_box = local_box_left(cur_p);
- internal_left_box_width = local_box_left_width(cur_p);
- internal_right_box = local_box_right(cur_p);
- internal_right_box_width = local_box_right_width(cur_p);
- break;
- case dir_node: /* DIR: Adjust the dir stack for the |line_break| routine; */
- if (dir_dir(cur_p) >= 0) {
- line_break_dir = dir_dir(cur_p);
- push_dir_node(cur_p,dir_ptr); /* adds to |dir_ptr| */
- } else {
- pop_dir_node(dir_ptr);
- if (dir_ptr != null)
- line_break_dir = dir_dir(dir_ptr);
- }
- break;
- case pdf_refxform_node:
- case pdf_refximage_node:
- active_width[1] += width(cur_p);
- }
- /* / Advance past a whatsit node in the |line_break| loop/; */
- break;
- case glue_node:
- /* If node |cur_p| is a legal breakpoint, call |try_break|;
- then update the active widths by including the glue in
- |glue_ptr(cur_p)|; */
- /* When node |cur_p| is a glue node, we look at the previous to
- see whether or not a breakpoint is legal at |cur_p|, as
- explained above. */
- /* *INDENT-OFF* */
- if (auto_breaking) {
- halfword prev_p = alink(cur_p);
- if (prev_p != temp_head &&
- (is_char_node(prev_p) ||
- precedes_break(prev_p) ||
- ((type(prev_p) == kern_node)
- && (subtype(prev_p) != explicit)))) {
- ext_try_break(0, unhyphenated_node, line_break_dir, pdf_adjust_spacing,
- par_shape_ptr, adj_demerits,
- tracing_paragraphs, pdf_protrude_chars,
- line_penalty, last_line_fit,
- double_hyphen_demerits,
- final_hyphen_demerits, first_p, cur_p);
- }
- }
- /* *INDENT-ON* */
- check_shrinkage(glue_ptr(cur_p));
- q = glue_ptr(cur_p);
- active_width[1] += width(q);
- active_width[2 + stretch_order(q)] += stretch(q);
- active_width[7] += shrink(q);
- break;
- case kern_node:
- if (subtype(cur_p) == explicit) {
- kern_break();
- } else {
- active_width[1] += width(cur_p);
- if ((pdf_adjust_spacing > 1) && (subtype(cur_p) == normal)) {
- add_kern_stretch(active_width[8], cur_p);
- add_kern_shrink(active_width[9], cur_p);
- }
- }
- break;
- case disc_node:
- /* |select_disc|s are handled by the leading |init_disc| */
- if (subtype(cur_p) == select_disc)
- break;
- /* Try to break after a discretionary fragment, then |goto done5|; */
- /* The following code knows that discretionary texts contain
- only character nodes, kern nodes, box nodes, and rule
- nodes. */
- if (second_pass) {
- int actual_penalty = hyphen_penalty;
- if (subtype(cur_p) == automatic_disc)
- actual_penalty = ex_hyphen_penalty;
- s = vlink_pre_break(cur_p);
- do_one_seven_eight(reset_disc_width);
- if (s == null) { /* trivial pre-break */
- ext_try_break(actual_penalty, hyphenated_node,
- line_break_dir, pdf_adjust_spacing,
- par_shape_ptr, adj_demerits,
- tracing_paragraphs, pdf_protrude_chars,
- line_penalty, last_line_fit,
- double_hyphen_demerits,
- final_hyphen_demerits, first_p, cur_p);
- } else {
- add_to_widths(s, line_break_dir, pdf_adjust_spacing,
- disc_width);
- do_one_seven_eight(add_disc_width_to_active_width);
- ext_try_break(actual_penalty, hyphenated_node,
- line_break_dir, pdf_adjust_spacing,
- par_shape_ptr, adj_demerits,
- tracing_paragraphs, pdf_protrude_chars,
- line_penalty, last_line_fit,
- double_hyphen_demerits,
- final_hyphen_demerits, first_p, cur_p);
- if (subtype(cur_p) == init_disc) {
- /* we should at two break points after the one we
- added above:
- \item1 which does a possible break in INIT's |post_break|
- \item2 which means the |no_break| actually was broken
- just a character later */
- /* do the select-0 case 'f-f-i' */
- assert(type(vlink(cur_p)) == disc_node &&
- subtype(vlink(cur_p)) == select_disc);
- s = vlink_pre_break(vlink(cur_p));
- add_to_widths(s, line_break_dir, pdf_adjust_spacing,
- disc_width);
- ext_try_break(actual_penalty, hyphenated_node,
- line_break_dir, pdf_adjust_spacing,
- par_shape_ptr, adj_demerits,
- tracing_paragraphs,
- pdf_protrude_chars, line_penalty,
- last_line_fit, double_hyphen_demerits,
- final_hyphen_demerits, first_p,
- vlink(cur_p));
-#if 0
- /* TODO this does not work */
- /* go back to the starting situation */
- do_one_seven_eight
- (sub_disc_width_from_active_width);
- do_one_seven_eight(reset_disc_width);
- /* add select |no_break| to |active_width| */
- s = vlink_no_break(vlink(cur_p));
- add_to_widths(s, line_break_dir, pdf_adjust_spacing,
- disc_width);
- ext_try_break(actual_penalty, hyphenated_node,
- line_break_dir, pdf_adjust_spacing,
- par_shape_ptr, adj_demerits,
- tracing_paragraphs,
- pdf_protrude_chars, line_penalty,
- last_line_fit, double_hyphen_demerits,
- final_hyphen_demerits, first_p,
- vlink(cur_p));
-#endif
- }
- do_one_seven_eight(sub_disc_width_from_active_width);
- }
- }
- s = vlink_no_break(cur_p);
- add_to_widths(s, line_break_dir, pdf_adjust_spacing,
- active_width);
- break;
- case math_node:
- auto_breaking = (subtype(cur_p) == after);
- kern_break();
- break;
- case penalty_node:
- ext_try_break(penalty(cur_p), unhyphenated_node, line_break_dir,
- pdf_adjust_spacing, par_shape_ptr, adj_demerits,
- tracing_paragraphs, pdf_protrude_chars,
- line_penalty, last_line_fit,
- double_hyphen_demerits, final_hyphen_demerits,
- first_p, cur_p);
- break;
- case mark_node:
- case ins_node:
- case adjust_node:
- break;
- case glue_spec_node:
- fprintf(stdout, "\nfound a glue_spec in a paragraph!");
- break;
- default:
- fprintf(stdout, "\ntype=%d", type(cur_p));
- confusion("paragraph");
- }
- cur_p = vlink(cur_p);
- while (cur_p == null && nest_index > 0) {
- cur_p = nest_stack[--nest_index];
-#ifdef DEBUG
- fprintf(stderr,"Node Pop %d [%d]\n",nest_index,(int)cur_p);
-#endif
- }
- }
- if (cur_p == null) {
- /* Try the final line break at the end of the paragraph,
- and |goto done| if the desired breakpoints have been found */
-
- /* The forced line break at the paragraph's end will reduce the list of
- breakpoints so that all active nodes represent breaks at |cur_p=null|.
- On the first pass, we insist on finding an active node that has the
- correct ``looseness.'' On the final pass, there will be at least one active
- node, and we will match the desired looseness as well as we can.
-
- The global variable |best_bet| will be set to the active node for the best
- way to break the paragraph, and a few other variables are used to
- help determine what is best.
- */
-
- ext_try_break(eject_penalty, hyphenated_node, line_break_dir,
- pdf_adjust_spacing, par_shape_ptr, adj_demerits,
- tracing_paragraphs, pdf_protrude_chars, line_penalty,
- last_line_fit, double_hyphen_demerits,
- final_hyphen_demerits, first_p, cur_p);
- if (vlink(active) != active) {
- /* Find an active node with fewest demerits; */
- r = vlink(active);
- fewest_demerits = awful_bad;
- do {
- if (type(r) != delta_node) {
- if (total_demerits(r) < fewest_demerits) {
- fewest_demerits = total_demerits(r);
- best_bet = r;
- }
- }
- r = vlink(r);
- } while (r != active);
- best_line = line_number(best_bet);
-
- /* /Find an active node with fewest demerits; */
- if (looseness == 0)
- goto DONE;
- /*Find the best active node for the desired looseness; */
-
- /* The adjustment for a desired looseness is a slightly more complicated
- version of the loop just considered. Note that if a paragraph is broken
- into segments by displayed equations, each segment will be subject to the
- looseness calculation, independently of the other segments.
- */
- r = vlink(active);
- actual_looseness = 0;
- do {
- if (type(r) != delta_node) {
- line_diff = line_number(r) - best_line;
- if (((line_diff < actual_looseness)
- && (looseness <= line_diff))
- || ((line_diff > actual_looseness)
- && (looseness >= line_diff))) {
- best_bet = r;
- actual_looseness = line_diff;
- fewest_demerits = total_demerits(r);
- } else if ((line_diff == actual_looseness) &&
- (total_demerits(r) < fewest_demerits)) {
- best_bet = r;
- fewest_demerits = total_demerits(r);
- }
- }
- r = vlink(r);
- } while (r != active);
- best_line = line_number(best_bet);
-
- /* /Find the best active node for the desired looseness; */
- if ((actual_looseness == looseness) || final_pass)
- goto DONE;
- }
- }
-
- /* Clean up the memory by removing the break nodes; */
- clean_up_the_memory();
- /* /Clean up the memory by removing the break nodes; */
-
- if (!second_pass) {
- if (tracing_paragraphs > 0)
- tprint_nl("@@secondpass");
- threshold = tolerance;
- second_pass = true;
- final_pass = (emergency_stretch <= 0);
- } else { /* if at first you do not succeed, \dots */
- if (tracing_paragraphs > 0)
- tprint_nl("@@emergencypass");
- background[2] += emergency_stretch;
- final_pass = true;
- }
- }
-
- DONE:
- if (tracing_paragraphs > 0) {
- end_diagnostic(true);
- normalize_selector();
- }
- if (do_last_line_fit) {
- /* Adjust the final line of the paragraph; */
- /* Here we either reset |do_last_line_fit| or adjust the |par_fill_skip| glue.
- */
- if (active_short(best_bet) == 0) {
- do_last_line_fit = false;
- } else {
- q = new_spec(glue_ptr(last_line_fill));
- delete_glue_ref(glue_ptr(last_line_fill));
- width(q) += (active_short(best_bet) - active_glue(best_bet));
- stretch(q) = 0;
- glue_ptr(last_line_fill) = q;
- }
- }
-
- /* Break the paragraph at the chosen...; */
- /* Once the best sequence of breakpoints has been found (hurray), we call on the
- procedure |post_line_break| to finish the remainder of the work.
- (By introducing this subprocedure, we are able to keep |line_break|
- from getting extremely long.)
- */
-
- /* first thing |ext_post_line_break| does is reset |dir_ptr| */
- flush_node_list(dir_ptr);
- dir_ptr = null;
- ext_post_line_break(paragraph_dir,
- right_skip,
- left_skip,
- pdf_protrude_chars,
- par_shape_ptr,
- pdf_adjust_spacing,
- pdf_each_line_height,
- pdf_each_line_depth,
- pdf_first_line_height,
- pdf_last_line_depth,
- inter_line_penalties_ptr,
- inter_line_penalty,
- club_penalty,
- club_penalties_ptr,
- widow_penalties_ptr,
- widow_penalty,
- broken_penalty,
- final_par_glue,
- best_bet,
- last_special_line,
- second_width,
- second_indent, first_width, first_indent, best_line,
- pdf_ignored_dimen);
- /* /Break the paragraph at the chosen... */
- /* Clean up the memory by removing the break nodes; */
- clean_up_the_memory();
-}
-
-@ @c
-void get_linebreak_info (int *f, int *a)
-{
- *f = fewest_demerits;
- *a = actual_looseness;
-}
+% linebreak.w
+%
+% Copyright 2006-2008 Taco Hoekwater <taco@@luatex.org>
+%
+% This file is part of LuaTeX.
+%
+% LuaTeX is free software; you can redistribute it and/or modify it under
+% the terms of the GNU General Public License as published by the Free
+% Software Foundation; either version 2 of the License, or (at your
+% option) any later version.
+%
+% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
+% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
+% License for more details.
+%
+% You should have received a copy of the GNU General Public License along
+% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
+
+@ @c
+static const char _svn_version[] =
+ "$Id: linebreak.w 4777 2014-02-10 10:09:39Z luigi $"
+ "$URL: https://foundry.supelec.fr/svn/luatex/trunk/source/texk/web2c/luatexdir/tex/linebreak.w $";
+
+#include "ptexlib.h"
+
+
+@ We come now to what is probably the most interesting algorithm of \TeX:
+the mechanism for choosing the ``best possible'' breakpoints that yield
+the individual lines of a paragraph. \TeX's line-breaking algorithm takes
+a given horizontal list and converts it to a sequence of boxes that are
+appended to the current vertical list. In the course of doing this, it
+creates a special data structure containing three kinds of records that are
+not used elsewhere in \TeX. Such nodes are created while a paragraph is
+being processed, and they are destroyed afterwards; thus, the other parts
+of \TeX\ do not need to know anything about how line-breaking is done.
+
+The method used here is based on an approach devised by Michael F. Plass and
+@^Plass, Michael Frederick@>
+@^Knuth, Donald Ervin@>
+the author in 1977, subsequently generalized and improved by the same two
+people in 1980. A detailed discussion appears in {\sl SOFTWARE---Practice
+\AM\ Experience \bf11} (1981), 1119--1184, where it is shown that the
+line-breaking problem can be regarded as a special case of the problem of
+computing the shortest path in an acyclic network. The cited paper includes
+numerous examples and describes the history of line breaking as it has been
+practiced by printers through the ages. The present implementation adds two
+new ideas to the algorithm of 1980: Memory space requirements are considerably
+reduced by using smaller records for inactive nodes than for active ones,
+and arithmetic overflow is avoided by using ``delta distances'' instead of
+keeping track of the total distance from the beginning of the paragraph to the
+current point.
+
+The |line_break| procedure should be invoked only in horizontal mode; it
+leaves that mode and places its output into the current vlist of the
+enclosing vertical mode (or internal vertical mode).
+There is one explicit parameter: |d| is true for partial paragraphs
+preceding display math mode; in this case the amount of additional
+penalty inserted before the final line is |display_widow_penalty|
+instead of |widow_penalty|.
+
+There are also a number of implicit parameters: The hlist to be broken
+starts at |vlink(head)|, and it is nonempty. The value of |prev_graf| in the
+enclosing semantic level tells where the paragraph should begin in the
+sequence of line numbers, in case hanging indentation or \.{\\parshape}
+are in use; |prev_graf| is zero unless this paragraph is being continued
+after a displayed formula. Other implicit parameters, such as the
+|par_shape_ptr| and various penalties to use for hyphenation, etc., appear
+in |eqtb|.
+
+After |line_break| has acted, it will have updated the current vlist and the
+value of |prev_graf|. Furthermore, the global variable |just_box| will
+point to the final box created by |line_break|, so that the width of this
+line can be ascertained when it is necessary to decide whether to use
+|above_display_skip| or |above_display_short_skip| before a displayed formula.
+
+@c
+halfword just_box; /* the |hlist_node| for the last line of the new paragraph */
+
+
+@ In it's complete form, |line_break| is a rather lengthy
+procedure---sort of a small world unto itself---we must build it up
+little by little. Below you see only the general outline.
+
+The main task performed here is to move the list from |head| to
+|temp_head| and go into the enclosing semantic level. We also append
+the \.{\\parfillskip} glue to the end of the paragraph, removing a
+space (or other glue node) if it was there, since spaces usually
+precede blank lines and instances of `\.{\$\$}'. The |par_fill_skip|
+is preceded by an infinite penalty, so it will never be considered as
+a potential breakpoint.
+
+That code assumes that a |glue_node| and a |penalty_node| occupy the
+same number of |mem|~words.
+@^data structure assumptions@>
+
+Most other processing is delegated to external functions.
+
+@c
+void line_break(boolean d, int line_break_context)
+{
+ int paragraph_dir = 0; /* main direction of paragraph */
+ halfword final_par_glue;
+ halfword start_of_par;
+ int callback_id;
+ pack_begin_line = cur_list.ml_field; /* this is for over/underfull box messages */
+ alink(temp_head) = null; /* hh-ls */
+ vlink(temp_head) = vlink(cur_list.head_field);
+ new_hyphenation(temp_head, cur_list.tail_field);
+ cur_list.tail_field = new_ligkern(temp_head, cur_list.tail_field);
+ if (is_char_node(cur_list.tail_field)) {
+ tail_append(new_penalty(inf_penalty));
+ } else if (type(cur_list.tail_field) != glue_node) {
+ tail_append(new_penalty(inf_penalty));
+ } else {
+ type(cur_list.tail_field) = penalty_node;
+ delete_glue_ref(glue_ptr(cur_list.tail_field));
+ if (leader_ptr(cur_list.tail_field) != null)
+ flush_node_list(leader_ptr(cur_list.tail_field));
+ penalty(cur_list.tail_field) = inf_penalty;
+ }
+ final_par_glue = new_param_glue(par_fill_skip_code);
+ couple_nodes(cur_list.tail_field, final_par_glue);
+ cur_list.tail_field = vlink(cur_list.tail_field);
+#ifdef DEBUG
+ {
+ int n = temp_head;
+ fprintf(stdout, "pre_linebreak_filter status:\n");
+ while (n) {
+ fprintf(stdout, " %s node %d\n",
+ get_node_name(type(n), subtype(n)), (int) n);
+ n = vlink(n);
+ }
+ }
+#endif
+ lua_node_filter(pre_linebreak_filter_callback,
+ line_break_context, temp_head,
+ addressof(cur_list.tail_field));
+ last_line_fill = cur_list.tail_field;
+ pop_nest();
+ start_of_par = cur_list.tail_field;
+#ifdef DEBUG
+ {
+ int n = temp_head;
+ fprintf(stdout, "pre_linebreak_filter returned:\n");
+ while (n) {
+ fprintf(stdout, " %s node %d\n",
+ get_node_name(type(n), subtype(n)), (int) n);
+ n = vlink(n);
+ }
+ }
+#endif
+ callback_id = callback_defined(linebreak_filter_callback);
+ if (callback_id > 0) {
+ callback_id =
+ lua_linebreak_callback(d, temp_head,
+ addressof(cur_list.tail_field));
+ if (callback_id > 0) {
+ /* find the correct value for the |just_box| */
+ halfword box_search = cur_list.tail_field;
+ just_box = null;
+ if (box_search != null) {
+ do {
+ if (type(box_search) == hlist_node) {
+ just_box = box_search;
+ }
+ box_search = vlink(box_search);
+ } while (box_search != null);
+ }
+ if (just_box == null) {
+ help3
+ ("A linebreaking routine should return a non-empty list of nodes",
+ "and at least one of those has to be a \\hbox.",
+ "Sorry, I cannot recover from this.");
+ print_err("Invalid linebreak_filter");
+ succumb();
+ }
+ } else {
+ if (int_par(tracing_paragraphs_code) > 0) {
+ begin_diagnostic();
+ tprint_nl
+ ("Lua linebreak_filter failed, reverting to default on line ");
+ print_int(line);
+ end_diagnostic(true);
+ }
+ }
+ }
+ if (callback_id == 0) {
+ if ((!is_char_node(vlink(temp_head)))
+ && ((type(vlink(temp_head)) == whatsit_node)
+ && (subtype(vlink(temp_head)) == local_par_node)))
+ paragraph_dir = local_par_dir(vlink(temp_head));
+ else
+ assert(0); /* |paragraph_dir = 0|; */
+ ext_do_line_break(paragraph_dir,
+ int_par(pretolerance_code),
+ int_par(tracing_paragraphs_code),
+ int_par(tolerance_code),
+ dimen_par(emergency_stretch_code),
+ int_par(looseness_code),
+ int_par(hyphen_penalty_code),
+ int_par(ex_hyphen_penalty_code),
+ int_par(pdf_adjust_spacing_code),
+ equiv(par_shape_loc),
+ int_par(adj_demerits_code),
+ int_par(pdf_protrude_chars_code),
+ int_par(line_penalty_code),
+ int_par(last_line_fit_code),
+ int_par(double_hyphen_demerits_code),
+ int_par(final_hyphen_demerits_code),
+ dimen_par(hang_indent_code),
+ dimen_par(hsize_code),
+ int_par(hang_after_code),
+ glue_par(left_skip_code),
+ glue_par(right_skip_code),
+ dimen_par(pdf_each_line_height_code),
+ dimen_par(pdf_each_line_depth_code),
+ dimen_par(pdf_first_line_height_code),
+ dimen_par(pdf_last_line_depth_code),
+ equiv(inter_line_penalties_loc),
+ int_par(inter_line_penalty_code),
+ int_par(club_penalty_code),
+ equiv(club_penalties_loc),
+ (d ? equiv(display_widow_penalties_loc) : equiv(widow_penalties_loc)),
+ (d ? int_par(display_widow_penalty_code) : int_par(widow_penalty_code)),
+ int_par(broken_penalty_code),
+ final_par_glue, dimen_par(pdf_ignored_dimen_code));
+ }
+ lua_node_filter(post_linebreak_filter_callback,
+ line_break_context, start_of_par,
+ addressof(cur_list.tail_field));
+ pack_begin_line = 0;
+}
+
+
+@ Glue nodes in a horizontal list that is being paragraphed are not supposed to
+ include ``infinite'' shrinkability; that is why the algorithm maintains
+ four registers for stretching but only one for shrinking. If the user tries to
+ introduce infinite shrinkability, the shrinkability will be reset to finite
+ and an error message will be issued. A boolean variable |no_shrink_error_yet|
+ prevents this error message from appearing more than once per paragraph.
+
+@c
+#define check_shrinkage(a) \
+ if ((shrink_order((a))!=normal)&&(shrink((a))!=0)) \
+ a=finite_shrink((a))
+
+static boolean no_shrink_error_yet; /*have we complained about infinite shrinkage? */
+
+static halfword finite_shrink(halfword p)
+{ /* recovers from infinite shrinkage */
+ halfword q; /*new glue specification */
+ const char *hlp[] = {
+ "The paragraph just ended includes some glue that has",
+ "infinite shrinkability, e.g., `\\hskip 0pt minus 1fil'.",
+ "Such glue doesn't belong there---it allows a paragraph",
+ "of any length to fit on one line. But it's safe to proceed,",
+ "since the offensive shrinkability has been made finite.",
+ NULL
+ };
+ if (no_shrink_error_yet) {
+ no_shrink_error_yet = false;
+ tex_error("Infinite glue shrinkage found in a paragraph", hlp);
+ }
+ q = new_spec(p);
+ shrink_order(q) = normal;
+ delete_glue_ref(p);
+ return q;
+}
+
+@ A pointer variable |cur_p| runs through the given horizontal list as we look
+ for breakpoints. This variable is global, since it is used both by |line_break|
+ and by its subprocedure |try_break|.
+
+ Another global variable called |threshold| is used to determine the feasibility
+ of individual lines: breakpoints are feasible if there is a way to reach
+ them without creating lines whose badness exceeds |threshold|. (The
+ badness is compared to |threshold| before penalties are added, so that
+ penalty values do not affect the feasibility of breakpoints, except that
+ no break is allowed when the penalty is 10000 or more.) If |threshold|
+ is 10000 or more, all legal breaks are considered feasible, since the
+ |badness| function specified above never returns a value greater than~10000.
+
+ Up to three passes might be made through the paragraph in an attempt to find at
+ least one set of feasible breakpoints. On the first pass, we have
+ |threshold=pretolerance| and |second_pass=final_pass=false|.
+ If this pass fails to find a
+ feasible solution, |threshold| is set to |tolerance|, |second_pass| is set
+ |true|, and an attempt is made to hyphenate as many words as possible.
+ If that fails too, we add |emergency_stretch| to the background
+ stretchability and set |final_pass=true|.
+
+@c
+static boolean second_pass; /* is this our second attempt to break this paragraph? */
+static boolean final_pass; /*is this our final attempt to break this paragraph? */
+static int threshold; /* maximum badness on feasible lines */
+
+/* maximum fill level for |hlist_stack|*/
+#define max_hlist_stack 512 /* maybe good if larger than |2 *
+ max_quarterword|, so that box nesting
+ level would overflow first */
+
+/* stack for |find_protchar_left()| and |find_protchar_right()| */
+static halfword hlist_stack[max_hlist_stack];
+
+/* fill level for |hlist_stack| */
+static short hlist_stack_level = 0;
+
+@ @c
+static void push_node(halfword p)
+{
+ if (hlist_stack_level >= max_hlist_stack)
+ pdf_error("push_node", "stack overflow");
+ hlist_stack[hlist_stack_level++] = p;
+}
+
+static halfword pop_node(void)
+{
+ if (hlist_stack_level <= 0) /* would point to some bug */
+ pdf_error("pop_node", "stack underflow (internal error)");
+ return hlist_stack[--hlist_stack_level];
+}
+
+@ @c
+static int max_stretch_ratio = 0; /*maximal stretch ratio of expanded fonts */
+static int max_shrink_ratio = 0; /*maximal shrink ratio of expanded fonts */
+static int cur_font_step = 0; /*the current step of expanded fonts */
+
+
+static boolean check_expand_pars(internal_font_number f)
+{
+ int m;
+
+ if ((font_step(f) == 0)
+ || ((font_max_stretch(f) == 0) && (font_max_shrink(f) == 0)))
+ return false;
+ if (cur_font_step < 0)
+ cur_font_step = font_step(f);
+ else if (cur_font_step != font_step(f))
+ pdf_error("font expansion",
+ "using fonts with different step of expansion in one paragraph is not allowed");
+ m = font_max_stretch(f);
+ if (m != 0) {
+ if (max_stretch_ratio < 0)
+ max_stretch_ratio = m;
+ else if (max_stretch_ratio != m)
+ pdf_error("font expansion",
+ "using fonts with different limit of expansion in one paragraph is not allowed");
+ }
+ m = font_max_shrink(f);
+ if (m != 0) {
+ if (max_shrink_ratio < 0)
+ max_shrink_ratio = -m;
+ else if (max_shrink_ratio != -m)
+ pdf_error("font expansion",
+ "using fonts with different limit of expansion in one paragraph is not allowed");
+ }
+ return true;
+}
+
+@ searches left to right from list head |l|, returns 1st non-skipable item
+
+@c
+/*public*/ halfword find_protchar_left(halfword l, boolean d)
+{
+ halfword t;
+ boolean run;
+ if ((vlink(l) != null) && (type(l) == hlist_node) && (width(l) == 0)
+ && (height(l) == 0) && (depth(l) == 0) && (list_ptr(l) == null)) {
+ l = vlink(l); /*for paragraph start with \.{\\parindent} = 0pt */
+ } else if (d) {
+ while ((vlink(l) != null) && (!(is_char_node(l) || non_discardable(l)))) {
+ l = vlink(l); /* std.\ discardables at line break, \TeX book, p 95 */
+ }
+ }
+ hlist_stack_level = 0;
+ run = true;
+ do {
+ t = l;
+ while (run && (type(l) == hlist_node) && (list_ptr(l) != null)) {
+ push_node(l);
+ l = list_ptr(l);
+ }
+ while (run && cp_skipable(l)) {
+ while ((vlink(l) == null) && (hlist_stack_level > 0)) {
+ l = pop_node(); /* don't visit this node again */
+ run = false;
+ }
+ if (vlink(l) != null)
+ l = vlink(l);
+ else if (hlist_stack_level == 0)
+ run = false;
+ }
+ } while (t != l);
+ return l;
+}
+
+
+@ searches right to left from list tail |r| to head |l|, returns 1st non-skipable item
+
+@c
+/*public*/ halfword find_protchar_right(halfword l, halfword r)
+{
+ halfword t;
+ boolean run;
+ if (r == null)
+ return null;
+ hlist_stack_level = 0;
+ run = true;
+ do {
+ t = r;
+ while (run && (type(r) == hlist_node) && (list_ptr(r) != null)) {
+ push_node(l);
+ push_node(r);
+ l = list_ptr(r);
+ r = l;
+ while (vlink(r) != null) {
+ halfword s = r;
+ r = vlink(r);
+ alink(r) = s;
+ }
+ }
+ while (run && cp_skipable(r)) {
+ while ((r == l) && (hlist_stack_level > 0)) {
+ r = pop_node(); /* don't visit this node again */
+ l = pop_node();
+ }
+ if ((r != l) && (r != null)) {
+ if (alink(r) != null) {
+ assert(vlink(alink(r)) == r);
+ r = alink(r);
+ } else { /* this is the input: \.{\\leavevmode\\penalty-10000\\penalty-10000} (bug \#268) */
+ run = false;
+ }
+ } else if ((r == l) && (hlist_stack_level == 0))
+ run = false;
+ }
+ } while (t != r);
+ return r;
+}
+
+@ @c
+#define left_pw(a) char_pw((a), left_side)
+#define right_pw(a) char_pw((a), right_side)
+
+@ When looking for optimal line breaks, \TeX\ creates a ``break node'' for
+ each break that is {\sl feasible}, in the sense that there is a way to end
+ a line at the given place without requiring any line to stretch more than
+ a given tolerance. A break node is characterized by three things: the position
+ of the break (which is a pointer to a |glue_node|, |math_node|, |penalty_node|,
+ or |disc_node|); the ordinal number of the line that will follow this
+ breakpoint; and the fitness classification of the line that has just
+ ended, i.e., |tight_fit|, |decent_fit|, |loose_fit|, or |very_loose_fit|.
+
+@c
+typedef enum {
+ very_loose_fit = 0, /* fitness classification for lines stretching more than
+ their stretchability */
+ loose_fit, /* fitness classification for lines stretching 0.5 to 1.0 of their
+ stretchability */
+ decent_fit, /* fitness classification for all other lines */
+ tight_fit /* fitness classification for lines shrinking 0.5 to 1.0 of their
+ shrinkability */
+} fitness_value;
+
+
+@ The algorithm essentially determines the best possible way to achieve
+ each feasible combination of position, line, and fitness. Thus, it answers
+ questions like, ``What is the best way to break the opening part of the
+ paragraph so that the fourth line is a tight line ending at such-and-such
+ a place?'' However, the fact that all lines are to be the same length
+ after a certain point makes it possible to regard all sufficiently large
+ line numbers as equivalent, when the looseness parameter is zero, and this
+ makes it possible for the algorithm to save space and time.
+
+ An ``active node'' and a ``passive node'' are created in |mem| for each
+ feasible breakpoint that needs to be considered. Active nodes are three
+ words long and passive nodes are two words long. We need active nodes only
+ for breakpoints near the place in the paragraph that is currently being
+ examined, so they are recycled within a comparatively short time after
+ they are created.
+
+@ An active node for a given breakpoint contains six fields:
+
+|vlink| points to the next node in the list of active nodes; the
+last active node has |vlink=active|.
+
+|break_node| points to the passive node associated with this
+breakpoint.
+
+|line_number| is the number of the line that follows this
+breakpoint.
+
+|fitness| is the fitness classification of the line ending at this
+breakpoint.
+
+|type| is either |hyphenated_node| or |unhyphenated_node|, depending on
+whether this breakpoint is a |disc_node|.
+
+|total_demerits| is the minimum possible sum of demerits over all
+lines leading from the beginning of the paragraph to this breakpoint.
+
+The value of |vlink(active)| points to the first active node on a vlinked list
+of all currently active nodes. This list is in order by |line_number|,
+except that nodes with |line_number>easy_line| may be in any order relative
+to each other.
+
+@c
+void initialize_active(void)
+{
+ type(active) = hyphenated_node;
+ line_number(active) = max_halfword;
+ subtype(active) = 0; /* the |subtype| is never examined */
+}
+
+@ The passive node for a given breakpoint contains EIGHT fields:
+
+|vlink| points to the passive node created just before this one,
+if any, otherwise it is |null|.
+
+|cur_break| points to the position of this breakpoint in the
+horizontal list for the paragraph being broken.
+
+|prev_break| points to the passive node that should precede this
+one in an optimal path to this breakpoint.
+
+|serial| is equal to |n| if this passive node is the |n|th
+one created during the current pass. (This field is used only when
+printing out detailed statistics about the line-breaking calculations.)
+
+|passive_pen_inter| holds the current \.{\\localinterlinepenalty}
+
+|passive_pen_broken| holds the current \.{\\localbrokenpenalty}
+
+There is a global variable called |passive| that points to the most
+recently created passive node. Another global variable, |printed_node|,
+is used to help print out the paragraph when detailed information about
+the line-breaking computation is being displayed.
+
+@c
+static halfword passive; /* most recent node on passive list */
+static halfword printed_node; /*most recent node that has been printed */
+static halfword pass_number; /*the number of passive nodes allocated on this pass */
+
+
+@ The active list also contains ``delta'' nodes that help the algorithm
+compute the badness of individual lines. Such nodes appear only between two
+active nodes, and they have |type=delta_node|. If |p| and |r| are active nodes
+and if |q| is a delta node between them, so that |vlink(p)=q| and |vlink(q)=r|,
+then |q| tells the space difference between lines in the horizontal list that
+start after breakpoint |p| and lines that start after breakpoint |r|. In
+other words, if we know the length of the line that starts after |p| and
+ends at our current position, then the corresponding length of the line that
+starts after |r| is obtained by adding the amounts in node~|q|. A delta node
+contains seven scaled numbers, since it must record the net change in glue
+stretchability with respect to all orders of infinity. The natural width
+difference appears in |mem[q+1].sc|; the stretch differences in units of
+pt, sfi, fil, fill, and filll appear in |mem[q+2..q+6].sc|; and the shrink
+difference appears in |mem[q+7].sc|. The |subtype| field of a delta node
+is not used.
+
+Actually, we have two more fields that are used by |pdftex|.
+
+
+As the algorithm runs, it maintains a set of seven delta-like registers
+for the length of the line following the first active breakpoint to the
+current position in the given hlist. When it makes a pass through the
+active list, it also maintains a similar set of seven registers for the
+length following the active breakpoint of current interest. A third set
+holds the length of an empty line (namely, the sum of \.{\\leftskip} and
+\.{\\rightskip}); and a fourth set is used to create new delta nodes.
+
+When we pass a delta node we want to do operations like
+$$\hbox{\ignorespaces|for
+k:=1 to 7 do cur_active_width[k]:=cur_active_width[k]+mem[q+k].sc|};$$ and we
+want to do this without the overhead of |for| loops. The |do_all_six|
+macro makes such six-tuples convenient.
+
+@c
+static scaled active_width[10] = { 0 }; /*distance from first active node to~|cur_p| */
+static scaled background[10] = { 0 }; /*length of an ``empty'' line */
+static scaled break_width[10] = { 0 }; /*length being computed after current break */
+
+static boolean auto_breaking; /*make |auto_breaking| accessible out of |line_break| */
+
+@ Let's state the principles of the delta nodes more precisely and concisely,
+ so that the following programs will be less obscure. For each legal
+ breakpoint~|p| in the paragraph, we define two quantities $\alpha(p)$ and
+ $\beta(p)$ such that the length of material in a line from breakpoint~|p|
+ to breakpoint~|q| is $\gamma+\beta(q)-\alpha(p)$, for some fixed $\gamma$.
+ Intuitively, $\alpha(p)$ and $\beta(q)$ are the total length of material from
+ the beginning of the paragraph to a point ``after'' a break at |p| and to a
+ point ``before'' a break at |q|; and $\gamma$ is the width of an empty line,
+ namely the length contributed by \.{\\leftskip} and \.{\\rightskip}.
+
+ Suppose, for example, that the paragraph consists entirely of alternating
+ boxes and glue skips; let the boxes have widths $x_1\ldots x_n$ and
+ let the skips have widths $y_1\ldots y_n$, so that the paragraph can be
+ represented by $x_1y_1\ldots x_ny_n$. Let $p_i$ be the legal breakpoint
+ at $y_i$; then $\alpha(p_i)=x_1+y_1+\cdots+x_i+y_i$, and $\beta(p_i)=
+ x_1+y_1+\cdots+x_i$. To check this, note that the length of material from
+ $p_2$ to $p_5$, say, is $\gamma+x_3+y_3+x_4+y_4+x_5=\gamma+\beta(p_5)
+ -\alpha(p_2)$.
+
+ The quantities $\alpha$, $\beta$, $\gamma$ involve glue stretchability and
+ shrinkability as well as a natural width. If we were to compute $\alpha(p)$
+ and $\beta(p)$ for each |p|, we would need multiple precision arithmetic, and
+ the multiprecise numbers would have to be kept in the active nodes.
+ \TeX\ avoids this problem by working entirely with relative differences
+ or ``deltas.'' Suppose, for example, that the active list contains
+ $a_1\,\delta_1\,a_2\,\delta_2\,a_3$, where the |a|'s are active breakpoints
+ and the $\delta$'s are delta nodes. Then $\delta_1=\alpha(a_1)-\alpha(a_2)$
+ and $\delta_2=\alpha(a_2)-\alpha(a_3)$. If the line breaking algorithm is
+ currently positioned at some other breakpoint |p|, the |active_width| array
+ contains the value $\gamma+\beta(p)-\alpha(a_1)$. If we are scanning through
+ the list of active nodes and considering a tentative line that runs from
+ $a_2$ to~|p|, say, the |cur_active_width| array will contain the value
+ $\gamma+\beta(p)-\alpha(a_2)$. Thus, when we move from $a_2$ to $a_3$,
+ we want to add $\alpha(a_2)-\alpha(a_3)$ to |cur_active_width|; and this
+ is just $\delta_2$, which appears in the active list between $a_2$ and
+ $a_3$. The |background| array contains $\gamma$. The |break_width| array
+ will be used to calculate values of new delta nodes when the active
+ list is being updated.
+
+
+@ The heart of the line-breaking procedure is `|try_break|', a subroutine
+ that tests if the current breakpoint |cur_p| is feasible, by running
+ through the active list to see what lines of text can be made from active
+ nodes to~|cur_p|. If feasible breaks are possible, new break nodes are
+ created. If |cur_p| is too far from an active node, that node is
+ deactivated.
+
+ The parameter |pi| to |try_break| is the penalty associated
+ with a break at |cur_p|; we have |pi=eject_penalty| if the break is forced,
+ and |pi=inf_penalty| if the break is illegal.
+
+ The other parameter, |break_type|, is set to |hyphenated_node| or |unhyphenated_node|,
+ depending on whether or not the current break is at a |disc_node|. The
+ end of a paragraph is also regarded as `|hyphenated_node|'; this case is
+ distinguishable by the condition |cur_p=null|.
+
+
+@c
+static int internal_pen_inter; /* running \.{\\localinterlinepenalty} */
+static int internal_pen_broken; /* running \.{\\localbrokenpenalty} */
+static halfword internal_left_box; /* running \.{\\localleftbox} */
+static int internal_left_box_width; /* running \.{\\localleftbox} width */
+static halfword init_internal_left_box; /* running \.{\\localleftbox} */
+static int init_internal_left_box_width; /* running \.{\\localleftbox} width */
+static halfword internal_right_box; /* running \.{\\localrightbox} */
+static int internal_right_box_width; /* running \.{\\localrightbox} width */
+
+static scaled disc_width[10] = { 0 }; /* the length of discretionary material preceding a break */
+
+@ As we consider various ways to end a line at |cur_p|, in a given line number
+ class, we keep track of the best total demerits known, in an array with
+ one entry for each of the fitness classifications. For example,
+ |minimal_demerits[tight_fit]| contains the fewest total demerits of feasible
+ line breaks ending at |cur_p| with a |tight_fit| line; |best_place[tight_fit]|
+ points to the passive node for the break before~|cur_p| that achieves such
+ an optimum; and |best_pl_line[tight_fit]| is the |line_number| field in the
+ active node corresponding to |best_place[tight_fit]|. When no feasible break
+ sequence is known, the |minimal_demerits| entries will be equal to
+ |awful_bad|, which is $2^{30}-1$. Another variable, |minimum_demerits|,
+ keeps track of the smallest value in the |minimal_demerits| array.
+
+@c
+static int minimal_demerits[4]; /* best total demerits known for current
+ line class and position, given the fitness */
+static int minimum_demerits; /* best total demerits known for current line class
+ and position */
+static halfword best_place[4]; /* how to achieve |minimal_demerits| */
+static halfword best_pl_line[4]; /*corresponding line number */
+
+
+
+@ The length of lines depends on whether the user has specified
+\.{\\parshape} or \.{\\hangindent}. If |par_shape_ptr| is not null, it
+points to a $(2n+1)$-word record in |mem|, where the |vinfo| in the first
+word contains the value of |n|, and the other $2n$ words contain the left
+margins and line lengths for the first |n| lines of the paragraph; the
+specifications for line |n| apply to all subsequent lines. If
+|par_shape_ptr=null|, the shape of the paragraph depends on the value of
+|n=hang_after|; if |n>=0|, hanging indentation takes place on lines |n+1|,
+|n+2|, \dots, otherwise it takes place on lines 1, \dots, $\vert
+n\vert$. When hanging indentation is active, the left margin is
+|hang_indent|, if |hang_indent>=0|, else it is 0; the line length is
+$|hsize|-\vert|hang_indent|\vert$. The normal setting is
+|par_shape_ptr=null|, |hang_after=1|, and |hang_indent=0|.
+Note that if |hang_indent=0|, the value of |hang_after| is irrelevant.
+@^length of lines@> @^hanging indentation@>
+
+@c
+static halfword easy_line; /*line numbers |>easy_line| are equivalent in break nodes */
+static halfword last_special_line; /*line numbers |>last_special_line| all have the same width */
+static scaled first_width; /*the width of all lines |<=last_special_line|, if
+ no \.{\\parshape} has been specified */
+static scaled second_width; /*the width of all lines |>last_special_line| */
+static scaled first_indent; /*left margin to go with |first_width| */
+static scaled second_indent; /*left margin to go with |second_width| */
+
+static halfword best_bet; /*use this passive node and its predecessors */
+static int fewest_demerits; /*the demerits associated with |best_bet| */
+static halfword best_line; /*line number following the last line of the new paragraph */
+static int actual_looseness; /*the difference between |line_number(best_bet)|
+ and the optimum |best_line| */
+static int line_diff; /*the difference between the current line number and
+ the optimum |best_line| */
+
+
+
+@ \TeX\ makes use of the fact that |hlist_node|, |vlist_node|,
+ |rule_node|, |ins_node|, |mark_node|, |adjust_node|,
+ |disc_node|, |whatsit_node|, and |math_node| are at the low end of the
+ type codes, by permitting a break at glue in a list if and only if the
+ |type| of the previous node is less than |math_node|. Furthermore, a
+ node is discarded after a break if its type is |math_node| or~more.
+
+@c
+#define do_all_six(a) a(1);a(2);a(3);a(4);a(5);a(6);a(7)
+#define do_seven_eight(a) if (pdf_adjust_spacing > 1) { a(8);a(9); }
+#define do_all_eight(a) do_all_six(a); do_seven_eight(a)
+#define do_one_seven_eight(a) a(1); do_seven_eight(a)
+
+#define store_background(a) {active_width[a]=background[a];}
+
+#define kern_break() { \
+ if ((!is_char_node(vlink(cur_p))) && auto_breaking) \
+ if (type(vlink(cur_p))==glue_node) \
+ ext_try_break(0,unhyphenated_node, line_break_dir, pdf_adjust_spacing, \
+ par_shape_ptr, adj_demerits, \
+ tracing_paragraphs, pdf_protrude_chars, \
+ line_penalty, last_line_fit, \
+ double_hyphen_demerits, final_hyphen_demerits,first_p,cur_p); \
+ if (type(cur_p)!=math_node) active_width[1]+=width(cur_p); \
+ else active_width[1]+=surround(cur_p); \
+ }
+
+#define clean_up_the_memory() { \
+ q=vlink(active); \
+ while (q!=active) { \
+ cur_p=vlink(q); \
+ if (type(q)==delta_node) flush_node(q); \
+ else flush_node(q); \
+ q=cur_p; \
+ } \
+ q=passive; \
+ while (q!=null) { \
+ cur_p=vlink(q); \
+ flush_node(q); \
+ q=cur_p; \
+ } \
+ }
+
+static boolean do_last_line_fit; /* special algorithm for last line of paragraph? */
+static scaled fill_width[4]; /* infinite stretch components of |par_fill_skip| */
+static scaled best_pl_short[4]; /* |shortfall| corresponding to |minimal_demerits| */
+static scaled best_pl_glue[4]; /*corresponding glue stretch or shrink */
+
+#define reset_disc_width(a) disc_width[(a)] = 0
+
+#define add_disc_width_to_break_width(a) break_width[(a)] += disc_width[(a)]
+#define sub_disc_width_from_active_width(a) active_width[(a)] -= disc_width[(a)]
+
+#define add_char_shrink(a,b) a += char_shrink((b))
+#define add_char_stretch(a,b) a += char_stretch((b))
+#define sub_char_shrink(a,b) a -= char_shrink((b))
+#define sub_char_stretch(a,b) a -= char_stretch((b))
+
+#define add_kern_shrink(a,b) a += kern_shrink((b))
+#define add_kern_stretch(a,b) a += kern_stretch((b))
+#define sub_kern_shrink(a,b) a -= kern_shrink((b))
+#define sub_kern_stretch(a,b) a -= kern_stretch((b))
+
+
+@ This function is used to add the width of a list of nodes
+(from a discretionary) to one of the width arrays.
+
+
+Replacement texts and discretionary texts are supposed to contain
+only character nodes, kern nodes, and box or rule nodes.
+
+@c
+static void add_to_widths(halfword s, int line_break_dir,
+ int pdf_adjust_spacing, scaled * widths)
+{
+ while (s != null) {
+ if (is_char_node(s)) {
+ widths[1] += pack_width(line_break_dir, dir_TRT, s, true);
+ if ((pdf_adjust_spacing > 1) && check_expand_pars(font(s))) {
+ set_prev_char_p(s);
+ add_char_stretch(widths[8], s);
+ add_char_shrink(widths[9], s);
+ };
+ } else {
+ switch (type(s)) {
+ case hlist_node:
+ case vlist_node:
+ widths[1] += pack_width(line_break_dir, box_dir(s), s, false);
+ break;
+ case kern_node:
+ if ((pdf_adjust_spacing > 1) && (subtype(s) == normal)) {
+ add_kern_stretch(widths[8], s);
+ add_kern_shrink(widths[9], s);
+ }
+ /* fall through */
+ case rule_node:
+ widths[1] += width(s);
+ break;
+ case disc_node: /* TH temp */
+ break;
+ default:
+ confusion("add_disc_widths");
+ }
+ }
+ s = vlink(s);
+ }
+}
+
+@ This function is used to substract the width of a list of nodes
+(from a discretionary) from one of the width arrays.
+It is used only once, but deserves it own function because of orthogonality
+with the |add_to_widths| function.
+
+@c
+static void sub_from_widths(halfword s, int line_break_dir,
+ int pdf_adjust_spacing, scaled * widths)
+{
+ while (s != null) {
+ /* Subtract the width of node |s| from |break_width|; */
+ if (is_char_node(s)) {
+ widths[1] -= pack_width(line_break_dir, dir_TRT, s, true);
+ if ((pdf_adjust_spacing > 1) && check_expand_pars(font(s))) {
+ set_prev_char_p(s);
+ sub_char_stretch(widths[8], s);
+ sub_char_shrink(widths[9], s);
+ }
+ } else {
+ switch (type(s)) {
+ case hlist_node:
+ case vlist_node:
+ widths[1] -= pack_width(line_break_dir, box_dir(s), s, false);
+ break;
+ case kern_node:
+ if ((pdf_adjust_spacing > 1) && (subtype(s) == normal)) {
+ sub_kern_stretch(widths[8], s);
+ sub_kern_shrink(widths[9], s);
+ }
+ /* fall through */
+ case rule_node:
+ widths[1] -= width(s);
+ break;
+ case disc_node: /* TH temp */
+ break;
+ default:
+ confusion("sub_disc_widths");
+ break;
+ }
+ }
+ s = vlink(s);
+ }
+}
+
+
+@ When we insert a new active node for a break at |cur_p|, suppose this
+ new node is to be placed just before active node |a|; then we essentially
+ want to insert `$\delta\,|cur_p|\,\delta^\prime$' before |a|, where
+ $\delta=\alpha(a)-\alpha(|cur_p|)$ and $\delta^\prime=\alpha(|cur_p|)-\alpha(a)$
+ in the notation explained above. The |cur_active_width| array now holds
+ $\gamma+\beta(|cur_p|)-\alpha(a)$; so $\delta$ can be obtained by
+ subtracting |cur_active_width| from the quantity $\gamma+\beta(|cur_p|)-
+ \alpha(|cur_p|)$. The latter quantity can be regarded as the length of a
+ line ``from |cur_p| to |cur_p|''; we call it the |break_width| at |cur_p|.
+
+ The |break_width| is usually negative, since it consists of the background
+ (which is normally zero) minus the width of nodes following~|cur_p| that are
+ eliminated after a break. If, for example, node |cur_p| is a glue node, the
+ width of this glue is subtracted from the background; and we also look
+ ahead to eliminate all subsequent glue and penalty and kern and math
+ nodes, subtracting their widths as well.
+
+ Kern nodes do not disappear at a line break unless they are |explicit|.
+
+@c
+static void
+compute_break_width(int break_type, int line_break_dir, int pdf_adjust_spacing,
+ halfword p
+ /*, halfword s */ )
+{
+ halfword s; /* glue and other 'whitespace' to be skipped after a break
+ * used if unhyphenated, or |post_break==empty| */
+ s = p;
+ if (break_type > unhyphenated_node && p != null) {
+ /*Compute the discretionary |break_width| values; */
+ /* When |p| is a discretionary break, the length of a line
+ ``from |p| to |p|'' has to be defined properly so
+ that the other calculations work out. Suppose that the
+ pre-break text at |p| has length $l_0$, the post-break
+ text has length $l_1$, and the replacement text has length
+ |l|. Suppose also that |q| is the node following the
+ replacement text. Then length of a line from |p| to |q|
+ will be computed as $\gamma+\beta(q)-\alpha(|p|)$, where
+ $\beta(q)=\beta(|p|)-l_0+l$. The actual length will be
+ the background plus $l_1$, so the length from |p| to
+ |p| should be $\gamma+l_0+l_1-l$. If the post-break text
+ of the discretionary is empty, a break may also discard~|q|;
+ in that unusual case we subtract the length of~|q| and any
+ other nodes that will be discarded after the discretionary
+ break.
+
+ TH: I don't quite understand the above remarks.
+
+ The value of $l_0$ need not be computed, since |line_break|
+ will put it into the global variable |disc_width| before
+ calling |try_break|.
+ */
+ /* In case of nested discretionaries, we always follow the no-break
+ path, as we are talking about the breaking on {\it this} position.
+ */
+
+ sub_from_widths(vlink_no_break(p), line_break_dir, pdf_adjust_spacing,
+ break_width);
+ add_to_widths(vlink_post_break(p), line_break_dir, pdf_adjust_spacing,
+ break_width);
+ do_one_seven_eight(add_disc_width_to_break_width);
+ if (vlink_post_break(p) == null) {
+ s = vlink(p); /* no |post_break|: 'skip' any 'whitespace' following */
+ } else {
+ s = null;
+ }
+ }
+ while (s != null) {
+ switch (type(s)) {
+ case glue_node:
+ /*Subtract glue from |break_width|; */
+ {
+ halfword v = glue_ptr(s);
+ break_width[1] -= width(v);
+ break_width[2 + stretch_order(v)] -= stretch(v);
+ break_width[7] -= shrink(v);
+ }
+ break;
+ case penalty_node:
+ break;
+ case math_node:
+ break_width[1] -= surround(s);
+ break;
+ case kern_node:
+ if (subtype(s) != explicit)
+ return;
+ else
+ break_width[1] -= width(s);
+ break;
+ default:
+ return;
+ };
+ s = vlink(s);
+ }
+}
+
+@ @c
+static void
+print_break_node(halfword q, fitness_value fit_class,
+ quarterword break_type, halfword cur_p)
+{
+ /* Print a symbolic description of the new break node */
+ tprint_nl("@@@@");
+ print_int(serial(passive));
+ tprint(": line ");
+ print_int(line_number(q) - 1);
+ print_char('.');
+ print_int(fit_class);
+ if (break_type == hyphenated_node)
+ print_char('-');
+ tprint(" t=");
+ print_int(total_demerits(q));
+ if (do_last_line_fit) {
+ /*Print additional data in the new active node; */
+ tprint(" s=");
+ print_scaled(active_short(q));
+ if (cur_p == null)
+ tprint(" a=");
+ else
+ tprint(" g=");
+ print_scaled(active_glue(q));
+ }
+ tprint(" -> @@");
+ if (prev_break(passive) == null)
+ print_char('0');
+ else
+ print_int(serial(prev_break(passive)));
+}
+
+@ @c
+static void
+print_feasible_break(halfword cur_p, pointer r, halfword b, int pi,
+ int d, boolean artificial_demerits)
+{
+ /* Print a symbolic description of this feasible break; */
+ if (printed_node != cur_p) {
+ /* Print the list between |printed_node| and |cur_p|, then
+ set |printed_node:=cur_p|; */
+ tprint_nl("");
+ if (cur_p == null) {
+ short_display(vlink(printed_node));
+ } else {
+ halfword save_link = vlink(cur_p);
+ vlink(cur_p) = null;
+ tprint_nl("");
+ short_display(vlink(printed_node));
+ vlink(cur_p) = save_link;
+ }
+ printed_node = cur_p;
+ }
+ tprint_nl("@@");
+ if (cur_p == null) {
+ tprint_esc("par");
+ } else if (type(cur_p) != glue_node) {
+ if (type(cur_p) == penalty_node)
+ tprint_esc("penalty");
+ else if (type(cur_p) == disc_node)
+ tprint_esc("discretionary");
+ else if (type(cur_p) == kern_node)
+ tprint_esc("kern");
+ else
+ tprint_esc("math");
+ }
+ tprint(" via @@");
+ if (break_node(r) == null)
+ print_char('0');
+ else
+ print_int(serial(break_node(r)));
+ tprint(" b=");
+ if (b > inf_bad)
+ print_char('*');
+ else
+ print_int(b);
+ tprint(" p=");
+ print_int(pi);
+ tprint(" d=");
+ if (artificial_demerits)
+ print_char('*');
+ else
+ print_int(d);
+}
+
+@ @c
+#define add_disc_width_to_active_width(a) active_width[a] += disc_width[a]
+#define update_width(a) cur_active_width[a] += varmem[(r+(a))].cint
+
+#define set_break_width_to_background(a) break_width[a]=background[(a)]
+
+#define convert_to_break_width(a) \
+ varmem[(prev_r+(a))].cint = varmem[(prev_r+(a))].cint-cur_active_width[(a)]+break_width[(a)]
+
+#define store_break_width(a) active_width[(a)]=break_width[(a)]
+
+#define new_delta_to_break_width(a) \
+ varmem[(q+(a))].cint=break_width[(a)]-cur_active_width[(a)]
+
+#define new_delta_from_break_width(a) \
+ varmem[(q+(a))].cint=cur_active_width[(a)]-break_width[(a)]
+
+#define copy_to_cur_active(a) cur_active_width[(a)]=active_width[(a)]
+
+#define combine_two_deltas(a) varmem[(prev_r+(a))].cint += varmem[(r+(a))].cint
+#define downdate_width(a) cur_active_width[(a)] -= varmem[(prev_r+(a))].cint
+#define update_active(a) active_width[(a)]+=varmem[(r+(a))].cint
+
+#define total_font_stretch cur_active_width[8]
+#define total_font_shrink cur_active_width[9]
+
+#define cal_margin_kern_var(a) { \
+ character(cp) = character((a)); \
+ font(cp) = font((a)); \
+ do_subst_font(cp, 1000); \
+ if (font(cp) != font((a))) \
+ margin_kern_stretch += (left_pw((a)) - left_pw(cp)); \
+ font(cp) = font((a)); \
+ do_subst_font(cp, -1000); \
+ if (font(cp) != font((a))) \
+ margin_kern_shrink += (left_pw(cp) - left_pw((a))); \
+ }
+
+static void
+ext_try_break(int pi,
+ quarterword break_type,
+ int line_break_dir,
+ int pdf_adjust_spacing,
+ int par_shape_ptr,
+ int adj_demerits,
+ int tracing_paragraphs,
+ int pdf_protrude_chars,
+ int line_penalty,
+ int last_line_fit,
+ int double_hyphen_demerits,
+ int final_hyphen_demerits, halfword first_p, halfword cur_p)
+{
+ /* labels: |CONTINUE,DEACTIVATE,FOUND,NOT_FOUND|; */
+ pointer r; /* runs through the active list */
+ scaled margin_kern_stretch;
+ scaled margin_kern_shrink;
+ halfword lp, rp, cp;
+ halfword prev_r; /* stays a step behind |r| */
+ halfword prev_prev_r; /*a step behind |prev_r|, if |type(prev_r)=delta_node| */
+ halfword old_l; /* maximum line number in current equivalence class of lines */
+ boolean no_break_yet; /* have we found a feasible break at |cur_p|? */
+ halfword q; /*points to a new node being created */
+ halfword l; /*line number of current active node */
+ boolean node_r_stays_active; /*should node |r| remain in the active list? */
+ scaled line_width; /*the current line will be justified to this width */
+ fitness_value fit_class; /*possible fitness class of test line */
+ halfword b; /*badness of test line */
+ int d; /*demerits of test line */
+ boolean artificial_demerits; /*has |d| been forced to zero? */
+
+ scaled shortfall; /*used in badness calculations */
+ scaled g; /*glue stretch or shrink of test line, adjustment for last line */
+ scaled cur_active_width[10] = { 0 }; /*distance from current active node */
+
+ line_width = 0;
+ g = 0;
+ prev_prev_r = null;
+ /*Make sure that |pi| is in the proper range; */
+ if (pi >= inf_penalty) {
+ return; /* this breakpoint is inhibited by infinite penalty */
+ } else if (pi <= -inf_penalty) {
+ pi = eject_penalty; /*this breakpoint will be forced */
+ }
+
+ no_break_yet = true;
+ prev_r = active;
+ old_l = 0;
+ do_all_eight(copy_to_cur_active);
+
+ while (1) {
+ r = vlink(prev_r);
+ /* If node |r| is of type |delta_node|, update |cur_active_width|,
+ set |prev_r| and |prev_prev_r|, then |goto continue|; */
+ /* The following code uses the fact that |type(active)<>delta_node| */
+ if (type(r) == delta_node) {
+ do_all_eight(update_width); /* IMPLICIT ,r */
+ prev_prev_r = prev_r;
+ prev_r = r;
+ continue;
+ }
+ /* If a line number class has ended, create new active nodes for
+ the best feasible breaks in that class; then |return|
+ if |r=active|, otherwise compute the new |line_width|; */
+ /* The first part of the following code is part of \TeX's inner loop, so
+ we don't want to waste any time. The current active node, namely node |r|,
+ contains the line number that will be considered next. At the end of the
+ list we have arranged the data structure so that |r=active| and
+ |line_number(active)>old_l|.
+ */
+ l = line_number(r);
+ if (l > old_l) { /* now we are no longer in the inner loop */
+ if ((minimum_demerits < awful_bad)
+ && ((old_l != easy_line) || (r == active))) {
+ /*Create new active nodes for the best feasible breaks just found */
+ /* It is not necessary to create new active nodes having |minimal_demerits|
+ greater than
+ |minimum_demerits+abs(adj_demerits)|, since such active nodes will never
+ be chosen in the final paragraph breaks. This observation allows us to
+ omit a substantial number of feasible breakpoints from further consideration.
+ */
+ if (no_break_yet) {
+ no_break_yet = false;
+ do_all_eight(set_break_width_to_background);
+ compute_break_width(break_type, line_break_dir,
+ pdf_adjust_spacing, cur_p);
+ }
+ /* Insert a delta node to prepare for breaks at |cur_p|; */
+ /* We use the fact that |type(active)<>delta_node|. */
+ if (type(prev_r) == delta_node) { /* modify an existing delta node */
+ do_all_eight(convert_to_break_width); /* IMPLICIT |prev_r| */
+ } else if (prev_r == active) { /* no delta node needed at the beginning */
+ do_all_eight(store_break_width);
+ } else {
+ q = new_node(delta_node, 0);
+ vlink(q) = r;
+ do_all_eight(new_delta_to_break_width); /* IMPLICIT q */
+ vlink(prev_r) = q;
+ prev_prev_r = prev_r;
+ prev_r = q;
+ }
+
+ if (abs(adj_demerits) >= awful_bad - minimum_demerits)
+ minimum_demerits = awful_bad - 1;
+ else
+ minimum_demerits += abs(adj_demerits);
+ for (fit_class = very_loose_fit; fit_class <= tight_fit;
+ fit_class++) {
+ if (minimal_demerits[fit_class] <= minimum_demerits) {
+ /* Insert a new active node from |best_place[fit_class]|
+ to |cur_p|; */
+ /* When we create an active node, we also create the corresponding
+ passive node.
+ */
+ q = new_node(passive_node, 0);
+ vlink(q) = passive;
+ passive = q;
+ cur_break(q) = cur_p;
+ incr(pass_number);
+ serial(q) = pass_number;
+ prev_break(q) = best_place[fit_class];
+ /*Here we keep track of the subparagraph penalties in the break nodes */
+ passive_pen_inter(q) = internal_pen_inter;
+ passive_pen_broken(q) = internal_pen_broken;
+ passive_last_left_box(q) = internal_left_box;
+ passive_last_left_box_width(q) =
+ internal_left_box_width;
+ if (prev_break(q) != null) {
+ passive_left_box(q) =
+ passive_last_left_box(prev_break(q));
+ passive_left_box_width(q) =
+ passive_last_left_box_width(prev_break(q));
+ } else {
+ passive_left_box(q) = init_internal_left_box;
+ passive_left_box_width(q) =
+ init_internal_left_box_width;
+ }
+ passive_right_box(q) = internal_right_box;
+ passive_right_box_width(q) = internal_right_box_width;
+ q = new_node(break_type, fit_class);
+ break_node(q) = passive;
+ line_number(q) = best_pl_line[fit_class] + 1;
+ total_demerits(q) = minimal_demerits[fit_class];
+ if (do_last_line_fit) {
+ /*Store additional data in the new active node */
+ /* Here we save these data in the active node
+ representing a potential line break. */
+ active_short(q) = best_pl_short[fit_class];
+ active_glue(q) = best_pl_glue[fit_class];
+ }
+ vlink(q) = r;
+ vlink(prev_r) = q;
+ prev_r = q;
+ if (tracing_paragraphs > 0)
+ print_break_node(q, fit_class, break_type, cur_p);
+ }
+ minimal_demerits[fit_class] = awful_bad;
+ }
+ minimum_demerits = awful_bad;
+ /* Insert a delta node to prepare for the next active node; */
+ /* When the following code is performed, we will have just inserted at
+ least one active node before |r|, so |type(prev_r)<>delta_node|.
+ */
+ if (r != active) {
+ q = new_node(delta_node, 0);
+ vlink(q) = r;
+ do_all_eight(new_delta_from_break_width); /* IMPLICIT q */
+ vlink(prev_r) = q;
+ prev_prev_r = prev_r;
+ prev_r = q;
+ }
+ }
+ if (r == active)
+ return;
+ /*Compute the new line width; */
+ /* When we come to the following code, we have just encountered
+ the first active node~|r| whose |line_number| field contains
+ |l|. Thus we want to compute the length of the $l\mskip1mu$th
+ line of the current paragraph. Furthermore, we want to set
+ |old_l| to the last number in the class of line numbers
+ equivalent to~|l|.
+ */
+ if (l > easy_line) {
+ old_l = max_halfword - 1;
+ line_width = second_width;
+ } else {
+ old_l = l;
+ if (l > last_special_line) {
+ line_width = second_width;
+ } else if (par_shape_ptr == null) {
+ line_width = first_width;
+ } else {
+ line_width = varmem[(par_shape_ptr + 2 * l + 1)].cint;
+ }
+ }
+ }
+ /* /If a line number class has ended, create new active nodes for
+ the best feasible breaks in that class; then |return|
+ if |r=active|, otherwise compute the new |line_width|; */
+
+ /* Consider the demerits for a line from |r| to |cur_p|;
+ deactivate node |r| if it should no longer be active;
+ then |goto continue| if a line from |r| to |cur_p| is infeasible,
+ otherwise record a new feasible break; */
+ artificial_demerits = false;
+ shortfall = line_width - cur_active_width[1];
+ if (break_node(r) == null)
+ shortfall -= init_internal_left_box_width;
+ else
+ shortfall -= passive_last_left_box_width(break_node(r));
+ shortfall -= internal_right_box_width;
+ if (pdf_protrude_chars > 1) {
+ halfword l1, o;
+ l1 = (break_node(r) == null) ? first_p : cur_break(break_node(r));
+ if (cur_p == null) {
+ o = null;
+ } else { /* TODO |if (is_character_node(alink(cur_p)))| */
+ o = alink(cur_p);
+ assert(vlink(o) == cur_p);
+ }
+ /* MAGIC: the disc could be a SELECT subtype, to we might need
+ to get the last character as |pre_break| from either the
+ |pre_break| list (if the previous INIT disc was taken), or the
+ |no_break| (sic) list (if the previous INIT disc was not taken)
+
+ BUT:
+ the last characters (hyphenation character) if these two list
+ should always be the same anyway, so we just look at |pre_break|.
+ */
+ /* let's look at the right margin first */
+ if ((cur_p != null) && (type(cur_p) == disc_node)
+ && (vlink_pre_break(cur_p) != null)) {
+ /* a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break| */
+ o = tlink_pre_break(cur_p);
+ } else {
+ o = find_protchar_right(l1, o);
+ }
+ /* now the left margin */
+ if ((l1 != null) && (type(l1) == disc_node)
+ && (vlink_post_break(l1) != null)) {
+ /* FIXME: first 'char' could be a disc! */
+ l1 = vlink_post_break(l1); /* protrude the first char */
+ } else {
+ l1 = find_protchar_left(l1, true);
+ }
+ shortfall += (left_pw(l1) + right_pw(o));
+ }
+ if ((shortfall != 0) && (pdf_adjust_spacing > 1)) {
+ margin_kern_stretch = 0;
+ margin_kern_shrink = 0;
+ if (pdf_protrude_chars > 1) {
+ /* Calculate variations of marginal kerns; */
+ lp = last_leftmost_char;
+ rp = last_rightmost_char;
+ cp = raw_glyph_node();
+ if (lp != null) {
+ cal_margin_kern_var(lp);
+ }
+ if (rp != null) {
+ cal_margin_kern_var(rp);
+ }
+ flush_node(cp);
+ }
+ if ((shortfall > 0)
+ && ((total_font_stretch + margin_kern_stretch) > 0)) {
+ if ((total_font_stretch + margin_kern_stretch) > shortfall)
+ shortfall = ((total_font_stretch + margin_kern_stretch) /
+ (max_stretch_ratio / cur_font_step)) / 2;
+ else
+ shortfall -= (total_font_stretch + margin_kern_stretch);
+ } else if ((shortfall < 0)
+ && ((total_font_shrink + margin_kern_shrink) > 0)) {
+ if ((total_font_shrink + margin_kern_shrink) > -shortfall)
+ shortfall = -((total_font_shrink + margin_kern_shrink) /
+ (max_shrink_ratio / cur_font_step)) / 2;
+ else
+ shortfall += (total_font_shrink + margin_kern_shrink);
+ }
+ }
+ if (shortfall > 0) {
+ /* Set the value of |b| to the badness for stretching the line,
+ and compute the corresponding |fit_class| */
+
+ /* When a line must stretch, the available stretchability can be
+ found in the subarray |cur_active_width[2..6]|, in units of
+ points, sfi, fil, fill and filll.
+
+ The present section is part of \TeX's inner loop, and it is
+ most often performed when the badness is infinite; therefore
+ it is worth while to make a quick test for large width excess
+ and small stretchability, before calling the |badness|
+ subroutine. */
+
+ if ((cur_active_width[3] != 0) || (cur_active_width[4] != 0) ||
+ (cur_active_width[5] != 0) || (cur_active_width[6] != 0)) {
+ if (do_last_line_fit) {
+ if (cur_p == null) { /* the last line of a paragraph */
+ /* Perform computations for last line and |goto found|; */
+
+ /* Here we compute the adjustment |g| and badness |b| for
+ a line from |r| to the end of the paragraph. When any
+ of the criteria for adjustment is violated we fall
+ through to the normal algorithm.
+
+ The last line must be too short, and have infinite
+ stretch entirely due to |par_fill_skip|. */
+ if ((active_short(r) == 0) || (active_glue(r) <= 0))
+ /* previous line was neither stretched nor shrunk, or
+ was infinitely bad */
+ goto NOT_FOUND;
+ if ((cur_active_width[3] != fill_width[0]) ||
+ (cur_active_width[4] != fill_width[1]) ||
+ (cur_active_width[5] != fill_width[2]) ||
+ (cur_active_width[6] != fill_width[3]))
+ /* infinite stretch of this line not entirely due to
+ |par_fill_skip| */
+ goto NOT_FOUND;
+ if (active_short(r) > 0)
+ g = cur_active_width[2];
+ else
+ g = cur_active_width[7];
+ if (g <= 0)
+ /*no finite stretch resp.\ no shrink */
+ goto NOT_FOUND;
+ arith_error = false;
+ g = fract(g, active_short(r), active_glue(r),
+ max_dimen);
+ if (last_line_fit < 1000)
+ g = fract(g, last_line_fit, 1000, max_dimen);
+ if (arith_error) {
+ if (active_short(r) > 0)
+ g = max_dimen;
+ else
+ g = -max_dimen;
+ }
+ if (g > 0) {
+ /*Set the value of |b| to the badness of the last line
+ for stretching, compute the corresponding |fit_class,
+ and |goto found|| */
+ /* These badness computations are rather similar to
+ those of the standard algorithm, with the adjustment
+ amount |g| replacing the |shortfall|. */
+ if (g > shortfall)
+ g = shortfall;
+ if (g > 7230584) {
+ if (cur_active_width[2] < 1663497) {
+ b = inf_bad;
+ fit_class = very_loose_fit;
+ goto FOUND;
+ }
+ }
+ b = badness(g, cur_active_width[2]);
+ if (b > 99) {
+ fit_class = very_loose_fit;
+ } else if (b > 12) {
+ fit_class = loose_fit;
+ } else {
+ fit_class = decent_fit;
+ }
+ goto FOUND;
+ } else if (g < 0) {
+ /*Set the value of |b| to the badness of the last line
+ for shrinking, compute the corresponding |fit_class,
+ and |goto found||; */
+ if (-g > cur_active_width[7])
+ g = -cur_active_width[7];
+ b = badness(-g, cur_active_width[7]);
+ if (b > 12)
+ fit_class = tight_fit;
+ else
+ fit_class = decent_fit;
+ goto FOUND;
+ }
+ }
+ NOT_FOUND:
+ shortfall = 0;
+ }
+ b = 0;
+ fit_class = decent_fit; /* infinite stretch */
+ } else {
+ if (shortfall > 7230584 && cur_active_width[2] < 1663497) {
+ b = inf_bad;
+ fit_class = very_loose_fit;
+ } else {
+ b = badness(shortfall, cur_active_width[2]);
+ if (b > 99) {
+ fit_class = very_loose_fit;
+ } else if (b > 12) {
+ fit_class = loose_fit;
+ } else {
+ fit_class = decent_fit;
+ }
+ }
+ }
+ } else {
+ /* Set the value of |b| to the badness for shrinking the line,
+ and compute the corresponding |fit_class|; */
+ /* Shrinkability is never infinite in a paragraph; we can shrink
+ the line from |r| to |cur_p| by at most
+ |cur_active_width[7]|. */
+ if (-shortfall > cur_active_width[7])
+ b = inf_bad + 1;
+ else
+ b = badness(-shortfall, cur_active_width[7]);
+ if (b > 12)
+ fit_class = tight_fit;
+ else
+ fit_class = decent_fit;
+ }
+ if (do_last_line_fit) {
+ /* Adjust the additional data for last line; */
+ if (cur_p == null)
+ shortfall = 0;
+ if (shortfall > 0) {
+ g = cur_active_width[2];
+ } else if (shortfall < 0) {
+ g = cur_active_width[7];
+ } else {
+ g = 0;
+ }
+ }
+ FOUND:
+ if ((b > inf_bad) || (pi == eject_penalty)) {
+ /* Prepare to deactivate node~|r|, and |goto deactivate| unless
+ there is a reason to consider lines of text from |r| to |cur_p| */
+ /* During the final pass, we dare not lose all active nodes, lest we lose
+ touch with the line breaks already found. The code shown here makes
+ sure that such a catastrophe does not happen, by permitting overfull
+ boxes as a last resort. This particular part of \TeX\ was a source of
+ several subtle bugs before the correct program logic was finally
+ discovered; readers who seek to ``improve'' \TeX\ should therefore
+ think thrice before daring to make any changes here.
+ */
+ if (final_pass && (minimum_demerits == awful_bad) &&
+ (vlink(r) == active) && (prev_r == active)) {
+ artificial_demerits = true; /* set demerits zero, this break is forced */
+ } else if (b > threshold) {
+ goto DEACTIVATE;
+ }
+ node_r_stays_active = false;
+ } else {
+ prev_r = r;
+ if (b > threshold)
+ continue;
+ node_r_stays_active = true;
+ }
+ /* Record a new feasible break; */
+ /* When we get to this part of the code, the line from |r| to |cur_p| is
+ feasible, its badness is~|b|, and its fitness classification is
+ |fit_class|. We don't want to make an active node for this break yet,
+ but we will compute the total demerits and record them in the
+ |minimal_demerits| array, if such a break is the current champion among
+ all ways to get to |cur_p| in a given line-number class and fitness
+ class.
+ */
+ if (artificial_demerits) {
+ d = 0;
+ } else {
+ /* Compute the demerits, |d|, from |r| to |cur_p|; */
+ d = line_penalty + b;
+ if (abs(d) >= 10000)
+ d = 100000000;
+ else
+ d = d * d;
+ if (pi != 0) {
+ if (pi > 0) {
+ d += (pi * pi);
+ } else if (pi > eject_penalty) {
+ d -= (pi * pi);
+ }
+ }
+ if ((break_type == hyphenated_node) && (type(r) == hyphenated_node)) {
+ if (cur_p != null)
+ d += double_hyphen_demerits;
+ else
+ d += final_hyphen_demerits;
+ }
+ if (abs(fit_class - fitness(r)) > 1)
+ d = d + adj_demerits;
+ }
+ if (tracing_paragraphs > 0)
+ print_feasible_break(cur_p, r, b, pi, d, artificial_demerits);
+ d += total_demerits(r); /*this is the minimum total demerits
+ from the beginning to |cur_p| via |r| */
+ if (d <= minimal_demerits[fit_class]) {
+ minimal_demerits[fit_class] = d;
+ best_place[fit_class] = break_node(r);
+ best_pl_line[fit_class] = l;
+ if (do_last_line_fit) {
+ /* Store additional data for this feasible break; */
+ /* For each feasible break we record the shortfall and glue stretch or
+ shrink (or adjustment). */
+ best_pl_short[fit_class] = shortfall;
+ best_pl_glue[fit_class] = g;
+ }
+ if (d < minimum_demerits)
+ minimum_demerits = d;
+ }
+ /* /Record a new feasible break */
+ if (node_r_stays_active)
+ continue; /*|prev_r| has been set to |r| */
+ DEACTIVATE:
+ /* Deactivate node |r|; */
+ /* When an active node disappears, we must delete an adjacent delta node if
+ the active node was at the beginning or the end of the active list, or
+ if it was surrounded by delta nodes. We also must preserve the property
+ that |cur_active_width| represents the length of material from
+ |vlink(prev_r)| to~|cur_p|. */
+
+ vlink(prev_r) = vlink(r);
+ flush_node(r);
+ if (prev_r == active) {
+ /*Update the active widths, since the first active node has been
+ deleted */
+ /* The following code uses the fact that |type(active)<>delta_node|.
+ If the active list has just become empty, we do not need to update the
+ |active_width| array, since it will be initialized when an active
+ node is next inserted.
+ */
+ r = vlink(active);
+ if (type(r) == delta_node) {
+ do_all_eight(update_active); /* IMPLICIT r */
+ do_all_eight(copy_to_cur_active);
+ vlink(active) = vlink(r);
+ flush_node(r);
+ }
+ } else if (type(prev_r) == delta_node) {
+ r = vlink(prev_r);
+ if (r == active) {
+ do_all_eight(downdate_width); /* IMPLICIT |prev_r| */
+ vlink(prev_prev_r) = active;
+ flush_node(prev_r);
+ prev_r = prev_prev_r;
+ } else if (type(r) == delta_node) {
+ do_all_eight(update_width); /* IMPLICIT ,r */
+ do_all_eight(combine_two_deltas); /* IMPLICIT r |prev_r| */
+ vlink(prev_r) = vlink(r);
+ flush_node(r);
+ }
+ }
+ }
+}
+
+@ @c
+void
+ext_do_line_break(int paragraph_dir,
+ int pretolerance,
+ int tracing_paragraphs,
+ int tolerance,
+ scaled emergency_stretch,
+ int looseness,
+ int hyphen_penalty,
+ int ex_hyphen_penalty,
+ int pdf_adjust_spacing,
+ halfword par_shape_ptr,
+ int adj_demerits,
+ int pdf_protrude_chars,
+ int line_penalty,
+ int last_line_fit,
+ int double_hyphen_demerits,
+ int final_hyphen_demerits,
+ int hang_indent,
+ int hsize,
+ int hang_after,
+ halfword left_skip,
+ halfword right_skip,
+ int pdf_each_line_height,
+ int pdf_each_line_depth,
+ int pdf_first_line_height,
+ int pdf_last_line_depth,
+ halfword inter_line_penalties_ptr,
+ int inter_line_penalty,
+ int club_penalty,
+ halfword club_penalties_ptr,
+ halfword widow_penalties_ptr,
+ int widow_penalty,
+ int broken_penalty,
+ halfword final_par_glue, halfword pdf_ignored_dimen)
+{
+ /* DONE,DONE1,DONE2,DONE3,DONE4,DONE5,CONTINUE; */
+ halfword cur_p, q, r, s; /* miscellaneous nodes of temporary interest */
+ int line_break_dir = paragraph_dir;
+
+ /* Get ready to start ... */
+ minimum_demerits = awful_bad;
+ minimal_demerits[tight_fit] = awful_bad;
+ minimal_demerits[decent_fit] = awful_bad;
+ minimal_demerits[loose_fit] = awful_bad;
+ minimal_demerits[very_loose_fit] = awful_bad;
+
+ /* We compute the values of |easy_line| and the other local variables relating
+ to line length when the |line_break| procedure is initializing itself. */
+ if (par_shape_ptr == null) {
+ if (hang_indent == 0) {
+ last_special_line = 0;
+ second_width = hsize;
+ second_indent = 0;
+ } else {
+ /* Set line length parameters in preparation for hanging indentation */
+ /* We compute the values of |easy_line| and the other local variables relating
+ to line length when the |line_break| procedure is initializing itself. */
+ last_special_line = abs(hang_after);
+ if (hang_after < 0) {
+ first_width = hsize - abs(hang_indent);
+ if (hang_indent >= 0)
+ first_indent = hang_indent;
+ else
+ first_indent = 0;
+ second_width = hsize;
+ second_indent = 0;
+ } else {
+ first_width = hsize;
+ first_indent = 0;
+ second_width = hsize - abs(hang_indent);
+ if (hang_indent >= 0)
+ second_indent = hang_indent;
+ else
+ second_indent = 0;
+ }
+ }
+ } else {
+ last_special_line = vinfo(par_shape_ptr + 1) - 1;
+ second_indent =
+ varmem[(par_shape_ptr + 2 * (last_special_line + 1))].cint;
+ second_width =
+ varmem[(par_shape_ptr + 2 * (last_special_line + 1) + 1)].cint;
+ }
+ if (looseness == 0)
+ easy_line = last_special_line;
+ else
+ easy_line = max_halfword;
+
+ no_shrink_error_yet = true;
+ check_shrinkage(left_skip);
+ check_shrinkage(right_skip);
+ q = left_skip;
+ r = right_skip;
+ background[1] = width(q) + width(r);
+ background[2] = 0;
+ background[3] = 0;
+ background[4] = 0;
+ background[5] = 0;
+ background[6] = 0;
+ background[2 + stretch_order(q)] = stretch(q);
+ background[2 + stretch_order(r)] += stretch(r);
+ background[7] = shrink(q) + shrink(r);
+ if (pdf_adjust_spacing > 1) {
+ background[8] = 0;
+ background[9] = 0;
+ max_stretch_ratio = -1;
+ max_shrink_ratio = -1;
+ cur_font_step = -1;
+ set_prev_char_p(null);
+ }
+ /* Check for special treatment of last line of paragraph; */
+ /* The new algorithm for the last line requires that the stretchability
+ |par_fill_skip| is infinite and the stretchability of |left_skip| plus
+ |right_skip| is finite.
+ */
+ do_last_line_fit = false;
+ if (last_line_fit > 0) {
+ q = glue_ptr(last_line_fill);
+ if ((stretch(q) > 0) && (stretch_order(q) > normal)) {
+ if ((background[3] == 0) && (background[4] == 0) &&
+ (background[5] == 0) && (background[6] == 0)) {
+ do_last_line_fit = true;
+ fill_width[0] = 0;
+ fill_width[1] = 0;
+ fill_width[2] = 0;
+ fill_width[3] = 0;
+ fill_width[stretch_order(q) - 1] = stretch(q);
+ }
+ }
+ }
+ /* DIR: Initialize |dir_ptr| for |line_break| */
+ if (dir_ptr != null) {
+ flush_node_list(dir_ptr);
+ dir_ptr = null;
+ }
+#if 0
+ push_dir(paragraph_dir,dir_ptr); /* TODO what was the point of this? */
+#endif
+
+ /* Find optimal breakpoints; */
+ threshold = pretolerance;
+ if (threshold >= 0) {
+ if (tracing_paragraphs > 0) {
+ begin_diagnostic();
+ tprint_nl("@@firstpass");
+ }
+ second_pass = false;
+ final_pass = false;
+ } else {
+ threshold = tolerance;
+ second_pass = true;
+ final_pass = (emergency_stretch <= 0);
+ if (tracing_paragraphs > 0)
+ begin_diagnostic();
+ }
+
+ while (1) {
+ halfword first_p;
+ halfword nest_stack[10];
+ int nest_index = 0;
+ if (threshold > inf_bad)
+ threshold = inf_bad;
+ /* Create an active breakpoint representing the beginning of the paragraph */
+ q = new_node(unhyphenated_node, decent_fit);
+ vlink(q) = active;
+ break_node(q) = null;
+ line_number(q) = cur_list.pg_field + 1;
+ total_demerits(q) = 0;
+ active_short(q) = 0;
+ active_glue(q) = 0;
+ vlink(active) = q;
+ do_all_eight(store_background);
+ passive = null;
+ printed_node = temp_head;
+ pass_number = 0;
+ font_in_short_display = null_font;
+ /* /Create an active breakpoint representing the beginning of the paragraph */
+ auto_breaking = true;
+ cur_p = vlink(temp_head);
+ /* LOCAL: Initialize with first |local_paragraph| node */
+ if ((cur_p != null) && (type(cur_p) == whatsit_node)
+ && (subtype(cur_p) == local_par_node)) {
+ alink(cur_p) = temp_head; /* this used to be an assert, but may as well force it */
+ internal_pen_inter = local_pen_inter(cur_p);
+ internal_pen_broken = local_pen_broken(cur_p);
+ init_internal_left_box = local_box_left(cur_p);
+ init_internal_left_box_width = local_box_left_width(cur_p);
+ internal_left_box = init_internal_left_box;
+ internal_left_box_width = init_internal_left_box_width;
+ internal_right_box = local_box_right(cur_p);
+ internal_right_box_width = local_box_right_width(cur_p);
+ } else {
+ internal_pen_inter = 0;
+ internal_pen_broken = 0;
+ init_internal_left_box = null;
+ init_internal_left_box_width = 0;
+ internal_left_box = init_internal_left_box;
+ internal_left_box_width = init_internal_left_box_width;
+ internal_right_box = null;
+ internal_right_box_width = 0;
+ }
+ /* /LOCAL: Initialize with first |local_paragraph| node */
+ set_prev_char_p(null);
+ first_p = cur_p;
+ /* to access the first node of paragraph as the first active node
+ has |break_node=null| */
+ while ((cur_p != null) && (vlink(active) != active)) {
+ /* |try_break| if |cur_p| is a legal breakpoint; on the 2nd pass, also look at |disc_node|s. */
+
+ while (is_char_node(cur_p)) {
+ /* Advance |cur_p| to the node following the present string of characters ; */
+ /* 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 |vlink(cur_p)=null| when |cur_p| is a character node.
+ */
+ active_width[1] +=
+ pack_width(line_break_dir, dir_TRT, cur_p, true);
+ if ((pdf_adjust_spacing > 1) && check_expand_pars(font(cur_p))) {
+ set_prev_char_p(cur_p);
+ add_char_stretch(active_width[8], cur_p);
+ add_char_shrink(active_width[9], cur_p);
+ }
+ cur_p = vlink(cur_p);
+ while (cur_p == null && nest_index > 0) {
+ cur_p = nest_stack[--nest_index];
+#ifdef DEBUG
+ fprintf(stderr,"Node Pop %d [%d]\n",nest_index,(int)cur_p);
+#endif
+ }
+ }
+ if (cur_p == null) { /* TODO */
+ confusion("linebreak_tail");
+ }
+ /* Determine legal breaks: As we move through the hlist, we need to keep
+ the |active_width| array up to date, so that the badness of individual
+ lines is readily calculated by |try_break|. It is convenient to use the
+ short name |active_width[1]| for the component of active width that represents
+ real width as opposed to glue. */
+
+ switch (type(cur_p)) {
+ case hlist_node:
+ case vlist_node:
+ active_width[1] +=
+ pack_width(line_break_dir, box_dir(cur_p), cur_p, false);
+ break;
+ case rule_node:
+ active_width[1] += width(cur_p);
+ break;
+ case whatsit_node:
+ /* Advance past a whatsit node in the |line_break| loop; */
+ switch (subtype(cur_p)) {
+ case local_par_node: /* LOCAL: Advance past a |local_paragraph| node; */
+ internal_pen_inter = local_pen_inter(cur_p);
+ internal_pen_broken = local_pen_broken(cur_p);
+ internal_left_box = local_box_left(cur_p);
+ internal_left_box_width = local_box_left_width(cur_p);
+ internal_right_box = local_box_right(cur_p);
+ internal_right_box_width = local_box_right_width(cur_p);
+ break;
+ case dir_node: /* DIR: Adjust the dir stack for the |line_break| routine; */
+ if (dir_dir(cur_p) >= 0) {
+ line_break_dir = dir_dir(cur_p);
+ push_dir_node(cur_p,dir_ptr); /* adds to |dir_ptr| */
+ } else {
+ pop_dir_node(dir_ptr);
+ if (dir_ptr != null)
+ line_break_dir = dir_dir(dir_ptr);
+ }
+ break;
+ case pdf_refxform_node:
+ case pdf_refximage_node:
+ active_width[1] += width(cur_p);
+ }
+ /* / Advance past a whatsit node in the |line_break| loop/; */
+ break;
+ case glue_node:
+ /* If node |cur_p| is a legal breakpoint, call |try_break|;
+ then update the active widths by including the glue in
+ |glue_ptr(cur_p)|; */
+ /* When node |cur_p| is a glue node, we look at the previous to
+ see whether or not a breakpoint is legal at |cur_p|, as
+ explained above. */
+ /* *INDENT-OFF* */
+ if (auto_breaking) {
+ halfword prev_p = alink(cur_p);
+ if (prev_p != temp_head &&
+ (is_char_node(prev_p) ||
+ precedes_break(prev_p) ||
+ ((type(prev_p) == kern_node)
+ && (subtype(prev_p) != explicit)))) {
+ ext_try_break(0, unhyphenated_node, line_break_dir, pdf_adjust_spacing,
+ par_shape_ptr, adj_demerits,
+ tracing_paragraphs, pdf_protrude_chars,
+ line_penalty, last_line_fit,
+ double_hyphen_demerits,
+ final_hyphen_demerits, first_p, cur_p);
+ }
+ }
+ /* *INDENT-ON* */
+ check_shrinkage(glue_ptr(cur_p));
+ q = glue_ptr(cur_p);
+ active_width[1] += width(q);
+ active_width[2 + stretch_order(q)] += stretch(q);
+ active_width[7] += shrink(q);
+ break;
+ case kern_node:
+ if (subtype(cur_p) == explicit) {
+ kern_break();
+ } else {
+ active_width[1] += width(cur_p);
+ if ((pdf_adjust_spacing > 1) && (subtype(cur_p) == normal)) {
+ add_kern_stretch(active_width[8], cur_p);
+ add_kern_shrink(active_width[9], cur_p);
+ }
+ }
+ break;
+ case disc_node:
+ /* |select_disc|s are handled by the leading |init_disc| */
+ if (subtype(cur_p) == select_disc)
+ break;
+ /* Try to break after a discretionary fragment, then |goto done5|; */
+ /* The following code knows that discretionary texts contain
+ only character nodes, kern nodes, box nodes, and rule
+ nodes. */
+ if (second_pass) {
+ int actual_penalty = hyphen_penalty;
+ if (subtype(cur_p) == automatic_disc)
+ actual_penalty = ex_hyphen_penalty;
+ s = vlink_pre_break(cur_p);
+ do_one_seven_eight(reset_disc_width);
+ if (s == null) { /* trivial pre-break */
+ ext_try_break(actual_penalty, hyphenated_node,
+ line_break_dir, pdf_adjust_spacing,
+ par_shape_ptr, adj_demerits,
+ tracing_paragraphs, pdf_protrude_chars,
+ line_penalty, last_line_fit,
+ double_hyphen_demerits,
+ final_hyphen_demerits, first_p, cur_p);
+ } else {
+ add_to_widths(s, line_break_dir, pdf_adjust_spacing,
+ disc_width);
+ do_one_seven_eight(add_disc_width_to_active_width);
+ ext_try_break(actual_penalty, hyphenated_node,
+ line_break_dir, pdf_adjust_spacing,
+ par_shape_ptr, adj_demerits,
+ tracing_paragraphs, pdf_protrude_chars,
+ line_penalty, last_line_fit,
+ double_hyphen_demerits,
+ final_hyphen_demerits, first_p, cur_p);
+ if (subtype(cur_p) == init_disc) {
+ /* we should at two break points after the one we
+ added above:
+ \item1 which does a possible break in INIT's |post_break|
+ \item2 which means the |no_break| actually was broken
+ just a character later */
+ /* do the select-0 case 'f-f-i' */
+ assert(type(vlink(cur_p)) == disc_node &&
+ subtype(vlink(cur_p)) == select_disc);
+ s = vlink_pre_break(vlink(cur_p));
+ add_to_widths(s, line_break_dir, pdf_adjust_spacing,
+ disc_width);
+ ext_try_break(actual_penalty, hyphenated_node,
+ line_break_dir, pdf_adjust_spacing,
+ par_shape_ptr, adj_demerits,
+ tracing_paragraphs,
+ pdf_protrude_chars, line_penalty,
+ last_line_fit, double_hyphen_demerits,
+ final_hyphen_demerits, first_p,
+ vlink(cur_p));
+#if 0
+ /* TODO this does not work */
+ /* go back to the starting situation */
+ do_one_seven_eight
+ (sub_disc_width_from_active_width);
+ do_one_seven_eight(reset_disc_width);
+ /* add select |no_break| to |active_width| */
+ s = vlink_no_break(vlink(cur_p));
+ add_to_widths(s, line_break_dir, pdf_adjust_spacing,
+ disc_width);
+ ext_try_break(actual_penalty, hyphenated_node,
+ line_break_dir, pdf_adjust_spacing,
+ par_shape_ptr, adj_demerits,
+ tracing_paragraphs,
+ pdf_protrude_chars, line_penalty,
+ last_line_fit, double_hyphen_demerits,
+ final_hyphen_demerits, first_p,
+ vlink(cur_p));
+#endif
+ }
+ do_one_seven_eight(sub_disc_width_from_active_width);
+ }
+ }
+ s = vlink_no_break(cur_p);
+ add_to_widths(s, line_break_dir, pdf_adjust_spacing,
+ active_width);
+ break;
+ case math_node:
+ auto_breaking = (subtype(cur_p) == after);
+ kern_break();
+ break;
+ case penalty_node:
+ ext_try_break(penalty(cur_p), unhyphenated_node, line_break_dir,
+ pdf_adjust_spacing, par_shape_ptr, adj_demerits,
+ tracing_paragraphs, pdf_protrude_chars,
+ line_penalty, last_line_fit,
+ double_hyphen_demerits, final_hyphen_demerits,
+ first_p, cur_p);
+ break;
+ case mark_node:
+ case ins_node:
+ case adjust_node:
+ break;
+ case glue_spec_node:
+ fprintf(stdout, "\nfound a glue_spec in a paragraph!");
+ break;
+ default:
+ fprintf(stdout, "\ntype=%d", type(cur_p));
+ confusion("paragraph");
+ }
+ cur_p = vlink(cur_p);
+ while (cur_p == null && nest_index > 0) {
+ cur_p = nest_stack[--nest_index];
+#ifdef DEBUG
+ fprintf(stderr,"Node Pop %d [%d]\n",nest_index,(int)cur_p);
+#endif
+ }
+ }
+ if (cur_p == null) {
+ /* Try the final line break at the end of the paragraph,
+ and |goto done| if the desired breakpoints have been found */
+
+ /* The forced line break at the paragraph's end will reduce the list of
+ breakpoints so that all active nodes represent breaks at |cur_p=null|.
+ On the first pass, we insist on finding an active node that has the
+ correct ``looseness.'' On the final pass, there will be at least one active
+ node, and we will match the desired looseness as well as we can.
+
+ The global variable |best_bet| will be set to the active node for the best
+ way to break the paragraph, and a few other variables are used to
+ help determine what is best.
+ */
+
+ ext_try_break(eject_penalty, hyphenated_node, line_break_dir,
+ pdf_adjust_spacing, par_shape_ptr, adj_demerits,
+ tracing_paragraphs, pdf_protrude_chars, line_penalty,
+ last_line_fit, double_hyphen_demerits,
+ final_hyphen_demerits, first_p, cur_p);
+ if (vlink(active) != active) {
+ /* Find an active node with fewest demerits; */
+ r = vlink(active);
+ fewest_demerits = awful_bad;
+ do {
+ if (type(r) != delta_node) {
+ if (total_demerits(r) < fewest_demerits) {
+ fewest_demerits = total_demerits(r);
+ best_bet = r;
+ }
+ }
+ r = vlink(r);
+ } while (r != active);
+ best_line = line_number(best_bet);
+
+ /* /Find an active node with fewest demerits; */
+ if (looseness == 0)
+ goto DONE;
+ /*Find the best active node for the desired looseness; */
+
+ /* The adjustment for a desired looseness is a slightly more complicated
+ version of the loop just considered. Note that if a paragraph is broken
+ into segments by displayed equations, each segment will be subject to the
+ looseness calculation, independently of the other segments.
+ */
+ r = vlink(active);
+ actual_looseness = 0;
+ do {
+ if (type(r) != delta_node) {
+ line_diff = line_number(r) - best_line;
+ if (((line_diff < actual_looseness)
+ && (looseness <= line_diff))
+ || ((line_diff > actual_looseness)
+ && (looseness >= line_diff))) {
+ best_bet = r;
+ actual_looseness = line_diff;
+ fewest_demerits = total_demerits(r);
+ } else if ((line_diff == actual_looseness) &&
+ (total_demerits(r) < fewest_demerits)) {
+ best_bet = r;
+ fewest_demerits = total_demerits(r);
+ }
+ }
+ r = vlink(r);
+ } while (r != active);
+ best_line = line_number(best_bet);
+
+ /* /Find the best active node for the desired looseness; */
+ if ((actual_looseness == looseness) || final_pass)
+ goto DONE;
+ }
+ }
+
+ /* Clean up the memory by removing the break nodes; */
+ clean_up_the_memory();
+ /* /Clean up the memory by removing the break nodes; */
+
+ if (!second_pass) {
+ if (tracing_paragraphs > 0)
+ tprint_nl("@@secondpass");
+ threshold = tolerance;
+ second_pass = true;
+ final_pass = (emergency_stretch <= 0);
+ } else { /* if at first you do not succeed, \dots */
+ if (tracing_paragraphs > 0)
+ tprint_nl("@@emergencypass");
+ background[2] += emergency_stretch;
+ final_pass = true;
+ }
+ }
+
+ DONE:
+ if (tracing_paragraphs > 0) {
+ end_diagnostic(true);
+ normalize_selector();
+ }
+ if (do_last_line_fit) {
+ /* Adjust the final line of the paragraph; */
+ /* Here we either reset |do_last_line_fit| or adjust the |par_fill_skip| glue.
+ */
+ if (active_short(best_bet) == 0) {
+ do_last_line_fit = false;
+ } else {
+ q = new_spec(glue_ptr(last_line_fill));
+ delete_glue_ref(glue_ptr(last_line_fill));
+ width(q) += (active_short(best_bet) - active_glue(best_bet));
+ stretch(q) = 0;
+ glue_ptr(last_line_fill) = q;
+ }
+ }
+
+ /* Break the paragraph at the chosen...; */
+ /* Once the best sequence of breakpoints has been found (hurray), we call on the
+ procedure |post_line_break| to finish the remainder of the work.
+ (By introducing this subprocedure, we are able to keep |line_break|
+ from getting extremely long.)
+ */
+
+ /* first thing |ext_post_line_break| does is reset |dir_ptr| */
+ flush_node_list(dir_ptr);
+ dir_ptr = null;
+ ext_post_line_break(paragraph_dir,
+ right_skip,
+ left_skip,
+ pdf_protrude_chars,
+ par_shape_ptr,
+ pdf_adjust_spacing,
+ pdf_each_line_height,
+ pdf_each_line_depth,
+ pdf_first_line_height,
+ pdf_last_line_depth,
+ inter_line_penalties_ptr,
+ inter_line_penalty,
+ club_penalty,
+ club_penalties_ptr,
+ widow_penalties_ptr,
+ widow_penalty,
+ broken_penalty,
+ final_par_glue,
+ best_bet,
+ last_special_line,
+ second_width,
+ second_indent, first_width, first_indent, best_line,
+ pdf_ignored_dimen);
+ /* /Break the paragraph at the chosen... */
+ /* Clean up the memory by removing the break nodes; */
+ clean_up_the_memory();
+}
+
+@ @c
+void get_linebreak_info (int *f, int *a)
+{
+ *f = fewest_demerits;
+ *a = actual_looseness;
+}
diff --git a/Build/source/texk/web2c/luatexdir/tex/mlist.w b/Build/source/texk/web2c/luatexdir/tex/mlist.w
index 69c2b40ad3f..50ee01fb5da 100644
--- a/Build/source/texk/web2c/luatexdir/tex/mlist.w
+++ b/Build/source/texk/web2c/luatexdir/tex/mlist.w
@@ -1,3599 +1,3607 @@
-% mlist.w
-%
-% Copyright 2006-2010 Taco Hoekwater <taco@@luatex.org>
-%
-% This file is part of LuaTeX.
-%
-% LuaTeX is free software; you can redistribute it and/or modify it under
-% the terms of the GNU General Public License as published by the Free
-% Software Foundation; either version 2 of the License, or (at your
-% option) any later version.
-%
-% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
-% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
-% License for more details.
-%
-% You should have received a copy of the GNU General Public License along
-% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
-
-\def\LuaTeX{Lua\TeX}
-
-@ @c
-static const char _svn_version[] =
- "$Id: mlist.w 4634 2013-04-21 14:45:45Z hhenkel $"
- "$URL: https://foundry.supelec.fr/svn/luatex/branches/ex-glyph/source/texk/web2c/luatexdir/tex/mlist.w $";
-
-#include "ptexlib.h"
-#include "lua/luatex-api.h"
-
-@ @c
-#define delimiter_factor int_par(delimiter_factor_code)
-#define delimiter_shortfall dimen_par(delimiter_shortfall_code)
-#define bin_op_penalty int_par(bin_op_penalty_code)
-#define rel_penalty int_par(rel_penalty_code)
-#define null_delimiter_space dimen_par(null_delimiter_space_code)
-#define script_space dimen_par(script_space_code)
-#define disable_lig int_par(disable_lig_code)
-#define disable_kern int_par(disable_kern_code)
-
-#define nDEBUG
-
-#define reset_attributes(p,newatt) do { \
- delete_attribute_ref(node_attr(p)); \
- node_attr(p) = newatt; \
- if (newatt!=null) { \
- assert(type(newatt)==attribute_list_node); \
- add_node_attr_ref(node_attr(p)); \
- } \
- } while (0)
-
-
-#define DEFINE_MATH_PARAMETERS(A,B,C,D) do { \
- if (B==text_size) { \
- def_math_param(A, text_style, (C),D); \
- def_math_param(A, cramped_text_style, (C),D); \
- } else if (B==script_size) { \
- def_math_param(A, script_style, (C),D); \
- def_math_param(A, cramped_script_style, (C),D); \
- } else if (B==script_script_size) { \
- def_math_param(A, script_script_style, (C),D); \
- def_math_param(A, cramped_script_script_style, (C),D); \
- } \
- } while (0)
-
-#define DEFINE_DMATH_PARAMETERS(A,B,C,D) do { \
- if (B==text_size) { \
- def_math_param(A, display_style,(C),D); \
- def_math_param(A, cramped_display_style,(C),D); \
- } \
- } while (0)
-
-
-#define is_new_mathfont(A) (font_math_params(A)>0)
-#define is_old_mathfont(A,B) (font_math_params(A)==0 && font_params(A)>=(B))
-
-
-#define font_MATH_par(a,b) \
- (font_math_params(a)>=b ? font_math_param(a,b) : undefined_math_parameter)
-
-
-@ here are the math parameters that are font-dependant
-
-@ Before an mlist is converted to an hlist, \TeX\ makes sure that
-the fonts in family~2 have enough parameters to be math-symbol
-fonts, and that the fonts in family~3 have enough parameters to be
-math-extension fonts. The math-symbol parameters are referred to by using the
-following macros, which take a size code as their parameter; for example,
-|num1(cur_size)| gives the value of the |num1| parameter for the current size.
-@^parameters for symbols@>
-@^font parameters@>
-
-@c
-#define total_mathsy_params 22
-#define total_mathex_params 13
-
-#define mathsy(A,B) font_param(fam_fnt(2,A),B)
-#define math_x_height(A) mathsy(A,5) /* height of `\.x' */
-#define math_quad(A) mathsy(A,6) /* \.{18mu} */
-#define num1(A) mathsy(A,8) /* numerator shift-up in display styles */
-#define num2(A) mathsy(A,9) /* numerator shift-up in non-display, non-\.{\\atop} */
-#define num3(A) mathsy(A,10) /* numerator shift-up in non-display \.{\\atop} */
-#define denom1(A) mathsy(A,11) /* denominator shift-down in display styles */
-#define denom2(A) mathsy(A,12) /* denominator shift-down in non-display styles */
-#define sup1(A) mathsy(A,13) /* superscript shift-up in uncramped display style */
-#define sup2(A) mathsy(A,14) /* superscript shift-up in uncramped non-display */
-#define sup3(A) mathsy(A,15) /* superscript shift-up in cramped styles */
-#define sub1(A) mathsy(A,16) /* subscript shift-down if superscript is absent */
-#define sub2(A) mathsy(A,17) /* subscript shift-down if superscript is present */
-#define sup_drop(A) mathsy(A,18) /* superscript baseline below top of large box */
-#define sub_drop(A) mathsy(A,19) /* subscript baseline below bottom of large box */
-#define delim1(A) mathsy(A,20) /* size of \.{\\atopwithdelims} delimiters in display styles */
-#define delim2(A) mathsy(A,21) /* size of \.{\\atopwithdelims} delimiters in non-displays */
-#define axis_height(A) mathsy(A,22) /* height of fraction lines above the baseline */
-
-
-@ The math-extension parameters have similar macros, but the size code is
-omitted (since it is always |cur_size| when we refer to such parameters).
-@^parameters for symbols@>
-@^font parameters@>
-
-@c
-#define mathex(A,B) font_param(fam_fnt(3,A),B)
-#define default_rule_thickness(A) mathex(A,8) /* thickness of \.{\\over} bars */
-#define big_op_spacing1(A) mathex(A,9) /* minimum clearance above a displayed op */
-#define big_op_spacing2(A) mathex(A,10) /* minimum clearance below a displayed op */
-#define big_op_spacing3(A) mathex(A,11) /* minimum baselineskip above displayed op */
-#define big_op_spacing4(A) mathex(A,12) /* minimum baselineskip below displayed op */
-#define big_op_spacing5(A) mathex(A,13) /* padding above and below displayed limits */
-
-@ I (TH) made a bunch of extensions cf. the MATH table in OpenType, but some of
-the MathConstants values have no matching usage in \LuaTeX\ right now.
-
-ScriptPercentScaleDown,
-ScriptScriptPercentScaleDown:
- These should be handled by the macro package, on the engine
- side there are three separate fonts
-
-DelimitedSubFormulaMinHeight:
- This is perhaps related to word's natural math input? I have
- no idea what to do about it
-
-MathLeading:
- LuaTeX does not currently handle multi-line displays, and
- the parameter does not seem to make much sense elsewhere
-
-FlattenedAccentBaseHeight:
- This is based on the 'flac' GSUB feature. It would not be hard
- to support that, but proper math accent placements cf. MATH
- needs support for MathTopAccentAttachment table to be
- implemented first
-
-SkewedFractionHorizontalGap,
-SkewedFractionVerticalGap:
- I am not sure it makes sense implementing skewed fractions,
- so I would like to see an example first
-
-Also still TODO for OpenType Math:
- * extensible large operators
- * prescripts
-
-@ this is not really a math parameter at all
-
-@c
-static void math_param_error(const char *param, int style)
-{
- char s[256];
- const char *hlp[] = {
- "Sorry, but I can't typeset math unless various parameters have",
- "been set. This is normally done by loading special math fonts",
- "into the math family slots. Your font set is lacking at least",
- "the parameter mentioned earlier.",
- NULL
- };
- snprintf(s, 256, "Math error: parameter \\Umath%s\\%sstyle is not set",
- param, math_style_names[style]);
- tex_error(s, hlp);
-#if 0
- flush_math();
-#endif
- return;
-}
-
-
-@ @c
-static scaled accent_base_height(int f)
-{
- scaled a;
- if (is_new_mathfont(f)) {
- a = font_MATH_par(f, AccentBaseHeight);
- if (a == undefined_math_parameter)
- a = x_height(f);
- } else {
- a = x_height(f);
- }
- return a;
-}
-
-@ the non-staticness of this function is for the benefit of |texmath.w|
-
-@c
-scaled get_math_quad(int var)
-{
- scaled a = get_math_param(math_param_quad, var);
- if (a == undefined_math_parameter) {
- math_param_error("quad", var);
- a = 0;
- }
- return a;
-}
-
-@ this parameter is different because it is called with a size
- specifier instead of a style specifier.
-
-@c
-static scaled math_axis(int b)
-{
- scaled a;
- int var;
- if (b == script_size)
- var = script_style;
- else if (b == script_script_size)
- var = script_script_style;
- else
- var = text_style;
- a = get_math_param(math_param_axis, var);
- if (a == undefined_math_parameter) {
- math_param_error("axis", var);
- a = 0;
- }
- return a;
-}
-
-@ @c
-static scaled get_math_quad_size(int b)
-{
- int var;
- if (b == script_size)
- var = script_style;
- else if (b == script_script_size)
- var = script_script_style;
- else
- var = text_style;
- return get_math_param(math_param_quad, var);
-}
-
-
-@ @c
-static scaled minimum_operator_size(int var)
-{
- scaled a = get_math_param(math_param_operator_size, var);
- return a;
-}
-
-@ Old-style fonts do not define the |radical_rule|. This allows |make_radical| to select
- the backward compatibility code, and it means that we can't raise an error here.
-
-@c
-static scaled radical_rule(int var)
-{
- scaled a = get_math_param(math_param_radical_rule, var);
- return a;
-}
-
-@ now follow all the trivial math parameters
-
-@c
-#define get_math_param_or_error(a,b) do_get_math_param_or_error(a, math_param_##b, #b)
-
-static scaled do_get_math_param_or_error(int var, int param, const char *name)
-{
- scaled a = get_math_param(param, var);
- if (a == undefined_math_parameter) {
- math_param_error(name, var);
- a = 0;
- }
- return a;
-}
-
-@ @c
-#define radical_degree_before(a) get_math_param_or_error(a, radical_degree_before)
-#define radical_degree_after(a) get_math_param_or_error(a, radical_degree_after)
-#define radical_degree_raise(a) get_math_param_or_error(a, radical_degree_raise)
-
-#define connector_overlap_min(a) get_math_param_or_error(a, connector_overlap_min)
-
-#define overbar_rule(a) get_math_param_or_error(a, overbar_rule)
-#define overbar_kern(a) get_math_param_or_error(a, overbar_kern)
-#define overbar_vgap(a) get_math_param_or_error(a, overbar_vgap)
-
-#define underbar_rule(a) get_math_param_or_error(a, underbar_rule)
-#define underbar_kern(a) get_math_param_or_error(a, underbar_kern)
-#define underbar_vgap(a) get_math_param_or_error(a, underbar_vgap)
-
-#define under_delimiter_vgap(a) get_math_param_or_error(a, under_delimiter_vgap)
-#define under_delimiter_bgap(a) get_math_param_or_error(a, under_delimiter_bgap)
-
-#define over_delimiter_vgap(a) get_math_param_or_error(a, over_delimiter_vgap)
-#define over_delimiter_bgap(a) get_math_param_or_error(a, over_delimiter_bgap)
-
-#define radical_vgap(a) get_math_param_or_error(a, radical_vgap)
-#define radical_kern(a) get_math_param_or_error(a, radical_kern)
-
-#define stack_vgap(a) get_math_param_or_error(a, stack_vgap)
-#define stack_num_up(a) get_math_param_or_error(a, stack_num_up)
-#define stack_denom_down(a) get_math_param_or_error(a, stack_denom_down)
-
-#define fraction_rule(a) get_math_param_or_error(a, fraction_rule)
-#define fraction_num_vgap(a) get_math_param_or_error(a, fraction_num_vgap)
-#define fraction_denom_vgap(a) get_math_param_or_error(a, fraction_denom_vgap)
-#define fraction_num_up(a) get_math_param_or_error(a, fraction_num_up)
-#define fraction_denom_down(a) get_math_param_or_error(a, fraction_denom_down)
-#define fraction_del_size(a) get_math_param_or_error(a, fraction_del_size)
-
-#define limit_above_vgap(a) get_math_param_or_error(a, limit_above_vgap)
-#define limit_above_bgap(a) get_math_param_or_error(a, limit_above_bgap)
-#define limit_above_kern(a) get_math_param_or_error(a, limit_above_kern)
-
-#define limit_below_vgap(a) get_math_param_or_error(a, limit_below_vgap)
-#define limit_below_bgap(a) get_math_param_or_error(a, limit_below_bgap)
-#define limit_below_kern(a) get_math_param_or_error(a, limit_below_kern)
-
-#define sub_shift_drop(a) get_math_param_or_error(a, sub_shift_drop)
-#define sup_shift_drop(a) get_math_param_or_error(a, sup_shift_drop)
-#define sub_shift_down(a) get_math_param_or_error(a, sub_shift_down)
-#define sub_sup_shift_down(a) get_math_param_or_error(a, sub_sup_shift_down)
-#define sup_shift_up(a) get_math_param_or_error(a, sup_shift_up)
-#define sub_top_max(a) get_math_param_or_error(a, sub_top_max)
-#define sup_bottom_min(a) get_math_param_or_error(a, sup_bottom_min)
-#define sup_sub_bottom_max(a) get_math_param_or_error(a, sup_sub_bottom_max)
-#define subsup_vgap(a) get_math_param_or_error(a, subsup_vgap)
-
-#define space_after_script(a) get_math_param_or_error(a, space_after_script)
-
-@ @c
-void fixup_math_parameters(int fam_id, int size_id, int f, int lvl)
-{
- if (is_new_mathfont(f)) { /* fix all known parameters */
-
- DEFINE_MATH_PARAMETERS(math_param_quad, size_id, font_size(f), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_quad, size_id, font_size(f), lvl);
- DEFINE_MATH_PARAMETERS(math_param_axis, size_id,
- font_MATH_par(f, AxisHeight), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_axis, size_id,
- font_MATH_par(f, AxisHeight), lvl);
- DEFINE_MATH_PARAMETERS(math_param_overbar_kern, size_id,
- font_MATH_par(f, OverbarExtraAscender), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_overbar_kern, size_id,
- font_MATH_par(f, OverbarExtraAscender), lvl);
- DEFINE_MATH_PARAMETERS(math_param_overbar_rule, size_id,
- font_MATH_par(f, OverbarRuleThickness), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_overbar_rule, size_id,
- font_MATH_par(f, OverbarRuleThickness), lvl);
- DEFINE_MATH_PARAMETERS(math_param_overbar_vgap, size_id,
- font_MATH_par(f, OverbarVerticalGap), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_overbar_vgap, size_id,
- font_MATH_par(f, OverbarVerticalGap), lvl);
- DEFINE_MATH_PARAMETERS(math_param_underbar_kern, size_id,
- font_MATH_par(f, UnderbarExtraDescender), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_underbar_kern, size_id,
- font_MATH_par(f, UnderbarExtraDescender), lvl);
- DEFINE_MATH_PARAMETERS(math_param_underbar_rule, size_id,
- font_MATH_par(f, UnderbarRuleThickness), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_underbar_rule, size_id,
- font_MATH_par(f, UnderbarRuleThickness), lvl);
- DEFINE_MATH_PARAMETERS(math_param_underbar_vgap, size_id,
- font_MATH_par(f, UnderbarVerticalGap), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_underbar_vgap, size_id,
- font_MATH_par(f, UnderbarVerticalGap), lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_under_delimiter_vgap, size_id,
- font_MATH_par(f, StretchStackGapAboveMin), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_under_delimiter_vgap, size_id,
- font_MATH_par(f, StretchStackGapAboveMin), lvl);
- DEFINE_MATH_PARAMETERS(math_param_under_delimiter_bgap, size_id,
- font_MATH_par(f, StretchStackBottomShiftDown),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_under_delimiter_bgap, size_id,
- font_MATH_par(f, StretchStackBottomShiftDown),
- lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_over_delimiter_vgap, size_id,
- font_MATH_par(f, StretchStackGapBelowMin), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_over_delimiter_vgap, size_id,
- font_MATH_par(f, StretchStackGapBelowMin), lvl);
- DEFINE_MATH_PARAMETERS(math_param_over_delimiter_bgap, size_id,
- font_MATH_par(f, StretchStackTopShiftUp), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_over_delimiter_bgap, size_id,
- font_MATH_par(f, StretchStackTopShiftUp), lvl);
-
-
- DEFINE_MATH_PARAMETERS(math_param_stack_num_up, size_id,
- font_MATH_par(f, StackTopShiftUp), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_stack_num_up, size_id,
- font_MATH_par(f, StackTopDisplayStyleShiftUp),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_stack_denom_down, size_id,
- font_MATH_par(f, StackBottomShiftDown), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_stack_denom_down, size_id,
- font_MATH_par(f,
- StackBottomDisplayStyleShiftDown),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_stack_vgap, size_id,
- font_MATH_par(f, StackGapMin), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_stack_vgap, size_id,
- font_MATH_par(f, StackDisplayStyleGapMin), lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_radical_kern, size_id,
- font_MATH_par(f, RadicalExtraAscender), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_radical_kern, size_id,
- font_MATH_par(f, RadicalExtraAscender), lvl);
-
- DEFINE_DMATH_PARAMETERS(math_param_operator_size, size_id,
- font_MATH_par(f, DisplayOperatorMinHeight),
- lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_radical_rule, size_id,
- font_MATH_par(f, RadicalRuleThickness), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_radical_rule, size_id,
- font_MATH_par(f, RadicalRuleThickness), lvl);
- DEFINE_MATH_PARAMETERS(math_param_radical_vgap, size_id,
- font_MATH_par(f, RadicalVerticalGap), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_radical_vgap, size_id,
- font_MATH_par(f,
- RadicalDisplayStyleVerticalGap),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_radical_degree_before, size_id,
- font_MATH_par(f, RadicalKernBeforeDegree), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_radical_degree_before, size_id,
- font_MATH_par(f, RadicalKernBeforeDegree), lvl);
- DEFINE_MATH_PARAMETERS(math_param_radical_degree_after, size_id,
- font_MATH_par(f, RadicalKernAfterDegree), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_radical_degree_after, size_id,
- font_MATH_par(f, RadicalKernAfterDegree), lvl);
- DEFINE_MATH_PARAMETERS(math_param_radical_degree_raise, size_id,
- font_MATH_par(f,
- RadicalDegreeBottomRaisePercent),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_radical_degree_raise, size_id,
- font_MATH_par(f,
- RadicalDegreeBottomRaisePercent),
- lvl);
- if (size_id == text_size) {
- def_math_param(math_param_sup_shift_up, display_style,
- font_MATH_par(f, SuperscriptShiftUp), lvl);
- def_math_param(math_param_sup_shift_up, cramped_display_style,
- font_MATH_par(f, SuperscriptShiftUpCramped), lvl);
- def_math_param(math_param_sup_shift_up, text_style,
- font_MATH_par(f, SuperscriptShiftUp), lvl);
- def_math_param(math_param_sup_shift_up, cramped_text_style,
- font_MATH_par(f, SuperscriptShiftUpCramped), lvl);
- } else if (size_id == script_size) {
- def_math_param(math_param_sup_shift_up, script_style,
- font_MATH_par(f, SuperscriptShiftUp), lvl);
- def_math_param(math_param_sup_shift_up, cramped_script_style,
- font_MATH_par(f, SuperscriptShiftUpCramped), lvl);
- } else if (size_id == script_script_size) {
- def_math_param(math_param_sup_shift_up, script_script_style,
- font_MATH_par(f, SuperscriptShiftUp), lvl);
- def_math_param(math_param_sup_shift_up, cramped_script_script_style,
- font_MATH_par(f, SuperscriptShiftUpCramped), lvl);
- }
-
- DEFINE_MATH_PARAMETERS(math_param_sub_shift_drop, size_id,
- font_MATH_par(f, SubscriptBaselineDropMin), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sub_shift_drop, size_id,
- font_MATH_par(f, SubscriptBaselineDropMin),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_sup_shift_drop, size_id,
- font_MATH_par(f, SuperscriptBaselineDropMax),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sup_shift_drop, size_id,
- font_MATH_par(f, SuperscriptBaselineDropMax),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_sub_shift_down, size_id,
- font_MATH_par(f, SubscriptShiftDown), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sub_shift_down, size_id,
- font_MATH_par(f, SubscriptShiftDown), lvl);
-
- if (font_MATH_par(f, SubscriptShiftDownWithSuperscript) !=
- undefined_math_parameter) {
- DEFINE_MATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
- font_MATH_par(f,
- SubscriptShiftDownWithSuperscript),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
- font_MATH_par(f,
- SubscriptShiftDownWithSuperscript),
- lvl);
- } else {
- DEFINE_MATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
- font_MATH_par(f, SubscriptShiftDown), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
- font_MATH_par(f, SubscriptShiftDown), lvl);
- }
-
- DEFINE_MATH_PARAMETERS(math_param_sub_top_max, size_id,
- font_MATH_par(f, SubscriptTopMax), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sub_top_max, size_id,
- font_MATH_par(f, SubscriptTopMax), lvl);
- DEFINE_MATH_PARAMETERS(math_param_sup_bottom_min, size_id,
- font_MATH_par(f, SuperscriptBottomMin), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sup_bottom_min, size_id,
- font_MATH_par(f, SuperscriptBottomMin), lvl);
- DEFINE_MATH_PARAMETERS(math_param_sup_sub_bottom_max, size_id,
- font_MATH_par(f,
- SuperscriptBottomMaxWithSubscript),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sup_sub_bottom_max, size_id,
- font_MATH_par(f,
- SuperscriptBottomMaxWithSubscript),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_subsup_vgap, size_id,
- font_MATH_par(f, SubSuperscriptGapMin), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_subsup_vgap, size_id,
- font_MATH_par(f, SubSuperscriptGapMin), lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_limit_above_vgap, size_id,
- font_MATH_par(f, UpperLimitGapMin), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_above_vgap, size_id,
- font_MATH_par(f, UpperLimitGapMin), lvl);
- DEFINE_MATH_PARAMETERS(math_param_limit_above_bgap, size_id,
- font_MATH_par(f, UpperLimitBaselineRiseMin),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_above_bgap, size_id,
- font_MATH_par(f, UpperLimitBaselineRiseMin),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_limit_above_kern, size_id, 0, lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_above_kern, size_id, 0, lvl);
- DEFINE_MATH_PARAMETERS(math_param_limit_below_vgap, size_id,
- font_MATH_par(f, LowerLimitGapMin), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_below_vgap, size_id,
- font_MATH_par(f, LowerLimitGapMin), lvl);
- DEFINE_MATH_PARAMETERS(math_param_limit_below_bgap, size_id,
- font_MATH_par(f, LowerLimitBaselineDropMin),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_below_bgap, size_id,
- font_MATH_par(f, LowerLimitBaselineDropMin),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_limit_below_kern, size_id, 0, lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_below_kern, size_id, 0, lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_fraction_rule, size_id,
- font_MATH_par(f, FractionRuleThickness), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_rule, size_id,
- font_MATH_par(f, FractionRuleThickness), lvl);
- DEFINE_MATH_PARAMETERS(math_param_fraction_num_vgap, size_id,
- font_MATH_par(f, FractionNumeratorGapMin), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_num_vgap, size_id,
- font_MATH_par(f,
- FractionNumeratorDisplayStyleGapMin),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_fraction_num_up, size_id,
- font_MATH_par(f, FractionNumeratorShiftUp), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_num_up, size_id,
- font_MATH_par(f,
- FractionNumeratorDisplayStyleShiftUp),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_fraction_denom_vgap, size_id,
- font_MATH_par(f, FractionDenominatorGapMin),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_denom_vgap, size_id,
- font_MATH_par(f,
- FractionDenominatorDisplayStyleGapMin),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_fraction_denom_down, size_id,
- font_MATH_par(f, FractionDenominatorShiftDown),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_denom_down, size_id,
- font_MATH_par(f,
- FractionDenominatorDisplayStyleShiftDown),
- lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_fraction_del_size, size_id,
- font_MATH_par(f, FractionDelimiterSize), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_del_size, size_id,
- font_MATH_par(f,
- FractionDelimiterDisplayStyleSize),
- lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_space_after_script, size_id,
- font_MATH_par(f, SpaceAfterScript), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_space_after_script, size_id,
- font_MATH_par(f, SpaceAfterScript), lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_connector_overlap_min, size_id,
- font_MATH_par(f, MinConnectorOverlap), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_connector_overlap_min, size_id,
- font_MATH_par(f, MinConnectorOverlap), lvl);
-
-
- } else if (fam_id == 2 && is_old_mathfont(f, total_mathsy_params)) {
- /* fix old-style |sy| parameters */
- DEFINE_MATH_PARAMETERS(math_param_quad, size_id, math_quad(size_id),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_quad, size_id, math_quad(size_id),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_axis, size_id, axis_height(size_id),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_axis, size_id, axis_height(size_id),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_stack_num_up, size_id, num3(size_id),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_stack_num_up, size_id, num1(size_id),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_stack_denom_down, size_id,
- denom2(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_stack_denom_down, size_id,
- denom1(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_fraction_num_up, size_id,
- num2(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_num_up, size_id,
- num1(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_fraction_denom_down, size_id,
- denom2(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_denom_down, size_id,
- denom1(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_fraction_del_size, size_id,
- delim2(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_del_size, size_id,
- delim1(size_id), lvl);
- if (size_id == text_size) {
- def_math_param(math_param_sup_shift_up, display_style,
- sup1(size_id), lvl);
- def_math_param(math_param_sup_shift_up, cramped_display_style,
- sup3(size_id), lvl);
- def_math_param(math_param_sup_shift_up, text_style, sup2(size_id),
- lvl);
- def_math_param(math_param_sup_shift_up, cramped_text_style,
- sup3(size_id), lvl);
- } else if (size_id == script_size) {
- def_math_param(math_param_sub_shift_drop, display_style,
- sub_drop(size_id), lvl);
- def_math_param(math_param_sub_shift_drop, cramped_display_style,
- sub_drop(size_id), lvl);
- def_math_param(math_param_sub_shift_drop, text_style,
- sub_drop(size_id), lvl);
- def_math_param(math_param_sub_shift_drop, cramped_text_style,
- sub_drop(size_id), lvl);
- def_math_param(math_param_sup_shift_drop, display_style,
- sup_drop(size_id), lvl);
- def_math_param(math_param_sup_shift_drop, cramped_display_style,
- sup_drop(size_id), lvl);
- def_math_param(math_param_sup_shift_drop, text_style,
- sup_drop(size_id), lvl);
- def_math_param(math_param_sup_shift_drop, cramped_text_style,
- sup_drop(size_id), lvl);
- def_math_param(math_param_sup_shift_up, script_style, sup2(size_id),
- lvl);
- def_math_param(math_param_sup_shift_up, cramped_script_style,
- sup3(size_id), lvl);
- } else if (size_id == script_script_size) {
- def_math_param(math_param_sub_shift_drop, script_style,
- sub_drop(size_id), lvl);
- def_math_param(math_param_sub_shift_drop, cramped_script_style,
- sub_drop(size_id), lvl);
- def_math_param(math_param_sub_shift_drop, script_script_style,
- sub_drop(size_id), lvl);
- def_math_param(math_param_sub_shift_drop,
- cramped_script_script_style, sub_drop(size_id), lvl);
- def_math_param(math_param_sup_shift_drop, script_style,
- sup_drop(size_id), lvl);
- def_math_param(math_param_sup_shift_drop, cramped_script_style,
- sup_drop(size_id), lvl);
- def_math_param(math_param_sup_shift_drop, script_script_style,
- sup_drop(size_id), lvl);
- def_math_param(math_param_sup_shift_drop,
- cramped_script_script_style, sup_drop(size_id), lvl);
- def_math_param(math_param_sup_shift_up, script_script_style,
- sup2(size_id), lvl);
- def_math_param(math_param_sup_shift_up, cramped_script_script_style,
- sup3(size_id), lvl);
- }
- DEFINE_MATH_PARAMETERS(math_param_sub_shift_down, size_id,
- sub1(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sub_shift_down, size_id,
- sub1(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
- sub2(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
- sub2(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_sub_top_max, size_id,
- (abs(math_x_height(size_id) * 4) / 5), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sub_top_max, size_id,
- (abs(math_x_height(size_id) * 4) / 5), lvl);
- DEFINE_MATH_PARAMETERS(math_param_sup_bottom_min, size_id,
- (abs(math_x_height(size_id)) / 4), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sup_bottom_min, size_id,
- (abs(math_x_height(size_id)) / 4), lvl);
- DEFINE_MATH_PARAMETERS(math_param_sup_sub_bottom_max, size_id,
- (abs(math_x_height(size_id) * 4) / 5), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_sup_sub_bottom_max, size_id,
- (abs(math_x_height(size_id) * 4) / 5), lvl);
-
- /* The display-size |radical_vgap| is done twice because it needs
- values from both the sy and the ex font. */
- DEFINE_DMATH_PARAMETERS(math_param_radical_vgap, size_id,
- (default_rule_thickness(size_id) +
- (abs(math_x_height(size_id)) / 4)), lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_radical_degree_raise, size_id,
- 60, lvl);
- DEFINE_DMATH_PARAMETERS(math_param_radical_degree_raise, size_id,
- 60, lvl);
- DEFINE_MATH_PARAMETERS(math_param_radical_degree_before, size_id,
- xn_over_d(get_math_quad_size(size_id), 5, 18),
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_radical_degree_before, size_id,
- xn_over_d(get_math_quad_size(size_id), 5, 18),
- lvl);
- DEFINE_MATH_PARAMETERS(math_param_radical_degree_after, size_id,
- (-xn_over_d
- (get_math_quad_size(size_id), 10, 18)), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_radical_degree_after, size_id,
- (-xn_over_d
- (get_math_quad_size(size_id), 10, 18)), lvl);
-
- } else if (fam_id == 3 && is_old_mathfont(f, total_mathex_params)) {
- /* fix old-style |ex| parameters */
- DEFINE_MATH_PARAMETERS(math_param_overbar_kern, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_overbar_rule, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_overbar_vgap, size_id,
- 3 * default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_overbar_kern, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_overbar_rule, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_overbar_vgap, size_id,
- 3 * default_rule_thickness(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_underbar_kern, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_underbar_rule, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_underbar_vgap, size_id,
- 3 * default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_underbar_kern, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_underbar_rule, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_underbar_vgap, size_id,
- 3 * default_rule_thickness(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_radical_kern, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_radical_kern, size_id,
- default_rule_thickness(size_id), lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_radical_vgap, size_id,
- (default_rule_thickness(size_id) +
- (abs(default_rule_thickness(size_id)) / 4)),
- lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_stack_vgap, size_id,
- 3 * default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_stack_vgap, size_id,
- 7 * default_rule_thickness(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_fraction_rule, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_rule, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_fraction_num_vgap, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_num_vgap, size_id,
- 3 * default_rule_thickness(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_fraction_denom_vgap, size_id,
- default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_fraction_denom_vgap, size_id,
- 3 * default_rule_thickness(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_limit_above_vgap, size_id,
- big_op_spacing1(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_above_vgap, size_id,
- big_op_spacing1(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_limit_above_bgap, size_id,
- big_op_spacing3(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_above_bgap, size_id,
- big_op_spacing3(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_limit_above_kern, size_id,
- big_op_spacing5(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_above_kern, size_id,
- big_op_spacing5(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_limit_below_vgap, size_id,
- big_op_spacing2(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_below_vgap, size_id,
- big_op_spacing2(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_limit_below_bgap, size_id,
- big_op_spacing4(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_below_bgap, size_id,
- big_op_spacing4(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_limit_below_kern, size_id,
- big_op_spacing5(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_limit_below_kern, size_id,
- big_op_spacing5(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_subsup_vgap, size_id,
- 4 * default_rule_thickness(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_subsup_vgap, size_id,
- 4 * default_rule_thickness(size_id), lvl);
- /* All of the |space_after_script|s are done in |finalize_math_parameters| because the
- \.{\\scriptspace} may have been altered by the user
- */
- DEFINE_MATH_PARAMETERS(math_param_connector_overlap_min, size_id, 0,
- lvl);
- DEFINE_DMATH_PARAMETERS(math_param_connector_overlap_min, size_id, 0,
- lvl);
-
- DEFINE_MATH_PARAMETERS(math_param_under_delimiter_vgap, size_id,
- big_op_spacing2(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_under_delimiter_vgap, size_id,
- big_op_spacing2(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_under_delimiter_bgap, size_id,
- big_op_spacing4(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_under_delimiter_bgap, size_id,
- big_op_spacing4(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_over_delimiter_vgap, size_id,
- big_op_spacing1(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_over_delimiter_vgap, size_id,
- big_op_spacing1(size_id), lvl);
- DEFINE_MATH_PARAMETERS(math_param_over_delimiter_bgap, size_id,
- big_op_spacing3(size_id), lvl);
- DEFINE_DMATH_PARAMETERS(math_param_over_delimiter_bgap, size_id,
- big_op_spacing3(size_id), lvl);
-
- /* The display-size |radical_vgap| is done twice because it needs
- values from both the sy and the ex font. */
- DEFINE_DMATH_PARAMETERS(math_param_radical_vgap, size_id,
- (default_rule_thickness(size_id) +
- (abs(math_x_height(size_id)) / 4)), lvl);
- }
-}
-
-@ This needs to be called just at the start of |mlist_to_hlist|, for
-backward compatibility with \.{\\scriptspace}.
-
-@c
-static void finalize_math_parameters(void)
-{
- int saved_trace = int_par(tracing_assigns_code);
- int_par(tracing_assigns_code) = 0;
- if (get_math_param(math_param_space_after_script, display_style) ==
- undefined_math_parameter) {
- def_math_param(math_param_space_after_script, display_style,
- script_space, level_one);
- def_math_param(math_param_space_after_script, text_style,
- script_space, level_one);
- def_math_param(math_param_space_after_script, script_style,
- script_space, level_one);
- def_math_param(math_param_space_after_script, script_script_style,
- script_space, level_one);
- def_math_param(math_param_space_after_script, cramped_display_style,
- script_space, level_one);
- def_math_param(math_param_space_after_script, cramped_text_style,
- script_space, level_one);
- def_math_param(math_param_space_after_script, cramped_script_style,
- script_space, level_one);
- def_math_param(math_param_space_after_script,
- cramped_script_script_style, script_space, level_one);
- }
- int_par(tracing_assigns_code) = saved_trace;
-
-}
-
-
-@ In order to convert mlists to hlists, i.e., noads to nodes, we need several
-subroutines that are conveniently dealt with now.
-
-Let us first introduce the macros that make it easy to get at the parameters and
-other font information. A size code, which is a multiple of 256, is added to a
-family number to get an index into the table of internal font numbers
-for each combination of family and size. (Be alert: Size codes get
-larger as the type gets smaller.)
-
-@c
-static const char *math_size_string(int s)
-{
- if (s == text_size)
- return "textfont";
- else if (s == script_size)
- return "scriptfont";
- else
- return "scriptscriptfont";
-}
-
-@ When the style changes, the following piece of program computes associated
-information:
-
-@c
-#define setup_cur_size(a) do { \
- if (a==script_style || \
- a==cramped_script_style) \
- cur_size=script_size; \
- else if (a==script_script_style || \
- a==cramped_script_script_style) \
- cur_size=script_script_size; \
- else cur_size=text_size; \
- } while (0)
-
-
-@ a simple routine that creates a flat copy of a nucleus
-@c
-static pointer math_clone(pointer q)
-{
- pointer x;
- if (q == null)
- return null;
- x = new_node(type(q), 0);
- reset_attributes(x, node_attr(q));
- if (type(q) == math_char_node) {
- math_fam(x) = math_fam(q);
- math_character(x) = math_character(q);
- } else {
- math_list(x) = math_list(q);
- }
- return x;
-}
-
-
-
-
-@ Here is a function that returns a pointer to a rule node having a given
- thickness |t|. The rule will extend horizontally to the boundary of the vlist
- that eventually contains it.
-
-@c
-static pointer do_fraction_rule(scaled t, pointer att)
-{
- pointer p; /* the new node */
- p = new_rule();
- rule_dir(p) = math_direction;
- height(p) = t;
- depth(p) = 0;
- reset_attributes(p, att);
- return p;
-}
-
-
-@ The |overbar| function returns a pointer to a vlist box that consists of
- a given box |b|, above which has been placed a kern of height |k| under a
- fraction rule of thickness |t| under additional space of height |ht|.
-
-@c
-static pointer overbar(pointer b, scaled k, scaled t, scaled ht, pointer att)
-{
- pointer p, q; /* nodes being constructed */
- p = new_kern(k);
- vlink(p) = b;
- reset_attributes(p, att);
- q = do_fraction_rule(t, att);
- vlink(q) = p;
- p = new_kern(ht);
- reset_attributes(p, att);
- vlink(p) = q;
- q = vpackage(p, 0, additional, max_dimen, math_direction);
- reset_attributes(q, att);
- return q;
-}
-
-@ Here is a subroutine that creates a new box, whose list contains a
- single character, and whose width includes the italic correction for
- that character. The height or depth of the box will be negative, if
- the height or depth of the character is negative; thus, this routine
- may deliver a slightly different result than |hpack| would produce.
-
-@c
-static pointer char_box(internal_font_number f, int c, pointer bb)
-{
- pointer b, p; /* the new box and its character node */
- b = new_null_box();
- width(b) = char_width(f, c) + char_italic(f, c);
- height(b) = char_height(f, c);
- depth(b) = char_depth(f, c);
- reset_attributes(b, bb);
- p = new_char(f, c);
- reset_attributes(p, bb);
- list_ptr(b) = p;
- return b;
-}
-
-@ Another handy subroutine computes the height plus depth of
- a given character:
-
-@c
-static scaled height_plus_depth(internal_font_number f, int c)
-{
- return (char_height(f, c) + char_depth(f, c));
-}
-
-
-@ When we build an extensible character, it's handy to have the
- following subroutine, which puts a given character on top
- of the characters already in box |b|:
-
-@c
-static scaled stack_into_box(pointer b, internal_font_number f, int c)
-{
- pointer p, q; /* new node placed into |b| */
- p = char_box(f, c, node_attr(b));
- if (type(b) == vlist_node) {
- vlink(p) = list_ptr(b);
- list_ptr(b) = p;
- height(b) = height(p);
- if (width(b) < width(p))
- width(b) = width(p);
- return height_plus_depth(f, c);
- } else {
- q = list_ptr(b);
- if (q == null) {
- list_ptr(b) = p;
- } else {
- while (vlink(q) != null)
- q = vlink(q);
- vlink(q) = p;
- }
- if (height(b) < height(p))
- height(b) = height(p);
- if (depth(b) < depth(p))
- depth(b) = depth(p);
- return char_width(f, c);
- }
-}
-
-static void stack_glue_into_box(pointer b, scaled min, scaled max) {
- pointer p, q; /* new node placed into |b| */
- q = new_spec(zero_glue);
- width(q) = min;
- stretch(q) = max-min;
- p = new_glue(q);
- reset_attributes(p, node_attr(b));
- if (type(b) == vlist_node) {
- vlink(p) = list_ptr(b);
- list_ptr(b) = p;
- height(b) = height(p);
- } else {
- q = list_ptr(b);
- if (q == null) {
- list_ptr(b) = p;
- } else {
- while (vlink(q) != null)
- q = vlink(q);
- vlink(q) = p;
- }
- if (height(b) < height(p))
- height(b) = height(p);
- if (depth(b) < depth(p))
- depth(b) = depth(p);
- }
-}
-
-@ \TeX's most important routine for dealing with formulas is called
- |mlist_to_hlist|. After a formula has been scanned and represented
- as an mlist, this routine converts it to an hlist that can be placed
- into a box or incorporated into the text of a paragraph. The
- explicit parameter |cur_mlist| points to the first node or noad in
- the given mlist (and it might be |null|); the parameter |penalties|
- is |true| if penalty nodes for potential line breaks are to be
- inserted into the resulting hlist, the parameter |cur_style| is a
- style code. After |mlist_to_hlist| has acted, |vlink(temp_head)|
- points to the translated hlist.
-
- Since mlists can be inside mlists, the procedure is recursive. And since this
- is not part of \TeX's inner loop, the program has been written in a manner
- that stresses compactness over efficiency.
-@^recursion@>
-
-@c
-int cur_size; /* size code corresponding to |cur_style| */
-
-@ @c
-static pointer get_delim_box(extinfo * ext, internal_font_number f, scaled v,
- pointer att, int boxtype, int cur_style)
-{
- pointer b; /* new box */
- scaled b_max; /* natural (maximum) size of the stack */
- scaled s_max; /* amount of possible shrink in the stack */
- extinfo *cur;
- scaled min_overlap, prev_overlap;
- int i; /* a temporary counter number of extensible pieces */
- int with_extenders; /* number of times to repeat each repeatable item in |ext| */
- int num_extenders, num_normal;
- scaled a, c, d;
-
- assert(ext != NULL);
- b = new_null_box();
- type(b) = (quarterword) boxtype;
- reset_attributes(b, att);
- min_overlap = connector_overlap_min(cur_style);
- assert(min_overlap >= 0);
- with_extenders = -1;
- num_extenders = 0;
- num_normal = 0;
-
- cur = ext;
- while (cur != NULL) {
- if (!char_exists(f, cur->glyph)) {
- const char *hlp[] = {
- "Each glyph part in an extensible item should exist in the font.",
- "I will give up trying to find a suitable size for now. Fix your font!",
- NULL
- };
- tex_error("Variant part doesn't exist.", hlp);
- width(b) = null_delimiter_space;
- return b;
- }
- if (cur->extender > 0)
- num_extenders++;
- else
- num_normal++;
- /* no negative overlaps or advances are allowed */
- if (cur->start_overlap < 0 || cur->end_overlap < 0 || cur->advance < 0) {
- const char *hlp[] = {
- "All measurements in extensible items should be positive.",
- "To get around this problem, I have changed the font metrics.",
- "Fix your font!",
- NULL
- };
- tex_error("Extensible recipe has negative fields.", hlp);
- if (cur->start_overlap < 0)
- cur->start_overlap = 0;
- if (cur->end_overlap < 0)
- cur->end_overlap = 0;
- if (cur->advance < 0)
- cur->advance = 0;
- }
- cur = cur->next;
- }
- if (num_normal == 0) {
- const char *hlp[] = {
- "Each extensible recipe should have at least one non-repeatable part.",
- "To get around this problem, I have changed the first part to be",
- "non-repeatable. Fix your font!",
- NULL
- };
- tex_error("Extensible recipe has no fixed parts.", hlp);
- ext->extender = 0;
- num_normal = 1;
- num_extenders--;
- }
- /* |ext| holds a linked list of numerous items that may or may not be
- repeatable. For the total height, we have to figure out how many items
- are needed to create a stack of at least |v|.
- The next |while| loop does that. It has two goals: it finds out
- the natural height |b_max| of the all the parts needed to reach
- at least |v|, and it sets |with_extenders| to the number of times
- each of the repeatable items in |ext| has to be repeated to reach
- that height.
- */
- cur = ext;
- b_max = 0;
- while (b_max < v && num_extenders > 0) {
- b_max = 0;
- prev_overlap = 0;
- with_extenders++;
- for (cur = ext; cur != NULL; cur = cur->next) {
- if (cur->extender == 0) {
- c = cur->start_overlap;
- if (min_overlap < c)
- c = min_overlap;
- if (prev_overlap < c)
- c = prev_overlap;
- a = cur->advance;
- if (a == 0) {
- /* for tfm fonts */
- if (boxtype == vlist_node)
- a = height_plus_depth(f, cur->glyph);
- else
- a = char_width(f, cur->glyph);
- assert(a >= 0);
- }
- b_max += a - c;
- prev_overlap = cur->end_overlap;
- } else {
- i = with_extenders;
- while (i > 0) {
- c = cur->start_overlap;
- if (min_overlap < c)
- c = min_overlap;
- if (prev_overlap < c)
- c = prev_overlap;
- a = cur->advance;
- if (a == 0) {
- /* for tfm fonts */
- if (boxtype == vlist_node)
- a = height_plus_depth(f, cur->glyph);
- else
- a = char_width(f, cur->glyph);
- assert(a >= 0);
- }
- b_max += a - c;
- prev_overlap = cur->end_overlap;
- i--;
- }
- }
- }
- }
-
- /* assemble box using |with_extenders| copies of each extender, with
- appropriate glue wherever an overlap occurs */
- prev_overlap = 0;
- b_max = 0;
- s_max = 0;
- for (cur = ext; cur != NULL; cur = cur->next) {
- if (cur->extender == 0) {
- c = cur->start_overlap;
- if (prev_overlap < c)
- c = prev_overlap;
- d = c;
- if (min_overlap < c)
- c = min_overlap;
- if (d > 0) {
- stack_glue_into_box(b, -d, -c);
- s_max += (-c) - (-d);
- b_max -= d;
- }
- b_max += stack_into_box(b, f, cur->glyph);
- prev_overlap = cur->end_overlap;
- i--;
- } else {
- i = with_extenders;
- while (i > 0) {
- c = cur->start_overlap;
- if (prev_overlap < c)
- c = prev_overlap;
- d = c;
- if (min_overlap < c)
- c = min_overlap;
- if (d > 0) {
- stack_glue_into_box(b, -d, -c);
- s_max += (-c) - (-d);
- b_max -= d;
- }
- b_max += stack_into_box(b, f, cur->glyph);
- prev_overlap = cur->end_overlap;
- i--;
- }
- }
- }
-
- /* set glue so as to stretch the connections if needed */
- d = 0;
- if (v > b_max && s_max > 0) {
- d = v-b_max;
- /* don't stretch more than |s_max| */
- if (d > s_max)
- d = s_max;
- glue_order(b) = normal;
- glue_sign(b) = stretching;
- glue_set(b) = unfloat(d/(float) s_max);
- b_max += d;
- }
-
- if (boxtype == vlist_node)
- height(b) = b_max;
- else
- width(b) = b_max;
-
- return b;
-}
-
-static pointer get_delim_vbox(extinfo * ext, internal_font_number f, scaled v,
- pointer att, int cur_style)
-{
- return get_delim_box(ext, f, v, att, vlist_node, cur_style);
-}
-
-static pointer get_delim_hbox(extinfo * ext, internal_font_number f, scaled v,
- pointer att, int cur_style)
-{
- return get_delim_box(ext, f, v, att, hlist_node, cur_style);
-}
-
-
-
-@ The |var_delimiter| function, which finds or constructs a sufficiently
- large delimiter, is the most interesting of the auxiliary functions that
- currently concern us. Given a pointer |d| to a delimiter field in some noad,
- together with a size code |s| and a vertical distance |v|, this function
- returns a pointer to a box that contains the smallest variant of |d| whose
- height plus depth is |v| or more. (And if no variant is large enough, it
- returns the largest available variant.) In particular, this routine will
- construct arbitrarily large delimiters from extensible components, if
- |d| leads to such characters.
-
- The value returned is a box whose |shift_amount| has been set so that
- the box is vertically centered with respect to the axis in the given size.
- If a built-up symbol is returned, the height of the box before shifting
- will be the height of its topmost component.
-
-@c
-static void endless_loop_error(internal_font_number g, int y)
-{
- char s[256];
- const char *hlp[] = {
- "You managed to create a seemingly endless charlist chain in the current",
- "font. I have counted until 10000 already and still have not escaped, so"
- "I will jump out of the loop all by myself now. Fix your font!",
- NULL
- };
- snprintf(s, 256, "Math error: endless loop in charlist (U+%04x in %s)",
- (int) y, font_name(g));
- tex_error(s, hlp);
-}
-
-static pointer do_var_delimiter(pointer d, int s, scaled v, scaled * ic,
- boolean flat, int cur_style)
-{
- /* label found,continue; */
- pointer b; /* the box that will be constructed */
- internal_font_number f, g; /* best-so-far and tentative font codes */
- int c, i, x, y; /* best-so-far and tentative character codes */
- scaled u; /* height-plus-depth of a tentative character */
- scaled w; /* largest height-plus-depth so far */
- int z; /* runs through font family members */
- boolean large_attempt; /* are we trying the ``large'' variant? */
- pointer att; /* to save the current attribute list */
- boolean do_parts;
- extinfo *ext;
- att = null;
- f = null_font;
- c = 0;
- w = 0;
- do_parts = false;
- large_attempt = false;
- if (d == null)
- goto FOUND;
- z = small_fam(d);
- x = small_char(d);
- i = 0;
- while (true) {
- /* The search process is complicated slightly by the facts that some of the
- characters might not be present in some of the fonts, and they might not
- be probed in increasing order of height. */
- if ((z != 0) || (x != 0)) {
- g = fam_fnt(z, s);
- if (g != null_font) {
- y = x;
- CONTINUE:
- i++;
- if (char_exists(g, y)) {
- if (flat)
- u = char_width(g, y);
- else
- u = height_plus_depth(g, y);
- if (u > w) {
- f = g;
- c = y;
- w = u;
- if (u >= v)
- goto FOUND;
- }
- if (char_tag(g, y) == ext_tag) {
- f = g;
- c = y;
- do_parts = true;
- goto FOUND;
- }
- if (i > 10000) {
- /* endless loop */
- endless_loop_error(g, y);
- goto FOUND;
- }
- if (char_tag(g, y) == list_tag) {
- y = char_remainder(g, y);
- goto CONTINUE;
- }
- }
- }
- }
- if (large_attempt)
- goto FOUND; /* there were none large enough */
- large_attempt = true;
- z = large_fam(d);
- x = large_char(d);
- }
- FOUND:
- if (d != null) {
- att = node_attr(d);
- node_attr(d) = null;
- flush_node(d);
- }
- if (f != null_font) {
- /* When the following code is executed, |do_parts| will be true
- if a built-up symbol is supposed to be returned.
- */
- ext = NULL;
- if ((do_parts) &&
- ((!flat
- && (ext = get_charinfo_vert_variants(char_info(f, c))) != NULL)
- || (flat
- && (ext =
- get_charinfo_hor_variants(char_info(f, c))) != NULL))) {
- b = (flat ? get_delim_hbox(ext, f, v, att, cur_style) :
- get_delim_vbox(ext, f, v, att, cur_style));
- } else {
- b = char_box(f, c, att);
- }
- /* This next test is because for OT MATH fonts, the italic correction of an
- extensible character is only used for the placement of a subscript
- (in negated form), and it is not supposed to be added to the
- width of the character box at all.
-
- This has an effect later on in |make_op| as well, where it has to do
- an extra correction for |make_script|'s addition of yet another italic
- correction.
- */
- if (!is_new_mathfont(f)) {
- width(b) += char_italic(f, c);
- }
- if (ic != NULL)
- *ic = char_italic(f, c);
- } else {
- b = new_null_box();
- reset_attributes(b, att);
- width(b) = (flat ? 0 : null_delimiter_space); /* use this width if no delimiter was found */
- if (ic != NULL)
- *ic = 0;
- }
- if (!flat)
- shift_amount(b) = half(height(b) - depth(b)) - math_axis(s);
- delete_attribute_ref(att);
- return b;
-}
-
-
-static pointer var_delimiter(pointer d, int s, scaled v, scaled * ic,
- int cur_style)
-{
- return do_var_delimiter(d, s, v, ic, false, cur_style);
-}
-
-static pointer flat_delimiter(pointer d, int s, scaled v, int cur_style)
-{
- return do_var_delimiter(d, s, v, NULL, true, cur_style);
-}
-
-@ The next subroutine is much simpler; it is used for numerators and
-denominators of fractions as well as for displayed operators and
-their limits above and below. It takes a given box~|b| and
-changes it so that the new box is centered in a box of width~|w|.
-The centering is done by putting \.{\\hss} glue at the left and right
-of the list inside |b|, then packaging the new box; thus, the
-actual box might not really be centered, if it already contains
-infinite glue.
-
-
-The given box might contain a single character whose italic correction
-has been added to the width of the box; in this case a compensating
-kern is inserted.
-
-@c
-static pointer rebox(pointer b, scaled w)
-{
- pointer p, q, r, att; /* temporary registers for list manipulation */
- internal_font_number f; /* font in a one-character box */
- scaled v; /* width of a character without italic correction */
-
- if ((width(b) != w) && (list_ptr(b) != null)) {
- if (type(b) == vlist_node) {
- p = hpack(b, 0, additional, -1);
- reset_attributes(p, node_attr(b));
- b = p;
- }
- p = list_ptr(b);
- att = node_attr(b);
- add_node_attr_ref(att);
- if ((is_char_node(p)) && (vlink(p) == null)) {
- f = font(p);
- v = char_width(f, character(p));
- if (v != width(b)) {
- q = new_kern(width(b) - v);
- reset_attributes(q, att);
- vlink(p) = q;
- }
- }
- list_ptr(b) = null;
- flush_node(b);
- b = new_glue(ss_glue);
- reset_attributes(b, att);
- vlink(b) = p;
- while (vlink(p) != null)
- p = vlink(p);
- q = new_glue(ss_glue);
- reset_attributes(q, att);
- vlink(p) = q;
- r = hpack(b, w, exactly, -1);
- reset_attributes(r, att);
- delete_attribute_ref(att);
- return r;
- } else {
- width(b) = w;
- return b;
- }
-}
-
-@ Here is a subroutine that creates a new glue specification from another
-one that is expressed in `\.{mu}', given the value of the math unit.
-
-@c
-#define mu_mult(A) mult_and_add(n,(A),xn_over_d((A),f,unity),max_dimen)
-
-static pointer math_glue(pointer g, scaled m)
-{
- pointer p; /* the new glue specification */
- int n; /* integer part of |m| */
- scaled f; /* fraction part of |m| */
- n = x_over_n(m, unity);
- f = tex_remainder;
- if (f < 0) {
- decr(n);
- f = f + unity;
- }
- p = new_node(glue_spec_node, 0);
- width(p) = mu_mult(width(g)); /* convert \.{mu} to \.{pt} */
- stretch_order(p) = stretch_order(g);
- if (stretch_order(p) == normal)
- stretch(p) = mu_mult(stretch(g));
- else
- stretch(p) = stretch(g);
- shrink_order(p) = shrink_order(g);
- if (shrink_order(p) == normal)
- shrink(p) = mu_mult(shrink(g));
- else
- shrink(p) = shrink(g);
- return p;
-}
-
-@ The |math_kern| subroutine removes |mu_glue| from a kern node, given
-the value of the math unit.
-
-@c
-static void math_kern(pointer p, scaled m)
-{
- int n; /* integer part of |m| */
- scaled f; /* fraction part of |m| */
- if (subtype(p) == mu_glue) {
- n = x_over_n(m, unity);
- f = tex_remainder;
- if (f < 0) {
- decr(n);
- f = f + unity;
- }
- width(p) = mu_mult(width(p));
- subtype(p) = explicit;
- }
-}
-
-@ @c
-void run_mlist_to_hlist(halfword p, int mstyle, boolean penalties)
-{
- int callback_id;
- int a, sfix;
- lua_State *L = Luas;
- if (p == null) {
- vlink(temp_head) = null;
- return;
- }
- finalize_math_parameters();
- callback_id = callback_defined(mlist_to_hlist_callback);
- if (callback_id > 0) {
- sfix = lua_gettop(L);
- if (!get_callback(L, callback_id)) {
- lua_settop(L, sfix);
- return;
- }
- nodelist_to_lua(L, p); /* arg 1 */
- lua_pushstring(L, math_style_names[mstyle]); /* arg 2 */
- lua_pushboolean(L, penalties); /* arg 3 */
- if (lua_pcall(L, 3, 1, 0) != 0) { /* 3 args, 1 result */
- fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
- lua_settop(L, sfix);
- error();
- return;
- }
- a = nodelist_from_lua(L);
- lua_settop(L, sfix);
- vlink(temp_head) = a;
- } else if (callback_id == 0) {
- mlist_to_hlist_args(p, mstyle, penalties);
- } else {
- vlink(temp_head) = null;
- }
-}
-
-@ The recursion in |mlist_to_hlist| is due primarily to a subroutine
-called |clean_box| that puts a given noad field into a box using a given
-math style; |mlist_to_hlist| can call |clean_box|, which can call
-|mlist_to_hlist|.
-@^recursion@>
-
-
-The box returned by |clean_box| is ``clean'' in the
-sense that its |shift_amount| is zero.
-
-@c
-static pointer clean_box(pointer p, int s, int cur_style)
-{
- pointer q; /* beginning of a list to be boxed */
- pointer x; /* box to be returned */
- pointer r; /* temporary pointer */
- pointer mlist = null; /* beginning of mlist to be translated */
- switch (type(p)) {
- case math_char_node:
- mlist = new_noad();
- r = math_clone(p);
- nucleus(mlist) = r;
- break;
- case sub_box_node:
- q = math_list(p);
- goto FOUND;
- break;
- case sub_mlist_node:
- mlist = math_list(p);
- break;
- default:
- q = new_null_box();
- goto FOUND;
- }
- mlist_to_hlist_args(mlist, s, false);
- q = vlink(temp_head); /* recursive call */
- setup_cur_size(cur_style);
- FOUND:
- if (is_char_node(q) || (q == null))
- x = hpack(q, 0, additional, -1);
- else if ((vlink(q) == null) && (type(q) <= vlist_node)
- && (shift_amount(q) == 0))
- x = q; /* it's already clean */
- else
- x = hpack(q, 0, additional, -1);
- if (x != q && q != null)
- reset_attributes(x, node_attr(q));
- /* Here we save memory space in a common case. */
- q = list_ptr(x);
- if (is_char_node(q)) {
- r = vlink(q);
- if (r != null) {
- if (vlink(r) == null) {
- if (!is_char_node(r)) {
- if (type(r) == kern_node) {
- /* unneeded italic correction */
- flush_node(r);
- vlink(q) = null;
- }
- }
- }
- }
- }
- return x;
-}
-
-@ It is convenient to have a procedure that converts a |math_char|
-field to an ``unpacked'' form. The |fetch| routine sets |cur_f| and |cur_c|
-to the font code and character code of a given noad field.
-It also takes care of issuing error messages for
-nonexistent characters; in such cases, |char_exists(cur_f,cur_c)| will be |false|
-after |fetch| has acted, and the field will also have been reset to |null|.
-
-The outputs of |fetch| are placed in global variables.
-
-@c
-internal_font_number cur_f; /* the |font| field of a |math_char| */
-int cur_c; /* the |character| field of a |math_char| */
-
-static void fetch(pointer a)
-{ /* unpack the |math_char| field |a| */
- cur_c = math_character(a);
- cur_f = fam_fnt(math_fam(a), cur_size);
- if (cur_f == null_font) {
- char *msg;
- const char *hlp[] = {
- "Somewhere in the math formula just ended, you used the",
- "stated character from an undefined font family. For example,",
- "plain TeX doesn't allow \\it or \\sl in subscripts. Proceed,",
- "and I'll try to forget that I needed that character.",
- NULL
- };
- msg = xmalloc(256);
- snprintf(msg, 255, "\\%s%d is undefined (character %d)",
- math_size_string(cur_size), (int) math_fam(a), (int) cur_c);
- tex_error(msg, hlp);
- free(msg);
- } else {
- if (!(char_exists(cur_f, cur_c))) {
- char_warning(cur_f, cur_c);
- }
- }
-}
-
-
-@ We need to do a lot of different things, so |mlist_to_hlist| makes two
-passes over the given mlist.
-
-The first pass does most of the processing: It removes ``mu'' spacing from
-glue, it recursively evaluates all subsidiary mlists so that only the
-top-level mlist remains to be handled, it puts fractions and square roots
-and such things into boxes, it attaches subscripts and superscripts, and
-it computes the overall height and depth of the top-level mlist so that
-the size of delimiters for a |fence_noad| will be known.
-The hlist resulting from each noad is recorded in that noad's |new_hlist|
-field, an integer field that replaces the |nucleus| or |thickness|.
-@^recursion@>
-
-The second pass eliminates all noads and inserts the correct glue and
-penalties between nodes.
-
-@c
-static void assign_new_hlist(pointer q, pointer r)
-{
- switch (type(q)) {
- case fraction_noad:
- math_list(numerator(q)) = null;
- flush_node(numerator(q));
- numerator(q) = null;
- math_list(denominator(q)) = null;
- flush_node(denominator(q));
- denominator(q) = null;
- break;
- case radical_noad:
- case simple_noad:
- case accent_noad:
- if (nucleus(q) != null) {
- math_list(nucleus(q)) = null;
- flush_node(nucleus(q));
- nucleus(q) = null;
- }
- break;
- }
- new_hlist(q) = r;
-}
-
-@ @c
-#define choose_mlist(A) do { p=A(q); A(q)=null; } while (0)
-
-
-@ Most of the actual construction work of |mlist_to_hlist| is done
-by procedures with names
-like |make_fraction|, |make_radical|, etc. To illustrate
-the general setup of such procedures, let's begin with a couple of
-simple ones.
-
-@c
-static void make_over(pointer q, int cur_style)
-{
- pointer p;
- p = overbar(clean_box(nucleus(q), cramped_style(cur_style), cur_style),
- overbar_vgap(cur_style),
- overbar_rule(cur_style),
- overbar_kern(cur_style), node_attr(nucleus(q)));
- math_list(nucleus(q)) = p;
- type(nucleus(q)) = sub_box_node;
-}
-
-static void make_under(pointer q, int cur_style)
-{
- pointer p, x, y, r; /* temporary registers for box construction */
- scaled delta; /* overall height plus depth */
- x = clean_box(nucleus(q), cur_style, cur_style);
- p = new_kern(underbar_vgap(cur_style));
- reset_attributes(p, node_attr(q));
- vlink(x) = p;
- r = do_fraction_rule(underbar_rule(cur_style), node_attr(q));
- vlink(p) = r;
- y = vpackage(x, 0, additional, max_dimen, math_direction);
- reset_attributes(y, node_attr(q));
- delta = height(y) + depth(y) + underbar_kern(cur_style);
- height(y) = height(x);
- depth(y) = delta - height(y);
- math_list(nucleus(q)) = y;
- type(nucleus(q)) = sub_box_node;
-}
-
-static void make_vcenter(pointer q)
-{
- pointer v; /* the box that should be centered vertically */
- scaled delta; /* its height plus depth */
- v = math_list(nucleus(q));
- if (type(v) != vlist_node)
- confusion("vcenter"); /* this can't happen vcenter */
- delta = height(v) + depth(v);
- height(v) = math_axis(cur_size) + half(delta);
- depth(v) = delta - height(v);
-}
-
-@ According to the rules in the \.{DVI} file specifications, we ensure alignment
-@^square roots@>
-between a square root sign and the rule above its nucleus by assuming that the
-baseline of the square-root symbol is the same as the bottom of the rule. The
-height of the square-root symbol will be the thickness of the rule, and the
-depth of the square-root symbol should exceed or equal the height-plus-depth
-of the nucleus plus a certain minimum clearance~|psi|. The symbol will be
-placed so that the actual clearance is |psi| plus half the excess.
-
-@c
-static void make_radical(pointer q, int cur_style)
-{
- pointer x, y, p; /* temporary registers for box construction */
- scaled delta, clr, theta, h; /* dimensions involved in the calculation */
- x = clean_box(nucleus(q), cramped_style(cur_style), cur_style);
- clr = radical_vgap(cur_style);
- theta = radical_rule(cur_style);
- if (theta == undefined_math_parameter) {
- theta = fraction_rule(cur_style);
- y = var_delimiter(left_delimiter(q), cur_size,
- height(x) + depth(x) + clr + theta, NULL, cur_style);
- /* If |y| is a composite then set |theta| to the height of its top
- character, else set it to the height of |y|. */
- if (list_ptr(y) != null
- && type(list_ptr(y)) == hlist_node
- && list_ptr(list_ptr(y)) != null
- && type(list_ptr(list_ptr(y))) == glyph_node) { /* and it should be */
- theta = char_height(font(list_ptr(list_ptr(y))),
- character(list_ptr(list_ptr(y))));
- } else {
- theta = height(y);
- }
- } else {
- y = var_delimiter(left_delimiter(q), cur_size,
- height(x) + depth(x) + clr + theta, NULL, cur_style);
- }
- left_delimiter(q) = null;
- delta = (depth(y) + height(y) - theta) - (height(x) + depth(x) + clr);
- if (delta > 0)
- clr = clr + half(delta); /* increase the actual clearance */
- shift_amount(y) = (height(y) - theta) - (height(x) + clr);
- h = depth(y) + height(y);
- p = overbar(x, clr, theta, radical_kern(cur_style), node_attr(y));
- vlink(y) = p;
- if (degree(q) != null) {
- scaled wr, br, ar;
- pointer r = clean_box(degree(q), script_script_style, cur_style);
- reset_attributes(r, node_attr(degree(q)));
- wr = width(r);
- if (wr == 0) {
- flush_node(r);
- } else {
- br = radical_degree_before(cur_style);
- ar = radical_degree_after(cur_style);
- if (-ar > (wr + br))
- ar = -(wr + br);
- x = new_kern(ar);
- reset_attributes(x, node_attr(degree(q)));
- vlink(x) = y;
- shift_amount(r) =
- -((xn_over_d(h, radical_degree_raise(cur_style), 100)) -
- depth(y) - shift_amount(y));
- vlink(r) = x;
- x = new_kern(br);
- reset_attributes(x, node_attr(degree(q)));
- vlink(x) = r;
- y = x;
- }
- math_list(degree(q)) = null; /* for \.{\\Uroot ..{<list>}{}} */
- flush_node(degree(q));
- }
- p = hpack(y, 0, additional, -1);
- reset_attributes(p, node_attr(q));
- math_list(nucleus(q)) = p;
- type(nucleus(q)) = sub_box_node;
-}
-
-
-@ Construct a vlist box
-@c
-static pointer
-wrapup_delimiter(pointer x, pointer y, pointer q,
- scaled shift_up, scaled shift_down)
-{
- pointer p; /* temporary register for box construction */
- pointer v = new_null_box();
- type(v) = vlist_node;
- height(v) = shift_up + height(x);
- depth(v) = depth(y) + shift_down;
- reset_attributes(v, node_attr(q));
- p = new_kern((shift_up - depth(x)) - (height(y) - shift_down));
- reset_attributes(p, node_attr(q));
- vlink(p) = y;
- vlink(x) = p;
- list_ptr(v) = x;
- return v;
-}
-
-@ @c
-#define fixup_widths(x,y) do { \
- if (width(y) >= width(x)) { \
- width(x) = width(y); \
- } else { \
- width(y) = width(x); \
- } \
- } while (0)
-
-@ this has the |nucleus| box |x| as a limit above an extensible delimiter |y|
-
-@c
-static void make_over_delimiter(pointer q, int cur_style)
-{
- pointer x, y, v; /* temporary registers for box construction */
- scaled shift_up, shift_down, clr, delta;
- x = clean_box(nucleus(q), sub_style(cur_style), cur_style);
- y = flat_delimiter(left_delimiter(q), cur_size, width(x), cur_style);
- left_delimiter(q) = null;
- fixup_widths(x, y);
- shift_up = over_delimiter_bgap(cur_style);
- shift_down = 0;
- clr = over_delimiter_vgap(cur_style);
- delta = clr - ((shift_up - depth(x)) - (height(y) - shift_down));
- if (delta > 0) {
- shift_up = shift_up + delta;
- }
- v = wrapup_delimiter(x, y, q, shift_up, shift_down);
- width(v) = width(x); /* this also equals |width(y)| */
- math_list(nucleus(q)) = v;
- type(nucleus(q)) = sub_box_node;
-}
-
-@ this has the extensible delimiter |x| as a limit above |nucleus| box |y|
-
-@c
-static void make_delimiter_over(pointer q, int cur_style)
-{
- pointer x, y, v; /* temporary registers for box construction */
- scaled shift_up, shift_down, clr, actual;
- y = clean_box(nucleus(q), cur_style, cur_style);
- x = flat_delimiter(left_delimiter(q),
- cur_size + (cur_size == script_script_size ? 0 : 1),
- width(y), cur_style);
- left_delimiter(q) = null;
- fixup_widths(x, y);
- shift_up = over_delimiter_bgap(cur_style)-height(x)-depth(x);
- shift_down = 0;
- clr = over_delimiter_vgap(cur_style);
- actual = shift_up - height(y);
- if (actual < clr) {
- shift_up = shift_up + (clr-actual);
- }
- v = wrapup_delimiter(x, y, q, shift_up, shift_down);
- width(v) = width(x); /* this also equals |width(y)| */
- math_list(nucleus(q)) = v;
- type(nucleus(q)) = sub_box_node;
-}
-
-
-@ this has the extensible delimiter |y| as a limit below a |nucleus| box |x|
-
-@c
-static void make_delimiter_under(pointer q, int cur_style)
-{
- pointer x, y, v; /* temporary registers for box construction */
- scaled shift_up, shift_down, clr, actual;
- x = clean_box(nucleus(q), cur_style, cur_style);
- y = flat_delimiter(left_delimiter(q),
- cur_size + (cur_size == script_script_size ? 0 : 1),
- width(x), cur_style);
- left_delimiter(q) = null;
- fixup_widths(x, y);
- shift_up = 0;
- shift_down = under_delimiter_bgap(cur_style) - height(y)-depth(y);
- clr = under_delimiter_vgap(cur_style);
- actual = shift_down - depth(x);
- if (actual<clr) {
- shift_down += (clr-actual);
- }
- v = wrapup_delimiter(x, y, q, shift_up, shift_down);
- width(v) = width(y); /* this also equals |width(y)| */
- math_list(nucleus(q)) = v;
- type(nucleus(q)) = sub_box_node;
-
-}
-
-@ this has the extensible delimiter |x| as a limit below |nucleus| box |y|
-
-@c
-static void make_under_delimiter(pointer q, int cur_style)
-{
- pointer x, y, v; /* temporary registers for box construction */
- scaled shift_up, shift_down, clr, delta;
- y = clean_box(nucleus(q), sup_style(cur_style), cur_style);
- x = flat_delimiter(left_delimiter(q), cur_size, width(y), cur_style);
- left_delimiter(q) = null;
- fixup_widths(x, y);
- shift_up = 0;
- shift_down = under_delimiter_bgap(cur_style);
- clr = under_delimiter_vgap(cur_style);
- delta = clr - ((shift_up - depth(x)) - (height(y) - shift_down));
- if (delta > 0) {
- shift_down = shift_down + delta;
- }
- v = wrapup_delimiter(x, y, q, shift_up, shift_down);
- width(v) = width(y); /* this also equals |width(y)| */
- math_list(nucleus(q)) = v;
- type(nucleus(q)) = sub_box_node;
-
-}
-
-
-@ Slants are not considered when placing accents in math mode. The accenter is
-centered over the accentee, and the accent width is treated as zero with
-respect to the size of the final box.
-
-@c
-#define TOP_CODE 1
-#define BOT_CODE 2
-#define TOP_OR_BOT_MASK ((TOP_CODE) | (BOT_CODE))
-#define STRETCH_ACCENT_CODE 4
-
-static boolean compute_accent_skew(pointer q, int top_or_bot, scaled *s)
-{
- pointer p; /* temporary register for box construction */
- boolean s_is_absolute; /* will be true if a top-accent is placed in |s| */
-
- s_is_absolute = false;
-
- if (type(nucleus(q)) == math_char_node) {
- fetch(nucleus(q));
- if (is_new_mathfont(cur_f)) {
- if (top_or_bot == TOP_CODE) {
- *s = char_top_accent(cur_f, cur_c);
- if (*s != INT_MIN) {
- s_is_absolute = true;
- }
- } else {
- *s = char_bot_accent(cur_f, cur_c);
- if (*s != INT_MIN) {
- s_is_absolute = true;
- }
- }
- } else {
- if (top_or_bot == TOP_CODE) {
- *s = get_kern(cur_f, cur_c, skew_char(cur_f));
- } else {
- *s = 0;
- }
- }
- } else if (type(nucleus(q)) == sub_mlist_node) {
- /* if |nucleus(q)| is a |sub_mlist_node| composed of an |accent_noad| we
- * use the positioning of the nucleus of that noad, recursing until
- * the inner most |accent_noad|. This way multiple stacked accents are
- * aligned to the inner most one. */
- p = math_list(nucleus(q));
- if (type(p) == accent_noad) {
- s_is_absolute = compute_accent_skew(p, top_or_bot, s);
- }
- }
-
- return s_is_absolute;
-}
-
-static void do_make_math_accent(pointer q, internal_font_number f, int c,
- int flags, int cur_style)
-{
- pointer p, r, x, y; /* temporary registers for box construction */
- scaled s; /* amount to skew the accent to the right */
- scaled h; /* height of character being accented */
- scaled delta; /* space to remove between accent and accentee */
- scaled w; /* width of the accentee, not including sub/superscripts */
- boolean s_is_absolute; /* will be true if a top-accent is placed in |s| */
- extinfo *ext;
- pointer attr_p;
- const int top_or_bot = flags & TOP_OR_BOT_MASK;
- attr_p = (top_or_bot == TOP_CODE ? accent_chr(q) : bot_accent_chr(q));
- c = cur_c;
- f = cur_f;
-
- s = 0;
- s_is_absolute = false;
- /* Compute the amount of skew, or set |s| to an alignment point */
- s_is_absolute = compute_accent_skew(q, top_or_bot, &s);
-
- x = clean_box(nucleus(q), cramped_style(cur_style), cur_style);
- w = width(x);
- h = height(x);
- if (is_new_mathfont(cur_f) && !s_is_absolute) {
- s = half(w);
- s_is_absolute = true;
- }
- /* Switch to a larger accent if available and appropriate */
- y = null;
- ext = NULL;
- if ((flags & STRETCH_ACCENT_CODE) && (char_width(f, c) < w)) {
- while (1) {
- if ((char_tag(f, c) == ext_tag) &&
- ((ext = get_charinfo_hor_variants(char_info(f, c))) != NULL)) {
- y = get_delim_hbox(ext, f, w, node_attr(attr_p), cur_style);
- break;
- } else if (char_tag(f, c) != list_tag) {
- break;
- } else {
- int yy = char_remainder(f, c);
- if (!char_exists(f, yy))
- break;
- if (char_width(f, yy) > w)
- break;
- c = yy;
- }
- }
- }
- if (y == null) {
- y = char_box(f, c, node_attr(attr_p));
- }
- if (top_or_bot == TOP_CODE) {
- if (h < accent_base_height(f))
- delta = h;
- else
- delta = accent_base_height(f);
- } else {
- delta = 0; /* hm */
- }
- if ((supscr(q) != null) || (subscr(q) != null)) {
- if (type(nucleus(q)) == math_char_node) {
- /* Swap the subscript and superscript into box |x| */
- flush_node_list(x);
- x = new_noad();
- r = math_clone(nucleus(q));
- nucleus(x) = r;
- supscr(x) = supscr(q);
- supscr(q) = null;
- subscr(x) = subscr(q);
- subscr(q) = null;
- type(nucleus(q)) = sub_mlist_node;
- math_list(nucleus(q)) = x;
- x = clean_box(nucleus(q), cur_style, cur_style);
- delta = delta + height(x) - h;
- h = height(x);
- }
- }
- if (s_is_absolute) {
- scaled sa;
- if (ext != NULL) {
- sa = half(width(y)); /* if the accent is extensible just take the center */
- } else {
- sa = char_top_accent(f, c);
- }
- if (sa == INT_MIN) {
- sa = half(width(y)); /* just take the center */
- }
- shift_amount(y) = s - sa;
- } else {
- if (width(y)== 0) {
- shift_amount(y) = s + w;
- } else {
- shift_amount(y) = s + half(w - width(y));
- }
- }
- width(y) = 0;
- if (top_or_bot == TOP_CODE) {
- p = new_kern(-delta);
- vlink(p) = x;
- vlink(y) = p;
- } else {
-#if 0
- p = new_kern(-delta);
- vlink(x) = p;
- vlink(p) = y;
- y = x;
-#endif
- vlink(x) = y;
- y = x;
- }
- r = vpackage(y, 0, additional, max_dimen, math_direction);
- reset_attributes(r, node_attr(q));
- width(r) = width(x);
- y = r;
- if (top_or_bot == TOP_CODE) {
- if (height(y) < h) {
- /* Make the height of box |y| equal to |h| */
- p = new_kern(h - height(y));
- reset_attributes(p, node_attr(q));
- vlink(p) = list_ptr(y);
- list_ptr(y) = p;
- height(y) = h;
- }
- } else {
- shift_amount(y) = -(h - height(y));
- }
- math_list(nucleus(q)) = y;
- type(nucleus(q)) = sub_box_node;
-}
-
-static void make_math_accent(pointer q, int cur_style)
-{
- int topstretch = !(subtype(q) % 2);
- int botstretch = !(subtype(q) / 2);
-
- if (accent_chr(q) != null) {
- fetch(accent_chr(q));
- if (char_exists(cur_f, cur_c)) {
- do_make_math_accent(q, cur_f, cur_c, TOP_CODE | (topstretch ? STRETCH_ACCENT_CODE : 0), cur_style);
- }
- flush_node(accent_chr(q));
- accent_chr(q) = null;
- }
- if (bot_accent_chr(q) != null) {
- fetch(bot_accent_chr(q));
- if (char_exists(cur_f, cur_c)) {
- do_make_math_accent(q, cur_f, cur_c, BOT_CODE | (botstretch ? STRETCH_ACCENT_CODE : 0), cur_style);
- }
- flush_node(bot_accent_chr(q));
- bot_accent_chr(q) = null;
- }
-}
-
-@ The |make_fraction| procedure is a bit different because it sets
-|new_hlist(q)| directly rather than making a sub-box.
-
-@c
-static void make_fraction(pointer q, int cur_style)
-{
- pointer p, v, x, y, z; /* temporary registers for box construction */
- scaled delta, delta1, delta2, shift_up, shift_down, clr;
- /* dimensions for box calculations */
- if (thickness(q) == default_code)
- thickness(q) = fraction_rule(cur_style);
- /* Create equal-width boxes |x| and |z| for the numerator and denominator,
- and compute the default amounts |shift_up| and |shift_down| by which they
- are displaced from the baseline */
- x = clean_box(numerator(q), num_style(cur_style), cur_style);
- z = clean_box(denominator(q), denom_style(cur_style), cur_style);
- if (width(x) < width(z))
- x = rebox(x, width(z));
- else
- z = rebox(z, width(x));
- if (thickness(q) == 0) {
- shift_up = stack_num_up(cur_style);
- shift_down = stack_denom_down(cur_style);
- /* The numerator and denominator must be separated by a certain minimum
- clearance, called |clr| in the following program. The difference between
- |clr| and the actual clearance is |2delta|. */
- clr = stack_vgap(cur_style);
- delta = half(clr - ((shift_up - depth(x)) - (height(z) - shift_down)));
- if (delta > 0) {
- shift_up = shift_up + delta;
- shift_down = shift_down + delta;
- }
- } else {
- shift_up = fraction_num_up(cur_style);
- shift_down = fraction_denom_down(cur_style);
- /* In the case of a fraction line, the minimum clearance depends on the actual
- thickness of the line. */
- delta = half(thickness(q));
- clr = fraction_num_vgap(cur_style);
- clr = ext_xn_over_d(clr, thickness(q), fraction_rule(cur_style));
- delta1 = clr - ((shift_up - depth(x)) - (math_axis(cur_size) + delta));
- if (delta1 > 0)
- shift_up = shift_up + delta1;
- clr = fraction_denom_vgap(cur_style);
- clr = ext_xn_over_d(clr, thickness(q), fraction_rule(cur_style));
- delta2 =
- clr - ((math_axis(cur_size) - delta) - (height(z) - shift_down));
- if (delta2 > 0)
- shift_down = shift_down + delta2;
- }
- /* Construct a vlist box for the fraction, according to |shift_up| and |shift_down| */
- v = new_null_box();
- type(v) = vlist_node;
- height(v) = shift_up + height(x);
- depth(v) = depth(z) + shift_down;
- width(v) = width(x); /* this also equals |width(z)| */
- reset_attributes(v, node_attr(q));
- if (thickness(q) == 0) {
- p = new_kern((shift_up - depth(x)) - (height(z) - shift_down));
- vlink(p) = z;
- } else {
- y = do_fraction_rule(thickness(q), node_attr(q));
- p = new_kern((math_axis(cur_size) - delta) - (height(z) - shift_down));
- reset_attributes(p, node_attr(q));
- vlink(y) = p;
- vlink(p) = z;
- p = new_kern((shift_up - depth(x)) - (math_axis(cur_size) + delta));
- vlink(p) = y;
- }
- reset_attributes(p, node_attr(q));
- vlink(x) = p;
- list_ptr(v) = x;
- /* Put the fraction into a box with its delimiters, and make |new_hlist(q)|
- point to it */
- delta = fraction_del_size(cur_style);
- x = var_delimiter(left_delimiter(q), cur_size, delta, NULL, cur_style);
- left_delimiter(q) = null;
- vlink(x) = v;
- z = var_delimiter(right_delimiter(q), cur_size, delta, NULL, cur_style);
- right_delimiter(q) = null;
- vlink(v) = z;
- y = hpack(x, 0, additional, -1);
- reset_attributes(y, node_attr(q));
- assign_new_hlist(q, y);
-}
-
-
-@ If the nucleus of an |op_noad| is a single character, it is to be
-centered vertically with respect to the axis, after first being enlarged
-(via a character list in the font) if we are in display style. The normal
-convention for placing displayed limits is to put them above and below the
-operator in display style.
-
-The italic correction is removed from the character if there is a subscript
-and the limits are not being displayed. The |make_op|
-routine returns the value that should be used as an offset between
-subscript and superscript.
-
-After |make_op| has acted, |subtype(q)| will be |limits| if and only if
-the limits have been set above and below the operator. In that case,
-|new_hlist(q)| will already contain the desired final box.
-
-@c
-static scaled make_op(pointer q, int cur_style)
-{
- scaled delta; /* offset between subscript and superscript */
- pointer p, v, x, y, z; /* temporary registers for box construction */
- int c; /* register for character examination */
- scaled shift_up, shift_down; /* dimensions for box calculation */
- scaled ok_size;
- if ((subtype(q) == op_noad_type_normal) && (cur_style < text_style))
- subtype(q) = op_noad_type_limits;
- if (type(nucleus(q)) == math_char_node) {
- fetch(nucleus(q));
- if (cur_style < text_style) { /* try to make it larger */
- ok_size = minimum_operator_size(cur_style);
- if (ok_size != undefined_math_parameter) {
- /* creating a temporary delimiter is the cleanest way */
- y = new_node(delim_node, 0);
- small_fam(y) = math_fam(nucleus(q));
- small_char(y) = math_character(nucleus(q));
- x = var_delimiter(y, text_size, ok_size, &delta, cur_style);
- if ((subscr(q) != null) && (subtype(q) != op_noad_type_limits)) {
- width(x) -= delta; /* remove italic correction */
- }
- /* For an OT MATH font, we may have to get rid of yet another italic
- correction because |make_scripts()| will add one.
- This test is somewhat more complicated because |x| can be a null
- delimiter */
- if ((subscr(q) != null || supscr(q) != null)
- && (subtype(q) != op_noad_type_limits)
- && ((list_ptr(x) != null)
- && (type(list_ptr(x)) == glyph_node)
- && is_new_mathfont(font(list_ptr(x))))) {
- width(x) -= delta; /* remove another italic correction */
- }
- } else {
- ok_size = height_plus_depth(cur_f, cur_c) + 1;
- while ((char_tag(cur_f, cur_c) == list_tag) &&
- height_plus_depth(cur_f, cur_c) < ok_size) {
- c = char_remainder(cur_f, cur_c);
- if (!char_exists(cur_f, c))
- break;
- cur_c = c;
- math_character(nucleus(q)) = c;
- }
- delta = char_italic(cur_f, cur_c);
- x = clean_box(nucleus(q), cur_style, cur_style);
- if ((subscr(q) != null) && (subtype(q) != op_noad_type_limits))
- width(x) = width(x) - delta; /* remove italic correction */
-
- shift_amount(x) =
- half(height(x) - depth(x)) - math_axis(cur_size);
- /* center vertically */
- }
- type(nucleus(q)) = sub_box_node;
- math_list(nucleus(q)) = x;
-
- } else { /* normal size */
- delta = char_italic(cur_f, cur_c);
- x = clean_box(nucleus(q), cur_style, cur_style);
- if ((subscr(q) != null) && (subtype(q) != op_noad_type_limits))
- width(x) = width(x) - delta; /* remove italic correction */
-
- /* For an OT MATH font, we may have to get rid of yet another italic
- correction because |make_scripts()| will add one.
- This test is somewhat more complicated because |x| can be a null
- delimiter */
- if ((subscr(q) != null || supscr(q) != null)
- && (subtype(q) != op_noad_type_limits)
- && ((list_ptr(x) != null)
- && (type(list_ptr(x)) == glyph_node)
- && is_new_mathfont(font(list_ptr(x))))) {
- width(x) -= delta; /* remove another italic correction */
- }
-
- shift_amount(x) = half(height(x) - depth(x)) - math_axis(cur_size);
- /* center vertically */
- type(nucleus(q)) = sub_box_node;
- math_list(nucleus(q)) = x;
- }
- } else {
- delta = 0;
- }
- if (subtype(q) == op_noad_type_limits) {
- /* The following program builds a vlist box |v| for displayed limits. The
- width of the box is not affected by the fact that the limits may be skewed. */
- x = clean_box(supscr(q), sup_style(cur_style), cur_style);
- y = clean_box(nucleus(q), cur_style, cur_style);
- z = clean_box(subscr(q), sub_style(cur_style), cur_style);
- v = new_null_box();
- reset_attributes(v, node_attr(q));
- type(v) = vlist_node;
- width(v) = width(y);
- if (width(x) > width(v))
- width(v) = width(x);
- if (width(z) > width(v))
- width(v) = width(z);
- x = rebox(x, width(v));
- y = rebox(y, width(v));
- z = rebox(z, width(v));
- shift_amount(x) = half(delta);
- shift_amount(z) = -shift_amount(x);
- height(v) = height(y);
- depth(v) = depth(y);
- /* Attach the limits to |y| and adjust |height(v)|, |depth(v)| to
- account for their presence */
- /* We use |shift_up| and |shift_down| in the following program for the
- amount of glue between the displayed operator |y| and its limits |x| and
- |z|. The vlist inside box |v| will consist of |x| followed by |y| followed
- by |z|, with kern nodes for the spaces between and around them. */
- if (supscr(q) == null) {
- list_ptr(x) = null;
- flush_node(x);
- list_ptr(v) = y;
- } else {
- shift_up = limit_above_bgap(cur_style) - depth(x);
- if (shift_up < limit_above_vgap(cur_style))
- shift_up = limit_above_vgap(cur_style);
- p = new_kern(shift_up);
- reset_attributes(p, node_attr(q));
- vlink(p) = y;
- vlink(x) = p;
- p = new_kern(limit_above_kern(cur_style));
- reset_attributes(p, node_attr(q));
- vlink(p) = x;
- list_ptr(v) = p;
- height(v) =
- height(v) + limit_above_kern(cur_style) + height(x) + depth(x) +
- shift_up;
- }
- if (subscr(q) == null) {
- list_ptr(z) = null;
- flush_node(z);
- } else {
- shift_down = limit_below_bgap(cur_style) - height(z);
- if (shift_down < limit_below_vgap(cur_style))
- shift_down = limit_below_vgap(cur_style);
- p = new_kern(shift_down);
- reset_attributes(p, node_attr(q));
- vlink(y) = p;
- vlink(p) = z;
- p = new_kern(limit_below_kern(cur_style));
- reset_attributes(p, node_attr(q));
- vlink(z) = p;
- depth(v) =
- depth(v) + limit_below_kern(cur_style) + height(z) + depth(z) +
- shift_down;
- }
- if (subscr(q) != null) {
- math_list(subscr(q)) = null;
- flush_node(subscr(q));
- subscr(q) = null;
- }
- if (supscr(q) != null) {
- math_list(supscr(q)) = null;
- flush_node(supscr(q));
- supscr(q) = null;
- }
- assign_new_hlist(q, v);
- }
- return delta;
-}
-
-@ A ligature found in a math formula does not create a ligature, because
-there is no question of hyphenation afterwards; the ligature will simply be
-stored in an ordinary |glyph_node|, after residing in an |ord_noad|.
-
-The |type| is converted to |math_text_char| here if we would not want to
-apply an italic correction to the current character unless it belongs
-to a math font (i.e., a font with |space=0|).
-
-No boundary characters enter into these ligatures.
-
-@c
-static void make_ord(pointer q)
-{
- int a; /* the left-side character for lig/kern testing */
- pointer p, r, s; /* temporary registers for list manipulation */
- scaled k; /* a kern */
- liginfo lig; /* a ligature */
- RESTART:
- if (subscr(q) == null &&
- supscr(q) == null && type(nucleus(q)) == math_char_node) {
- p = vlink(q);
- if ((p != null) &&
- (type(p) == simple_noad) &&
- (subtype(p) <= punct_noad_type) &&
- (type(nucleus(p)) == math_char_node) &&
- (math_fam(nucleus(p)) == math_fam(nucleus(q)))) {
- type(nucleus(q)) = math_text_char_node;
- fetch(nucleus(q));
- a = cur_c;
- if ((has_kern(cur_f, a)) || (has_lig(cur_f, a))) {
- cur_c = math_character(nucleus(p));
- /* If character |a| has a kern with |cur_c|, attach
- the kern after~|q|; or if it has a ligature with |cur_c|, combine
- noads |q| and~|p| appropriately; then |return| if the cursor has
- moved past a noad, or |goto restart| */
-
- /* Note that a ligature between an |ord_noad| and another kind of noad
- is replaced by an |ord_noad|, when the two noads collapse into one.
- But we could make a parenthesis (say) change shape when it follows
- certain letters. Presumably a font designer will define such
- ligatures only when this convention makes sense. */
-
- if (disable_lig == 0 && has_lig(cur_f, a)) {
- lig = get_ligature(cur_f, a, cur_c);
- if (is_valid_ligature(lig)) {
- check_interrupt(); /* allow a way out of infinite ligature loop */
- switch (lig_type(lig)) {
- case 1:
- case 5:
- math_character(nucleus(q)) = lig_replacement(lig); /* \.{=:\char`\|}, \.{=:\char`\|>} */
- break;
- case 2:
- case 6:
- math_character(nucleus(p)) = lig_replacement(lig); /* \.{\char`\|=:}, \.{\char`\|=:>} */
- break;
- case 3:
- case 7:
- case 11:
- r = new_noad(); /* \.{\char`\|=:\char`\|}, \.{\char`\|=:\char`\|>}, \.{\char`\|=:\char`\|>>} */
- reset_attributes(r, node_attr(q));
- s = new_node(math_char_node, 0);
- reset_attributes(s, node_attr(q));
- nucleus(r) = s;
- math_character(nucleus(r)) = lig_replacement(lig);
- math_fam(nucleus(r)) = math_fam(nucleus(q));
- vlink(q) = r;
- vlink(r) = p;
- if (lig_type(lig) < 11)
- type(nucleus(r)) = math_char_node;
- else
- type(nucleus(r)) = math_text_char_node; /* prevent combination */
- break;
- default:
- vlink(q) = vlink(p);
- math_character(nucleus(q)) = lig_replacement(lig); /* \.{=:} */
- s = math_clone(subscr(p));
- subscr(q) = s;
- s = math_clone(supscr(p));
- supscr(q) = s;
- math_reset(subscr(p)); /* just in case */
- math_reset(supscr(p));
- flush_node(p);
- break;
- }
- if (lig_type(lig) > 3)
- return;
- type(nucleus(q)) = math_char_node;
- goto RESTART;
- }
- }
- if (disable_kern == 0 && has_kern(cur_f, a)) {
- k = get_kern(cur_f, a, cur_c); /* todo: should this use mathkerns? */
- if (k != 0) {
- p = new_kern(k);
- reset_attributes(p, node_attr(q));
- vlink(p) = vlink(q);
- vlink(q) = p;
- return;
- }
- }
- }
- }
- }
-}
-
-@ If the fonts for the left and right bits of a mathkern are not
-both new-style fonts, then return a sentinel value meaning:
-please use old-style italic correction placement
-
-@c
-#define MATH_KERN_NOT_FOUND 0x7FFFFFFF
-
-@ This function tries to find the kern needed for proper cut-ins.
- The left side doesn't move, but the right side does, so the first
- order of business is to create a staggered fence line on the
- left side of the right character.
-
- The microsoft spec says that there are four quadrants, but the
- actual images say
-
-@c
-static scaled math_kern_at(internal_font_number f, int c, int side, int v)
-{
- int h, k, numkerns;
- scaled *kerns_heights;
- scaled kern = 0;
- charinfo *co = char_info(f, c); /* known to exist */
- numkerns = get_charinfo_math_kerns(co, side);
-#ifdef DEBUG
- fprintf(stderr, " entries = %d, height = %d\n", numkerns, v);
-#endif
- if (numkerns == 0)
- return kern;
- if (side == top_left_kern) {
- kerns_heights = co->top_left_math_kern_array;
- } else if (side == bottom_left_kern) {
- kerns_heights = co->bottom_left_math_kern_array;
- } else if (side == top_right_kern) {
- kerns_heights = co->top_right_math_kern_array;
- } else if (side == bottom_right_kern) {
- kerns_heights = co->bottom_right_math_kern_array;
- } else {
- confusion("math_kern_at");
- kerns_heights = NULL; /* not reached */
- }
-#ifdef DEBUG
- fprintf(stderr, " entry 0: %d,%d\n", kerns_heights[0], kerns_heights[1]);
-#endif
- if (v < kerns_heights[0])
- return kerns_heights[1];
- for (k = 0; k < numkerns; k++) {
- h = kerns_heights[(k * 2)];
- kern = kerns_heights[(k * 2) + 1];
-#ifdef DEBUG
- if (k > 0)
- fprintf(stderr, " entry %d: %d,%d\n", k, h, kern);
-#endif
- if (h > v) {
- return kern;
- }
- }
- return kern;
-}
-
-@ @c
-static scaled
-find_math_kern(internal_font_number l_f, int l_c,
- internal_font_number r_f, int r_c, int cmd, scaled shift)
-{
- scaled corr_height_top = 0, corr_height_bot = 0;
- scaled krn_l = 0, krn_r = 0, krn = 0;
- if ((!is_new_mathfont(l_f)) || (!is_new_mathfont(r_f))
- || (!char_exists(l_f, l_c)) || (!char_exists(r_f, r_c)))
- return MATH_KERN_NOT_FOUND;
-
- if (cmd == sup_mark_cmd) {
- corr_height_top = char_height(l_f, l_c);
- corr_height_bot = -char_depth(r_f, r_c) + shift; /* bottom of superscript */
- krn_l = math_kern_at(l_f, l_c, top_right_kern, corr_height_top);
- krn_r = math_kern_at(r_f, r_c, bottom_left_kern, corr_height_top);
-#ifdef DEBUG
- fprintf(stderr, "SUPER Top LR = %d,%d (shift %d)\n", krn_l, krn_r,
- shift);
-#endif
- krn = (krn_l + krn_r);
- krn_l = math_kern_at(l_f, l_c, top_right_kern, corr_height_bot);
- krn_r = math_kern_at(r_f, r_c, bottom_left_kern, corr_height_bot);
-#ifdef DEBUG
- fprintf(stderr, "SUPER Bot LR = %d,%d\n", krn_l, krn_r);
-#endif
- if ((krn_l + krn_r) < krn)
- krn = (krn_l + krn_r);
- return (krn);
-
- } else if (cmd == sub_mark_cmd) {
- corr_height_top = char_height(r_f, r_c) - shift; /* top of subscript */
- corr_height_bot = -char_depth(l_f, l_c);
- krn_l = math_kern_at(l_f, l_c, bottom_right_kern, corr_height_top);
- krn_r = math_kern_at(r_f, r_c, top_left_kern, corr_height_top);
-#ifdef DEBUG
- fprintf(stderr, "SUB Top LR = %d,%d\n", krn_l, krn_r);
-#endif
- krn = (krn_l + krn_r);
- krn_l = math_kern_at(l_f, l_c, bottom_right_kern, corr_height_bot);
- krn_r = math_kern_at(r_f, r_c, top_left_kern, corr_height_bot);
-#ifdef DEBUG
- fprintf(stderr, "SUB Bot LR = %d,%d\n", krn_l, krn_r);
-#endif
- if ((krn_l + krn_r) < krn)
- krn = (krn_l + krn_r);
- return (krn);
-
- } else {
- confusion("find_math_kern");
- }
- return 0; /* not reached */
-}
-
-@ just a small helper
-@c
-static pointer attach_hkern_to_new_hlist(pointer q, scaled delta2)
-{
- pointer y;
- pointer z = new_kern(delta2);
- if (new_hlist(q) == null) { /* this is somewhat weird */
- new_hlist(q) = z;
- } else {
- y = new_hlist(q);
- while (vlink(y) != null)
- y = vlink(y);
- vlink(y) = z;
- }
- return new_hlist(q);
-}
-
-@
-@c
-#ifdef DEBUG
-void dump_simple_field(pointer q)
-{
- pointer p;
- printf(" [%d, type=%d, vlink=%d] ", q, type(q), vlink(q));
- switch (type(q)) {
- case math_char_node:
- printf("mathchar ");
- break;
- case math_text_char_node:
- printf("texchar ");
- break;
- case sub_box_node:
- printf("box ");
- break;
- case sub_mlist_node:
- printf("mlist ");
- p = math_list(q);
- while (p != null) {
- dump_simple_field(p);
- p = vlink(p);
- }
- break;
- }
-}
-
-
-void dump_simple_node(pointer q)
-{
- printf("node %d, type=%d, vlink=%d\n", q, type(q), vlink(q));
- printf("nucleus: ");
- dump_simple_field(nucleus(q));
- printf("\n");
- printf("sub: ");
- dump_simple_field(subscr(q));
- printf("\n");
- printf("sup: ");
- dump_simple_field(supscr(q));
- printf("\n\n");
-}
-#endif
-
-@ The purpose of |make_scripts(q,it)| 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 be horizontally shifted over |delta1|, the subscript over |delta2|.
-
-We set |shift_down| and |shift_up| to the minimum amounts to shift the
-baseline of subscripts and superscripts based on the given nucleus.
-
-@c
-static void make_scripts(pointer q, pointer p, scaled it, int cur_style)
-{
- pointer x, y, z; /* temporary registers for box construction */
- scaled shift_up, shift_down, clr; /* dimensions in the calculation */
- scaled delta1, delta2;
- delta1 = it;
- delta2 = 0;
-#ifdef DEBUG
- printf("it: %d\n", it);
- dump_simple_node(q);
- printf("p: node %d, type=%d, subtype=%d\n", p, type(p), subtype(p));
-#endif
- switch (type(nucleus(q))) {
- case math_char_node:
- case math_text_char_node:
- if ((subscr(q) == null) && (delta1 != 0)) {
- x = new_kern(delta1);
- reset_attributes(x, node_attr(nucleus(q)));
- vlink(p) = x;
- delta1 = 0;
- }
- }
- assign_new_hlist(q, p);
- if (is_char_node(p)) {
- shift_up = 0;
- shift_down = 0;
- } else {
- z = hpack(p, 0, additional, -1);
- shift_up = height(z) - sup_shift_drop(cur_style); /* r18 */
- shift_down = depth(z) + sub_shift_drop(cur_style); /* r19 */
- list_ptr(z) = null;
- flush_node(z);
- }
- if (supscr(q) == null) {
- /* Construct a subscript box |x| when there is no superscript */
- /* 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. */
- x = clean_box(subscr(q), sub_style(cur_style), cur_style);
- width(x) = width(x) + space_after_script(cur_style);
- if (shift_down < sub_shift_down(cur_style))
- shift_down = sub_shift_down(cur_style);
- clr = height(x) - sub_top_max(cur_style);
- if (shift_down < clr)
- shift_down = clr;
- shift_amount(x) = shift_down;
-
- /* now find and correct for horizontal shift */
- if (is_char_node(p) && subscr(q) != null
- && type(subscr(q)) == math_char_node) {
- fetch(subscr(q));
- if (char_exists(cur_f, cur_c)) {
- delta2 =
- find_math_kern(font(p), character(p), cur_f, cur_c,
- sub_mark_cmd, shift_down);
- if (delta2 != MATH_KERN_NOT_FOUND && delta2 != 0) {
- p = attach_hkern_to_new_hlist(q, delta2);
- }
- }
- }
-
- } else {
- /* Construct a superscript box |x| */
- /*The bottom of a superscript should never descend below the baseline plus
- one-fourth of the x-height. */
- x = clean_box(supscr(q), sup_style(cur_style), cur_style);
- width(x) = width(x) + space_after_script(cur_style);
- clr = sup_shift_up(cur_style);
- if (shift_up < clr)
- shift_up = clr;
- clr = depth(x) + sup_bottom_min(cur_style);
- if (shift_up < clr)
- shift_up = clr;
-
- if (subscr(q) == null) {
- shift_amount(x) = -shift_up;
- /* now find and correct for horizontal shift */
- if (is_char_node(p) && type(supscr(q)) == math_char_node) {
- fetch(supscr(q));
- if (char_exists(cur_f, cur_c)) {
- clr =
- find_math_kern(font(p), character(p), cur_f, cur_c,
- sup_mark_cmd, shift_up);
- if (clr != MATH_KERN_NOT_FOUND && clr != 0) {
- p = attach_hkern_to_new_hlist(q, clr);
- }
- }
- }
- } else {
- /* Construct a sub/superscript combination box |x|, with the
- superscript offset by |delta| */
- /* When both subscript and superscript are present, the subscript must be
- separated from the superscript by at least four times |default_rule_thickness|.
- If this condition would be violated, the subscript moves down, after which
- both subscript and superscript move up so that the bottom of the superscript
- is at least as high as the baseline plus four-fifths of the x-height. */
-
- y = clean_box(subscr(q), sub_style(cur_style), cur_style);
- width(y) = width(y) + space_after_script(cur_style);
- if (shift_down < sub_sup_shift_down(cur_style))
- shift_down = sub_sup_shift_down(cur_style);
- clr = subsup_vgap(cur_style) -
- ((shift_up - depth(x)) - (height(y) - shift_down));
- if (clr > 0) {
- shift_down = shift_down + clr;
- clr = sup_sub_bottom_max(cur_style) - (shift_up - depth(x));
- if (clr > 0) {
- shift_up = shift_up + clr;
- shift_down = shift_down - clr;
- }
- }
- /* now find and correct for horizontal shift */
- if (is_char_node(p) && subscr(q) != null
- && type(subscr(q)) == math_char_node) {
- fetch(subscr(q));
- if (char_exists(cur_f, cur_c)) {
- delta2 =
- find_math_kern(font(p), character(p), cur_f, cur_c,
- sub_mark_cmd, shift_down);
- if (delta2 != MATH_KERN_NOT_FOUND && delta2 != 0) {
- p = attach_hkern_to_new_hlist(q, delta2);
- }
- }
- }
- /* now the horizontal shift for the superscript. */
- /* the superscript is also to be shifted by |delta1| (the italic correction) */
- clr = MATH_KERN_NOT_FOUND;
- if (is_char_node(p) && supscr(q) != null
- && type(supscr(q)) == math_char_node) {
- fetch(supscr(q));
- if (char_exists(cur_f, cur_c)) {
- clr =
- find_math_kern(font(p), character(p), cur_f, cur_c,
- sup_mark_cmd, shift_up);
- }
- }
- if (delta2 == MATH_KERN_NOT_FOUND)
- delta2 = 0;
- if (clr != MATH_KERN_NOT_FOUND) {
- shift_amount(x) = clr + delta1 - delta2;
- } else {
- shift_amount(x) = delta1 - delta2;
- }
- p = new_kern((shift_up - depth(x)) - (height(y) - shift_down));
- reset_attributes(p, node_attr(q));
- vlink(x) = p;
- vlink(p) = y;
- x = vpackage(x, 0, additional, max_dimen, math_direction);
- reset_attributes(x, node_attr(q));
- shift_amount(x) = shift_down;
- }
- }
-
-
- if (new_hlist(q) == null) {
- new_hlist(q) = x;
- } else {
- p = new_hlist(q);
- while (vlink(p) != null)
- p = vlink(p);
- vlink(p) = x;
- }
- if (subscr(q) != null) {
- math_list(subscr(q)) = null;
- flush_node(subscr(q));
- subscr(q) = null;
- }
- if (supscr(q) != null) {
- math_list(supscr(q)) = null;
- flush_node(supscr(q));
- supscr(q) = null;
- }
-
-}
-
-@ The |make_left_right| function constructs a left or right delimiter of
-the required size and returns the value |open_noad| or |close_noad|. The
-|left_noad_side| and |right_noad_side| will both be based on the original |style|,
-so they will have consistent sizes.
-
-@c
-static small_number make_left_right(pointer q, int style, scaled max_d,
- scaled max_hv)
-{
- scaled delta, delta1, delta2; /* dimensions used in the calculation */
- pointer tmp;
- setup_cur_size(style);
- delta2 = max_d + math_axis(cur_size);
- delta1 = max_hv + max_d - delta2;
- if (delta2 > delta1)
- delta1 = delta2; /* |delta1| is max distance from axis */
- delta = (delta1 / 500) * delimiter_factor;
- delta2 = delta1 + delta1 - delimiter_shortfall;
- if (delta < delta2)
- delta = delta2;
- tmp = var_delimiter(delimiter(q), cur_size, delta, NULL, style);
- delimiter(q) = null;
- assign_new_hlist(q, tmp);
- if (subtype(q) == left_noad_side)
- return open_noad_type;
- else
- return close_noad_type;
-}
-
-@ @c
-#define TEXT_STYLES(A,B) do { \
- def_math_param(A,display_style,(B),level_one); \
- def_math_param(A,cramped_display_style,(B),level_one); \
- def_math_param(A,text_style,(B),level_one); \
- def_math_param(A,cramped_text_style,(B),level_one); \
- } while (0)
-
-#define SCRIPT_STYLES(A,B) do { \
- def_math_param(A,script_style,(B),level_one); \
- def_math_param(A,cramped_script_style,(B),level_one); \
- def_math_param(A,script_script_style,(B),level_one); \
- def_math_param(A,cramped_script_script_style,(B),level_one); \
- } while (0)
-
-#define ALL_STYLES(A,B) do { \
- TEXT_STYLES(A,(B)); \
- SCRIPT_STYLES(A,(B)); \
- } while (0)
-
-#define SPLIT_STYLES(A,B,C) do { \
- TEXT_STYLES(A,(B)); \
- SCRIPT_STYLES(A,(C)); \
- } while (0)
-
-
-void initialize_math_spacing(void)
-{
- /* *INDENT-OFF* */
- ALL_STYLES (math_param_ord_ord_spacing, 0);
- ALL_STYLES (math_param_ord_op_spacing, thin_mu_skip_code);
- SPLIT_STYLES (math_param_ord_bin_spacing, med_mu_skip_code, 0);
- SPLIT_STYLES (math_param_ord_rel_spacing, thick_mu_skip_code, 0);
- ALL_STYLES (math_param_ord_open_spacing, 0);
- ALL_STYLES (math_param_ord_close_spacing, 0);
- ALL_STYLES (math_param_ord_punct_spacing, 0);
- SPLIT_STYLES (math_param_ord_inner_spacing, thin_mu_skip_code, 0);
-
- ALL_STYLES (math_param_op_ord_spacing, thin_mu_skip_code);
- ALL_STYLES (math_param_op_op_spacing, thin_mu_skip_code);
- ALL_STYLES (math_param_op_bin_spacing, 0);
- SPLIT_STYLES (math_param_op_rel_spacing, thick_mu_skip_code, 0);
- ALL_STYLES (math_param_op_open_spacing, 0);
- ALL_STYLES (math_param_op_close_spacing, 0);
- ALL_STYLES (math_param_op_punct_spacing, 0);
- SPLIT_STYLES (math_param_op_inner_spacing, thin_mu_skip_code, 0);
-
- SPLIT_STYLES (math_param_bin_ord_spacing, med_mu_skip_code, 0);
- SPLIT_STYLES (math_param_bin_op_spacing, med_mu_skip_code, 0);
- ALL_STYLES (math_param_bin_bin_spacing, 0);
- ALL_STYLES (math_param_bin_rel_spacing, 0);
- SPLIT_STYLES (math_param_bin_open_spacing, med_mu_skip_code, 0);
- ALL_STYLES (math_param_bin_close_spacing, 0);
- ALL_STYLES (math_param_bin_punct_spacing, 0);
- SPLIT_STYLES (math_param_bin_inner_spacing, med_mu_skip_code, 0);
-
- SPLIT_STYLES (math_param_rel_ord_spacing, thick_mu_skip_code, 0);
- SPLIT_STYLES (math_param_rel_op_spacing, thick_mu_skip_code, 0);
- ALL_STYLES (math_param_rel_bin_spacing, 0);
- ALL_STYLES (math_param_rel_rel_spacing, 0);
- SPLIT_STYLES (math_param_rel_open_spacing, thick_mu_skip_code, 0);
- ALL_STYLES (math_param_rel_close_spacing, 0);
- ALL_STYLES (math_param_rel_punct_spacing, 0);
- SPLIT_STYLES (math_param_rel_inner_spacing, thick_mu_skip_code, 0);
-
- ALL_STYLES (math_param_open_ord_spacing, 0);
- ALL_STYLES (math_param_open_op_spacing, 0);
- ALL_STYLES (math_param_open_bin_spacing, 0);
- ALL_STYLES (math_param_open_rel_spacing, 0);
- ALL_STYLES (math_param_open_open_spacing, 0);
- ALL_STYLES (math_param_open_close_spacing, 0);
- ALL_STYLES (math_param_open_punct_spacing, 0);
- ALL_STYLES (math_param_open_inner_spacing, 0);
-
- ALL_STYLES (math_param_close_ord_spacing, 0);
- ALL_STYLES (math_param_close_op_spacing, thin_mu_skip_code);
- SPLIT_STYLES (math_param_close_bin_spacing, med_mu_skip_code, 0);
- SPLIT_STYLES (math_param_close_rel_spacing, thick_mu_skip_code, 0);
- ALL_STYLES (math_param_close_open_spacing, 0);
- ALL_STYLES (math_param_close_close_spacing, 0);
- ALL_STYLES (math_param_close_punct_spacing, 0);
- SPLIT_STYLES (math_param_close_inner_spacing, thin_mu_skip_code, 0);
-
- SPLIT_STYLES (math_param_punct_ord_spacing, thin_mu_skip_code, 0);
- SPLIT_STYLES (math_param_punct_op_spacing, thin_mu_skip_code, 0);
- ALL_STYLES (math_param_punct_bin_spacing, 0);
- SPLIT_STYLES (math_param_punct_rel_spacing, thin_mu_skip_code, 0);
- SPLIT_STYLES (math_param_punct_open_spacing, thin_mu_skip_code, 0);
- SPLIT_STYLES (math_param_punct_close_spacing, thin_mu_skip_code, 0);
- SPLIT_STYLES (math_param_punct_punct_spacing, thin_mu_skip_code, 0);
- SPLIT_STYLES (math_param_punct_inner_spacing, thin_mu_skip_code, 0);
-
- SPLIT_STYLES (math_param_inner_ord_spacing, thin_mu_skip_code, 0);
- ALL_STYLES (math_param_inner_op_spacing, thin_mu_skip_code);
- SPLIT_STYLES (math_param_inner_bin_spacing, med_mu_skip_code, 0);
- SPLIT_STYLES (math_param_inner_rel_spacing, thick_mu_skip_code, 0);
- SPLIT_STYLES (math_param_inner_open_spacing, thin_mu_skip_code, 0);
- ALL_STYLES (math_param_inner_close_spacing, 0);
- SPLIT_STYLES (math_param_inner_punct_spacing, thin_mu_skip_code, 0);
- SPLIT_STYLES (math_param_inner_inner_spacing, thin_mu_skip_code, 0);
- /* *INDENT-ON* */
-}
-
-
-@ @c
-#define both_types(A,B) ((A)*16+(B))
-
-static pointer math_spacing_glue(int l_type, int r_type, int mstyle, scaled mmu)
-{
- int x = -1;
- pointer z = null;
- if (l_type == op_noad_type_limits || l_type == op_noad_type_no_limits)
- l_type = op_noad_type_normal;
- if (r_type == op_noad_type_limits || r_type == op_noad_type_no_limits)
- r_type = op_noad_type_normal;
- switch (both_types(l_type, r_type)) {
- /* *INDENT-OFF* */
- case both_types(ord_noad_type, ord_noad_type ): x = get_math_param(math_param_ord_ord_spacing,mstyle); break;
- case both_types(ord_noad_type, op_noad_type_normal ): x = get_math_param(math_param_ord_op_spacing,mstyle); break;
- case both_types(ord_noad_type, bin_noad_type ): x = get_math_param(math_param_ord_bin_spacing,mstyle); break;
- case both_types(ord_noad_type, rel_noad_type ): x = get_math_param(math_param_ord_rel_spacing,mstyle); break;
- case both_types(ord_noad_type, open_noad_type ): x = get_math_param(math_param_ord_open_spacing,mstyle); break;
- case both_types(ord_noad_type, close_noad_type): x = get_math_param(math_param_ord_close_spacing,mstyle); break;
- case both_types(ord_noad_type, punct_noad_type): x = get_math_param(math_param_ord_punct_spacing,mstyle); break;
- case both_types(ord_noad_type, inner_noad_type): x = get_math_param(math_param_ord_inner_spacing,mstyle); break;
- case both_types(op_noad_type_normal, ord_noad_type ): x = get_math_param(math_param_op_ord_spacing,mstyle); break;
- case both_types(op_noad_type_normal, op_noad_type_normal ): x = get_math_param(math_param_op_op_spacing,mstyle); break;
-#if 0
- case both_types(op_noad_type_normal, bin_noad_type ): x = get_math_param(math_param_op_bin_spacing,mstyle); break;
-#endif
- case both_types(op_noad_type_normal, rel_noad_type ): x = get_math_param(math_param_op_rel_spacing,mstyle); break;
- case both_types(op_noad_type_normal, open_noad_type ): x = get_math_param(math_param_op_open_spacing,mstyle); break;
- case both_types(op_noad_type_normal, close_noad_type): x = get_math_param(math_param_op_close_spacing,mstyle); break;
- case both_types(op_noad_type_normal, punct_noad_type): x = get_math_param(math_param_op_punct_spacing,mstyle); break;
- case both_types(op_noad_type_normal, inner_noad_type): x = get_math_param(math_param_op_inner_spacing,mstyle); break;
- case both_types(bin_noad_type, ord_noad_type ): x = get_math_param(math_param_bin_ord_spacing,mstyle); break;
- case both_types(bin_noad_type, op_noad_type_normal ): x = get_math_param(math_param_bin_op_spacing,mstyle); break;
-#if 0
- case both_types(bin_noad_type, bin_noad_type ): x = get_math_param(math_param_bin_bin_spacing,mstyle); break;
- case both_types(bin_noad_type, rel_noad_type ): x = get_math_param(math_param_bin_rel_spacing,mstyle); break;
-#endif
- case both_types(bin_noad_type, open_noad_type ): x = get_math_param(math_param_bin_open_spacing,mstyle); break;
-#if 0
- case both_types(bin_noad_type, close_noad_type): x = get_math_param(math_param_bin_close_spacing,mstyle); break;
- case both_types(bin_noad_type, punct_noad_type): x = get_math_param(math_param_bin_punct_spacing,mstyle); break;
-#endif
- case both_types(bin_noad_type, inner_noad_type): x = get_math_param(math_param_bin_inner_spacing,mstyle); break;
- case both_types(rel_noad_type, ord_noad_type ): x = get_math_param(math_param_rel_ord_spacing,mstyle); break;
- case both_types(rel_noad_type, op_noad_type_normal ): x = get_math_param(math_param_rel_op_spacing,mstyle); break;
-#if 0
- case both_types(rel_noad_type, bin_noad_type ): x = get_math_param(math_param_rel_bin_spacing,mstyle); break;
-#endif
- case both_types(rel_noad_type, rel_noad_type ): x = get_math_param(math_param_rel_rel_spacing,mstyle); break;
- case both_types(rel_noad_type, open_noad_type ): x = get_math_param(math_param_rel_open_spacing,mstyle); break;
- case both_types(rel_noad_type, close_noad_type): x = get_math_param(math_param_rel_close_spacing,mstyle); break;
- case both_types(rel_noad_type, punct_noad_type): x = get_math_param(math_param_rel_punct_spacing,mstyle); break;
- case both_types(rel_noad_type, inner_noad_type): x = get_math_param(math_param_rel_inner_spacing,mstyle); break;
- case both_types(open_noad_type, ord_noad_type ): x = get_math_param(math_param_open_ord_spacing,mstyle); break;
- case both_types(open_noad_type, op_noad_type_normal ): x = get_math_param(math_param_open_op_spacing,mstyle); break;
-#if 0
- case both_types(open_noad_type, bin_noad_type ): x = get_math_param(math_param_open_bin_spacing,mstyle); break;
-#endif
- case both_types(open_noad_type, rel_noad_type ): x = get_math_param(math_param_open_rel_spacing,mstyle); break;
- case both_types(open_noad_type, open_noad_type ): x = get_math_param(math_param_open_open_spacing,mstyle); break;
- case both_types(open_noad_type, close_noad_type): x = get_math_param(math_param_open_close_spacing,mstyle); break;
- case both_types(open_noad_type, punct_noad_type): x = get_math_param(math_param_open_punct_spacing,mstyle); break;
- case both_types(open_noad_type, inner_noad_type): x = get_math_param(math_param_open_inner_spacing,mstyle); break;
- case both_types(close_noad_type,ord_noad_type ): x = get_math_param(math_param_close_ord_spacing,mstyle); break;
- case both_types(close_noad_type,op_noad_type_normal ): x = get_math_param(math_param_close_op_spacing,mstyle); break;
- case both_types(close_noad_type,bin_noad_type ): x = get_math_param(math_param_close_bin_spacing,mstyle); break;
- case both_types(close_noad_type,rel_noad_type ): x = get_math_param(math_param_close_rel_spacing,mstyle); break;
- case both_types(close_noad_type,open_noad_type ): x = get_math_param(math_param_close_open_spacing,mstyle); break;
- case both_types(close_noad_type,close_noad_type): x = get_math_param(math_param_close_close_spacing,mstyle); break;
- case both_types(close_noad_type,punct_noad_type): x = get_math_param(math_param_close_punct_spacing,mstyle); break;
- case both_types(close_noad_type,inner_noad_type): x = get_math_param(math_param_close_inner_spacing,mstyle); break;
- case both_types(punct_noad_type,ord_noad_type ): x = get_math_param(math_param_punct_ord_spacing,mstyle); break;
- case both_types(punct_noad_type,op_noad_type_normal ): x = get_math_param(math_param_punct_op_spacing,mstyle); break;
-#if 0
- case both_types(punct_noad_type,bin_noad_type ): x = get_math_param(math_param_punct_bin_spacing,mstyle); break;
-#endif
- case both_types(punct_noad_type,rel_noad_type ): x = get_math_param(math_param_punct_rel_spacing,mstyle); break;
- case both_types(punct_noad_type,open_noad_type ): x = get_math_param(math_param_punct_open_spacing,mstyle); break;
- case both_types(punct_noad_type,close_noad_type): x = get_math_param(math_param_punct_close_spacing,mstyle); break;
- case both_types(punct_noad_type,punct_noad_type): x = get_math_param(math_param_punct_punct_spacing,mstyle); break;
- case both_types(punct_noad_type,inner_noad_type): x = get_math_param(math_param_punct_inner_spacing,mstyle); break;
- case both_types(inner_noad_type,ord_noad_type ): x = get_math_param(math_param_inner_ord_spacing,mstyle); break;
- case both_types(inner_noad_type,op_noad_type_normal ): x = get_math_param(math_param_inner_op_spacing,mstyle); break;
- case both_types(inner_noad_type,bin_noad_type ): x = get_math_param(math_param_inner_bin_spacing,mstyle); break;
- case both_types(inner_noad_type,rel_noad_type ): x = get_math_param(math_param_inner_rel_spacing,mstyle); break;
- case both_types(inner_noad_type,open_noad_type ): x = get_math_param(math_param_inner_open_spacing,mstyle); break;
- case both_types(inner_noad_type,close_noad_type): x = get_math_param(math_param_inner_close_spacing,mstyle); break;
- case both_types(inner_noad_type,punct_noad_type): x = get_math_param(math_param_inner_punct_spacing,mstyle); break;
- case both_types(inner_noad_type,inner_noad_type): x = get_math_param(math_param_inner_inner_spacing,mstyle); break;
- /* *INDENT-ON* */
- }
- if (x < 0) {
- confusion("mathspacing");
- }
- if (x != 0) {
- pointer y;
- if (x <= thick_mu_skip_code) { /* trap thin/med/thick settings cf. old TeX */
- y = math_glue(glue_par(x), mmu);
- z = new_glue(y);
- glue_ref_count(y) = null;
- subtype(z) = (quarterword) (x + 1); /* store a symbolic subtype */
- } else {
- y = math_glue(x, mmu);
- z = new_glue(y);
- glue_ref_count(y) = null;
- }
- }
- return z;
-}
-
-@ @c
-static pointer check_nucleus_complexity(halfword q, scaled * delta,
- int cur_style)
-{
- pointer p = null;
- switch (type(nucleus(q))) {
- case math_char_node:
- case math_text_char_node:
- fetch(nucleus(q));
- if (char_exists(cur_f, cur_c)) {
- *delta = char_italic(cur_f, cur_c);
- p = new_glyph(cur_f, cur_c);
- reset_attributes(p, node_attr(nucleus(q)));
- if ((is_new_mathfont(cur_f) && get_char_cat_code(cur_c) == 11) ||
- (!is_new_mathfont(cur_f) && type(nucleus(q)) == math_text_char_node && space(cur_f)) != 0) {
- *delta = 0; /* no italic correction in mid-word of text font */
- }
- if ((subscr(q) == null) && (supscr(q) == null) && (*delta != 0)) {
- pointer x = new_kern(*delta);
- reset_attributes(x, node_attr(nucleus(q)));
- vlink(p) = x;
- *delta = 0;
- }
- }
- break;
- case sub_box_node:
- p = math_list(nucleus(q));
- break;
- case sub_mlist_node:
- mlist_to_hlist_args(math_list(nucleus(q)), cur_style, false); /* recursive call */
- setup_cur_size(cur_style);
- p = hpack(vlink(temp_head), 0, additional, -1);
- reset_attributes(p, node_attr(nucleus(q)));
- break;
- default:
- confusion("mlist2"); /* this can't happen mlist2 */
- }
- return p;
-}
-
-@ Here is the overall plan of |mlist_to_hlist|, and the list of its
- local variables.
-
-@c
-static void mlist_to_hlist(pointer mlist, boolean penalties, int cur_style)
-{
- pointer q; /* runs through the mlist */
- pointer r; /* the most recent noad preceding |q| */
- int style;
- int r_type; /* the |type| of noad |r|, or |op_noad| if |r=null| */
- int r_subtype; /* the |subtype| of noad |r| if |r_type| is |fence_noad| */
- int t; /* the effective |type| of noad |q| during the second pass */
- int t_subtype; /* the effective |subtype| of noad |q| during the second pass */
- pointer p, x, y, z; /* temporary registers for list construction */
- int pen; /* a penalty to be inserted */
- scaled max_hl, max_d; /* maximum height and depth of the list translated so far */
- scaled delta; /* italic correction offset for subscript and superscript */
- scaled cur_mu; /* the math unit width corresponding to |cur_size| */
- style = cur_style; /* tuck global parameter away as local variable */
- q = mlist;
- r = null;
- r_type = simple_noad;
- r_subtype = op_noad_type_normal;
- max_hl = 0;
- max_d = 0;
- x = null;
- p = null;
- setup_cur_size(cur_style);
- cur_mu = x_over_n(get_math_quad(cur_size), 18);
- while (q != null) {
- /* We use the fact that no character nodes appear in an mlist, hence
- the field |type(q)| is always present. */
-
- /* One of the things we must do on the first pass is change a |bin_noad| to
- an |ord_noad| if the |bin_noad| is not in the context of a binary operator.
- The values of |r| and |r_type| make this fairly easy. */
- RESWITCH:
- delta = 0;
- switch (type(q)) {
- case simple_noad:
- switch (subtype(q)) {
- case bin_noad_type:
- switch (r_type) {
- case simple_noad:
- switch (r_subtype) {
- case bin_noad_type:
- case op_noad_type_normal:
- case op_noad_type_limits:
- case op_noad_type_no_limits:
- case rel_noad_type:
- case open_noad_type:
- case punct_noad_type:
- subtype(q) = ord_noad_type;
- goto RESWITCH;
- break;
- }
- break;
- case fence_noad:
- if (r_subtype == left_noad_side) {
- subtype(q) = ord_noad_type;
- goto RESWITCH;
- }
- break;
- }
- break;
- case over_noad_type:
- make_over(q, cur_style);
- break;
- case under_noad_type:
- make_under(q, cur_style);
- break;
- case vcenter_noad_type:
- make_vcenter(q);
- break;
- case rel_noad_type:
- case close_noad_type:
- case punct_noad_type:
- if (r_type == simple_noad && r_subtype == bin_noad_type) {
- type(r) = simple_noad;
- subtype(r) = ord_noad_type;
- }
- break;
- case op_noad_type_normal:
- case op_noad_type_limits:
- case op_noad_type_no_limits:
- delta = make_op(q, cur_style);
- if (subtype(q) == op_noad_type_limits)
- goto CHECK_DIMENSIONS;
- break;
- case ord_noad_type:
- make_ord(q);
- break;
- case open_noad_type:
- case inner_noad_type:
- break;
- }
- break;
- case fence_noad:
- if (subtype(q) != left_noad_side)
- if (r_type == simple_noad && r_subtype == bin_noad_type) {
- type(r) = simple_noad;
- subtype(r) = ord_noad_type;
- }
- goto DONE_WITH_NOAD;
- break;
- case fraction_noad:
- make_fraction(q, cur_style);
- goto CHECK_DIMENSIONS;
- break;
- case radical_noad:
- if (subtype(q) == 4)
- make_under_delimiter(q, cur_style);
- else if (subtype(q) == 5)
- make_over_delimiter(q, cur_style);
- else if (subtype(q) == 6)
- make_delimiter_under(q, cur_style);
- else if (subtype(q) == 7)
- make_delimiter_over(q, cur_style);
- else
- make_radical(q, cur_style);
- break;
- case accent_noad:
- make_math_accent(q, cur_style);
- break;
- case style_node:
- cur_style = subtype(q);
- setup_cur_size(cur_style);
- cur_mu = x_over_n(get_math_quad(cur_size), 18);
- goto DONE_WITH_NODE;
- break;
- case choice_node:
- switch (cur_style / 2) {
- case 0:
- choose_mlist(display_mlist);
- break; /* |display_style=0| */
- case 1:
- choose_mlist(text_mlist);
- break; /* |text_style=2| */
- case 2:
- choose_mlist(script_mlist);
- break; /* |script_style=4| */
- case 3:
- choose_mlist(script_script_mlist);
- break; /* |script_script_style=6| */
- } /* there are no other cases */
- flush_node_list(display_mlist(q));
- flush_node_list(text_mlist(q));
- flush_node_list(script_mlist(q));
- flush_node_list(script_script_mlist(q));
- type(q) = style_node;
- subtype(q) = (quarterword) cur_style;
- if (p != null) {
- z = vlink(q);
- vlink(q) = p;
- while (vlink(p) != null)
- p = vlink(p);
- vlink(p) = z;
- }
- goto DONE_WITH_NODE;
- break;
- case ins_node:
- case mark_node:
- case adjust_node:
- case whatsit_node:
- case penalty_node:
- case disc_node:
- goto DONE_WITH_NODE;
- break;
- case rule_node:
- if (height(q) > max_hl)
- max_hl = height(q);
- if (depth(q) > max_d)
- max_d = depth(q);
- goto DONE_WITH_NODE;
- break;
- case glue_node:
- /*
- Conditional math glue (`\.{\\nonscript}') results in a |glue_node|
- pointing to |zero_glue|, with |subtype(q)=cond_math_glue|; in such a case
- the node following will be eliminated if it is a glue or kern node and if the
- current size is different from |text_size|. Unconditional math glue
- (`\.{\\muskip}') is converted to normal glue by multiplying the dimensions
- by |cur_mu|.
- */
- if (subtype(q) == mu_glue) {
- x = glue_ptr(q);
- y = math_glue(x, cur_mu);
- delete_glue_ref(x);
- glue_ptr(q) = y;
- subtype(q) = normal;
- } else if ((cur_size != text_size)
- && (subtype(q) == cond_math_glue)) {
- p = vlink(q);
- if (p != null)
- if ((type(p) == glue_node) || (type(p) == kern_node)) {
- vlink(q) = vlink(p);
- vlink(p) = null;
- flush_node_list(p);
- }
- }
- goto DONE_WITH_NODE;
- break;
- case kern_node:
- math_kern(q, cur_mu);
- goto DONE_WITH_NODE;
- break;
- default:
- confusion("mlist1"); /* this can't happen mlist1 */
- }
- /* When we get to the following part of the program, we have ``fallen through''
- from cases that did not lead to |check_dimensions| or |done_with_noad| or
- |done_with_node|. Thus, |q|~points to a noad whose nucleus may need to be
- converted to an hlist, and whose subscripts and superscripts need to be
- appended if they are present.
-
- If |nucleus(q)| is not a |math_char|, the variable |delta| is the amount
- by which a superscript should be moved right with respect to a subscript
- when both are present.
- */
- p = check_nucleus_complexity(q, &delta, cur_style);
-
- if ((subscr(q) == null) && (supscr(q) == null)) {
- assign_new_hlist(q, p);
- } else {
- make_scripts(q, p, delta, cur_style); /* top, bottom */
- }
- CHECK_DIMENSIONS:
- z = hpack(new_hlist(q), 0, additional, -1);
- if (height(z) > max_hl)
- max_hl = height(z);
- if (depth(z) > max_d)
- max_d = depth(z);
- list_ptr(z) = null;
- flush_node(z); /* only drop the \.{\\hbox} */
- DONE_WITH_NOAD:
- r = q;
- r_type = type(r);
- r_subtype = subtype(r);
- if (r_type == fence_noad) {
- r_subtype = left_noad_side;
- cur_style = style;
- setup_cur_size(cur_style);
- cur_mu = x_over_n(get_math_quad(cur_size), 18);
- }
- DONE_WITH_NODE:
- q = vlink(q);
- }
- if (r_type == simple_noad && r_subtype == bin_noad_type) {
- type(r) = simple_noad;
- subtype(r) = ord_noad_type;
- }
- /* Make a second pass over the mlist, removing all noads and inserting the
- proper spacing and penalties */
-
- /* We have now tied up all the loose ends of the first pass of |mlist_to_hlist|.
- The second pass simply goes through and hooks everything together with the
- proper glue and penalties. It also handles the |fence_noad|s that
- might be present, since |max_hl| and |max_d| are now known. Variable |p| points
- to a node at the current end of the final hlist.
- */
- p = temp_head;
- vlink(p) = null;
- q = mlist;
- r_type = 0;
- r_subtype = 0;
- cur_style = style;
- setup_cur_size(cur_style);
- cur_mu = x_over_n(get_math_quad(cur_size), 18);
- NEXT_NODE:
- while (q != null) {
- /* If node |q| is a style node, change the style and |goto delete_q|;
- otherwise if it is not a noad, put it into the hlist,
- advance |q|, and |goto done|; otherwise set |s| to the size
- of noad |q|, set |t| to the associated type (|ord_noad..
- inner_noad|), and set |pen| to the associated penalty */
- /* Just before doing the big |case| switch in the second pass, the program
- sets up default values so that most of the branches are short. */
- t = simple_noad;
- t_subtype = ord_noad_type;
- pen = inf_penalty;
- switch (type(q)) {
- case simple_noad:
- t_subtype = subtype(q);
- switch (t_subtype) {
- case bin_noad_type:
- pen = bin_op_penalty;
- break;
- case rel_noad_type:
- pen = rel_penalty;
- break;
- case vcenter_noad_type:
- case over_noad_type:
- case under_noad_type:
- t_subtype = ord_noad_type;
- break;
- }
- case radical_noad:
- break;
- case accent_noad:
- break;
- case fraction_noad:
- t = simple_noad;
- t_subtype = inner_noad_type;
- break;
- case fence_noad:
- t_subtype = make_left_right(q, style, max_d, max_hl);
- break;
- case style_node:
- /* Change the current style and |goto delete_q| */
- cur_style = subtype(q);
- setup_cur_size(cur_style);
- cur_mu = x_over_n(get_math_quad(cur_size), 18);
- goto DELETE_Q;
- break;
- case whatsit_node:
- case penalty_node:
- case rule_node:
- case disc_node:
- case adjust_node:
- case ins_node:
- case mark_node:
- case glue_node:
- case kern_node:
- vlink(p) = q;
- p = q;
- q = vlink(q);
- vlink(p) = null;
- goto NEXT_NODE;
- break;
- default:
- confusion("mlist3"); /* this can't happen mlist3 */
- }
- /* Append inter-element spacing based on |r_type| and |t| */
- if (r_type > 0) { /* not the first noad */
- z = math_spacing_glue(r_subtype, t_subtype, cur_style, cur_mu);
- if (z != null) {
- reset_attributes(z, node_attr(p));
- vlink(p) = z;
- p = z;
- }
- }
-
- /* Append any |new_hlist| entries for |q|, and any appropriate penalties */
- /* We insert a penalty node after the hlist entries of noad |q| if |pen|
- is not an ``infinite'' penalty, and if the node immediately following |q|
- is not a penalty node or a |rel_noad| or absent entirely. */
-
- if (new_hlist(q) != null) {
- vlink(p) = new_hlist(q);
- do {
- p = vlink(p);
- } while (vlink(p) != null);
- }
- if (penalties && vlink(q) != null && pen < inf_penalty) {
- r_type = type(vlink(q));
- r_subtype = subtype(vlink(q));
- if (r_type != penalty_node
- && (r_type != simple_noad || r_subtype != rel_noad_type)) {
- z = new_penalty(pen);
- reset_attributes(z, node_attr(q));
- vlink(p) = z;
- p = z;
- }
- }
- if (type(q) == fence_noad && subtype(q) == right_noad_side) {
- t = simple_noad;
- t_subtype = open_noad_type;
- }
- r_type = t;
- r_subtype = t_subtype;
- DELETE_Q:
- r = q;
- q = vlink(q);
- /* The m-to-hlist conversion takes place in-place,
- so the various dependant fields may not be freed
- (as would happen if |flush_node| was called).
- A low-level |free_node| is easier than attempting
- to nullify such dependant fields for all possible
- node and noad types.
- */
- if (nodetype_has_attributes(type(r)))
- delete_attribute_ref(node_attr(r));
- free_node(r, get_node_size(type(r), subtype(r)));
- }
-}
-
-@ This used to be needed when |mlist_to_hlist| communicated via global
-variables.
-
-@c
-void mlist_to_hlist_args(pointer n, int w, boolean m)
-{
- mlist_to_hlist(n, m, w);
-}
+% mlist.w
+%
+% Copyright 2006-2010 Taco Hoekwater <taco@@luatex.org>
+%
+% This file is part of LuaTeX.
+%
+% LuaTeX is free software; you can redistribute it and/or modify it under
+% the terms of the GNU General Public License as published by the Free
+% Software Foundation; either version 2 of the License, or (at your
+% option) any later version.
+%
+% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
+% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
+% License for more details.
+%
+% You should have received a copy of the GNU General Public License along
+% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
+
+/* hh-ls: by using couple_nodes instead of vlink we make sure that we can backtrack as well as have valid prev links */
+
+
+\def\LuaTeX{Lua\TeX}
+
+@ @c
+static const char _svn_version[] =
+ "$Id: mlist.w 4793 2014-02-10 23:13:29Z luigi $"
+ "$URL: https://foundry.supelec.fr/svn/luatex/trunk/source/texk/web2c/luatexdir/tex/mlist.w $";
+
+#include "ptexlib.h"
+#include "lua/luatex-api.h"
+
+@ @c
+#define delimiter_factor int_par(delimiter_factor_code)
+#define delimiter_shortfall dimen_par(delimiter_shortfall_code)
+#define bin_op_penalty int_par(bin_op_penalty_code)
+#define rel_penalty int_par(rel_penalty_code)
+#define null_delimiter_space dimen_par(null_delimiter_space_code)
+#define script_space dimen_par(script_space_code)
+#define disable_lig int_par(disable_lig_code)
+#define disable_kern int_par(disable_kern_code)
+
+#define nDEBUG
+
+#define reset_attributes(p,newatt) do { \
+ delete_attribute_ref(node_attr(p)); \
+ node_attr(p) = newatt; \
+ if (newatt!=null) { \
+ assert(type(newatt)==attribute_list_node); \
+ add_node_attr_ref(node_attr(p)); \
+ } \
+ } while (0)
+
+
+#define DEFINE_MATH_PARAMETERS(A,B,C,D) do { \
+ if (B==text_size) { \
+ def_math_param(A, text_style, (C),D); \
+ def_math_param(A, cramped_text_style, (C),D); \
+ } else if (B==script_size) { \
+ def_math_param(A, script_style, (C),D); \
+ def_math_param(A, cramped_script_style, (C),D); \
+ } else if (B==script_script_size) { \
+ def_math_param(A, script_script_style, (C),D); \
+ def_math_param(A, cramped_script_script_style, (C),D); \
+ } \
+ } while (0)
+
+#define DEFINE_DMATH_PARAMETERS(A,B,C,D) do { \
+ if (B==text_size) { \
+ def_math_param(A, display_style,(C),D); \
+ def_math_param(A, cramped_display_style,(C),D); \
+ } \
+ } while (0)
+
+
+#define is_new_mathfont(A) (font_math_params(A)>0)
+#define is_old_mathfont(A,B) (font_math_params(A)==0 && font_params(A)>=(B))
+
+
+#define font_MATH_par(a,b) \
+ (font_math_params(a)>=b ? font_math_param(a,b) : undefined_math_parameter)
+
+
+@ here are the math parameters that are font-dependant
+
+@ Before an mlist is converted to an hlist, \TeX\ makes sure that
+the fonts in family~2 have enough parameters to be math-symbol
+fonts, and that the fonts in family~3 have enough parameters to be
+math-extension fonts. The math-symbol parameters are referred to by using the
+following macros, which take a size code as their parameter; for example,
+|num1(cur_size)| gives the value of the |num1| parameter for the current size.
+@^parameters for symbols@>
+@^font parameters@>
+
+@c
+#define total_mathsy_params 22
+#define total_mathex_params 13
+
+#define mathsy(A,B) font_param(fam_fnt(2,A),B)
+#define math_x_height(A) mathsy(A,5) /* height of `\.x' */
+#define math_quad(A) mathsy(A,6) /* \.{18mu} */
+#define num1(A) mathsy(A,8) /* numerator shift-up in display styles */
+#define num2(A) mathsy(A,9) /* numerator shift-up in non-display, non-\.{\\atop} */
+#define num3(A) mathsy(A,10) /* numerator shift-up in non-display \.{\\atop} */
+#define denom1(A) mathsy(A,11) /* denominator shift-down in display styles */
+#define denom2(A) mathsy(A,12) /* denominator shift-down in non-display styles */
+#define sup1(A) mathsy(A,13) /* superscript shift-up in uncramped display style */
+#define sup2(A) mathsy(A,14) /* superscript shift-up in uncramped non-display */
+#define sup3(A) mathsy(A,15) /* superscript shift-up in cramped styles */
+#define sub1(A) mathsy(A,16) /* subscript shift-down if superscript is absent */
+#define sub2(A) mathsy(A,17) /* subscript shift-down if superscript is present */
+#define sup_drop(A) mathsy(A,18) /* superscript baseline below top of large box */
+#define sub_drop(A) mathsy(A,19) /* subscript baseline below bottom of large box */
+#define delim1(A) mathsy(A,20) /* size of \.{\\atopwithdelims} delimiters in display styles */
+#define delim2(A) mathsy(A,21) /* size of \.{\\atopwithdelims} delimiters in non-displays */
+#define axis_height(A) mathsy(A,22) /* height of fraction lines above the baseline */
+
+
+@ The math-extension parameters have similar macros, but the size code is
+omitted (since it is always |cur_size| when we refer to such parameters).
+@^parameters for symbols@>
+@^font parameters@>
+
+@c
+#define mathex(A,B) font_param(fam_fnt(3,A),B)
+#define default_rule_thickness(A) mathex(A,8) /* thickness of \.{\\over} bars */
+#define big_op_spacing1(A) mathex(A,9) /* minimum clearance above a displayed op */
+#define big_op_spacing2(A) mathex(A,10) /* minimum clearance below a displayed op */
+#define big_op_spacing3(A) mathex(A,11) /* minimum baselineskip above displayed op */
+#define big_op_spacing4(A) mathex(A,12) /* minimum baselineskip below displayed op */
+#define big_op_spacing5(A) mathex(A,13) /* padding above and below displayed limits */
+
+@ I (TH) made a bunch of extensions cf. the MATH table in OpenType, but some of
+the MathConstants values have no matching usage in \LuaTeX\ right now.
+
+ScriptPercentScaleDown,
+ScriptScriptPercentScaleDown:
+ These should be handled by the macro package, on the engine
+ side there are three separate fonts
+
+DelimitedSubFormulaMinHeight:
+ This is perhaps related to word's natural math input? I have
+ no idea what to do about it
+
+MathLeading:
+ LuaTeX does not currently handle multi-line displays, and
+ the parameter does not seem to make much sense elsewhere
+
+FlattenedAccentBaseHeight:
+ This is based on the 'flac' GSUB feature. It would not be hard
+ to support that, but proper math accent placements cf. MATH
+ needs support for MathTopAccentAttachment table to be
+ implemented first
+
+SkewedFractionHorizontalGap,
+SkewedFractionVerticalGap:
+ I am not sure it makes sense implementing skewed fractions,
+ so I would like to see an example first
+
+Also still TODO for OpenType Math:
+ * extensible large operators
+ * prescripts
+
+@ this is not really a math parameter at all
+
+@c
+static void math_param_error(const char *param, int style)
+{
+ char s[256];
+ const char *hlp[] = {
+ "Sorry, but I can't typeset math unless various parameters have",
+ "been set. This is normally done by loading special math fonts",
+ "into the math family slots. Your font set is lacking at least",
+ "the parameter mentioned earlier.",
+ NULL
+ };
+ snprintf(s, 256, "Math error: parameter \\Umath%s\\%sstyle is not set",
+ param, math_style_names[style]);
+ tex_error(s, hlp);
+#if 0
+ flush_math();
+#endif
+ return;
+}
+
+
+@ @c
+static scaled accent_base_height(int f)
+{
+ scaled a;
+ if (is_new_mathfont(f)) {
+ a = font_MATH_par(f, AccentBaseHeight);
+ if (a == undefined_math_parameter)
+ a = x_height(f);
+ } else {
+ a = x_height(f);
+ }
+ return a;
+}
+
+@ the non-staticness of this function is for the benefit of |texmath.w|
+
+@c
+scaled get_math_quad(int var)
+{
+ scaled a = get_math_param(math_param_quad, var);
+ if (a == undefined_math_parameter) {
+ math_param_error("quad", var);
+ a = 0;
+ }
+ return a;
+}
+
+@ this parameter is different because it is called with a size
+ specifier instead of a style specifier.
+
+@c
+static scaled math_axis(int b)
+{
+ scaled a;
+ int var;
+ if (b == script_size)
+ var = script_style;
+ else if (b == script_script_size)
+ var = script_script_style;
+ else
+ var = text_style;
+ a = get_math_param(math_param_axis, var);
+ if (a == undefined_math_parameter) {
+ math_param_error("axis", var);
+ a = 0;
+ }
+ return a;
+}
+
+@ @c
+static scaled get_math_quad_size(int b)
+{
+ int var;
+ if (b == script_size)
+ var = script_style;
+ else if (b == script_script_size)
+ var = script_script_style;
+ else
+ var = text_style;
+ return get_math_param(math_param_quad, var);
+}
+
+
+@ @c
+static scaled minimum_operator_size(int var)
+{
+ scaled a = get_math_param(math_param_operator_size, var);
+ return a;
+}
+
+@ Old-style fonts do not define the |radical_rule|. This allows |make_radical| to select
+ the backward compatibility code, and it means that we can't raise an error here.
+
+@c
+static scaled radical_rule(int var)
+{
+ scaled a = get_math_param(math_param_radical_rule, var);
+ return a;
+}
+
+@ now follow all the trivial math parameters
+
+@c
+#define get_math_param_or_error(a,b) do_get_math_param_or_error(a, math_param_##b, #b)
+
+static scaled do_get_math_param_or_error(int var, int param, const char *name)
+{
+ scaled a = get_math_param(param, var);
+ if (a == undefined_math_parameter) {
+ math_param_error(name, var);
+ a = 0;
+ }
+ return a;
+}
+
+@ @c
+#define radical_degree_before(a) get_math_param_or_error(a, radical_degree_before)
+#define radical_degree_after(a) get_math_param_or_error(a, radical_degree_after)
+#define radical_degree_raise(a) get_math_param_or_error(a, radical_degree_raise)
+
+#define connector_overlap_min(a) get_math_param_or_error(a, connector_overlap_min)
+
+#define overbar_rule(a) get_math_param_or_error(a, overbar_rule)
+#define overbar_kern(a) get_math_param_or_error(a, overbar_kern)
+#define overbar_vgap(a) get_math_param_or_error(a, overbar_vgap)
+
+#define underbar_rule(a) get_math_param_or_error(a, underbar_rule)
+#define underbar_kern(a) get_math_param_or_error(a, underbar_kern)
+#define underbar_vgap(a) get_math_param_or_error(a, underbar_vgap)
+
+#define under_delimiter_vgap(a) get_math_param_or_error(a, under_delimiter_vgap)
+#define under_delimiter_bgap(a) get_math_param_or_error(a, under_delimiter_bgap)
+
+#define over_delimiter_vgap(a) get_math_param_or_error(a, over_delimiter_vgap)
+#define over_delimiter_bgap(a) get_math_param_or_error(a, over_delimiter_bgap)
+
+#define radical_vgap(a) get_math_param_or_error(a, radical_vgap)
+#define radical_kern(a) get_math_param_or_error(a, radical_kern)
+
+#define stack_vgap(a) get_math_param_or_error(a, stack_vgap)
+#define stack_num_up(a) get_math_param_or_error(a, stack_num_up)
+#define stack_denom_down(a) get_math_param_or_error(a, stack_denom_down)
+
+#define fraction_rule(a) get_math_param_or_error(a, fraction_rule)
+#define fraction_num_vgap(a) get_math_param_or_error(a, fraction_num_vgap)
+#define fraction_denom_vgap(a) get_math_param_or_error(a, fraction_denom_vgap)
+#define fraction_num_up(a) get_math_param_or_error(a, fraction_num_up)
+#define fraction_denom_down(a) get_math_param_or_error(a, fraction_denom_down)
+#define fraction_del_size(a) get_math_param_or_error(a, fraction_del_size)
+
+#define limit_above_vgap(a) get_math_param_or_error(a, limit_above_vgap)
+#define limit_above_bgap(a) get_math_param_or_error(a, limit_above_bgap)
+#define limit_above_kern(a) get_math_param_or_error(a, limit_above_kern)
+
+#define limit_below_vgap(a) get_math_param_or_error(a, limit_below_vgap)
+#define limit_below_bgap(a) get_math_param_or_error(a, limit_below_bgap)
+#define limit_below_kern(a) get_math_param_or_error(a, limit_below_kern)
+
+#define sub_shift_drop(a) get_math_param_or_error(a, sub_shift_drop)
+#define sup_shift_drop(a) get_math_param_or_error(a, sup_shift_drop)
+#define sub_shift_down(a) get_math_param_or_error(a, sub_shift_down)
+#define sub_sup_shift_down(a) get_math_param_or_error(a, sub_sup_shift_down)
+#define sup_shift_up(a) get_math_param_or_error(a, sup_shift_up)
+#define sub_top_max(a) get_math_param_or_error(a, sub_top_max)
+#define sup_bottom_min(a) get_math_param_or_error(a, sup_bottom_min)
+#define sup_sub_bottom_max(a) get_math_param_or_error(a, sup_sub_bottom_max)
+#define subsup_vgap(a) get_math_param_or_error(a, subsup_vgap)
+
+#define space_after_script(a) get_math_param_or_error(a, space_after_script)
+
+@ @c
+void fixup_math_parameters(int fam_id, int size_id, int f, int lvl)
+{
+ if (is_new_mathfont(f)) { /* fix all known parameters */
+
+ DEFINE_MATH_PARAMETERS(math_param_quad, size_id, font_size(f), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_quad, size_id, font_size(f), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_axis, size_id,
+ font_MATH_par(f, AxisHeight), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_axis, size_id,
+ font_MATH_par(f, AxisHeight), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_overbar_kern, size_id,
+ font_MATH_par(f, OverbarExtraAscender), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_overbar_kern, size_id,
+ font_MATH_par(f, OverbarExtraAscender), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_overbar_rule, size_id,
+ font_MATH_par(f, OverbarRuleThickness), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_overbar_rule, size_id,
+ font_MATH_par(f, OverbarRuleThickness), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_overbar_vgap, size_id,
+ font_MATH_par(f, OverbarVerticalGap), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_overbar_vgap, size_id,
+ font_MATH_par(f, OverbarVerticalGap), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_underbar_kern, size_id,
+ font_MATH_par(f, UnderbarExtraDescender), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_underbar_kern, size_id,
+ font_MATH_par(f, UnderbarExtraDescender), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_underbar_rule, size_id,
+ font_MATH_par(f, UnderbarRuleThickness), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_underbar_rule, size_id,
+ font_MATH_par(f, UnderbarRuleThickness), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_underbar_vgap, size_id,
+ font_MATH_par(f, UnderbarVerticalGap), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_underbar_vgap, size_id,
+ font_MATH_par(f, UnderbarVerticalGap), lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_under_delimiter_vgap, size_id,
+ font_MATH_par(f, StretchStackGapAboveMin), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_under_delimiter_vgap, size_id,
+ font_MATH_par(f, StretchStackGapAboveMin), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_under_delimiter_bgap, size_id,
+ font_MATH_par(f, StretchStackBottomShiftDown),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_under_delimiter_bgap, size_id,
+ font_MATH_par(f, StretchStackBottomShiftDown),
+ lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_over_delimiter_vgap, size_id,
+ font_MATH_par(f, StretchStackGapBelowMin), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_over_delimiter_vgap, size_id,
+ font_MATH_par(f, StretchStackGapBelowMin), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_over_delimiter_bgap, size_id,
+ font_MATH_par(f, StretchStackTopShiftUp), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_over_delimiter_bgap, size_id,
+ font_MATH_par(f, StretchStackTopShiftUp), lvl);
+
+
+ DEFINE_MATH_PARAMETERS(math_param_stack_num_up, size_id,
+ font_MATH_par(f, StackTopShiftUp), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_stack_num_up, size_id,
+ font_MATH_par(f, StackTopDisplayStyleShiftUp),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_stack_denom_down, size_id,
+ font_MATH_par(f, StackBottomShiftDown), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_stack_denom_down, size_id,
+ font_MATH_par(f,
+ StackBottomDisplayStyleShiftDown),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_stack_vgap, size_id,
+ font_MATH_par(f, StackGapMin), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_stack_vgap, size_id,
+ font_MATH_par(f, StackDisplayStyleGapMin), lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_radical_kern, size_id,
+ font_MATH_par(f, RadicalExtraAscender), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_radical_kern, size_id,
+ font_MATH_par(f, RadicalExtraAscender), lvl);
+
+ DEFINE_DMATH_PARAMETERS(math_param_operator_size, size_id,
+ font_MATH_par(f, DisplayOperatorMinHeight),
+ lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_radical_rule, size_id,
+ font_MATH_par(f, RadicalRuleThickness), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_radical_rule, size_id,
+ font_MATH_par(f, RadicalRuleThickness), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_radical_vgap, size_id,
+ font_MATH_par(f, RadicalVerticalGap), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_radical_vgap, size_id,
+ font_MATH_par(f,
+ RadicalDisplayStyleVerticalGap),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_radical_degree_before, size_id,
+ font_MATH_par(f, RadicalKernBeforeDegree), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_radical_degree_before, size_id,
+ font_MATH_par(f, RadicalKernBeforeDegree), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_radical_degree_after, size_id,
+ font_MATH_par(f, RadicalKernAfterDegree), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_radical_degree_after, size_id,
+ font_MATH_par(f, RadicalKernAfterDegree), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_radical_degree_raise, size_id,
+ font_MATH_par(f,
+ RadicalDegreeBottomRaisePercent),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_radical_degree_raise, size_id,
+ font_MATH_par(f,
+ RadicalDegreeBottomRaisePercent),
+ lvl);
+ if (size_id == text_size) {
+ def_math_param(math_param_sup_shift_up, display_style,
+ font_MATH_par(f, SuperscriptShiftUp), lvl);
+ def_math_param(math_param_sup_shift_up, cramped_display_style,
+ font_MATH_par(f, SuperscriptShiftUpCramped), lvl);
+ def_math_param(math_param_sup_shift_up, text_style,
+ font_MATH_par(f, SuperscriptShiftUp), lvl);
+ def_math_param(math_param_sup_shift_up, cramped_text_style,
+ font_MATH_par(f, SuperscriptShiftUpCramped), lvl);
+ } else if (size_id == script_size) {
+ def_math_param(math_param_sup_shift_up, script_style,
+ font_MATH_par(f, SuperscriptShiftUp), lvl);
+ def_math_param(math_param_sup_shift_up, cramped_script_style,
+ font_MATH_par(f, SuperscriptShiftUpCramped), lvl);
+ } else if (size_id == script_script_size) {
+ def_math_param(math_param_sup_shift_up, script_script_style,
+ font_MATH_par(f, SuperscriptShiftUp), lvl);
+ def_math_param(math_param_sup_shift_up, cramped_script_script_style,
+ font_MATH_par(f, SuperscriptShiftUpCramped), lvl);
+ }
+
+ DEFINE_MATH_PARAMETERS(math_param_sub_shift_drop, size_id,
+ font_MATH_par(f, SubscriptBaselineDropMin), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sub_shift_drop, size_id,
+ font_MATH_par(f, SubscriptBaselineDropMin),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_sup_shift_drop, size_id,
+ font_MATH_par(f, SuperscriptBaselineDropMax),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sup_shift_drop, size_id,
+ font_MATH_par(f, SuperscriptBaselineDropMax),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_sub_shift_down, size_id,
+ font_MATH_par(f, SubscriptShiftDown), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sub_shift_down, size_id,
+ font_MATH_par(f, SubscriptShiftDown), lvl);
+
+ if (font_MATH_par(f, SubscriptShiftDownWithSuperscript) !=
+ undefined_math_parameter) {
+ DEFINE_MATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
+ font_MATH_par(f,
+ SubscriptShiftDownWithSuperscript),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
+ font_MATH_par(f,
+ SubscriptShiftDownWithSuperscript),
+ lvl);
+ } else {
+ DEFINE_MATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
+ font_MATH_par(f, SubscriptShiftDown), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
+ font_MATH_par(f, SubscriptShiftDown), lvl);
+ }
+
+ DEFINE_MATH_PARAMETERS(math_param_sub_top_max, size_id,
+ font_MATH_par(f, SubscriptTopMax), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sub_top_max, size_id,
+ font_MATH_par(f, SubscriptTopMax), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_sup_bottom_min, size_id,
+ font_MATH_par(f, SuperscriptBottomMin), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sup_bottom_min, size_id,
+ font_MATH_par(f, SuperscriptBottomMin), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_sup_sub_bottom_max, size_id,
+ font_MATH_par(f,
+ SuperscriptBottomMaxWithSubscript),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sup_sub_bottom_max, size_id,
+ font_MATH_par(f,
+ SuperscriptBottomMaxWithSubscript),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_subsup_vgap, size_id,
+ font_MATH_par(f, SubSuperscriptGapMin), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_subsup_vgap, size_id,
+ font_MATH_par(f, SubSuperscriptGapMin), lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_limit_above_vgap, size_id,
+ font_MATH_par(f, UpperLimitGapMin), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_above_vgap, size_id,
+ font_MATH_par(f, UpperLimitGapMin), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_limit_above_bgap, size_id,
+ font_MATH_par(f, UpperLimitBaselineRiseMin),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_above_bgap, size_id,
+ font_MATH_par(f, UpperLimitBaselineRiseMin),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_limit_above_kern, size_id, 0, lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_above_kern, size_id, 0, lvl);
+ DEFINE_MATH_PARAMETERS(math_param_limit_below_vgap, size_id,
+ font_MATH_par(f, LowerLimitGapMin), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_below_vgap, size_id,
+ font_MATH_par(f, LowerLimitGapMin), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_limit_below_bgap, size_id,
+ font_MATH_par(f, LowerLimitBaselineDropMin),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_below_bgap, size_id,
+ font_MATH_par(f, LowerLimitBaselineDropMin),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_limit_below_kern, size_id, 0, lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_below_kern, size_id, 0, lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_fraction_rule, size_id,
+ font_MATH_par(f, FractionRuleThickness), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_rule, size_id,
+ font_MATH_par(f, FractionRuleThickness), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_fraction_num_vgap, size_id,
+ font_MATH_par(f, FractionNumeratorGapMin), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_num_vgap, size_id,
+ font_MATH_par(f,
+ FractionNumeratorDisplayStyleGapMin),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_fraction_num_up, size_id,
+ font_MATH_par(f, FractionNumeratorShiftUp), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_num_up, size_id,
+ font_MATH_par(f,
+ FractionNumeratorDisplayStyleShiftUp),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_fraction_denom_vgap, size_id,
+ font_MATH_par(f, FractionDenominatorGapMin),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_denom_vgap, size_id,
+ font_MATH_par(f,
+ FractionDenominatorDisplayStyleGapMin),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_fraction_denom_down, size_id,
+ font_MATH_par(f, FractionDenominatorShiftDown),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_denom_down, size_id,
+ font_MATH_par(f,
+ FractionDenominatorDisplayStyleShiftDown),
+ lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_fraction_del_size, size_id,
+ font_MATH_par(f, FractionDelimiterSize), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_del_size, size_id,
+ font_MATH_par(f,
+ FractionDelimiterDisplayStyleSize),
+ lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_space_after_script, size_id,
+ font_MATH_par(f, SpaceAfterScript), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_space_after_script, size_id,
+ font_MATH_par(f, SpaceAfterScript), lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_connector_overlap_min, size_id,
+ font_MATH_par(f, MinConnectorOverlap), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_connector_overlap_min, size_id,
+ font_MATH_par(f, MinConnectorOverlap), lvl);
+
+
+ } else if (fam_id == 2 && is_old_mathfont(f, total_mathsy_params)) {
+ /* fix old-style |sy| parameters */
+ DEFINE_MATH_PARAMETERS(math_param_quad, size_id, math_quad(size_id),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_quad, size_id, math_quad(size_id),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_axis, size_id, axis_height(size_id),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_axis, size_id, axis_height(size_id),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_stack_num_up, size_id, num3(size_id),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_stack_num_up, size_id, num1(size_id),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_stack_denom_down, size_id,
+ denom2(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_stack_denom_down, size_id,
+ denom1(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_fraction_num_up, size_id,
+ num2(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_num_up, size_id,
+ num1(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_fraction_denom_down, size_id,
+ denom2(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_denom_down, size_id,
+ denom1(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_fraction_del_size, size_id,
+ delim2(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_del_size, size_id,
+ delim1(size_id), lvl);
+ if (size_id == text_size) {
+ def_math_param(math_param_sup_shift_up, display_style,
+ sup1(size_id), lvl);
+ def_math_param(math_param_sup_shift_up, cramped_display_style,
+ sup3(size_id), lvl);
+ def_math_param(math_param_sup_shift_up, text_style, sup2(size_id),
+ lvl);
+ def_math_param(math_param_sup_shift_up, cramped_text_style,
+ sup3(size_id), lvl);
+ } else if (size_id == script_size) {
+ def_math_param(math_param_sub_shift_drop, display_style,
+ sub_drop(size_id), lvl);
+ def_math_param(math_param_sub_shift_drop, cramped_display_style,
+ sub_drop(size_id), lvl);
+ def_math_param(math_param_sub_shift_drop, text_style,
+ sub_drop(size_id), lvl);
+ def_math_param(math_param_sub_shift_drop, cramped_text_style,
+ sub_drop(size_id), lvl);
+ def_math_param(math_param_sup_shift_drop, display_style,
+ sup_drop(size_id), lvl);
+ def_math_param(math_param_sup_shift_drop, cramped_display_style,
+ sup_drop(size_id), lvl);
+ def_math_param(math_param_sup_shift_drop, text_style,
+ sup_drop(size_id), lvl);
+ def_math_param(math_param_sup_shift_drop, cramped_text_style,
+ sup_drop(size_id), lvl);
+ def_math_param(math_param_sup_shift_up, script_style, sup2(size_id),
+ lvl);
+ def_math_param(math_param_sup_shift_up, cramped_script_style,
+ sup3(size_id), lvl);
+ } else if (size_id == script_script_size) {
+ def_math_param(math_param_sub_shift_drop, script_style,
+ sub_drop(size_id), lvl);
+ def_math_param(math_param_sub_shift_drop, cramped_script_style,
+ sub_drop(size_id), lvl);
+ def_math_param(math_param_sub_shift_drop, script_script_style,
+ sub_drop(size_id), lvl);
+ def_math_param(math_param_sub_shift_drop,
+ cramped_script_script_style, sub_drop(size_id), lvl);
+ def_math_param(math_param_sup_shift_drop, script_style,
+ sup_drop(size_id), lvl);
+ def_math_param(math_param_sup_shift_drop, cramped_script_style,
+ sup_drop(size_id), lvl);
+ def_math_param(math_param_sup_shift_drop, script_script_style,
+ sup_drop(size_id), lvl);
+ def_math_param(math_param_sup_shift_drop,
+ cramped_script_script_style, sup_drop(size_id), lvl);
+ def_math_param(math_param_sup_shift_up, script_script_style,
+ sup2(size_id), lvl);
+ def_math_param(math_param_sup_shift_up, cramped_script_script_style,
+ sup3(size_id), lvl);
+ }
+ DEFINE_MATH_PARAMETERS(math_param_sub_shift_down, size_id,
+ sub1(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sub_shift_down, size_id,
+ sub1(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
+ sub2(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sub_sup_shift_down, size_id,
+ sub2(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_sub_top_max, size_id,
+ (abs(math_x_height(size_id) * 4) / 5), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sub_top_max, size_id,
+ (abs(math_x_height(size_id) * 4) / 5), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_sup_bottom_min, size_id,
+ (abs(math_x_height(size_id)) / 4), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sup_bottom_min, size_id,
+ (abs(math_x_height(size_id)) / 4), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_sup_sub_bottom_max, size_id,
+ (abs(math_x_height(size_id) * 4) / 5), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_sup_sub_bottom_max, size_id,
+ (abs(math_x_height(size_id) * 4) / 5), lvl);
+
+ /* The display-size |radical_vgap| is done twice because it needs
+ values from both the sy and the ex font. */
+ DEFINE_DMATH_PARAMETERS(math_param_radical_vgap, size_id,
+ (default_rule_thickness(size_id) +
+ (abs(math_x_height(size_id)) / 4)), lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_radical_degree_raise, size_id,
+ 60, lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_radical_degree_raise, size_id,
+ 60, lvl);
+ DEFINE_MATH_PARAMETERS(math_param_radical_degree_before, size_id,
+ xn_over_d(get_math_quad_size(size_id), 5, 18),
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_radical_degree_before, size_id,
+ xn_over_d(get_math_quad_size(size_id), 5, 18),
+ lvl);
+ DEFINE_MATH_PARAMETERS(math_param_radical_degree_after, size_id,
+ (-xn_over_d
+ (get_math_quad_size(size_id), 10, 18)), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_radical_degree_after, size_id,
+ (-xn_over_d
+ (get_math_quad_size(size_id), 10, 18)), lvl);
+
+ } else if (fam_id == 3 && is_old_mathfont(f, total_mathex_params)) {
+ /* fix old-style |ex| parameters */
+ DEFINE_MATH_PARAMETERS(math_param_overbar_kern, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_overbar_rule, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_overbar_vgap, size_id,
+ 3 * default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_overbar_kern, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_overbar_rule, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_overbar_vgap, size_id,
+ 3 * default_rule_thickness(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_underbar_kern, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_underbar_rule, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_underbar_vgap, size_id,
+ 3 * default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_underbar_kern, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_underbar_rule, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_underbar_vgap, size_id,
+ 3 * default_rule_thickness(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_radical_kern, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_radical_kern, size_id,
+ default_rule_thickness(size_id), lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_radical_vgap, size_id,
+ (default_rule_thickness(size_id) +
+ (abs(default_rule_thickness(size_id)) / 4)),
+ lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_stack_vgap, size_id,
+ 3 * default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_stack_vgap, size_id,
+ 7 * default_rule_thickness(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_fraction_rule, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_rule, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_fraction_num_vgap, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_num_vgap, size_id,
+ 3 * default_rule_thickness(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_fraction_denom_vgap, size_id,
+ default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_fraction_denom_vgap, size_id,
+ 3 * default_rule_thickness(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_limit_above_vgap, size_id,
+ big_op_spacing1(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_above_vgap, size_id,
+ big_op_spacing1(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_limit_above_bgap, size_id,
+ big_op_spacing3(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_above_bgap, size_id,
+ big_op_spacing3(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_limit_above_kern, size_id,
+ big_op_spacing5(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_above_kern, size_id,
+ big_op_spacing5(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_limit_below_vgap, size_id,
+ big_op_spacing2(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_below_vgap, size_id,
+ big_op_spacing2(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_limit_below_bgap, size_id,
+ big_op_spacing4(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_below_bgap, size_id,
+ big_op_spacing4(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_limit_below_kern, size_id,
+ big_op_spacing5(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_limit_below_kern, size_id,
+ big_op_spacing5(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_subsup_vgap, size_id,
+ 4 * default_rule_thickness(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_subsup_vgap, size_id,
+ 4 * default_rule_thickness(size_id), lvl);
+ /* All of the |space_after_script|s are done in |finalize_math_parameters| because the
+ \.{\\scriptspace} may have been altered by the user
+ */
+ DEFINE_MATH_PARAMETERS(math_param_connector_overlap_min, size_id, 0,
+ lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_connector_overlap_min, size_id, 0,
+ lvl);
+
+ DEFINE_MATH_PARAMETERS(math_param_under_delimiter_vgap, size_id,
+ big_op_spacing2(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_under_delimiter_vgap, size_id,
+ big_op_spacing2(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_under_delimiter_bgap, size_id,
+ big_op_spacing4(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_under_delimiter_bgap, size_id,
+ big_op_spacing4(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_over_delimiter_vgap, size_id,
+ big_op_spacing1(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_over_delimiter_vgap, size_id,
+ big_op_spacing1(size_id), lvl);
+ DEFINE_MATH_PARAMETERS(math_param_over_delimiter_bgap, size_id,
+ big_op_spacing3(size_id), lvl);
+ DEFINE_DMATH_PARAMETERS(math_param_over_delimiter_bgap, size_id,
+ big_op_spacing3(size_id), lvl);
+
+ /* The display-size |radical_vgap| is done twice because it needs
+ values from both the sy and the ex font. */
+ DEFINE_DMATH_PARAMETERS(math_param_radical_vgap, size_id,
+ (default_rule_thickness(size_id) +
+ (abs(math_x_height(size_id)) / 4)), lvl);
+ }
+}
+
+@ This needs to be called just at the start of |mlist_to_hlist|, for
+backward compatibility with \.{\\scriptspace}.
+
+@c
+static void finalize_math_parameters(void)
+{
+ int saved_trace = int_par(tracing_assigns_code);
+ int_par(tracing_assigns_code) = 0;
+ if (get_math_param(math_param_space_after_script, display_style) ==
+ undefined_math_parameter) {
+ def_math_param(math_param_space_after_script, display_style,
+ script_space, level_one);
+ def_math_param(math_param_space_after_script, text_style,
+ script_space, level_one);
+ def_math_param(math_param_space_after_script, script_style,
+ script_space, level_one);
+ def_math_param(math_param_space_after_script, script_script_style,
+ script_space, level_one);
+ def_math_param(math_param_space_after_script, cramped_display_style,
+ script_space, level_one);
+ def_math_param(math_param_space_after_script, cramped_text_style,
+ script_space, level_one);
+ def_math_param(math_param_space_after_script, cramped_script_style,
+ script_space, level_one);
+ def_math_param(math_param_space_after_script,
+ cramped_script_script_style, script_space, level_one);
+ }
+ int_par(tracing_assigns_code) = saved_trace;
+
+}
+
+
+@ In order to convert mlists to hlists, i.e., noads to nodes, we need several
+subroutines that are conveniently dealt with now.
+
+Let us first introduce the macros that make it easy to get at the parameters and
+other font information. A size code, which is a multiple of 256, is added to a
+family number to get an index into the table of internal font numbers
+for each combination of family and size. (Be alert: Size codes get
+larger as the type gets smaller.)
+
+@c
+static const char *math_size_string(int s)
+{
+ if (s == text_size)
+ return "textfont";
+ else if (s == script_size)
+ return "scriptfont";
+ else
+ return "scriptscriptfont";
+}
+
+@ When the style changes, the following piece of program computes associated
+information:
+
+@c
+#define setup_cur_size(a) do { \
+ if (a==script_style || \
+ a==cramped_script_style) \
+ cur_size=script_size; \
+ else if (a==script_script_style || \
+ a==cramped_script_script_style) \
+ cur_size=script_script_size; \
+ else cur_size=text_size; \
+ } while (0)
+
+
+@ a simple routine that creates a flat copy of a nucleus
+@c
+static pointer math_clone(pointer q)
+{
+ pointer x;
+ if (q == null)
+ return null;
+ x = new_node(type(q), 0);
+ reset_attributes(x, node_attr(q));
+ if (type(q) == math_char_node) {
+ math_fam(x) = math_fam(q);
+ math_character(x) = math_character(q);
+ } else {
+ math_list(x) = math_list(q);
+ }
+ return x;
+}
+
+
+
+
+@ Here is a function that returns a pointer to a rule node having a given
+ thickness |t|. The rule will extend horizontally to the boundary of the vlist
+ that eventually contains it.
+
+@c
+static pointer do_fraction_rule(scaled t, pointer att)
+{
+ pointer p; /* the new node */
+ p = new_rule();
+ rule_dir(p) = math_direction;
+ height(p) = t;
+ depth(p) = 0;
+ reset_attributes(p, att);
+ return p;
+}
+
+
+@ The |overbar| function returns a pointer to a vlist box that consists of
+ a given box |b|, above which has been placed a kern of height |k| under a
+ fraction rule of thickness |t| under additional space of height |ht|.
+
+@c
+static pointer overbar(pointer b, scaled k, scaled t, scaled ht, pointer att)
+{
+ pointer p, q; /* nodes being constructed */
+ p = new_kern(k);
+ couple_nodes(p,b);
+ reset_attributes(p, att);
+ q = do_fraction_rule(t, att);
+ couple_nodes(q,p);
+ p = new_kern(ht);
+ reset_attributes(p, att);
+ couple_nodes(p,q);
+ q = vpackage(p, 0, additional, max_dimen, math_direction);
+ reset_attributes(q, att);
+ return q;
+}
+
+@ Here is a subroutine that creates a new box, whose list contains a
+ single character, and whose width includes the italic correction for
+ that character. The height or depth of the box will be negative, if
+ the height or depth of the character is negative; thus, this routine
+ may deliver a slightly different result than |hpack| would produce.
+
+@c
+static pointer char_box(internal_font_number f, int c, pointer bb)
+{
+ pointer b, p; /* the new box and its character node */
+ b = new_null_box();
+ width(b) = char_width(f, c) + char_italic(f, c);
+ height(b) = char_height(f, c);
+ depth(b) = char_depth(f, c);
+ reset_attributes(b, bb);
+ p = new_char(f, c);
+ reset_attributes(p, bb);
+ list_ptr(b) = p;
+ return b;
+}
+
+@ Another handy subroutine computes the height plus depth of
+ a given character:
+
+@c
+static scaled height_plus_depth(internal_font_number f, int c)
+{
+ return (char_height(f, c) + char_depth(f, c));
+}
+
+
+@ When we build an extensible character, it's handy to have the
+ following subroutine, which puts a given character on top
+ of the characters already in box |b|:
+
+@c
+static scaled stack_into_box(pointer b, internal_font_number f, int c)
+{
+ pointer p, q; /* new node placed into |b| */
+ p = char_box(f, c, node_attr(b));
+ if (type(b) == vlist_node) {
+// vlink(p) = list_ptr(b);
+try_couple_nodes(p,list_ptr(b));
+ list_ptr(b) = p;
+ height(b) = height(p);
+ if (width(b) < width(p))
+ width(b) = width(p);
+ return height_plus_depth(f, c);
+ } else {
+ q = list_ptr(b);
+ if (q == null) {
+ list_ptr(b) = p;
+ } else {
+ while (vlink(q) != null)
+ q = vlink(q);
+ couple_nodes(q,p);
+ }
+ if (height(b) < height(p))
+ height(b) = height(p);
+ if (depth(b) < depth(p))
+ depth(b) = depth(p);
+ return char_width(f, c);
+ }
+}
+
+static void stack_glue_into_box(pointer b, scaled min, scaled max) {
+ pointer p, q; /* new node placed into |b| */
+ q = new_spec(zero_glue);
+ width(q) = min;
+ stretch(q) = max-min;
+ p = new_glue(q);
+ reset_attributes(p, node_attr(b));
+ if (type(b) == vlist_node) {
+// vlink(p) = list_ptr(b);
+try_couple_nodes(p,list_ptr(b));
+ list_ptr(b) = p;
+ height(b) = height(p);
+ } else {
+ q = list_ptr(b);
+ if (q == null) {
+ list_ptr(b) = p;
+ } else {
+ while (vlink(q) != null)
+ q = vlink(q);
+ couple_nodes(q,p);
+ }
+ if (height(b) < height(p))
+ height(b) = height(p);
+ if (depth(b) < depth(p))
+ depth(b) = depth(p);
+ }
+}
+
+@ \TeX's most important routine for dealing with formulas is called
+ |mlist_to_hlist|. After a formula has been scanned and represented
+ as an mlist, this routine converts it to an hlist that can be placed
+ into a box or incorporated into the text of a paragraph. The
+ explicit parameter |cur_mlist| points to the first node or noad in
+ the given mlist (and it might be |null|); the parameter |penalties|
+ is |true| if penalty nodes for potential line breaks are to be
+ inserted into the resulting hlist, the parameter |cur_style| is a
+ style code. After |mlist_to_hlist| has acted, |vlink(temp_head)|
+ points to the translated hlist.
+
+ Since mlists can be inside mlists, the procedure is recursive. And since this
+ is not part of \TeX's inner loop, the program has been written in a manner
+ that stresses compactness over efficiency.
+@^recursion@>
+
+@c
+int cur_size; /* size code corresponding to |cur_style| */
+
+@ @c
+static pointer get_delim_box(extinfo * ext, internal_font_number f, scaled v,
+ pointer att, int boxtype, int cur_style)
+{
+ pointer b; /* new box */
+ scaled b_max; /* natural (maximum) size of the stack */
+ scaled s_max; /* amount of possible shrink in the stack */
+ extinfo *cur;
+ scaled min_overlap, prev_overlap;
+ int i; /* a temporary counter number of extensible pieces */
+ int with_extenders; /* number of times to repeat each repeatable item in |ext| */
+ int num_extenders, num_normal;
+ scaled a, c, d;
+
+ assert(ext != NULL);
+ b = new_null_box();
+ type(b) = (quarterword) boxtype;
+ reset_attributes(b, att);
+ min_overlap = connector_overlap_min(cur_style);
+ assert(min_overlap >= 0);
+ with_extenders = -1;
+ num_extenders = 0;
+ num_normal = 0;
+
+ cur = ext;
+ while (cur != NULL) {
+ if (!char_exists(f, cur->glyph)) {
+ const char *hlp[] = {
+ "Each glyph part in an extensible item should exist in the font.",
+ "I will give up trying to find a suitable size for now. Fix your font!",
+ NULL
+ };
+ tex_error("Variant part doesn't exist.", hlp);
+ width(b) = null_delimiter_space;
+ return b;
+ }
+ if (cur->extender > 0)
+ num_extenders++;
+ else
+ num_normal++;
+ /* no negative overlaps or advances are allowed */
+ if (cur->start_overlap < 0 || cur->end_overlap < 0 || cur->advance < 0) {
+ const char *hlp[] = {
+ "All measurements in extensible items should be positive.",
+ "To get around this problem, I have changed the font metrics.",
+ "Fix your font!",
+ NULL
+ };
+ tex_error("Extensible recipe has negative fields.", hlp);
+ if (cur->start_overlap < 0)
+ cur->start_overlap = 0;
+ if (cur->end_overlap < 0)
+ cur->end_overlap = 0;
+ if (cur->advance < 0)
+ cur->advance = 0;
+ }
+ cur = cur->next;
+ }
+ if (num_normal == 0) {
+ const char *hlp[] = {
+ "Each extensible recipe should have at least one non-repeatable part.",
+ "To get around this problem, I have changed the first part to be",
+ "non-repeatable. Fix your font!",
+ NULL
+ };
+ tex_error("Extensible recipe has no fixed parts.", hlp);
+ ext->extender = 0;
+ num_normal = 1;
+ num_extenders--;
+ }
+ /* |ext| holds a linked list of numerous items that may or may not be
+ repeatable. For the total height, we have to figure out how many items
+ are needed to create a stack of at least |v|.
+ The next |while| loop does that. It has two goals: it finds out
+ the natural height |b_max| of the all the parts needed to reach
+ at least |v|, and it sets |with_extenders| to the number of times
+ each of the repeatable items in |ext| has to be repeated to reach
+ that height.
+ */
+ cur = ext;
+ b_max = 0;
+ while (b_max < v && num_extenders > 0) {
+ b_max = 0;
+ prev_overlap = 0;
+ with_extenders++;
+ for (cur = ext; cur != NULL; cur = cur->next) {
+ if (cur->extender == 0) {
+ c = cur->start_overlap;
+ if (min_overlap < c)
+ c = min_overlap;
+ if (prev_overlap < c)
+ c = prev_overlap;
+ a = cur->advance;
+ if (a == 0) {
+ /* for tfm fonts */
+ if (boxtype == vlist_node)
+ a = height_plus_depth(f, cur->glyph);
+ else
+ a = char_width(f, cur->glyph);
+ assert(a >= 0);
+ }
+ b_max += a - c;
+ prev_overlap = cur->end_overlap;
+ } else {
+ i = with_extenders;
+ while (i > 0) {
+ c = cur->start_overlap;
+ if (min_overlap < c)
+ c = min_overlap;
+ if (prev_overlap < c)
+ c = prev_overlap;
+ a = cur->advance;
+ if (a == 0) {
+ /* for tfm fonts */
+ if (boxtype == vlist_node)
+ a = height_plus_depth(f, cur->glyph);
+ else
+ a = char_width(f, cur->glyph);
+ assert(a >= 0);
+ }
+ b_max += a - c;
+ prev_overlap = cur->end_overlap;
+ i--;
+ }
+ }
+ }
+ }
+
+ /* assemble box using |with_extenders| copies of each extender, with
+ appropriate glue wherever an overlap occurs */
+ prev_overlap = 0;
+ b_max = 0;
+ s_max = 0;
+ for (cur = ext; cur != NULL; cur = cur->next) {
+ if (cur->extender == 0) {
+ c = cur->start_overlap;
+ if (prev_overlap < c)
+ c = prev_overlap;
+ d = c;
+ if (min_overlap < c)
+ c = min_overlap;
+ if (d > 0) {
+ stack_glue_into_box(b, -d, -c);
+ s_max += (-c) - (-d);
+ b_max -= d;
+ }
+ b_max += stack_into_box(b, f, cur->glyph);
+ prev_overlap = cur->end_overlap;
+ i--;
+ } else {
+ i = with_extenders;
+ while (i > 0) {
+ c = cur->start_overlap;
+ if (prev_overlap < c)
+ c = prev_overlap;
+ d = c;
+ if (min_overlap < c)
+ c = min_overlap;
+ if (d > 0) {
+ stack_glue_into_box(b, -d, -c);
+ s_max += (-c) - (-d);
+ b_max -= d;
+ }
+ b_max += stack_into_box(b, f, cur->glyph);
+ prev_overlap = cur->end_overlap;
+ i--;
+ }
+ }
+ }
+
+ /* set glue so as to stretch the connections if needed */
+ d = 0;
+ if (v > b_max && s_max > 0) {
+ d = v-b_max;
+ /* don't stretch more than |s_max| */
+ if (d > s_max)
+ d = s_max;
+ glue_order(b) = normal;
+ glue_sign(b) = stretching;
+ glue_set(b) = unfloat(d/(float) s_max);
+ b_max += d;
+ }
+
+ if (boxtype == vlist_node)
+ height(b) = b_max;
+ else
+ width(b) = b_max;
+
+ return b;
+}
+
+static pointer get_delim_vbox(extinfo * ext, internal_font_number f, scaled v,
+ pointer att, int cur_style)
+{
+ return get_delim_box(ext, f, v, att, vlist_node, cur_style);
+}
+
+static pointer get_delim_hbox(extinfo * ext, internal_font_number f, scaled v,
+ pointer att, int cur_style)
+{
+ return get_delim_box(ext, f, v, att, hlist_node, cur_style);
+}
+
+
+
+@ The |var_delimiter| function, which finds or constructs a sufficiently
+ large delimiter, is the most interesting of the auxiliary functions that
+ currently concern us. Given a pointer |d| to a delimiter field in some noad,
+ together with a size code |s| and a vertical distance |v|, this function
+ returns a pointer to a box that contains the smallest variant of |d| whose
+ height plus depth is |v| or more. (And if no variant is large enough, it
+ returns the largest available variant.) In particular, this routine will
+ construct arbitrarily large delimiters from extensible components, if
+ |d| leads to such characters.
+
+ The value returned is a box whose |shift_amount| has been set so that
+ the box is vertically centered with respect to the axis in the given size.
+ If a built-up symbol is returned, the height of the box before shifting
+ will be the height of its topmost component.
+
+@c
+static void endless_loop_error(internal_font_number g, int y)
+{
+ char s[256];
+ const char *hlp[] = {
+ "You managed to create a seemingly endless charlist chain in the current",
+ "font. I have counted until 10000 already and still have not escaped, so"
+ "I will jump out of the loop all by myself now. Fix your font!",
+ NULL
+ };
+ snprintf(s, 256, "Math error: endless loop in charlist (U+%04x in %s)",
+ (int) y, font_name(g));
+ tex_error(s, hlp);
+}
+
+static pointer do_var_delimiter(pointer d, int s, scaled v, scaled * ic,
+ boolean flat, int cur_style)
+{
+ /* label found,continue; */
+ pointer b; /* the box that will be constructed */
+ internal_font_number f, g; /* best-so-far and tentative font codes */
+ int c, i, x, y; /* best-so-far and tentative character codes */
+ scaled u; /* height-plus-depth of a tentative character */
+ scaled w; /* largest height-plus-depth so far */
+ int z; /* runs through font family members */
+ boolean large_attempt; /* are we trying the ``large'' variant? */
+ pointer att; /* to save the current attribute list */
+ boolean do_parts;
+ extinfo *ext;
+ att = null;
+ f = null_font;
+ c = 0;
+ w = 0;
+ do_parts = false;
+ large_attempt = false;
+ if (d == null)
+ goto FOUND;
+ z = small_fam(d);
+ x = small_char(d);
+ i = 0;
+ while (true) {
+ /* The search process is complicated slightly by the facts that some of the
+ characters might not be present in some of the fonts, and they might not
+ be probed in increasing order of height. */
+ if ((z != 0) || (x != 0)) {
+ g = fam_fnt(z, s);
+ if (g != null_font) {
+ y = x;
+ CONTINUE:
+ i++;
+ if (char_exists(g, y)) {
+ if (flat)
+ u = char_width(g, y);
+ else
+ u = height_plus_depth(g, y);
+ if (u > w) {
+ f = g;
+ c = y;
+ w = u;
+ if (u >= v)
+ goto FOUND;
+ }
+ if (char_tag(g, y) == ext_tag) {
+ f = g;
+ c = y;
+ do_parts = true;
+ goto FOUND;
+ }
+ if (i > 10000) {
+ /* endless loop */
+ endless_loop_error(g, y);
+ goto FOUND;
+ }
+ if (char_tag(g, y) == list_tag) {
+ y = char_remainder(g, y);
+ goto CONTINUE;
+ }
+ }
+ }
+ }
+ if (large_attempt)
+ goto FOUND; /* there were none large enough */
+ large_attempt = true;
+ z = large_fam(d);
+ x = large_char(d);
+ }
+ FOUND:
+ if (d != null) {
+ att = node_attr(d);
+ node_attr(d) = null;
+ flush_node(d);
+ }
+ if (f != null_font) {
+ /* When the following code is executed, |do_parts| will be true
+ if a built-up symbol is supposed to be returned.
+ */
+ ext = NULL;
+ if ((do_parts) &&
+ ((!flat
+ && (ext = get_charinfo_vert_variants(char_info(f, c))) != NULL)
+ || (flat
+ && (ext =
+ get_charinfo_hor_variants(char_info(f, c))) != NULL))) {
+ b = (flat ? get_delim_hbox(ext, f, v, att, cur_style) :
+ get_delim_vbox(ext, f, v, att, cur_style));
+ } else {
+ b = char_box(f, c, att);
+ }
+ /* This next test is because for OT MATH fonts, the italic correction of an
+ extensible character is only used for the placement of a subscript
+ (in negated form), and it is not supposed to be added to the
+ width of the character box at all.
+
+ This has an effect later on in |make_op| as well, where it has to do
+ an extra correction for |make_script|'s addition of yet another italic
+ correction.
+ */
+ if (!is_new_mathfont(f)) {
+ width(b) += char_italic(f, c);
+ }
+ if (ic != NULL)
+ *ic = char_italic(f, c);
+ } else {
+ b = new_null_box();
+ reset_attributes(b, att);
+ width(b) = (flat ? 0 : null_delimiter_space); /* use this width if no delimiter was found */
+ if (ic != NULL)
+ *ic = 0;
+ }
+ if (!flat)
+ shift_amount(b) = half(height(b) - depth(b)) - math_axis(s);
+ delete_attribute_ref(att);
+ return b;
+}
+
+
+static pointer var_delimiter(pointer d, int s, scaled v, scaled * ic,
+ int cur_style)
+{
+ return do_var_delimiter(d, s, v, ic, false, cur_style);
+}
+
+static pointer flat_delimiter(pointer d, int s, scaled v, int cur_style)
+{
+ return do_var_delimiter(d, s, v, NULL, true, cur_style);
+}
+
+@ The next subroutine is much simpler; it is used for numerators and
+denominators of fractions as well as for displayed operators and
+their limits above and below. It takes a given box~|b| and
+changes it so that the new box is centered in a box of width~|w|.
+The centering is done by putting \.{\\hss} glue at the left and right
+of the list inside |b|, then packaging the new box; thus, the
+actual box might not really be centered, if it already contains
+infinite glue.
+
+
+The given box might contain a single character whose italic correction
+has been added to the width of the box; in this case a compensating
+kern is inserted.
+
+@c
+static pointer rebox(pointer b, scaled w)
+{
+ pointer p, q, r, att; /* temporary registers for list manipulation */
+ internal_font_number f; /* font in a one-character box */
+ scaled v; /* width of a character without italic correction */
+
+ if ((width(b) != w) && (list_ptr(b) != null)) {
+ if (type(b) == vlist_node) {
+ p = hpack(b, 0, additional, -1);
+ reset_attributes(p, node_attr(b));
+ b = p;
+ }
+ p = list_ptr(b);
+ att = node_attr(b);
+ add_node_attr_ref(att);
+ if ((is_char_node(p)) && (vlink(p) == null)) {
+ f = font(p);
+ v = char_width(f, character(p));
+ if (v != width(b)) {
+ q = new_kern(width(b) - v);
+ reset_attributes(q, att);
+ couple_nodes(p,q);
+ }
+ }
+ list_ptr(b) = null;
+ flush_node(b);
+ b = new_glue(ss_glue);
+ reset_attributes(b, att);
+ couple_nodes(b,p);
+ while (vlink(p) != null)
+ p = vlink(p);
+ q = new_glue(ss_glue);
+ reset_attributes(q, att);
+ couple_nodes(p,q);
+ r = hpack(b, w, exactly, -1);
+ reset_attributes(r, att);
+ delete_attribute_ref(att);
+ return r;
+ } else {
+ width(b) = w;
+ return b;
+ }
+}
+
+@ Here is a subroutine that creates a new glue specification from another
+one that is expressed in `\.{mu}', given the value of the math unit.
+
+@c
+#define mu_mult(A) mult_and_add(n,(A),xn_over_d((A),f,unity),max_dimen)
+
+static pointer math_glue(pointer g, scaled m)
+{
+ pointer p; /* the new glue specification */
+ int n; /* integer part of |m| */
+ scaled f; /* fraction part of |m| */
+ n = x_over_n(m, unity);
+ f = tex_remainder;
+ if (f < 0) {
+ decr(n);
+ f = f + unity;
+ }
+ p = new_node(glue_spec_node, 0);
+ width(p) = mu_mult(width(g)); /* convert \.{mu} to \.{pt} */
+ stretch_order(p) = stretch_order(g);
+ if (stretch_order(p) == normal)
+ stretch(p) = mu_mult(stretch(g));
+ else
+ stretch(p) = stretch(g);
+ shrink_order(p) = shrink_order(g);
+ if (shrink_order(p) == normal)
+ shrink(p) = mu_mult(shrink(g));
+ else
+ shrink(p) = shrink(g);
+ return p;
+}
+
+@ The |math_kern| subroutine removes |mu_glue| from a kern node, given
+the value of the math unit.
+
+@c
+static void math_kern(pointer p, scaled m)
+{
+ int n; /* integer part of |m| */
+ scaled f; /* fraction part of |m| */
+ if (subtype(p) == mu_glue) {
+ n = x_over_n(m, unity);
+ f = tex_remainder;
+ if (f < 0) {
+ decr(n);
+ f = f + unity;
+ }
+ width(p) = mu_mult(width(p));
+ subtype(p) = explicit;
+ }
+}
+
+@ @c
+void run_mlist_to_hlist(halfword p, int mstyle, boolean penalties)
+{
+ int callback_id;
+ int a, sfix;
+ lua_State *L = Luas;
+ if (p == null) {
+ vlink(temp_head) = null;
+ return;
+ }
+ finalize_math_parameters();
+ callback_id = callback_defined(mlist_to_hlist_callback);
+ if (callback_id > 0) {
+ sfix = lua_gettop(L);
+ if (!get_callback(L, callback_id)) {
+ lua_settop(L, sfix);
+ return;
+ }
+ alink(p) = null ;
+ nodelist_to_lua(L, p); /* arg 1 */
+ lua_pushstring(L, math_style_names[mstyle]); /* arg 2 */
+ lua_pushboolean(L, penalties); /* arg 3 */
+ if (lua_pcall(L, 3, 1, 0) != 0) { /* 3 args, 1 result */
+ fprintf(stdout, "error: %s\n", lua_tostring(L, -1));
+ lua_settop(L, sfix);
+ error();
+ return;
+ }
+ a = nodelist_from_lua(L);
+ /* alink(vlink(a)) = null; */ /* hh-ls: not need to null here */
+ lua_settop(L, sfix);
+ vlink(temp_head) = a;
+ } else if (callback_id == 0) {
+ mlist_to_hlist_args(p, mstyle, penalties);
+ } else {
+ vlink(temp_head) = null;
+ }
+}
+
+@ The recursion in |mlist_to_hlist| is due primarily to a subroutine
+called |clean_box| that puts a given noad field into a box using a given
+math style; |mlist_to_hlist| can call |clean_box|, which can call
+|mlist_to_hlist|.
+@^recursion@>
+
+
+The box returned by |clean_box| is ``clean'' in the
+sense that its |shift_amount| is zero.
+
+@c
+static pointer clean_box(pointer p, int s, int cur_style)
+{
+ pointer q; /* beginning of a list to be boxed */
+ pointer x; /* box to be returned */
+ pointer r; /* temporary pointer */
+ pointer mlist = null; /* beginning of mlist to be translated */
+ switch (type(p)) {
+ case math_char_node:
+ mlist = new_noad();
+ r = math_clone(p);
+ nucleus(mlist) = r;
+ break;
+ case sub_box_node:
+ q = math_list(p);
+ goto FOUND;
+ break;
+ case sub_mlist_node:
+ mlist = math_list(p);
+ break;
+ default:
+ q = new_null_box();
+ goto FOUND;
+ }
+ mlist_to_hlist_args(mlist, s, false);
+ q = vlink(temp_head); /* recursive call */
+ setup_cur_size(cur_style);
+ FOUND:
+ if (is_char_node(q) || (q == null))
+ x = hpack(q, 0, additional, -1);
+ else if ((vlink(q) == null) && (type(q) <= vlist_node)
+ && (shift_amount(q) == 0))
+ x = q; /* it's already clean */
+ else
+ x = hpack(q, 0, additional, -1);
+ if (x != q && q != null)
+ reset_attributes(x, node_attr(q));
+ /* Here we save memory space in a common case. */
+ q = list_ptr(x);
+ if (is_char_node(q)) {
+ r = vlink(q);
+ if (r != null) {
+ if (vlink(r) == null) {
+ if (!is_char_node(r)) {
+ if (type(r) == kern_node) {
+ /* unneeded italic correction */
+ flush_node(r);
+ vlink(q) = null;
+ }
+ }
+ }
+ }
+ }
+ return x;
+}
+
+@ It is convenient to have a procedure that converts a |math_char|
+field to an ``unpacked'' form. The |fetch| routine sets |cur_f| and |cur_c|
+to the font code and character code of a given noad field.
+It also takes care of issuing error messages for
+nonexistent characters; in such cases, |char_exists(cur_f,cur_c)| will be |false|
+after |fetch| has acted, and the field will also have been reset to |null|.
+
+The outputs of |fetch| are placed in global variables.
+
+@c
+internal_font_number cur_f; /* the |font| field of a |math_char| */
+int cur_c; /* the |character| field of a |math_char| */
+
+static void fetch(pointer a)
+{ /* unpack the |math_char| field |a| */
+ cur_c = math_character(a);
+ cur_f = fam_fnt(math_fam(a), cur_size);
+ if (cur_f == null_font) {
+ char *msg;
+ const char *hlp[] = {
+ "Somewhere in the math formula just ended, you used the",
+ "stated character from an undefined font family. For example,",
+ "plain TeX doesn't allow \\it or \\sl in subscripts. Proceed,",
+ "and I'll try to forget that I needed that character.",
+ NULL
+ };
+ msg = xmalloc(256);
+ snprintf(msg, 255, "\\%s%d is undefined (character %d)",
+ math_size_string(cur_size), (int) math_fam(a), (int) cur_c);
+ tex_error(msg, hlp);
+ free(msg);
+ } else {
+ if (!(char_exists(cur_f, cur_c))) {
+ char_warning(cur_f, cur_c);
+ }
+ }
+}
+
+
+@ We need to do a lot of different things, so |mlist_to_hlist| makes two
+passes over the given mlist.
+
+The first pass does most of the processing: It removes ``mu'' spacing from
+glue, it recursively evaluates all subsidiary mlists so that only the
+top-level mlist remains to be handled, it puts fractions and square roots
+and such things into boxes, it attaches subscripts and superscripts, and
+it computes the overall height and depth of the top-level mlist so that
+the size of delimiters for a |fence_noad| will be known.
+The hlist resulting from each noad is recorded in that noad's |new_hlist|
+field, an integer field that replaces the |nucleus| or |thickness|.
+@^recursion@>
+
+The second pass eliminates all noads and inserts the correct glue and
+penalties between nodes.
+
+@c
+static void assign_new_hlist(pointer q, pointer r)
+{
+ switch (type(q)) {
+ case fraction_noad:
+ math_list(numerator(q)) = null;
+ flush_node(numerator(q));
+ numerator(q) = null;
+ math_list(denominator(q)) = null;
+ flush_node(denominator(q));
+ denominator(q) = null;
+ break;
+ case radical_noad:
+ case simple_noad:
+ case accent_noad:
+ if (nucleus(q) != null) {
+ math_list(nucleus(q)) = null;
+ flush_node(nucleus(q));
+ nucleus(q) = null;
+ }
+ break;
+ }
+ new_hlist(q) = r;
+}
+
+@ @c
+#define choose_mlist(A) do { p=A(q); A(q)=null; } while (0)
+
+
+@ Most of the actual construction work of |mlist_to_hlist| is done
+by procedures with names
+like |make_fraction|, |make_radical|, etc. To illustrate
+the general setup of such procedures, let's begin with a couple of
+simple ones.
+
+@c
+static void make_over(pointer q, int cur_style)
+{
+ pointer p;
+ p = overbar(clean_box(nucleus(q), cramped_style(cur_style), cur_style),
+ overbar_vgap(cur_style),
+ overbar_rule(cur_style),
+ overbar_kern(cur_style), node_attr(nucleus(q)));
+ math_list(nucleus(q)) = p;
+ type(nucleus(q)) = sub_box_node;
+}
+
+static void make_under(pointer q, int cur_style)
+{
+ pointer p, x, y, r; /* temporary registers for box construction */
+ scaled delta; /* overall height plus depth */
+ x = clean_box(nucleus(q), cur_style, cur_style);
+ p = new_kern(underbar_vgap(cur_style));
+ reset_attributes(p, node_attr(q));
+ couple_nodes(x,p);
+ r = do_fraction_rule(underbar_rule(cur_style), node_attr(q));
+ couple_nodes(p,r);
+ y = vpackage(x, 0, additional, max_dimen, math_direction);
+ reset_attributes(y, node_attr(q));
+ delta = height(y) + depth(y) + underbar_kern(cur_style);
+ height(y) = height(x);
+ depth(y) = delta - height(y);
+ math_list(nucleus(q)) = y;
+ type(nucleus(q)) = sub_box_node;
+}
+
+static void make_vcenter(pointer q)
+{
+ pointer v; /* the box that should be centered vertically */
+ scaled delta; /* its height plus depth */
+ v = math_list(nucleus(q));
+ if (type(v) != vlist_node)
+ confusion("vcenter"); /* this can't happen vcenter */
+ delta = height(v) + depth(v);
+ height(v) = math_axis(cur_size) + half(delta);
+ depth(v) = delta - height(v);
+}
+
+@ According to the rules in the \.{DVI} file specifications, we ensure alignment
+@^square roots@>
+between a square root sign and the rule above its nucleus by assuming that the
+baseline of the square-root symbol is the same as the bottom of the rule. The
+height of the square-root symbol will be the thickness of the rule, and the
+depth of the square-root symbol should exceed or equal the height-plus-depth
+of the nucleus plus a certain minimum clearance~|psi|. The symbol will be
+placed so that the actual clearance is |psi| plus half the excess.
+
+@c
+static void make_radical(pointer q, int cur_style)
+{
+ pointer x, y, p; /* temporary registers for box construction */
+ scaled delta, clr, theta, h; /* dimensions involved in the calculation */
+ x = clean_box(nucleus(q), cramped_style(cur_style), cur_style);
+ clr = radical_vgap(cur_style);
+ theta = radical_rule(cur_style);
+ if (theta == undefined_math_parameter) {
+ theta = fraction_rule(cur_style);
+ y = var_delimiter(left_delimiter(q), cur_size,
+ height(x) + depth(x) + clr + theta, NULL, cur_style);
+ /* If |y| is a composite then set |theta| to the height of its top
+ character, else set it to the height of |y|. */
+ if (list_ptr(y) != null
+ && type(list_ptr(y)) == hlist_node
+ && list_ptr(list_ptr(y)) != null
+ && type(list_ptr(list_ptr(y))) == glyph_node) { /* and it should be */
+ theta = char_height(font(list_ptr(list_ptr(y))),
+ character(list_ptr(list_ptr(y))));
+ } else {
+ theta = height(y);
+ }
+ } else {
+ y = var_delimiter(left_delimiter(q), cur_size,
+ height(x) + depth(x) + clr + theta, NULL, cur_style);
+ }
+ left_delimiter(q) = null;
+ delta = (depth(y) + height(y) - theta) - (height(x) + depth(x) + clr);
+ if (delta > 0)
+ clr = clr + half(delta); /* increase the actual clearance */
+ shift_amount(y) = (height(y) - theta) - (height(x) + clr);
+ h = depth(y) + height(y);
+ p = overbar(x, clr, theta, radical_kern(cur_style), node_attr(y));
+ couple_nodes(y,p);
+ if (degree(q) != null) {
+ scaled wr, br, ar;
+ pointer r = clean_box(degree(q), script_script_style, cur_style);
+ reset_attributes(r, node_attr(degree(q)));
+ wr = width(r);
+ if (wr == 0) {
+ flush_node(r);
+ } else {
+ br = radical_degree_before(cur_style);
+ ar = radical_degree_after(cur_style);
+ if (-ar > (wr + br))
+ ar = -(wr + br);
+ x = new_kern(ar);
+ reset_attributes(x, node_attr(degree(q)));
+ couple_nodes(x,y);
+ shift_amount(r) =
+ -((xn_over_d(h, radical_degree_raise(cur_style), 100)) -
+ depth(y) - shift_amount(y));
+ couple_nodes(r,x);
+ x = new_kern(br);
+ reset_attributes(x, node_attr(degree(q)));
+ couple_nodes(x,r);
+ y = x;
+ }
+ math_list(degree(q)) = null; /* for \.{\\Uroot ..{<list>}{}} */
+ flush_node(degree(q));
+ }
+ p = hpack(y, 0, additional, -1);
+ reset_attributes(p, node_attr(q));
+ math_list(nucleus(q)) = p;
+ type(nucleus(q)) = sub_box_node;
+}
+
+
+@ Construct a vlist box
+@c
+static pointer
+wrapup_delimiter(pointer x, pointer y, pointer q,
+ scaled shift_up, scaled shift_down)
+{
+ pointer p; /* temporary register for box construction */
+ pointer v = new_null_box();
+ type(v) = vlist_node;
+ height(v) = shift_up + height(x);
+ depth(v) = depth(y) + shift_down;
+ reset_attributes(v, node_attr(q));
+ p = new_kern((shift_up - depth(x)) - (height(y) - shift_down));
+ reset_attributes(p, node_attr(q));
+ couple_nodes(p,y);
+ couple_nodes(x,p);
+ list_ptr(v) = x;
+ return v;
+}
+
+@ @c
+#define fixup_widths(x,y) do { \
+ if (width(y) >= width(x)) { \
+ width(x) = width(y); \
+ } else { \
+ width(y) = width(x); \
+ } \
+ } while (0)
+
+@ this has the |nucleus| box |x| as a limit above an extensible delimiter |y|
+
+@c
+static void make_over_delimiter(pointer q, int cur_style)
+{
+ pointer x, y, v; /* temporary registers for box construction */
+ scaled shift_up, shift_down, clr, delta;
+ x = clean_box(nucleus(q), sub_style(cur_style), cur_style);
+ y = flat_delimiter(left_delimiter(q), cur_size, width(x), cur_style);
+ left_delimiter(q) = null;
+ fixup_widths(x, y);
+ shift_up = over_delimiter_bgap(cur_style);
+ shift_down = 0;
+ clr = over_delimiter_vgap(cur_style);
+ delta = clr - ((shift_up - depth(x)) - (height(y) - shift_down));
+ if (delta > 0) {
+ shift_up = shift_up + delta;
+ }
+ v = wrapup_delimiter(x, y, q, shift_up, shift_down);
+ width(v) = width(x); /* this also equals |width(y)| */
+ math_list(nucleus(q)) = v;
+ type(nucleus(q)) = sub_box_node;
+}
+
+@ this has the extensible delimiter |x| as a limit above |nucleus| box |y|
+
+@c
+static void make_delimiter_over(pointer q, int cur_style)
+{
+ pointer x, y, v; /* temporary registers for box construction */
+ scaled shift_up, shift_down, clr, actual;
+ y = clean_box(nucleus(q), cur_style, cur_style);
+ x = flat_delimiter(left_delimiter(q),
+ cur_size + (cur_size == script_script_size ? 0 : 1),
+ width(y), cur_style);
+ left_delimiter(q) = null;
+ fixup_widths(x, y);
+ shift_up = over_delimiter_bgap(cur_style)-height(x)-depth(x);
+ shift_down = 0;
+ clr = over_delimiter_vgap(cur_style);
+ actual = shift_up - height(y);
+ if (actual < clr) {
+ shift_up = shift_up + (clr-actual);
+ }
+ v = wrapup_delimiter(x, y, q, shift_up, shift_down);
+ width(v) = width(x); /* this also equals |width(y)| */
+ math_list(nucleus(q)) = v;
+ type(nucleus(q)) = sub_box_node;
+}
+
+
+@ this has the extensible delimiter |y| as a limit below a |nucleus| box |x|
+
+@c
+static void make_delimiter_under(pointer q, int cur_style)
+{
+ pointer x, y, v; /* temporary registers for box construction */
+ scaled shift_up, shift_down, clr, actual;
+ x = clean_box(nucleus(q), cur_style, cur_style);
+ y = flat_delimiter(left_delimiter(q),
+ cur_size + (cur_size == script_script_size ? 0 : 1),
+ width(x), cur_style);
+ left_delimiter(q) = null;
+ fixup_widths(x, y);
+ shift_up = 0;
+ shift_down = under_delimiter_bgap(cur_style) - height(y)-depth(y);
+ clr = under_delimiter_vgap(cur_style);
+ actual = shift_down - depth(x);
+ if (actual<clr) {
+ shift_down += (clr-actual);
+ }
+ v = wrapup_delimiter(x, y, q, shift_up, shift_down);
+ width(v) = width(y); /* this also equals |width(y)| */
+ math_list(nucleus(q)) = v;
+ type(nucleus(q)) = sub_box_node;
+
+}
+
+@ this has the extensible delimiter |x| as a limit below |nucleus| box |y|
+
+@c
+static void make_under_delimiter(pointer q, int cur_style)
+{
+ pointer x, y, v; /* temporary registers for box construction */
+ scaled shift_up, shift_down, clr, delta;
+ y = clean_box(nucleus(q), sup_style(cur_style), cur_style);
+ x = flat_delimiter(left_delimiter(q), cur_size, width(y), cur_style);
+ left_delimiter(q) = null;
+ fixup_widths(x, y);
+ shift_up = 0;
+ shift_down = under_delimiter_bgap(cur_style);
+ clr = under_delimiter_vgap(cur_style);
+ delta = clr - ((shift_up - depth(x)) - (height(y) - shift_down));
+ if (delta > 0) {
+ shift_down = shift_down + delta;
+ }
+ v = wrapup_delimiter(x, y, q, shift_up, shift_down);
+ width(v) = width(y); /* this also equals |width(y)| */
+ math_list(nucleus(q)) = v;
+ type(nucleus(q)) = sub_box_node;
+
+}
+
+
+@ Slants are not considered when placing accents in math mode. The accenter is
+centered over the accentee, and the accent width is treated as zero with
+respect to the size of the final box.
+
+@c
+#define TOP_CODE 1
+#define BOT_CODE 2
+#define TOP_OR_BOT_MASK ((TOP_CODE) | (BOT_CODE))
+#define STRETCH_ACCENT_CODE 4
+
+static boolean compute_accent_skew(pointer q, int top_or_bot, scaled *s)
+{
+ pointer p; /* temporary register for box construction */
+ boolean s_is_absolute; /* will be true if a top-accent is placed in |s| */
+
+ s_is_absolute = false;
+
+ if (type(nucleus(q)) == math_char_node) {
+ fetch(nucleus(q));
+ if (is_new_mathfont(cur_f)) {
+ if (top_or_bot == TOP_CODE) {
+ *s = char_top_accent(cur_f, cur_c);
+ if (*s != INT_MIN) {
+ s_is_absolute = true;
+ }
+ } else {
+ *s = char_bot_accent(cur_f, cur_c);
+ if (*s != INT_MIN) {
+ s_is_absolute = true;
+ }
+ }
+ } else {
+ if (top_or_bot == TOP_CODE) {
+ *s = get_kern(cur_f, cur_c, skew_char(cur_f));
+ } else {
+ *s = 0;
+ }
+ }
+ } else if (type(nucleus(q)) == sub_mlist_node) {
+ /* if |nucleus(q)| is a |sub_mlist_node| composed of an |accent_noad| we
+ * use the positioning of the nucleus of that noad, recursing until
+ * the inner most |accent_noad|. This way multiple stacked accents are
+ * aligned to the inner most one. */
+ p = math_list(nucleus(q));
+ if (type(p) == accent_noad) {
+ s_is_absolute = compute_accent_skew(p, top_or_bot, s);
+ }
+ }
+
+ return s_is_absolute;
+}
+
+static void do_make_math_accent(pointer q, internal_font_number f, int c,
+ int flags, int cur_style)
+{
+ pointer p, r, x, y; /* temporary registers for box construction */
+ scaled s; /* amount to skew the accent to the right */
+ scaled h; /* height of character being accented */
+ scaled delta; /* space to remove between accent and accentee */
+ scaled w; /* width of the accentee, not including sub/superscripts */
+ boolean s_is_absolute; /* will be true if a top-accent is placed in |s| */
+ extinfo *ext;
+ pointer attr_p;
+ const int top_or_bot = flags & TOP_OR_BOT_MASK;
+ attr_p = (top_or_bot == TOP_CODE ? accent_chr(q) : bot_accent_chr(q));
+ c = cur_c;
+ f = cur_f;
+
+ s = 0;
+ s_is_absolute = false;
+ /* Compute the amount of skew, or set |s| to an alignment point */
+ s_is_absolute = compute_accent_skew(q, top_or_bot, &s);
+
+ x = clean_box(nucleus(q), cramped_style(cur_style), cur_style);
+ w = width(x);
+ h = height(x);
+ if (is_new_mathfont(cur_f) && !s_is_absolute) {
+ s = half(w);
+ s_is_absolute = true;
+ }
+ /* Switch to a larger accent if available and appropriate */
+ y = null;
+ ext = NULL;
+ if ((flags & STRETCH_ACCENT_CODE) && (char_width(f, c) < w)) {
+ while (1) {
+ if ((char_tag(f, c) == ext_tag) &&
+ ((ext = get_charinfo_hor_variants(char_info(f, c))) != NULL)) {
+ y = get_delim_hbox(ext, f, w, node_attr(attr_p), cur_style);
+ break;
+ } else if (char_tag(f, c) != list_tag) {
+ break;
+ } else {
+ int yy = char_remainder(f, c);
+ if (!char_exists(f, yy))
+ break;
+ if (char_width(f, yy) > w)
+ break;
+ c = yy;
+ }
+ }
+ }
+ if (y == null) {
+ y = char_box(f, c, node_attr(attr_p));
+ }
+ if (top_or_bot == TOP_CODE) {
+ if (h < accent_base_height(f))
+ delta = h;
+ else
+ delta = accent_base_height(f);
+ } else {
+ delta = 0; /* hm */
+ }
+ if ((supscr(q) != null) || (subscr(q) != null)) {
+ if (type(nucleus(q)) == math_char_node) {
+ /* Swap the subscript and superscript into box |x| */
+ flush_node_list(x);
+ x = new_noad();
+ r = math_clone(nucleus(q));
+ nucleus(x) = r;
+ supscr(x) = supscr(q);
+ supscr(q) = null;
+ subscr(x) = subscr(q);
+ subscr(q) = null;
+ type(nucleus(q)) = sub_mlist_node;
+ math_list(nucleus(q)) = x;
+ x = clean_box(nucleus(q), cur_style, cur_style);
+ delta = delta + height(x) - h;
+ h = height(x);
+ }
+ }
+ if (s_is_absolute) {
+ scaled sa;
+ if (ext != NULL) {
+ sa = half(width(y)); /* if the accent is extensible just take the center */
+ } else {
+ sa = char_top_accent(f, c);
+ }
+ if (sa == INT_MIN) {
+ sa = half(width(y)); /* just take the center */
+ }
+ shift_amount(y) = s - sa;
+ } else {
+ if (width(y)== 0) {
+ shift_amount(y) = s + w;
+ } else {
+ shift_amount(y) = s + half(w - width(y));
+ }
+ }
+ width(y) = 0;
+ if (top_or_bot == TOP_CODE) {
+ p = new_kern(-delta);
+ couple_nodes(p,x);
+ couple_nodes(y,p);
+ } else {
+#if 0
+ p = new_kern(-delta);
+ couple_nodes(x,p);
+ couple_nodes(p,y);
+ y = x;
+#endif
+ couple_nodes(x,y);
+ y = x;
+ }
+ r = vpackage(y, 0, additional, max_dimen, math_direction);
+ reset_attributes(r, node_attr(q));
+ width(r) = width(x);
+ y = r;
+ if (top_or_bot == TOP_CODE) {
+ if (height(y) < h) {
+ /* Make the height of box |y| equal to |h| */
+ p = new_kern(h - height(y));
+ reset_attributes(p, node_attr(q));
+// vlink(p) = list_ptr(y);
+try_couple_nodes(p,list_ptr(y));
+ list_ptr(y) = p;
+ height(y) = h;
+ }
+ } else {
+ shift_amount(y) = -(h - height(y));
+ }
+ math_list(nucleus(q)) = y;
+ type(nucleus(q)) = sub_box_node;
+}
+
+static void make_math_accent(pointer q, int cur_style)
+{
+ int topstretch = !(subtype(q) % 2);
+ int botstretch = !(subtype(q) / 2);
+
+ if (accent_chr(q) != null) {
+ fetch(accent_chr(q));
+ if (char_exists(cur_f, cur_c)) {
+ do_make_math_accent(q, cur_f, cur_c, TOP_CODE | (topstretch ? STRETCH_ACCENT_CODE : 0), cur_style);
+ }
+ flush_node(accent_chr(q));
+ accent_chr(q) = null;
+ }
+ if (bot_accent_chr(q) != null) {
+ fetch(bot_accent_chr(q));
+ if (char_exists(cur_f, cur_c)) {
+ do_make_math_accent(q, cur_f, cur_c, BOT_CODE | (botstretch ? STRETCH_ACCENT_CODE : 0), cur_style);
+ }
+ flush_node(bot_accent_chr(q));
+ bot_accent_chr(q) = null;
+ }
+}
+
+@ The |make_fraction| procedure is a bit different because it sets
+|new_hlist(q)| directly rather than making a sub-box.
+
+@c
+static void make_fraction(pointer q, int cur_style)
+{
+ pointer p, v, x, y, z; /* temporary registers for box construction */
+ scaled delta, delta1, delta2, shift_up, shift_down, clr;
+ /* dimensions for box calculations */
+ if (thickness(q) == default_code)
+ thickness(q) = fraction_rule(cur_style);
+ /* Create equal-width boxes |x| and |z| for the numerator and denominator,
+ and compute the default amounts |shift_up| and |shift_down| by which they
+ are displaced from the baseline */
+ x = clean_box(numerator(q), num_style(cur_style), cur_style);
+ z = clean_box(denominator(q), denom_style(cur_style), cur_style);
+ if (width(x) < width(z))
+ x = rebox(x, width(z));
+ else
+ z = rebox(z, width(x));
+ if (thickness(q) == 0) {
+ shift_up = stack_num_up(cur_style);
+ shift_down = stack_denom_down(cur_style);
+ /* The numerator and denominator must be separated by a certain minimum
+ clearance, called |clr| in the following program. The difference between
+ |clr| and the actual clearance is |2delta|. */
+ clr = stack_vgap(cur_style);
+ delta = half(clr - ((shift_up - depth(x)) - (height(z) - shift_down)));
+ if (delta > 0) {
+ shift_up = shift_up + delta;
+ shift_down = shift_down + delta;
+ }
+ } else {
+ shift_up = fraction_num_up(cur_style);
+ shift_down = fraction_denom_down(cur_style);
+ /* In the case of a fraction line, the minimum clearance depends on the actual
+ thickness of the line. */
+ delta = half(thickness(q));
+ clr = fraction_num_vgap(cur_style);
+ clr = ext_xn_over_d(clr, thickness(q), fraction_rule(cur_style));
+ delta1 = clr - ((shift_up - depth(x)) - (math_axis(cur_size) + delta));
+ if (delta1 > 0)
+ shift_up = shift_up + delta1;
+ clr = fraction_denom_vgap(cur_style);
+ clr = ext_xn_over_d(clr, thickness(q), fraction_rule(cur_style));
+ delta2 =
+ clr - ((math_axis(cur_size) - delta) - (height(z) - shift_down));
+ if (delta2 > 0)
+ shift_down = shift_down + delta2;
+ }
+ /* Construct a vlist box for the fraction, according to |shift_up| and |shift_down| */
+ v = new_null_box();
+ type(v) = vlist_node;
+ height(v) = shift_up + height(x);
+ depth(v) = depth(z) + shift_down;
+ width(v) = width(x); /* this also equals |width(z)| */
+ reset_attributes(v, node_attr(q));
+ if (thickness(q) == 0) {
+ p = new_kern((shift_up - depth(x)) - (height(z) - shift_down));
+ couple_nodes(p,z);
+ } else {
+ y = do_fraction_rule(thickness(q), node_attr(q));
+ p = new_kern((math_axis(cur_size) - delta) - (height(z) - shift_down));
+ reset_attributes(p, node_attr(q));
+ couple_nodes(y,p);
+ couple_nodes(p,z);
+ p = new_kern((shift_up - depth(x)) - (math_axis(cur_size) + delta));
+ couple_nodes(p,y);
+ }
+ reset_attributes(p, node_attr(q));
+ couple_nodes(x,p);
+ list_ptr(v) = x;
+ /* Put the fraction into a box with its delimiters, and make |new_hlist(q)|
+ point to it */
+ delta = fraction_del_size(cur_style);
+ x = var_delimiter(left_delimiter(q), cur_size, delta, NULL, cur_style);
+ left_delimiter(q) = null;
+ couple_nodes(x,v);
+ z = var_delimiter(right_delimiter(q), cur_size, delta, NULL, cur_style);
+ right_delimiter(q) = null;
+ couple_nodes(v,z);
+ y = hpack(x, 0, additional, -1);
+ reset_attributes(y, node_attr(q));
+ assign_new_hlist(q, y);
+}
+
+
+@ If the nucleus of an |op_noad| is a single character, it is to be
+centered vertically with respect to the axis, after first being enlarged
+(via a character list in the font) if we are in display style. The normal
+convention for placing displayed limits is to put them above and below the
+operator in display style.
+
+The italic correction is removed from the character if there is a subscript
+and the limits are not being displayed. The |make_op|
+routine returns the value that should be used as an offset between
+subscript and superscript.
+
+After |make_op| has acted, |subtype(q)| will be |limits| if and only if
+the limits have been set above and below the operator. In that case,
+|new_hlist(q)| will already contain the desired final box.
+
+@c
+static scaled make_op(pointer q, int cur_style)
+{
+ scaled delta; /* offset between subscript and superscript */
+ pointer p, v, x, y, z; /* temporary registers for box construction */
+ int c; /* register for character examination */
+ scaled shift_up, shift_down; /* dimensions for box calculation */
+ scaled ok_size;
+ if ((subtype(q) == op_noad_type_normal) && (cur_style < text_style))
+ subtype(q) = op_noad_type_limits;
+ if (type(nucleus(q)) == math_char_node) {
+ fetch(nucleus(q));
+ if (cur_style < text_style) { /* try to make it larger */
+ ok_size = minimum_operator_size(cur_style);
+ if (ok_size != undefined_math_parameter) {
+ /* creating a temporary delimiter is the cleanest way */
+ y = new_node(delim_node, 0);
+ small_fam(y) = math_fam(nucleus(q));
+ small_char(y) = math_character(nucleus(q));
+ x = var_delimiter(y, text_size, ok_size, &delta, cur_style);
+ if ((subscr(q) != null) && (subtype(q) != op_noad_type_limits)) {
+ width(x) -= delta; /* remove italic correction */
+ }
+ /* For an OT MATH font, we may have to get rid of yet another italic
+ correction because |make_scripts()| will add one.
+ This test is somewhat more complicated because |x| can be a null
+ delimiter */
+ if ((subscr(q) != null || supscr(q) != null)
+ && (subtype(q) != op_noad_type_limits)
+ && ((list_ptr(x) != null)
+ && (type(list_ptr(x)) == glyph_node)
+ && is_new_mathfont(font(list_ptr(x))))) {
+ width(x) -= delta; /* remove another italic correction */
+ }
+ } else {
+ ok_size = height_plus_depth(cur_f, cur_c) + 1;
+ while ((char_tag(cur_f, cur_c) == list_tag) &&
+ height_plus_depth(cur_f, cur_c) < ok_size) {
+ c = char_remainder(cur_f, cur_c);
+ if (!char_exists(cur_f, c))
+ break;
+ cur_c = c;
+ math_character(nucleus(q)) = c;
+ }
+ delta = char_italic(cur_f, cur_c);
+ x = clean_box(nucleus(q), cur_style, cur_style);
+ if ((subscr(q) != null) && (subtype(q) != op_noad_type_limits))
+ width(x) = width(x) - delta; /* remove italic correction */
+
+ shift_amount(x) =
+ half(height(x) - depth(x)) - math_axis(cur_size);
+ /* center vertically */
+ }
+ type(nucleus(q)) = sub_box_node;
+ math_list(nucleus(q)) = x;
+
+ } else { /* normal size */
+ delta = char_italic(cur_f, cur_c);
+ x = clean_box(nucleus(q), cur_style, cur_style);
+ if ((subscr(q) != null) && (subtype(q) != op_noad_type_limits))
+ width(x) = width(x) - delta; /* remove italic correction */
+
+ /* For an OT MATH font, we may have to get rid of yet another italic
+ correction because |make_scripts()| will add one.
+ This test is somewhat more complicated because |x| can be a null
+ delimiter */
+ if ((subscr(q) != null || supscr(q) != null)
+ && (subtype(q) != op_noad_type_limits)
+ && ((list_ptr(x) != null)
+ && (type(list_ptr(x)) == glyph_node)
+ && is_new_mathfont(font(list_ptr(x))))) {
+ width(x) -= delta; /* remove another italic correction */
+ }
+
+ shift_amount(x) = half(height(x) - depth(x)) - math_axis(cur_size);
+ /* center vertically */
+ type(nucleus(q)) = sub_box_node;
+ math_list(nucleus(q)) = x;
+ }
+ } else {
+ delta = 0;
+ }
+ if (subtype(q) == op_noad_type_limits) {
+ /* The following program builds a vlist box |v| for displayed limits. The
+ width of the box is not affected by the fact that the limits may be skewed. */
+ x = clean_box(supscr(q), sup_style(cur_style), cur_style);
+ y = clean_box(nucleus(q), cur_style, cur_style);
+ z = clean_box(subscr(q), sub_style(cur_style), cur_style);
+ v = new_null_box();
+ reset_attributes(v, node_attr(q));
+ type(v) = vlist_node;
+ width(v) = width(y);
+ if (width(x) > width(v))
+ width(v) = width(x);
+ if (width(z) > width(v))
+ width(v) = width(z);
+ x = rebox(x, width(v));
+ y = rebox(y, width(v));
+ z = rebox(z, width(v));
+ shift_amount(x) = half(delta);
+ shift_amount(z) = -shift_amount(x);
+ height(v) = height(y);
+ depth(v) = depth(y);
+ /* Attach the limits to |y| and adjust |height(v)|, |depth(v)| to
+ account for their presence */
+ /* We use |shift_up| and |shift_down| in the following program for the
+ amount of glue between the displayed operator |y| and its limits |x| and
+ |z|. The vlist inside box |v| will consist of |x| followed by |y| followed
+ by |z|, with kern nodes for the spaces between and around them. */
+ if (supscr(q) == null) {
+ list_ptr(x) = null;
+ flush_node(x);
+ list_ptr(v) = y;
+ } else {
+ shift_up = limit_above_bgap(cur_style) - depth(x);
+ if (shift_up < limit_above_vgap(cur_style))
+ shift_up = limit_above_vgap(cur_style);
+ p = new_kern(shift_up);
+ reset_attributes(p, node_attr(q));
+ couple_nodes(p,y);
+ couple_nodes(x,p);
+ p = new_kern(limit_above_kern(cur_style));
+ reset_attributes(p, node_attr(q));
+ couple_nodes(p,x);
+ list_ptr(v) = p;
+ height(v) =
+ height(v) + limit_above_kern(cur_style) + height(x) + depth(x) +
+ shift_up;
+ }
+ if (subscr(q) == null) {
+ list_ptr(z) = null;
+ flush_node(z);
+ } else {
+ shift_down = limit_below_bgap(cur_style) - height(z);
+ if (shift_down < limit_below_vgap(cur_style))
+ shift_down = limit_below_vgap(cur_style);
+ p = new_kern(shift_down);
+ reset_attributes(p, node_attr(q));
+ couple_nodes(y,p);
+ couple_nodes(p,z);
+ p = new_kern(limit_below_kern(cur_style));
+ reset_attributes(p, node_attr(q));
+ couple_nodes(z,p);
+ depth(v) =
+ depth(v) + limit_below_kern(cur_style) + height(z) + depth(z) +
+ shift_down;
+ }
+ if (subscr(q) != null) {
+ math_list(subscr(q)) = null;
+ flush_node(subscr(q));
+ subscr(q) = null;
+ }
+ if (supscr(q) != null) {
+ math_list(supscr(q)) = null;
+ flush_node(supscr(q));
+ supscr(q) = null;
+ }
+ assign_new_hlist(q, v);
+ }
+ return delta;
+}
+
+@ A ligature found in a math formula does not create a ligature, because
+there is no question of hyphenation afterwards; the ligature will simply be
+stored in an ordinary |glyph_node|, after residing in an |ord_noad|.
+
+The |type| is converted to |math_text_char| here if we would not want to
+apply an italic correction to the current character unless it belongs
+to a math font (i.e., a font with |space=0|).
+
+No boundary characters enter into these ligatures.
+
+@c
+static void make_ord(pointer q)
+{
+ int a; /* the left-side character for lig/kern testing */
+ pointer p, r, s; /* temporary registers for list manipulation */
+ scaled k; /* a kern */
+ liginfo lig; /* a ligature */
+ RESTART:
+ if (subscr(q) == null &&
+ supscr(q) == null && type(nucleus(q)) == math_char_node) {
+ p = vlink(q);
+ if ((p != null) &&
+ (type(p) == simple_noad) &&
+ (subtype(p) <= punct_noad_type) &&
+ (type(nucleus(p)) == math_char_node) &&
+ (math_fam(nucleus(p)) == math_fam(nucleus(q)))) {
+ type(nucleus(q)) = math_text_char_node;
+ fetch(nucleus(q));
+ a = cur_c;
+ if ((has_kern(cur_f, a)) || (has_lig(cur_f, a))) {
+ cur_c = math_character(nucleus(p));
+ /* If character |a| has a kern with |cur_c|, attach
+ the kern after~|q|; or if it has a ligature with |cur_c|, combine
+ noads |q| and~|p| appropriately; then |return| if the cursor has
+ moved past a noad, or |goto restart| */
+
+ /* Note that a ligature between an |ord_noad| and another kind of noad
+ is replaced by an |ord_noad|, when the two noads collapse into one.
+ But we could make a parenthesis (say) change shape when it follows
+ certain letters. Presumably a font designer will define such
+ ligatures only when this convention makes sense. */
+
+ if (disable_lig == 0 && has_lig(cur_f, a)) {
+ lig = get_ligature(cur_f, a, cur_c);
+ if (is_valid_ligature(lig)) {
+ check_interrupt(); /* allow a way out of infinite ligature loop */
+ switch (lig_type(lig)) {
+ case 1:
+ case 5:
+ math_character(nucleus(q)) = lig_replacement(lig); /* \.{=:\char`\|}, \.{=:\char`\|>} */
+ break;
+ case 2:
+ case 6:
+ math_character(nucleus(p)) = lig_replacement(lig); /* \.{\char`\|=:}, \.{\char`\|=:>} */
+ break;
+ case 3:
+ case 7:
+ case 11:
+ r = new_noad(); /* \.{\char`\|=:\char`\|}, \.{\char`\|=:\char`\|>}, \.{\char`\|=:\char`\|>>} */
+ reset_attributes(r, node_attr(q));
+ s = new_node(math_char_node, 0);
+ reset_attributes(s, node_attr(q));
+ nucleus(r) = s;
+ math_character(nucleus(r)) = lig_replacement(lig);
+ math_fam(nucleus(r)) = math_fam(nucleus(q));
+ couple_nodes(q,r);
+ couple_nodes(r,p);
+ if (lig_type(lig) < 11)
+ type(nucleus(r)) = math_char_node;
+ else
+ type(nucleus(r)) = math_text_char_node; /* prevent combination */
+ break;
+ default:
+ couple_nodes(q,vlink(p));
+ math_character(nucleus(q)) = lig_replacement(lig); /* \.{=:} */
+ s = math_clone(subscr(p));
+ subscr(q) = s;
+ s = math_clone(supscr(p));
+ supscr(q) = s;
+ math_reset(subscr(p)); /* just in case */
+ math_reset(supscr(p));
+ flush_node(p);
+ break;
+ }
+ if (lig_type(lig) > 3)
+ return;
+ type(nucleus(q)) = math_char_node;
+ goto RESTART;
+ }
+ }
+ if (disable_kern == 0 && has_kern(cur_f, a)) {
+ k = get_kern(cur_f, a, cur_c); /* todo: should this use mathkerns? */
+ if (k != 0) {
+ p = new_kern(k);
+ reset_attributes(p, node_attr(q));
+ couple_nodes(p,vlink(q));
+ couple_nodes(q,p);
+ return;
+ }
+ }
+ }
+ }
+ }
+}
+
+@ If the fonts for the left and right bits of a mathkern are not
+both new-style fonts, then return a sentinel value meaning:
+please use old-style italic correction placement
+
+@c
+#define MATH_KERN_NOT_FOUND 0x7FFFFFFF
+
+@ This function tries to find the kern needed for proper cut-ins.
+ The left side doesn't move, but the right side does, so the first
+ order of business is to create a staggered fence line on the
+ left side of the right character.
+
+ The microsoft spec says that there are four quadrants, but the
+ actual images say
+
+@c
+static scaled math_kern_at(internal_font_number f, int c, int side, int v)
+{
+ int h, k, numkerns;
+ scaled *kerns_heights;
+ scaled kern = 0;
+ charinfo *co = char_info(f, c); /* known to exist */
+ numkerns = get_charinfo_math_kerns(co, side);
+#ifdef DEBUG
+ fprintf(stderr, " entries = %d, height = %d\n", numkerns, v);
+#endif
+ if (numkerns == 0)
+ return kern;
+ if (side == top_left_kern) {
+ kerns_heights = co->top_left_math_kern_array;
+ } else if (side == bottom_left_kern) {
+ kerns_heights = co->bottom_left_math_kern_array;
+ } else if (side == top_right_kern) {
+ kerns_heights = co->top_right_math_kern_array;
+ } else if (side == bottom_right_kern) {
+ kerns_heights = co->bottom_right_math_kern_array;
+ } else {
+ confusion("math_kern_at");
+ kerns_heights = NULL; /* not reached */
+ }
+#ifdef DEBUG
+ fprintf(stderr, " entry 0: %d,%d\n", kerns_heights[0], kerns_heights[1]);
+#endif
+ if (v < kerns_heights[0])
+ return kerns_heights[1];
+ for (k = 0; k < numkerns; k++) {
+ h = kerns_heights[(k * 2)];
+ kern = kerns_heights[(k * 2) + 1];
+#ifdef DEBUG
+ if (k > 0)
+ fprintf(stderr, " entry %d: %d,%d\n", k, h, kern);
+#endif
+ if (h > v) {
+ return kern;
+ }
+ }
+ return kern;
+}
+
+@ @c
+static scaled
+find_math_kern(internal_font_number l_f, int l_c,
+ internal_font_number r_f, int r_c, int cmd, scaled shift)
+{
+ scaled corr_height_top = 0, corr_height_bot = 0;
+ scaled krn_l = 0, krn_r = 0, krn = 0;
+ if ((!is_new_mathfont(l_f)) || (!is_new_mathfont(r_f))
+ || (!char_exists(l_f, l_c)) || (!char_exists(r_f, r_c)))
+ return MATH_KERN_NOT_FOUND;
+
+ if (cmd == sup_mark_cmd) {
+ corr_height_top = char_height(l_f, l_c);
+ corr_height_bot = -char_depth(r_f, r_c) + shift; /* bottom of superscript */
+ krn_l = math_kern_at(l_f, l_c, top_right_kern, corr_height_top);
+ krn_r = math_kern_at(r_f, r_c, bottom_left_kern, corr_height_top);
+#ifdef DEBUG
+ fprintf(stderr, "SUPER Top LR = %d,%d (shift %d)\n", krn_l, krn_r,
+ shift);
+#endif
+ krn = (krn_l + krn_r);
+ krn_l = math_kern_at(l_f, l_c, top_right_kern, corr_height_bot);
+ krn_r = math_kern_at(r_f, r_c, bottom_left_kern, corr_height_bot);
+#ifdef DEBUG
+ fprintf(stderr, "SUPER Bot LR = %d,%d\n", krn_l, krn_r);
+#endif
+ if ((krn_l + krn_r) < krn)
+ krn = (krn_l + krn_r);
+ return (krn);
+
+ } else if (cmd == sub_mark_cmd) {
+ corr_height_top = char_height(r_f, r_c) - shift; /* top of subscript */
+ corr_height_bot = -char_depth(l_f, l_c);
+ krn_l = math_kern_at(l_f, l_c, bottom_right_kern, corr_height_top);
+ krn_r = math_kern_at(r_f, r_c, top_left_kern, corr_height_top);
+#ifdef DEBUG
+ fprintf(stderr, "SUB Top LR = %d,%d\n", krn_l, krn_r);
+#endif
+ krn = (krn_l + krn_r);
+ krn_l = math_kern_at(l_f, l_c, bottom_right_kern, corr_height_bot);
+ krn_r = math_kern_at(r_f, r_c, top_left_kern, corr_height_bot);
+#ifdef DEBUG
+ fprintf(stderr, "SUB Bot LR = %d,%d\n", krn_l, krn_r);
+#endif
+ if ((krn_l + krn_r) < krn)
+ krn = (krn_l + krn_r);
+ return (krn);
+
+ } else {
+ confusion("find_math_kern");
+ }
+ return 0; /* not reached */
+}
+
+@ just a small helper
+@c
+static pointer attach_hkern_to_new_hlist(pointer q, scaled delta2)
+{
+ pointer y;
+ pointer z = new_kern(delta2);
+ if (new_hlist(q) == null) { /* this is somewhat weird */
+ new_hlist(q) = z;
+ } else {
+ y = new_hlist(q);
+ while (vlink(y) != null)
+ y = vlink(y);
+ couple_nodes(y,z);
+ }
+ return new_hlist(q);
+}
+
+@
+@c
+#ifdef DEBUG
+void dump_simple_field(pointer q)
+{
+ pointer p;
+ printf(" [%d, type=%d, vlink=%d] ", q, type(q), vlink(q));
+ switch (type(q)) {
+ case math_char_node:
+ printf("mathchar ");
+ break;
+ case math_text_char_node:
+ printf("texchar ");
+ break;
+ case sub_box_node:
+ printf("box ");
+ break;
+ case sub_mlist_node:
+ printf("mlist ");
+ p = math_list(q);
+ while (p != null) {
+ dump_simple_field(p);
+ p = vlink(p);
+ }
+ break;
+ }
+}
+
+
+void dump_simple_node(pointer q)
+{
+ printf("node %d, type=%d, vlink=%d\n", q, type(q), vlink(q));
+ printf("nucleus: ");
+ dump_simple_field(nucleus(q));
+ printf("\n");
+ printf("sub: ");
+ dump_simple_field(subscr(q));
+ printf("\n");
+ printf("sup: ");
+ dump_simple_field(supscr(q));
+ printf("\n\n");
+}
+#endif
+
+@ The purpose of |make_scripts(q,it)| 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 be horizontally shifted over |delta1|, the subscript over |delta2|.
+
+We set |shift_down| and |shift_up| to the minimum amounts to shift the
+baseline of subscripts and superscripts based on the given nucleus.
+
+@c
+static void make_scripts(pointer q, pointer p, scaled it, int cur_style)
+{
+ pointer x, y, z; /* temporary registers for box construction */
+ scaled shift_up, shift_down, clr; /* dimensions in the calculation */
+ scaled delta1, delta2;
+ delta1 = it;
+ delta2 = 0;
+#ifdef DEBUG
+ printf("it: %d\n", it);
+ dump_simple_node(q);
+ printf("p: node %d, type=%d, subtype=%d\n", p, type(p), subtype(p));
+#endif
+ switch (type(nucleus(q))) {
+ case math_char_node:
+ case math_text_char_node:
+ if ((subscr(q) == null) && (delta1 != 0)) {
+ x = new_kern(delta1);
+ reset_attributes(x, node_attr(nucleus(q)));
+ couple_nodes(p,x);
+ delta1 = 0;
+ }
+ }
+ assign_new_hlist(q, p);
+ if (is_char_node(p)) {
+ shift_up = 0;
+ shift_down = 0;
+ } else {
+ z = hpack(p, 0, additional, -1);
+ shift_up = height(z) - sup_shift_drop(cur_style); /* r18 */
+ shift_down = depth(z) + sub_shift_drop(cur_style); /* r19 */
+ list_ptr(z) = null;
+ flush_node(z);
+ }
+ if (supscr(q) == null) {
+ /* Construct a subscript box |x| when there is no superscript */
+ /* 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. */
+ x = clean_box(subscr(q), sub_style(cur_style), cur_style);
+ width(x) = width(x) + space_after_script(cur_style);
+ if (shift_down < sub_shift_down(cur_style))
+ shift_down = sub_shift_down(cur_style);
+ clr = height(x) - sub_top_max(cur_style);
+ if (shift_down < clr)
+ shift_down = clr;
+ shift_amount(x) = shift_down;
+
+ /* now find and correct for horizontal shift */
+ if (is_char_node(p) && subscr(q) != null
+ && type(subscr(q)) == math_char_node) {
+ fetch(subscr(q));
+ if (char_exists(cur_f, cur_c)) {
+ delta2 =
+ find_math_kern(font(p), character(p), cur_f, cur_c,
+ sub_mark_cmd, shift_down);
+ if (delta2 != MATH_KERN_NOT_FOUND && delta2 != 0) {
+ p = attach_hkern_to_new_hlist(q, delta2);
+ }
+ }
+ }
+
+ } else {
+ /* Construct a superscript box |x| */
+ /*The bottom of a superscript should never descend below the baseline plus
+ one-fourth of the x-height. */
+ x = clean_box(supscr(q), sup_style(cur_style), cur_style);
+ width(x) = width(x) + space_after_script(cur_style);
+ clr = sup_shift_up(cur_style);
+ if (shift_up < clr)
+ shift_up = clr;
+ clr = depth(x) + sup_bottom_min(cur_style);
+ if (shift_up < clr)
+ shift_up = clr;
+
+ if (subscr(q) == null) {
+ shift_amount(x) = -shift_up;
+ /* now find and correct for horizontal shift */
+ if (is_char_node(p) && type(supscr(q)) == math_char_node) {
+ fetch(supscr(q));
+ if (char_exists(cur_f, cur_c)) {
+ clr =
+ find_math_kern(font(p), character(p), cur_f, cur_c,
+ sup_mark_cmd, shift_up);
+ if (clr != MATH_KERN_NOT_FOUND && clr != 0) {
+ p = attach_hkern_to_new_hlist(q, clr);
+ }
+ }
+ }
+ } else {
+ /* Construct a sub/superscript combination box |x|, with the
+ superscript offset by |delta| */
+ /* When both subscript and superscript are present, the subscript must be
+ separated from the superscript by at least four times |default_rule_thickness|.
+ If this condition would be violated, the subscript moves down, after which
+ both subscript and superscript move up so that the bottom of the superscript
+ is at least as high as the baseline plus four-fifths of the x-height. */
+
+ y = clean_box(subscr(q), sub_style(cur_style), cur_style);
+ width(y) = width(y) + space_after_script(cur_style);
+ if (shift_down < sub_sup_shift_down(cur_style))
+ shift_down = sub_sup_shift_down(cur_style);
+ clr = subsup_vgap(cur_style) -
+ ((shift_up - depth(x)) - (height(y) - shift_down));
+ if (clr > 0) {
+ shift_down = shift_down + clr;
+ clr = sup_sub_bottom_max(cur_style) - (shift_up - depth(x));
+ if (clr > 0) {
+ shift_up = shift_up + clr;
+ shift_down = shift_down - clr;
+ }
+ }
+ /* now find and correct for horizontal shift */
+ if (is_char_node(p) && subscr(q) != null
+ && type(subscr(q)) == math_char_node) {
+ fetch(subscr(q));
+ if (char_exists(cur_f, cur_c)) {
+ delta2 =
+ find_math_kern(font(p), character(p), cur_f, cur_c,
+ sub_mark_cmd, shift_down);
+ if (delta2 != MATH_KERN_NOT_FOUND && delta2 != 0) {
+ p = attach_hkern_to_new_hlist(q, delta2);
+ }
+ }
+ }
+ /* now the horizontal shift for the superscript. */
+ /* the superscript is also to be shifted by |delta1| (the italic correction) */
+ clr = MATH_KERN_NOT_FOUND;
+ if (is_char_node(p) && supscr(q) != null
+ && type(supscr(q)) == math_char_node) {
+ fetch(supscr(q));
+ if (char_exists(cur_f, cur_c)) {
+ clr =
+ find_math_kern(font(p), character(p), cur_f, cur_c,
+ sup_mark_cmd, shift_up);
+ }
+ }
+ if (delta2 == MATH_KERN_NOT_FOUND)
+ delta2 = 0;
+ if (clr != MATH_KERN_NOT_FOUND) {
+ shift_amount(x) = clr + delta1 - delta2;
+ } else {
+ shift_amount(x) = delta1 - delta2;
+ }
+ p = new_kern((shift_up - depth(x)) - (height(y) - shift_down));
+ reset_attributes(p, node_attr(q));
+ couple_nodes(x,p);
+ couple_nodes(p,y);
+ x = vpackage(x, 0, additional, max_dimen, math_direction);
+ reset_attributes(x, node_attr(q));
+ shift_amount(x) = shift_down;
+ }
+ }
+
+
+ if (new_hlist(q) == null) {
+ new_hlist(q) = x;
+ } else {
+ p = new_hlist(q);
+ while (vlink(p) != null)
+ p = vlink(p);
+ couple_nodes(p,x);
+ }
+ if (subscr(q) != null) {
+ math_list(subscr(q)) = null;
+ flush_node(subscr(q));
+ subscr(q) = null;
+ }
+ if (supscr(q) != null) {
+ math_list(supscr(q)) = null;
+ flush_node(supscr(q));
+ supscr(q) = null;
+ }
+
+}
+
+@ The |make_left_right| function constructs a left or right delimiter of
+the required size and returns the value |open_noad| or |close_noad|. The
+|left_noad_side| and |right_noad_side| will both be based on the original |style|,
+so they will have consistent sizes.
+
+@c
+static small_number make_left_right(pointer q, int style, scaled max_d,
+ scaled max_hv)
+{
+ scaled delta, delta1, delta2; /* dimensions used in the calculation */
+ pointer tmp;
+ setup_cur_size(style);
+ delta2 = max_d + math_axis(cur_size);
+ delta1 = max_hv + max_d - delta2;
+ if (delta2 > delta1)
+ delta1 = delta2; /* |delta1| is max distance from axis */
+ delta = (delta1 / 500) * delimiter_factor;
+ delta2 = delta1 + delta1 - delimiter_shortfall;
+ if (delta < delta2)
+ delta = delta2;
+ tmp = var_delimiter(delimiter(q), cur_size, delta, NULL, style);
+ delimiter(q) = null;
+ assign_new_hlist(q, tmp);
+ if (subtype(q) == left_noad_side)
+ return open_noad_type;
+ else
+ return close_noad_type;
+}
+
+@ @c
+#define TEXT_STYLES(A,B) do { \
+ def_math_param(A,display_style,(B),level_one); \
+ def_math_param(A,cramped_display_style,(B),level_one); \
+ def_math_param(A,text_style,(B),level_one); \
+ def_math_param(A,cramped_text_style,(B),level_one); \
+ } while (0)
+
+#define SCRIPT_STYLES(A,B) do { \
+ def_math_param(A,script_style,(B),level_one); \
+ def_math_param(A,cramped_script_style,(B),level_one); \
+ def_math_param(A,script_script_style,(B),level_one); \
+ def_math_param(A,cramped_script_script_style,(B),level_one); \
+ } while (0)
+
+#define ALL_STYLES(A,B) do { \
+ TEXT_STYLES(A,(B)); \
+ SCRIPT_STYLES(A,(B)); \
+ } while (0)
+
+#define SPLIT_STYLES(A,B,C) do { \
+ TEXT_STYLES(A,(B)); \
+ SCRIPT_STYLES(A,(C)); \
+ } while (0)
+
+
+void initialize_math_spacing(void)
+{
+ /* *INDENT-OFF* */
+ ALL_STYLES (math_param_ord_ord_spacing, 0);
+ ALL_STYLES (math_param_ord_op_spacing, thin_mu_skip_code);
+ SPLIT_STYLES (math_param_ord_bin_spacing, med_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_ord_rel_spacing, thick_mu_skip_code, 0);
+ ALL_STYLES (math_param_ord_open_spacing, 0);
+ ALL_STYLES (math_param_ord_close_spacing, 0);
+ ALL_STYLES (math_param_ord_punct_spacing, 0);
+ SPLIT_STYLES (math_param_ord_inner_spacing, thin_mu_skip_code, 0);
+
+ ALL_STYLES (math_param_op_ord_spacing, thin_mu_skip_code);
+ ALL_STYLES (math_param_op_op_spacing, thin_mu_skip_code);
+ ALL_STYLES (math_param_op_bin_spacing, 0);
+ SPLIT_STYLES (math_param_op_rel_spacing, thick_mu_skip_code, 0);
+ ALL_STYLES (math_param_op_open_spacing, 0);
+ ALL_STYLES (math_param_op_close_spacing, 0);
+ ALL_STYLES (math_param_op_punct_spacing, 0);
+ SPLIT_STYLES (math_param_op_inner_spacing, thin_mu_skip_code, 0);
+
+ SPLIT_STYLES (math_param_bin_ord_spacing, med_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_bin_op_spacing, med_mu_skip_code, 0);
+ ALL_STYLES (math_param_bin_bin_spacing, 0);
+ ALL_STYLES (math_param_bin_rel_spacing, 0);
+ SPLIT_STYLES (math_param_bin_open_spacing, med_mu_skip_code, 0);
+ ALL_STYLES (math_param_bin_close_spacing, 0);
+ ALL_STYLES (math_param_bin_punct_spacing, 0);
+ SPLIT_STYLES (math_param_bin_inner_spacing, med_mu_skip_code, 0);
+
+ SPLIT_STYLES (math_param_rel_ord_spacing, thick_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_rel_op_spacing, thick_mu_skip_code, 0);
+ ALL_STYLES (math_param_rel_bin_spacing, 0);
+ ALL_STYLES (math_param_rel_rel_spacing, 0);
+ SPLIT_STYLES (math_param_rel_open_spacing, thick_mu_skip_code, 0);
+ ALL_STYLES (math_param_rel_close_spacing, 0);
+ ALL_STYLES (math_param_rel_punct_spacing, 0);
+ SPLIT_STYLES (math_param_rel_inner_spacing, thick_mu_skip_code, 0);
+
+ ALL_STYLES (math_param_open_ord_spacing, 0);
+ ALL_STYLES (math_param_open_op_spacing, 0);
+ ALL_STYLES (math_param_open_bin_spacing, 0);
+ ALL_STYLES (math_param_open_rel_spacing, 0);
+ ALL_STYLES (math_param_open_open_spacing, 0);
+ ALL_STYLES (math_param_open_close_spacing, 0);
+ ALL_STYLES (math_param_open_punct_spacing, 0);
+ ALL_STYLES (math_param_open_inner_spacing, 0);
+
+ ALL_STYLES (math_param_close_ord_spacing, 0);
+ ALL_STYLES (math_param_close_op_spacing, thin_mu_skip_code);
+ SPLIT_STYLES (math_param_close_bin_spacing, med_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_close_rel_spacing, thick_mu_skip_code, 0);
+ ALL_STYLES (math_param_close_open_spacing, 0);
+ ALL_STYLES (math_param_close_close_spacing, 0);
+ ALL_STYLES (math_param_close_punct_spacing, 0);
+ SPLIT_STYLES (math_param_close_inner_spacing, thin_mu_skip_code, 0);
+
+ SPLIT_STYLES (math_param_punct_ord_spacing, thin_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_punct_op_spacing, thin_mu_skip_code, 0);
+ ALL_STYLES (math_param_punct_bin_spacing, 0);
+ SPLIT_STYLES (math_param_punct_rel_spacing, thin_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_punct_open_spacing, thin_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_punct_close_spacing, thin_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_punct_punct_spacing, thin_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_punct_inner_spacing, thin_mu_skip_code, 0);
+
+ SPLIT_STYLES (math_param_inner_ord_spacing, thin_mu_skip_code, 0);
+ ALL_STYLES (math_param_inner_op_spacing, thin_mu_skip_code);
+ SPLIT_STYLES (math_param_inner_bin_spacing, med_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_inner_rel_spacing, thick_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_inner_open_spacing, thin_mu_skip_code, 0);
+ ALL_STYLES (math_param_inner_close_spacing, 0);
+ SPLIT_STYLES (math_param_inner_punct_spacing, thin_mu_skip_code, 0);
+ SPLIT_STYLES (math_param_inner_inner_spacing, thin_mu_skip_code, 0);
+ /* *INDENT-ON* */
+}
+
+
+@ @c
+#define both_types(A,B) ((A)*16+(B))
+
+static pointer math_spacing_glue(int l_type, int r_type, int mstyle, scaled mmu)
+{
+ int x = -1;
+ pointer z = null;
+ if (l_type == op_noad_type_limits || l_type == op_noad_type_no_limits)
+ l_type = op_noad_type_normal;
+ if (r_type == op_noad_type_limits || r_type == op_noad_type_no_limits)
+ r_type = op_noad_type_normal;
+ switch (both_types(l_type, r_type)) {
+ /* *INDENT-OFF* */
+ case both_types(ord_noad_type, ord_noad_type ): x = get_math_param(math_param_ord_ord_spacing,mstyle); break;
+ case both_types(ord_noad_type, op_noad_type_normal ): x = get_math_param(math_param_ord_op_spacing,mstyle); break;
+ case both_types(ord_noad_type, bin_noad_type ): x = get_math_param(math_param_ord_bin_spacing,mstyle); break;
+ case both_types(ord_noad_type, rel_noad_type ): x = get_math_param(math_param_ord_rel_spacing,mstyle); break;
+ case both_types(ord_noad_type, open_noad_type ): x = get_math_param(math_param_ord_open_spacing,mstyle); break;
+ case both_types(ord_noad_type, close_noad_type): x = get_math_param(math_param_ord_close_spacing,mstyle); break;
+ case both_types(ord_noad_type, punct_noad_type): x = get_math_param(math_param_ord_punct_spacing,mstyle); break;
+ case both_types(ord_noad_type, inner_noad_type): x = get_math_param(math_param_ord_inner_spacing,mstyle); break;
+ case both_types(op_noad_type_normal, ord_noad_type ): x = get_math_param(math_param_op_ord_spacing,mstyle); break;
+ case both_types(op_noad_type_normal, op_noad_type_normal ): x = get_math_param(math_param_op_op_spacing,mstyle); break;
+#if 0
+ case both_types(op_noad_type_normal, bin_noad_type ): x = get_math_param(math_param_op_bin_spacing,mstyle); break;
+#endif
+ case both_types(op_noad_type_normal, rel_noad_type ): x = get_math_param(math_param_op_rel_spacing,mstyle); break;
+ case both_types(op_noad_type_normal, open_noad_type ): x = get_math_param(math_param_op_open_spacing,mstyle); break;
+ case both_types(op_noad_type_normal, close_noad_type): x = get_math_param(math_param_op_close_spacing,mstyle); break;
+ case both_types(op_noad_type_normal, punct_noad_type): x = get_math_param(math_param_op_punct_spacing,mstyle); break;
+ case both_types(op_noad_type_normal, inner_noad_type): x = get_math_param(math_param_op_inner_spacing,mstyle); break;
+ case both_types(bin_noad_type, ord_noad_type ): x = get_math_param(math_param_bin_ord_spacing,mstyle); break;
+ case both_types(bin_noad_type, op_noad_type_normal ): x = get_math_param(math_param_bin_op_spacing,mstyle); break;
+#if 0
+ case both_types(bin_noad_type, bin_noad_type ): x = get_math_param(math_param_bin_bin_spacing,mstyle); break;
+ case both_types(bin_noad_type, rel_noad_type ): x = get_math_param(math_param_bin_rel_spacing,mstyle); break;
+#endif
+ case both_types(bin_noad_type, open_noad_type ): x = get_math_param(math_param_bin_open_spacing,mstyle); break;
+#if 0
+ case both_types(bin_noad_type, close_noad_type): x = get_math_param(math_param_bin_close_spacing,mstyle); break;
+ case both_types(bin_noad_type, punct_noad_type): x = get_math_param(math_param_bin_punct_spacing,mstyle); break;
+#endif
+ case both_types(bin_noad_type, inner_noad_type): x = get_math_param(math_param_bin_inner_spacing,mstyle); break;
+ case both_types(rel_noad_type, ord_noad_type ): x = get_math_param(math_param_rel_ord_spacing,mstyle); break;
+ case both_types(rel_noad_type, op_noad_type_normal ): x = get_math_param(math_param_rel_op_spacing,mstyle); break;
+#if 0
+ case both_types(rel_noad_type, bin_noad_type ): x = get_math_param(math_param_rel_bin_spacing,mstyle); break;
+#endif
+ case both_types(rel_noad_type, rel_noad_type ): x = get_math_param(math_param_rel_rel_spacing,mstyle); break;
+ case both_types(rel_noad_type, open_noad_type ): x = get_math_param(math_param_rel_open_spacing,mstyle); break;
+ case both_types(rel_noad_type, close_noad_type): x = get_math_param(math_param_rel_close_spacing,mstyle); break;
+ case both_types(rel_noad_type, punct_noad_type): x = get_math_param(math_param_rel_punct_spacing,mstyle); break;
+ case both_types(rel_noad_type, inner_noad_type): x = get_math_param(math_param_rel_inner_spacing,mstyle); break;
+ case both_types(open_noad_type, ord_noad_type ): x = get_math_param(math_param_open_ord_spacing,mstyle); break;
+ case both_types(open_noad_type, op_noad_type_normal ): x = get_math_param(math_param_open_op_spacing,mstyle); break;
+#if 0
+ case both_types(open_noad_type, bin_noad_type ): x = get_math_param(math_param_open_bin_spacing,mstyle); break;
+#endif
+ case both_types(open_noad_type, rel_noad_type ): x = get_math_param(math_param_open_rel_spacing,mstyle); break;
+ case both_types(open_noad_type, open_noad_type ): x = get_math_param(math_param_open_open_spacing,mstyle); break;
+ case both_types(open_noad_type, close_noad_type): x = get_math_param(math_param_open_close_spacing,mstyle); break;
+ case both_types(open_noad_type, punct_noad_type): x = get_math_param(math_param_open_punct_spacing,mstyle); break;
+ case both_types(open_noad_type, inner_noad_type): x = get_math_param(math_param_open_inner_spacing,mstyle); break;
+ case both_types(close_noad_type,ord_noad_type ): x = get_math_param(math_param_close_ord_spacing,mstyle); break;
+ case both_types(close_noad_type,op_noad_type_normal ): x = get_math_param(math_param_close_op_spacing,mstyle); break;
+ case both_types(close_noad_type,bin_noad_type ): x = get_math_param(math_param_close_bin_spacing,mstyle); break;
+ case both_types(close_noad_type,rel_noad_type ): x = get_math_param(math_param_close_rel_spacing,mstyle); break;
+ case both_types(close_noad_type,open_noad_type ): x = get_math_param(math_param_close_open_spacing,mstyle); break;
+ case both_types(close_noad_type,close_noad_type): x = get_math_param(math_param_close_close_spacing,mstyle); break;
+ case both_types(close_noad_type,punct_noad_type): x = get_math_param(math_param_close_punct_spacing,mstyle); break;
+ case both_types(close_noad_type,inner_noad_type): x = get_math_param(math_param_close_inner_spacing,mstyle); break;
+ case both_types(punct_noad_type,ord_noad_type ): x = get_math_param(math_param_punct_ord_spacing,mstyle); break;
+ case both_types(punct_noad_type,op_noad_type_normal ): x = get_math_param(math_param_punct_op_spacing,mstyle); break;
+#if 0
+ case both_types(punct_noad_type,bin_noad_type ): x = get_math_param(math_param_punct_bin_spacing,mstyle); break;
+#endif
+ case both_types(punct_noad_type,rel_noad_type ): x = get_math_param(math_param_punct_rel_spacing,mstyle); break;
+ case both_types(punct_noad_type,open_noad_type ): x = get_math_param(math_param_punct_open_spacing,mstyle); break;
+ case both_types(punct_noad_type,close_noad_type): x = get_math_param(math_param_punct_close_spacing,mstyle); break;
+ case both_types(punct_noad_type,punct_noad_type): x = get_math_param(math_param_punct_punct_spacing,mstyle); break;
+ case both_types(punct_noad_type,inner_noad_type): x = get_math_param(math_param_punct_inner_spacing,mstyle); break;
+ case both_types(inner_noad_type,ord_noad_type ): x = get_math_param(math_param_inner_ord_spacing,mstyle); break;
+ case both_types(inner_noad_type,op_noad_type_normal ): x = get_math_param(math_param_inner_op_spacing,mstyle); break;
+ case both_types(inner_noad_type,bin_noad_type ): x = get_math_param(math_param_inner_bin_spacing,mstyle); break;
+ case both_types(inner_noad_type,rel_noad_type ): x = get_math_param(math_param_inner_rel_spacing,mstyle); break;
+ case both_types(inner_noad_type,open_noad_type ): x = get_math_param(math_param_inner_open_spacing,mstyle); break;
+ case both_types(inner_noad_type,close_noad_type): x = get_math_param(math_param_inner_close_spacing,mstyle); break;
+ case both_types(inner_noad_type,punct_noad_type): x = get_math_param(math_param_inner_punct_spacing,mstyle); break;
+ case both_types(inner_noad_type,inner_noad_type): x = get_math_param(math_param_inner_inner_spacing,mstyle); break;
+ /* *INDENT-ON* */
+ }
+ if (x < 0) {
+ confusion("mathspacing");
+ }
+ if (x != 0) {
+ pointer y;
+ if (x <= thick_mu_skip_code) { /* trap thin/med/thick settings cf. old TeX */
+ y = math_glue(glue_par(x), mmu);
+ z = new_glue(y);
+ glue_ref_count(y) = null;
+ subtype(z) = (quarterword) (x + 1); /* store a symbolic subtype */
+ } else {
+ y = math_glue(x, mmu);
+ z = new_glue(y);
+ glue_ref_count(y) = null;
+ }
+ }
+ return z;
+}
+
+@ @c
+static pointer check_nucleus_complexity(halfword q, scaled * delta,
+ int cur_style)
+{
+ pointer p = null;
+ switch (type(nucleus(q))) {
+ case math_char_node:
+ case math_text_char_node:
+ fetch(nucleus(q));
+ if (char_exists(cur_f, cur_c)) {
+ *delta = char_italic(cur_f, cur_c);
+ p = new_glyph(cur_f, cur_c);
+ reset_attributes(p, node_attr(nucleus(q)));
+ if ((is_new_mathfont(cur_f) && get_char_cat_code(cur_c) == 11) ||
+ (!is_new_mathfont(cur_f) && type(nucleus(q)) == math_text_char_node && space(cur_f)) != 0) {
+ *delta = 0; /* no italic correction in mid-word of text font */
+ }
+ if ((subscr(q) == null) && (supscr(q) == null) && (*delta != 0)) {
+ pointer x = new_kern(*delta);
+ reset_attributes(x, node_attr(nucleus(q)));
+ couple_nodes(p,x);
+ *delta = 0;
+ }
+ }
+ break;
+ case sub_box_node:
+ p = math_list(nucleus(q));
+ break;
+ case sub_mlist_node:
+ mlist_to_hlist_args(math_list(nucleus(q)), cur_style, false); /* recursive call */
+ setup_cur_size(cur_style);
+ p = hpack(vlink(temp_head), 0, additional, -1);
+ reset_attributes(p, node_attr(nucleus(q)));
+ break;
+ default:
+ confusion("mlist2"); /* this can't happen mlist2 */
+ }
+ return p;
+}
+
+@ Here is the overall plan of |mlist_to_hlist|, and the list of its
+ local variables.
+
+@c
+static void mlist_to_hlist(pointer mlist, boolean penalties, int cur_style)
+{
+ pointer q; /* runs through the mlist */
+ pointer r; /* the most recent noad preceding |q| */
+ int style;
+ int r_type; /* the |type| of noad |r|, or |op_noad| if |r=null| */
+ int r_subtype; /* the |subtype| of noad |r| if |r_type| is |fence_noad| */
+ int t; /* the effective |type| of noad |q| during the second pass */
+ int t_subtype; /* the effective |subtype| of noad |q| during the second pass */
+ pointer p, x, y, z; /* temporary registers for list construction */
+ int pen; /* a penalty to be inserted */
+ scaled max_hl, max_d; /* maximum height and depth of the list translated so far */
+ scaled delta; /* italic correction offset for subscript and superscript */
+ scaled cur_mu; /* the math unit width corresponding to |cur_size| */
+ style = cur_style; /* tuck global parameter away as local variable */
+ q = mlist;
+ r = null;
+ r_type = simple_noad;
+ r_subtype = op_noad_type_normal;
+ max_hl = 0;
+ max_d = 0;
+ x = null;
+ p = null;
+ setup_cur_size(cur_style);
+ cur_mu = x_over_n(get_math_quad(cur_size), 18);
+ while (q != null) {
+ /* We use the fact that no character nodes appear in an mlist, hence
+ the field |type(q)| is always present. */
+
+ /* One of the things we must do on the first pass is change a |bin_noad| to
+ an |ord_noad| if the |bin_noad| is not in the context of a binary operator.
+ The values of |r| and |r_type| make this fairly easy. */
+ RESWITCH:
+ delta = 0;
+ switch (type(q)) {
+ case simple_noad:
+ switch (subtype(q)) {
+ case bin_noad_type:
+ switch (r_type) {
+ case simple_noad:
+ switch (r_subtype) {
+ case bin_noad_type:
+ case op_noad_type_normal:
+ case op_noad_type_limits:
+ case op_noad_type_no_limits:
+ case rel_noad_type:
+ case open_noad_type:
+ case punct_noad_type:
+ subtype(q) = ord_noad_type;
+ goto RESWITCH;
+ break;
+ }
+ break;
+ case fence_noad:
+ if (r_subtype == left_noad_side) {
+ subtype(q) = ord_noad_type;
+ goto RESWITCH;
+ }
+ break;
+ }
+ break;
+ case over_noad_type:
+ make_over(q, cur_style);
+ break;
+ case under_noad_type:
+ make_under(q, cur_style);
+ break;
+ case vcenter_noad_type:
+ make_vcenter(q);
+ break;
+ case rel_noad_type:
+ case close_noad_type:
+ case punct_noad_type:
+ if (r_type == simple_noad && r_subtype == bin_noad_type) {
+ type(r) = simple_noad;
+ subtype(r) = ord_noad_type;
+ }
+ break;
+ case op_noad_type_normal:
+ case op_noad_type_limits:
+ case op_noad_type_no_limits:
+ delta = make_op(q, cur_style);
+ if (subtype(q) == op_noad_type_limits)
+ goto CHECK_DIMENSIONS;
+ break;
+ case ord_noad_type:
+ make_ord(q);
+ break;
+ case open_noad_type:
+ case inner_noad_type:
+ break;
+ }
+ break;
+ case fence_noad:
+ if (subtype(q) != left_noad_side)
+ if (r_type == simple_noad && r_subtype == bin_noad_type) {
+ type(r) = simple_noad;
+ subtype(r) = ord_noad_type;
+ }
+ goto DONE_WITH_NOAD;
+ break;
+ case fraction_noad:
+ make_fraction(q, cur_style);
+ goto CHECK_DIMENSIONS;
+ break;
+ case radical_noad:
+ if (subtype(q) == 4)
+ make_under_delimiter(q, cur_style);
+ else if (subtype(q) == 5)
+ make_over_delimiter(q, cur_style);
+ else if (subtype(q) == 6)
+ make_delimiter_under(q, cur_style);
+ else if (subtype(q) == 7)
+ make_delimiter_over(q, cur_style);
+ else
+ make_radical(q, cur_style);
+ break;
+ case accent_noad:
+ make_math_accent(q, cur_style);
+ break;
+ case style_node:
+ cur_style = subtype(q);
+ setup_cur_size(cur_style);
+ cur_mu = x_over_n(get_math_quad(cur_size), 18);
+ goto DONE_WITH_NODE;
+ break;
+ case choice_node:
+ switch (cur_style / 2) {
+ case 0:
+ choose_mlist(display_mlist);
+ break; /* |display_style=0| */
+ case 1:
+ choose_mlist(text_mlist);
+ break; /* |text_style=2| */
+ case 2:
+ choose_mlist(script_mlist);
+ break; /* |script_style=4| */
+ case 3:
+ choose_mlist(script_script_mlist);
+ break; /* |script_script_style=6| */
+ } /* there are no other cases */
+ flush_node_list(display_mlist(q));
+ flush_node_list(text_mlist(q));
+ flush_node_list(script_mlist(q));
+ flush_node_list(script_script_mlist(q));
+ type(q) = style_node;
+ subtype(q) = (quarterword) cur_style;
+ if (p != null) {
+ z = vlink(q);
+ couple_nodes(q,p);
+ while (vlink(p) != null)
+ p = vlink(p);
+ couple_nodes(p,z);
+ }
+ goto DONE_WITH_NODE;
+ break;
+ case ins_node:
+ case mark_node:
+ case adjust_node:
+ case whatsit_node:
+ case penalty_node:
+ case disc_node:
+ goto DONE_WITH_NODE;
+ break;
+ case rule_node:
+ if (height(q) > max_hl)
+ max_hl = height(q);
+ if (depth(q) > max_d)
+ max_d = depth(q);
+ goto DONE_WITH_NODE;
+ break;
+ case glue_node:
+ /*
+ Conditional math glue (`\.{\\nonscript}') results in a |glue_node|
+ pointing to |zero_glue|, with |subtype(q)=cond_math_glue|; in such a case
+ the node following will be eliminated if it is a glue or kern node and if the
+ current size is different from |text_size|. Unconditional math glue
+ (`\.{\\muskip}') is converted to normal glue by multiplying the dimensions
+ by |cur_mu|.
+ */
+ if (subtype(q) == mu_glue) {
+ x = glue_ptr(q);
+ y = math_glue(x, cur_mu);
+ delete_glue_ref(x);
+ glue_ptr(q) = y;
+ subtype(q) = normal;
+ } else if ((cur_size != text_size)
+ && (subtype(q) == cond_math_glue)) {
+ p = vlink(q);
+ if (p != null)
+ if ((type(p) == glue_node) || (type(p) == kern_node)) {
+ couple_nodes(q,vlink(p));
+ vlink(p) = null;
+ flush_node_list(p);
+ }
+ }
+ goto DONE_WITH_NODE;
+ break;
+ case kern_node:
+ math_kern(q, cur_mu);
+ goto DONE_WITH_NODE;
+ break;
+ default:
+ confusion("mlist1"); /* this can't happen mlist1 */
+ }
+ /* When we get to the following part of the program, we have ``fallen through''
+ from cases that did not lead to |check_dimensions| or |done_with_noad| or
+ |done_with_node|. Thus, |q|~points to a noad whose nucleus may need to be
+ converted to an hlist, and whose subscripts and superscripts need to be
+ appended if they are present.
+
+ If |nucleus(q)| is not a |math_char|, the variable |delta| is the amount
+ by which a superscript should be moved right with respect to a subscript
+ when both are present.
+ */
+ p = check_nucleus_complexity(q, &delta, cur_style);
+
+ if ((subscr(q) == null) && (supscr(q) == null)) {
+ assign_new_hlist(q, p);
+ } else {
+ make_scripts(q, p, delta, cur_style); /* top, bottom */
+ }
+ CHECK_DIMENSIONS:
+ z = hpack(new_hlist(q), 0, additional, -1);
+ if (height(z) > max_hl)
+ max_hl = height(z);
+ if (depth(z) > max_d)
+ max_d = depth(z);
+ list_ptr(z) = null;
+ flush_node(z); /* only drop the \.{\\hbox} */
+ DONE_WITH_NOAD:
+ r = q;
+ r_type = type(r);
+ r_subtype = subtype(r);
+ if (r_type == fence_noad) {
+ r_subtype = left_noad_side;
+ cur_style = style;
+ setup_cur_size(cur_style);
+ cur_mu = x_over_n(get_math_quad(cur_size), 18);
+ }
+ DONE_WITH_NODE:
+ q = vlink(q);
+ }
+ if (r_type == simple_noad && r_subtype == bin_noad_type) {
+ type(r) = simple_noad;
+ subtype(r) = ord_noad_type;
+ }
+ /* Make a second pass over the mlist, removing all noads and inserting the
+ proper spacing and penalties */
+
+ /* We have now tied up all the loose ends of the first pass of |mlist_to_hlist|.
+ The second pass simply goes through and hooks everything together with the
+ proper glue and penalties. It also handles the |fence_noad|s that
+ might be present, since |max_hl| and |max_d| are now known. Variable |p| points
+ to a node at the current end of the final hlist.
+ */
+ p = temp_head;
+ vlink(p) = null;
+ q = mlist;
+ r_type = 0;
+ r_subtype = 0;
+ cur_style = style;
+ setup_cur_size(cur_style);
+ cur_mu = x_over_n(get_math_quad(cur_size), 18);
+ NEXT_NODE:
+ while (q != null) {
+ /* If node |q| is a style node, change the style and |goto delete_q|;
+ otherwise if it is not a noad, put it into the hlist,
+ advance |q|, and |goto done|; otherwise set |s| to the size
+ of noad |q|, set |t| to the associated type (|ord_noad..
+ inner_noad|), and set |pen| to the associated penalty */
+ /* Just before doing the big |case| switch in the second pass, the program
+ sets up default values so that most of the branches are short. */
+ t = simple_noad;
+ t_subtype = ord_noad_type;
+ pen = inf_penalty;
+ switch (type(q)) {
+ case simple_noad:
+ t_subtype = subtype(q);
+ switch (t_subtype) {
+ case bin_noad_type:
+ pen = bin_op_penalty;
+ break;
+ case rel_noad_type:
+ pen = rel_penalty;
+ break;
+ case vcenter_noad_type:
+ case over_noad_type:
+ case under_noad_type:
+ t_subtype = ord_noad_type;
+ break;
+ }
+ case radical_noad:
+ break;
+ case accent_noad:
+ break;
+ case fraction_noad:
+ t = simple_noad;
+ t_subtype = inner_noad_type;
+ break;
+ case fence_noad:
+ t_subtype = make_left_right(q, style, max_d, max_hl);
+ break;
+ case style_node:
+ /* Change the current style and |goto delete_q| */
+ cur_style = subtype(q);
+ setup_cur_size(cur_style);
+ cur_mu = x_over_n(get_math_quad(cur_size), 18);
+ goto DELETE_Q;
+ break;
+ case whatsit_node:
+ case penalty_node:
+ case rule_node:
+ case disc_node:
+ case adjust_node:
+ case ins_node:
+ case mark_node:
+ case glue_node:
+ case kern_node:
+ couple_nodes(p,q);
+ p = q;
+ q = vlink(q);
+ vlink(p) = null;
+ goto NEXT_NODE;
+ break;
+ default:
+ confusion("mlist3"); /* this can't happen mlist3 */
+ }
+ /* Append inter-element spacing based on |r_type| and |t| */
+ if (r_type > 0) { /* not the first noad */
+ z = math_spacing_glue(r_subtype, t_subtype, cur_style, cur_mu);
+ if (z != null) {
+ reset_attributes(z, node_attr(p));
+ couple_nodes(p,z);
+ p = z;
+ }
+ }
+
+ /* Append any |new_hlist| entries for |q|, and any appropriate penalties */
+ /* We insert a penalty node after the hlist entries of noad |q| if |pen|
+ is not an ``infinite'' penalty, and if the node immediately following |q|
+ is not a penalty node or a |rel_noad| or absent entirely. */
+
+ if (new_hlist(q) != null) {
+ couple_nodes(p,new_hlist(q));
+ do {
+ p = vlink(p);
+ } while (vlink(p) != null);
+ }
+ if (penalties && vlink(q) != null && pen < inf_penalty) {
+ r_type = type(vlink(q));
+ r_subtype = subtype(vlink(q));
+ if (r_type != penalty_node
+ && (r_type != simple_noad || r_subtype != rel_noad_type)) {
+ z = new_penalty(pen);
+ reset_attributes(z, node_attr(q));
+ couple_nodes(p,z);
+ p = z;
+ }
+ }
+ if (type(q) == fence_noad && subtype(q) == right_noad_side) {
+ t = simple_noad;
+ t_subtype = open_noad_type;
+ }
+ r_type = t;
+ r_subtype = t_subtype;
+ DELETE_Q:
+ r = q;
+ q = vlink(q);
+ /* The m-to-hlist conversion takes place in-place,
+ so the various dependant fields may not be freed
+ (as would happen if |flush_node| was called).
+ A low-level |free_node| is easier than attempting
+ to nullify such dependant fields for all possible
+ node and noad types.
+ */
+ if (nodetype_has_attributes(type(r)))
+ delete_attribute_ref(node_attr(r));
+ free_node(r, get_node_size(type(r), subtype(r)));
+ }
+}
+
+@ This used to be needed when |mlist_to_hlist| communicated via global
+variables.
+
+@c
+void mlist_to_hlist_args(pointer n, int w, boolean m)
+{
+ mlist_to_hlist(n, m, w);
+}
diff --git a/Build/source/texk/web2c/luatexdir/tex/texnodes.w b/Build/source/texk/web2c/luatexdir/tex/texnodes.w
index 4ea9cb49c3f..5f4f2739e4a 100644
--- a/Build/source/texk/web2c/luatexdir/tex/texnodes.w
+++ b/Build/source/texk/web2c/luatexdir/tex/texnodes.w
@@ -1,3400 +1,3409 @@
-% texnodes.w
-%
-% Copyright 2006-2010 Taco Hoekwater <taco@@luatex.org>
-%
-% This file is part of LuaTeX.
-%
-% LuaTeX is free software; you can redistribute it and/or modify it under
-% the terms of the GNU General Public License as published by the Free
-% Software Foundation; either version 2 of the License, or (at your
-% option) any later version.
-%
-% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
-% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
-% License for more details.
-%
-% You should have received a copy of the GNU General Public License along
-% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
-
-@ @c
-static const char _svn_version[] =
- "$Id: texnodes.w 4442 2012-05-25 22:40:34Z hhenkel $"
- "$URL: https://foundry.supelec.fr/svn/luatex/branches/ex-glyph/source/texk/web2c/luatexdir/tex/texnodes.w $";
-
-#include "ptexlib.h"
-#include "lua/luatex-api.h"
-
-@ @c
-#undef name
-
-#define noDEBUG
-#define DEBUG_OUT stdout
-
-#define adjust_pre subtype
-#define attribute(A) eqtb[attribute_base+(A)].cint
-
-#define uc_hyph int_par(uc_hyph_code)
-#define cur_lang int_par(cur_lang_code)
-#define left_hyphen_min int_par(left_hyphen_min_code)
-#define right_hyphen_min int_par(right_hyphen_min_code)
-
-#define text_direction int_par(text_direction_code)
-
-#define MAX_CHAIN_SIZE 13
-
-memory_word *volatile varmem = NULL;
-
-#ifndef NDEBUG
-char *varmem_sizes = NULL;
-#endif
-
-halfword var_mem_max = 0;
-halfword rover = 0;
-
-halfword free_chain[MAX_CHAIN_SIZE] = { null };
-
-static int my_prealloc = 0;
-
-int fix_node_lists = 1;
-
-int free_error_seen = 0;
-int copy_error_seen = 0;
-
-halfword slow_get_node(int s); /* defined below */
-int copy_error(halfword p); /* define below */
-
-#define fake_node 100
-#define fake_node_size 2
-#define fake_node_name "fake"
-
-#define variable_node_size 2
-
-const char *node_fields_list[] =
- { "attr", "width", "depth", "height", "dir", "shift",
- "glue_order", "glue_sign", "glue_set", "head", NULL
-};
-const char *node_fields_rule[] =
- { "attr", "width", "depth", "height", "dir", NULL };
-const char *node_fields_insert[] =
- { "attr", "cost", "depth", "height", "spec", "head", NULL };
-const char *node_fields_mark[] = { "attr", "class", "mark", NULL };
-const char *node_fields_adjust[] = { "attr", "head", NULL };
-const char *node_fields_disc[] = { "attr", "pre", "post", "replace", NULL };
-const char *node_fields_math[] = { "attr", "surround", NULL };
-const char *node_fields_glue[] = { "attr", "spec", "leader", NULL };
-const char *node_fields_kern[] = { "attr", "kern", "expansion_factor", NULL };
-const char *node_fields_penalty[] = { "attr", "penalty", NULL };
-
-const char *node_fields_unset[] =
- { "attr", "width", "depth", "height", "dir", "shrink",
- "glue_order", "glue_sign", "stretch", "span", "head", NULL
-};
-const char *node_fields_margin_kern[] = { "attr", "width", "glyph", NULL };
-
-const char *node_fields_glyph[] =
- { "attr", "char", "font", "lang", "left", "right", "uchyph",
- "components", "xoffset", "yoffset", "width", "height", "depth", "expansion_factor", NULL
-};
-const char *node_fields_style[] = { "attr", "style", NULL };
-const char *node_fields_choice[] =
- { "attr", "display", "text", "script", "scriptscript", NULL };
-const char *node_fields_ord[] = { "attr", "nucleus", "sub", "sup", NULL };
-const char *node_fields_op[] = { "attr", "nucleus", "sub", "sup", NULL };
-const char *node_fields_bin[] = { "attr", "nucleus", "sub", "sup", NULL };
-const char *node_fields_rel[] = { "attr", "nucleus", "sub", "sup", NULL };
-const char *node_fields_open[] = { "attr", "nucleus", "sub", "sup", NULL };
-const char *node_fields_close[] = { "attr", "nucleus", "sub", "sup", NULL };
-const char *node_fields_punct[] = { "attr", "nucleus", "sub", "sup", NULL };
-const char *node_fields_inner[] = { "attr", "nucleus", "sub", "sup", NULL };
-const char *node_fields_under[] = { "attr", "nucleus", "sub", "sup", NULL };
-const char *node_fields_over[] = { "attr", "nucleus", "sub", "sup", NULL };
-const char *node_fields_vcenter[] = { "attr", "nucleus", "sub", "sup", NULL };
-const char *node_fields_radical[] =
- { "attr", "nucleus", "sub", "sup", "left", "degree", NULL };
-const char *node_fields_fraction[] =
- { "attr", "width", "num", "denom", "left", "right", NULL };
-const char *node_fields_accent[] =
- { "attr", "nucleus", "sub", "sup", "accent", "bot_accent", NULL };
-const char *node_fields_fence[] = { "attr", "delim", NULL };
-const char *node_fields_math_char[] = { "attr", "fam", "char", NULL };
-const char *node_fields_sub_box[] = { "attr", "head", NULL };
-const char *node_fields_sub_mlist[] = { "attr", "head", NULL };
-const char *node_fields_math_text_char[] = { "attr", "fam", "char", NULL };
-const char *node_fields_delim[] =
- { "attr", "small_fam", "small_char", "large_fam", "large_char", NULL };
-
-const char *node_fields_inserting[] =
- { "height", "last_ins_ptr", "best_ins_ptr", NULL };
-
-const char *node_fields_splitup[] = { "height", "last_ins_ptr", "best_ins_ptr",
- "broken_ptr", "broken_ins", NULL
-};
-
-const char *node_fields_action[] = { "action_type", "named_id", "action_id",
- "file", "new_window", "data", "ref_count", NULL
-};
-const char *node_fields_attribute[] = { "number", "value", NULL };
-
-const char *node_fields_glue_spec[] = { "width", "stretch", "shrink",
- "stretch_order", "shrink_order", "ref_count", "writable", NULL
-};
-const char *node_fields_attribute_list[] = { NULL };
-
-const char *node_fields_whatsit_open[] =
- { "attr", "stream", "name", "area", "ext", NULL };
-const char *node_fields_whatsit_write[] = { "attr", "stream", "data", NULL };
-const char *node_fields_whatsit_close[] = { "attr", "stream", NULL };
-const char *node_fields_whatsit_special[] = { "attr", "data", NULL };
-
-const char *node_fields_whatsit_local_par[] =
- { "attr", "pen_inter", "pen_broken", "dir",
- "box_left", "box_left_width", "box_right", "box_right_width", NULL
-};
-const char *node_fields_whatsit_dir[] =
- { "attr", "dir", "level", "dvi_ptr", "dvi_h", NULL };
-
-const char *node_fields_whatsit_pdf_literal[] =
- { "attr", "mode", "data", NULL };
-const char *node_fields_whatsit_pdf_refobj[] = { "attr", "objnum", NULL };
-const char *node_fields_whatsit_pdf_refxform[] =
- { "attr", "width", "depth", "height", "objnum", NULL };
-const char *node_fields_whatsit_pdf_refximage[] =
- { "attr", "width", "depth", "height", "transform", "index", NULL };
-const char *node_fields_whatsit_pdf_annot[] =
- { "attr", "width", "depth", "height", "objnum", "data", NULL };
-const char *node_fields_whatsit_pdf_start_link[] =
- { "attr", "width", "depth", "height",
- "objnum", "link_attr", "action", NULL
-};
-const char *node_fields_whatsit_pdf_end_link[] = { "attr", NULL };
-
-const char *node_fields_whatsit_pdf_dest[] =
- { "attr", "width", "depth", "height",
- "named_id", "dest_id", "dest_type", "xyz_zoom", "objnum", NULL
-};
-
-const char *node_fields_whatsit_pdf_thread[] =
- { "attr", "width", "depth", "height",
- "named_id", "thread_id", "thread_attr", NULL
-};
-
-const char *node_fields_whatsit_pdf_start_thread[] =
- { "attr", "width", "depth", "height",
- "named_id", "thread_id", "thread_attr", NULL
-};
-const char *node_fields_whatsit_pdf_end_thread[] = { "attr", NULL };
-const char *node_fields_whatsit_pdf_save_pos[] = { "attr", NULL };
-const char *node_fields_whatsit_late_lua[] =
- { "attr", "reg", "data", "name", "string", NULL };
-const char *node_fields_whatsit_close_lua[] = { "attr", "reg", NULL };
-const char *node_fields_whatsit_pdf_colorstack[] =
- { "attr", "stack", "cmd", "data", NULL };
-const char *node_fields_whatsit_pdf_setmatrix[] = { "attr", "data", NULL };
-const char *node_fields_whatsit_pdf_save[] = { "attr", NULL };
-const char *node_fields_whatsit_pdf_restore[] = { "attr", NULL };
-const char *node_fields_whatsit_cancel_boundary[] = { "attr", NULL };
-const char *node_fields_whatsit_user_defined[] =
- { "attr", "user_id", "type", "value", NULL };
-
-node_info node_data[] = {
- {hlist_node, box_node_size, node_fields_list, "hlist"},
- {vlist_node, box_node_size, node_fields_list, "vlist"},
- {rule_node, rule_node_size, node_fields_rule, "rule"},
- {ins_node, ins_node_size, node_fields_insert, "ins"},
- {mark_node, mark_node_size, node_fields_mark, "mark"},
- {adjust_node, adjust_node_size, node_fields_adjust, "adjust"},
- {fake_node, fake_node_size, NULL, fake_node_name}, /* don't touch this! */
- {disc_node, disc_node_size, node_fields_disc, "disc"},
- {whatsit_node, -1, NULL, "whatsit"},
- {math_node, math_node_size, node_fields_math, "math"},
- {glue_node, glue_node_size, node_fields_glue, "glue"},
- {kern_node, kern_node_size, node_fields_kern, "kern"},
- {penalty_node, penalty_node_size, node_fields_penalty, "penalty"},
- {unset_node, box_node_size, node_fields_unset, "unset"},
- {style_node, style_node_size, node_fields_style, "style"},
- {choice_node, style_node_size, node_fields_choice, "choice"},
- {simple_noad, noad_size, node_fields_ord, "noad"},
- {old_op_noad, noad_size, node_fields_op, "op"},
- {old_bin_noad, noad_size, node_fields_bin, "bin"},
- {old_rel_noad, noad_size, node_fields_rel, "rel"},
- {old_open_noad, noad_size, node_fields_open, "open"},
- {old_close_noad, noad_size, node_fields_close, "close"},
- {old_punct_noad, noad_size, node_fields_punct, "punct"},
- {old_inner_noad, noad_size, node_fields_inner, "inner"},
- {radical_noad, radical_noad_size, node_fields_radical, "radical"},
- {fraction_noad, fraction_noad_size, node_fields_fraction, "fraction"},
- {old_under_noad, noad_size, node_fields_under, "under"},
- {old_over_noad, noad_size, node_fields_over, "over"},
- {accent_noad, accent_noad_size, node_fields_accent, "accent"},
- {old_vcenter_noad, noad_size, node_fields_vcenter, "vcenter"},
- {fence_noad, fence_noad_size, node_fields_fence, "fence"},
- {math_char_node, math_kernel_node_size, node_fields_math_char, "math_char"},
- {sub_box_node, math_kernel_node_size, node_fields_sub_box, "sub_box"},
- {sub_mlist_node, math_kernel_node_size, node_fields_sub_mlist, "sub_mlist"},
- {math_text_char_node, math_kernel_node_size, node_fields_math_text_char, "math_text_char"},
- {delim_node, math_shield_node_size, node_fields_delim, "delim"},
- {margin_kern_node, margin_kern_node_size, node_fields_margin_kern, "margin_kern"},
- {glyph_node, glyph_node_size, node_fields_glyph, "glyph"},
- {align_record_node, box_node_size, NULL, "align_record"},
- {pseudo_file_node, pseudo_file_node_size, NULL, "pseudo_file"},
- {pseudo_line_node, variable_node_size, NULL, "pseudo_line"},
- {inserting_node, page_ins_node_size, node_fields_inserting, "page_insert"},
- {split_up_node, page_ins_node_size, node_fields_splitup, "split_insert"},
- {expr_node, expr_node_size, NULL, "expr_stack"},
- {nesting_node, nesting_node_size, NULL, "nested_list"},
- {span_node, span_node_size, NULL, "span"},
- {attribute_node, attribute_node_size, node_fields_attribute, "attribute"},
- {glue_spec_node, glue_spec_size, node_fields_glue_spec, "glue_spec"},
- {attribute_list_node, attribute_node_size, node_fields_attribute_list, "attribute_list"},
- {action_node, pdf_action_size, node_fields_action, "action"},
- {temp_node, temp_node_size, NULL, "temp"},
- {align_stack_node, align_stack_node_size, NULL, "align_stack"},
- {movement_node, movement_node_size, NULL, "movement_stack"},
- {if_node, if_node_size, NULL, "if_stack"},
- {unhyphenated_node, active_node_size, NULL, "unhyphenated"},
- {hyphenated_node, active_node_size, NULL, "hyphenated"},
- {delta_node, delta_node_size, NULL, "delta"},
- {passive_node, passive_node_size, NULL, "passive"},
- {shape_node, variable_node_size, NULL, "shape"},
- {-1, -1, NULL, NULL}
-};
-
-#define last_normal_node shape_node
-
-node_info whatsit_node_data[] = {
- {open_node, open_node_size, node_fields_whatsit_open, "open"},
- {write_node, write_node_size, node_fields_whatsit_write, "write"},
- {close_node, close_node_size, node_fields_whatsit_close, "close"},
- {special_node, special_node_size, node_fields_whatsit_special, "special"},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {local_par_node, local_par_size, node_fields_whatsit_local_par,
- "local_par"},
- {dir_node, dir_node_size, node_fields_whatsit_dir, "dir"},
- {pdf_literal_node, write_node_size, node_fields_whatsit_pdf_literal,
- "pdf_literal"},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {pdf_refobj_node, pdf_refobj_node_size, node_fields_whatsit_pdf_refobj,
- "pdf_refobj"},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {pdf_refxform_node, pdf_refxform_node_size,
- node_fields_whatsit_pdf_refxform, "pdf_refxform"},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {pdf_refximage_node, pdf_refximage_node_size,
- node_fields_whatsit_pdf_refximage, "pdf_refximage"},
- {pdf_annot_node, pdf_annot_node_size, node_fields_whatsit_pdf_annot,
- "pdf_annot"},
- {pdf_start_link_node, pdf_annot_node_size,
- node_fields_whatsit_pdf_start_link, "pdf_start_link"},
- {pdf_end_link_node, pdf_end_link_node_size,
- node_fields_whatsit_pdf_end_link, "pdf_end_link"},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {pdf_dest_node, pdf_dest_node_size, node_fields_whatsit_pdf_dest,
- "pdf_dest"},
- {pdf_thread_node, pdf_thread_node_size, node_fields_whatsit_pdf_thread,
- "pdf_thread"},
- {pdf_start_thread_node, pdf_thread_node_size,
- node_fields_whatsit_pdf_start_thread, "pdf_start_thread"},
- {pdf_end_thread_node, pdf_end_thread_node_size,
- node_fields_whatsit_pdf_end_thread, "pdf_end_thread"},
- {pdf_save_pos_node, pdf_save_pos_node_size,
- node_fields_whatsit_pdf_save_pos, "pdf_save_pos"},
- {pdf_thread_data_node, pdf_thread_node_size, NULL, "pdf_thread_data"},
- {pdf_link_data_node, pdf_annot_node_size, NULL, "pdf_link_data"},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {late_lua_node, late_lua_node_size, node_fields_whatsit_late_lua,
- "late_lua"},
- {close_lua_node, write_node_size, node_fields_whatsit_close_lua,
- "close_lua"},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {fake_node, fake_node_size, NULL, fake_node_name},
- {pdf_colorstack_node, pdf_colorstack_node_size,
- node_fields_whatsit_pdf_colorstack, "pdf_colorstack"},
- {pdf_setmatrix_node, pdf_setmatrix_node_size,
- node_fields_whatsit_pdf_setmatrix, "pdf_setmatrix"},
- {pdf_save_node, pdf_save_node_size, node_fields_whatsit_pdf_save,
- "pdf_save"},
- {pdf_restore_node, pdf_restore_node_size, node_fields_whatsit_pdf_restore,
- "pdf_restore"},
- {cancel_boundary_node, cancel_boundary_size,
- node_fields_whatsit_cancel_boundary, "cancel_boundary"},
- {user_defined_node, user_defined_node_size,
- node_fields_whatsit_user_defined, "user_defined"},
- {-1, -1, NULL, NULL}
-};
-
-#define last_whatsit_node user_defined_node
-
-@ @c
-halfword new_node(int i, int j)
-{
- int s;
- halfword n;
- s = get_node_size(i, j);
- n = get_node(s);
- /* it should be possible to do this memset at |free_node()| */
- /* type() and subtype() will be set below, and vlink() is
- set to null by |get_node()|, so we can do we clearing one
- word less than |s| */
- (void) memset((void *) (varmem + n + 1), 0,
- (sizeof(memory_word) * ((unsigned) s - 1)));
- switch (i) {
- case glyph_node:
- init_lang_data(n);
- break;
- case hlist_node:
- case vlist_node:
- box_dir(n) = -1;
- break;
- case whatsit_node:
- if (j == open_node) {
- open_name(n) = get_nullstr();
- open_area(n) = open_name(n);
- open_ext(n) = open_name(n);
- }
- break;
- case disc_node:
- pre_break(n) = pre_break_head(n);
- type(pre_break(n)) = nesting_node;
- subtype(pre_break(n)) = pre_break_head(0);
- post_break(n) = post_break_head(n);
- type(post_break(n)) = nesting_node;
- subtype(post_break(n)) = post_break_head(0);
- no_break(n) = no_break_head(n);
- type(no_break(n)) = nesting_node;
- subtype(no_break(n)) = no_break_head(0);
- break;
- case rule_node:
- depth(n) = null_flag;
- height(n) = null_flag;
- rule_dir(n) = -1;
- /* fall through */
- case unset_node:
- width(n) = null_flag;
- break;
- case pseudo_line_node:
- case shape_node:
- /* this is a trick that makes |pseudo_files| slightly slower,
- but the overall allocation faster then an explicit test
- at the top of |new_node()|.
- */
- if (j>0) {
- free_node(n, variable_node_size);
- n = slow_get_node(j);
- (void) memset((void *) (varmem + n + 1), 0,
- (sizeof(memory_word) * ((unsigned) j - 1)));
- }
- break;
- default:
- break;
- }
- /* handle synctex extension */
- switch (i) {
- case math_node:
- synctex_tag_math(n) = cur_input.synctex_tag_field;
- synctex_line_math(n) = line;
- break;
- case glue_node:
- synctex_tag_glue(n) = cur_input.synctex_tag_field;
- synctex_line_glue(n) = line;
- break;
- case kern_node:
- /* synctex ignores implicit kerns */
- if (j != 0) {
- synctex_tag_kern(n) = cur_input.synctex_tag_field;
- synctex_line_kern(n) = line;
- }
- break;
- case hlist_node:
- case vlist_node:
- case unset_node:
- synctex_tag_box(n) = cur_input.synctex_tag_field;
- synctex_line_box(n) = line;
- break;
- case rule_node:
- synctex_tag_rule(n) = cur_input.synctex_tag_field;
- synctex_line_rule(n) = line;
- break;
- }
- /* take care of attributes */
- if (nodetype_has_attributes(i)) {
- build_attribute_list(n);
- }
- type(n) = (quarterword) i;
- subtype(n) = (quarterword) j;
-#ifdef DEBUG
- fprintf(DEBUG_OUT, "Alloc-ing %s node %d\n",
- get_node_name(type(n), subtype(n)), (int) n);
-#endif
- return n;
-}
-
-halfword raw_glyph_node(void)
-{
- register halfword n;
- n = get_node(glyph_node_size);
- (void) memset((void *) (varmem + n + 1), 0,
- (sizeof(memory_word) * (glyph_node_size - 1)));
- type(n) = glyph_node;
- subtype(n) = 0;
- return n;
-}
-
-halfword new_glyph_node(void)
-{
- register halfword n;
- n = get_node(glyph_node_size);
- (void) memset((void *) (varmem + n + 1), 0,
- (sizeof(memory_word) * (glyph_node_size - 1)));
- type(n) = glyph_node;
- subtype(n) = 0;
- build_attribute_list(n);
- return n;
-}
-
-
-@ makes a duplicate of the node list that starts at |p| and returns a
- pointer to the new list
-@c
-halfword do_copy_node_list(halfword p, halfword end)
-{
- halfword q = null; /* previous position in new list */
- halfword h = null; /* head of the list */
- copy_error_seen = 0;
- while (p != end) {
- register halfword s = copy_node(p);
- if (h == null) {
- h = s;
- } else {
- couple_nodes(q, s);
- }
- q = s;
- p = vlink(p);
- }
- return h;
-}
-
-halfword copy_node_list(halfword p)
-{
- return do_copy_node_list(p, null);
-}
-
-@ make a dupe of a single node
-@c
-halfword copy_node(const halfword p)
-{
- halfword r; /* current node being fabricated for new list */
- register halfword s; /* a helper variable for copying into variable mem */
- register int i;
- if (copy_error(p)) {
- r = new_node(temp_node, 0);
- return r;
- }
- i = get_node_size(type(p), subtype(p));
- r = get_node(i);
-
- (void) memcpy((void *) (varmem + r), (void *) (varmem + p),
- (sizeof(memory_word) * (unsigned) i));
-
- /* handle synctex extension */
- switch (type(p)) {
- case math_node:
- synctex_tag_math(r) = cur_input.synctex_tag_field;
- synctex_line_math(r) = line;
- break;
- case kern_node:
- synctex_tag_kern(r) = cur_input.synctex_tag_field;
- synctex_line_kern(r) = line;
- break;
- }
-
- if (nodetype_has_attributes(type(p))) {
- add_node_attr_ref(node_attr(p));
- alink(r) = null; /* needs checking */
- }
- vlink(r) = null;
-
-
- switch (type(p)) {
- case glyph_node:
- s = copy_node_list(lig_ptr(p));
- lig_ptr(r) = s;
- break;
- case glue_node:
- add_glue_ref(glue_ptr(p));
- s = copy_node_list(leader_ptr(p));
- leader_ptr(r) = s;
- break;
- case hlist_node:
- case vlist_node:
- case unset_node:
- s = copy_node_list(list_ptr(p));
- list_ptr(r) = s;
- break;
- case ins_node:
- add_glue_ref(split_top_ptr(p));
- s = copy_node_list(ins_ptr(p));
- ins_ptr(r) = s;
- break;
- case margin_kern_node:
- s = copy_node(margin_char(p));
- margin_char(r) = s;
- break;
- case disc_node:
- pre_break(r) = pre_break_head(r);
- if (vlink_pre_break(p) != null) {
- s = copy_node_list(vlink_pre_break(p));
- alink(s) = pre_break(r);
- tlink_pre_break(r) = tail_of_list(s);
- vlink_pre_break(r) = s;
- } else {
- assert(tlink(pre_break(r)) == null);
- }
- post_break(r) = post_break_head(r);
- if (vlink_post_break(p) != null) {
- s = copy_node_list(vlink_post_break(p));
- alink(s) = post_break(r);
- tlink_post_break(r) = tail_of_list(s);
- vlink_post_break(r) = s;
- } else {
- assert(tlink_post_break(r) == null);
- }
- no_break(r) = no_break_head(r);
- if (vlink(no_break(p)) != null) {
- s = copy_node_list(vlink_no_break(p));
- alink(s) = no_break(r);
- tlink_no_break(r) = tail_of_list(s);
- vlink_no_break(r) = s;
- } else {
- assert(tlink_no_break(r) == null);
- }
- break;
- case mark_node:
- add_token_ref(mark_ptr(p));
- break;
- case adjust_node:
- s = copy_node_list(adjust_ptr(p));
- adjust_ptr(r) = s;
- break;
-
- case choice_node:
- s = copy_node_list(display_mlist(p));
- display_mlist(r) = s;
- s = copy_node_list(text_mlist(p));
- text_mlist(r) = s;
- s = copy_node_list(script_mlist(p));
- script_mlist(r) = s;
- s = copy_node_list(script_script_mlist(p));
- script_script_mlist(r) = s;
- break;
- case simple_noad:
- case radical_noad:
- case accent_noad:
- s = copy_node_list(nucleus(p));
- nucleus(r) = s;
- s = copy_node_list(subscr(p));
- subscr(r) = s;
- s = copy_node_list(supscr(p));
- supscr(r) = s;
- if (type(p) == accent_noad) {
- s = copy_node_list(accent_chr(p));
- accent_chr(r) = s;
- s = copy_node_list(bot_accent_chr(p));
- bot_accent_chr(r) = s;
- } else if (type(p) == radical_noad) {
- s = copy_node(left_delimiter(p));
- left_delimiter(r) = s;
- s = copy_node_list(degree(p));
- degree(r) = s;
- }
- break;
- case fence_noad:
- s = copy_node(delimiter(p));
- delimiter(r) = s;
- break;
- case sub_box_node:
- case sub_mlist_node:
- s = copy_node_list(math_list(p));
- math_list(r) = s;
- break;
- case fraction_noad:
- s = copy_node_list(numerator(p));
- numerator(r) = s;
- s = copy_node_list(denominator(p));
- denominator(r) = s;
- s = copy_node(left_delimiter(p));
- left_delimiter(r) = s;
- s = copy_node(right_delimiter(p));
- right_delimiter(r) = s;
- break;
- case glue_spec_node:
- glue_ref_count(r) = null;
- break;
- case whatsit_node:
- switch (subtype(p)) {
- case dir_node:
- case local_par_node:
- break;
- case write_node:
- case special_node:
- add_token_ref(write_tokens(p));
- break;
- case pdf_literal_node:
- copy_pdf_literal(r, p);
- break;
- case pdf_colorstack_node:
- if (pdf_colorstack_cmd(p) <= colorstack_data)
- add_token_ref(pdf_colorstack_data(p));
- break;
- case pdf_setmatrix_node:
- add_token_ref(pdf_setmatrix_data(p));
- break;
- case late_lua_node:
- copy_late_lua(r, p);
- break;
- case pdf_annot_node:
- add_token_ref(pdf_annot_data(p));
- break;
- case pdf_start_link_node:
- if (pdf_link_attr(r) != null)
- add_token_ref(pdf_link_attr(r));
- add_action_ref(pdf_link_action(r));
- break;
- case pdf_dest_node:
- if (pdf_dest_named_id(p) > 0)
- add_token_ref(pdf_dest_id(p));
- break;
- case pdf_thread_node:
- case pdf_start_thread_node:
- if (pdf_thread_named_id(p) > 0)
- add_token_ref(pdf_thread_id(p));
- if (pdf_thread_attr(p) != null)
- add_token_ref(pdf_thread_attr(p));
- break;
- case user_defined_node:
- switch (user_node_type(p)) {
- case 'a':
- add_node_attr_ref(user_node_value(p));
- break;
- case 't':
- add_token_ref(user_node_value(p));
- break;
- case 's':
- /* |add_string_ref(user_node_value(p));| *//* if this was mpost .. */
- break;
- case 'n':
- s = copy_node_list(user_node_value(p));
- user_node_value(r) = s;
- break;
- }
- break;
-#if 0
- case style_node:
- case delim_node:
- case math_char_node:
- case math_text_char_node:
- break;
-#else
- default:
-#endif
- break;
- }
- break;
- }
-#ifdef DEBUG
- fprintf(DEBUG_OUT, "Alloc-ing %s node %d (copy of %d)\n",
- get_node_name(type(r), subtype(r)), (int) r, (int) p);
-#endif
- return r;
-}
-
-@ @c
-int valid_node(halfword p)
-{
- if (p > my_prealloc) {
- if (p < var_mem_max) {
-#ifndef NDEBUG
- if (varmem_sizes[p] > 0)
-#endif
- return 1;
- }
- } else {
- return 0;
- }
- return 0;
-}
-
-@ @c
-static void do_free_error(halfword p)
-{
- halfword r;
- char errstr[255] = { 0 };
- const char *errhlp[] = {
- "When I tried to free the node mentioned in the error message, it turned",
- "out it was not (or no longer) actually in use.",
- "Errors such as these are often caused by Lua node list alteration,",
- "but could also point to a bug in the executable. It should be safe to continue.",
- NULL
- };
-
- check_node_mem();
- if (free_error_seen)
- return;
-
- r = null;
- free_error_seen = 1;
- if (type(p) == glyph_node) {
- snprintf(errstr, 255,
- "Attempt to double-free glyph (%c) node %d, ignored",
- (int) character(p), (int) p);
- } else {
- snprintf(errstr, 255, "Attempt to double-free %s node %d, ignored",
- get_node_name(type(p), subtype(p)), (int) p);
- }
- tex_error(errstr, errhlp);
-#ifndef NDEBUG
- for (r = my_prealloc + 1; r < var_mem_max; r++) {
- if (vlink(r) == p) {
- halfword s = r;
- while (s > my_prealloc && varmem_sizes[s] == 0)
- s--;
- if (s != null
- && s != my_prealloc
- && s != var_mem_max
- && (r - s) < get_node_size(type(s), subtype(s))
- && alink(s) != p) {
-
- if (type(s) == disc_node) {
- fprintf(stdout,
- " pointed to from %s node %d (vlink %d, alink %d): ",
- get_node_name(type(s), subtype(s)), (int) s,
- (int) vlink(s), (int) alink(s));
- fprintf(stdout, "pre_break(%d,%d,%d), ",
- (int) vlink_pre_break(s), (int) tlink(pre_break(s)),
- (int) alink(pre_break(s)));
- fprintf(stdout, "post_break(%d,%d,%d), ",
- (int) vlink_post_break(s),
- (int) tlink(post_break(s)),
- (int) alink(post_break(s)));
- fprintf(stdout, "no_break(%d,%d,%d)",
- (int) vlink_no_break(s), (int) tlink(no_break(s)),
- (int) alink(no_break(s)));
- fprintf(stdout, "\n");
- } else {
- if (vlink(s) == p
- || (type(s) == glyph_node && lig_ptr(s) == p)
- || (type(s) == vlist_node && list_ptr(s) == p)
- || (type(s) == hlist_node && list_ptr(s) == p)
- || (type(s) == unset_node && list_ptr(s) == p)
- || (type(s) == ins_node && ins_ptr(s) == p)
- ) {
- fprintf(stdout,
- " pointed to from %s node %d (vlink %d, alink %d): ",
- get_node_name(type(s), subtype(s)), (int) s,
- (int) vlink(s), (int) alink(s));
- if (type(s) == glyph_node) {
- fprintf(stdout, "lig_ptr(%d)", (int) lig_ptr(s));
- } else if (type(s) == vlist_node
- || type(s) == hlist_node) {
- fprintf(stdout, "list_ptr(%d)", (int) list_ptr(s));
- }
- fprintf(stdout, "\n");
- } else {
- if ((type(s) != penalty_node)
- && (type(s) != math_node)
- && (type(s) != kern_node)
- ) {
- fprintf(stdout, " pointed to from %s node %d\n",
- get_node_name(type(s), subtype(s)),
- (int) s);
- }
- }
- }
- }
- }
- }
-#endif
-}
-
-static int free_error(halfword p)
-{
- assert(p > my_prealloc);
- assert(p < var_mem_max);
-#ifndef NDEBUG
- if (varmem_sizes[p] == 0) {
- do_free_error(p);
- return 1; /* double free */
- }
-#endif
- return 0;
-}
-
-
-@ @c
-static void do_copy_error(halfword p)
-{
- char errstr[255] = { 0 };
- const char *errhlp[] = {
- "When I tried to copy the node mentioned in the error message, it turned",
- "out it was not (or no longer) actually in use.",
- "Errors such as these are often caused by Lua node list alteration,",
- "but could also point to a bug in the executable. It should be safe to continue.",
- NULL
- };
-
- if (copy_error_seen)
- return;
-
- copy_error_seen = 1;
- if (type(p) == glyph_node) {
- snprintf(errstr, 255,
- "Attempt to copy free glyph (%c) node %d, ignored",
- (int) character(p), (int) p);
- } else {
- snprintf(errstr, 255, "Attempt to copy free %s node %d, ignored",
- get_node_name(type(p), subtype(p)), (int) p);
- }
- tex_error(errstr, errhlp);
-}
-
-
-int copy_error(halfword p)
-{
- assert(p >= 0);
- assert(p < var_mem_max);
-#ifndef NDEBUG
- if (p > my_prealloc && varmem_sizes[p] == 0) {
- do_copy_error(p);
- return 1; /* copy free node */
- }
-#endif
- return 0;
-}
-
-
-@ @c
-void flush_node(halfword p)
-{
-
- if (p == null) /* legal, but no-op */
- return;
-
-#ifdef DEBUG
- fprintf(DEBUG_OUT, "Free-ing %s node %d\n",
- get_node_name(type(p), subtype(p)), (int) p);
-#endif
- if (free_error(p))
- return;
-
- switch (type(p)) {
- case glyph_node:
- flush_node_list(lig_ptr(p));
- break;
- case glue_node:
- delete_glue_ref(glue_ptr(p));
- flush_node_list(leader_ptr(p));
- break;
-
- case attribute_node:
- case attribute_list_node:
- case temp_node:
- case glue_spec_node:
- case rule_node:
- case kern_node:
- case math_node:
- case penalty_node:
- break;
-
- case hlist_node:
- case vlist_node:
- case unset_node:
- flush_node_list(list_ptr(p));
- break;
- case whatsit_node:
- switch (subtype(p)) {
-
- case dir_node:
- break;
- case open_node:
- case write_node:
- case close_node:
- case pdf_save_node:
- case pdf_restore_node:
- case cancel_boundary_node:
- case close_lua_node:
- case pdf_refobj_node:
- case pdf_refxform_node:
- case pdf_refximage_node:
- case pdf_end_link_node:
- case pdf_end_thread_node:
- case pdf_save_pos_node:
- case local_par_node:
- break;
-
- case special_node:
- delete_token_ref(write_tokens(p));
- break;
- case pdf_literal_node:
- free_pdf_literal(p);
- break;
- case pdf_colorstack_node:
- if (pdf_colorstack_cmd(p) <= colorstack_data)
- delete_token_ref(pdf_colorstack_data(p));
- break;
- case pdf_setmatrix_node:
- delete_token_ref(pdf_setmatrix_data(p));
- break;
- case late_lua_node:
- free_late_lua(p);
- break;
- case pdf_annot_node:
- delete_token_ref(pdf_annot_data(p));
- break;
-
- case pdf_link_data_node:
- break;
-
- case pdf_start_link_node:
- if (pdf_link_attr(p) != null)
- delete_token_ref(pdf_link_attr(p));
- delete_action_ref(pdf_link_action(p));
- break;
- case pdf_dest_node:
- if (pdf_dest_named_id(p) > 0)
- delete_token_ref(pdf_dest_id(p));
- break;
-
- case pdf_thread_data_node:
- break;
-
- case pdf_thread_node:
- case pdf_start_thread_node:
- if (pdf_thread_named_id(p) > 0)
- delete_token_ref(pdf_thread_id(p));
- if (pdf_thread_attr(p) != null)
- delete_token_ref(pdf_thread_attr(p));
- break;
- case user_defined_node:
- switch (user_node_type(p)) {
- case 'a':
- delete_attribute_ref(user_node_value(p));
- break;
- case 't':
- delete_token_ref(user_node_value(p));
- break;
- case 'n':
- flush_node_list(user_node_value(p));
- break;
- case 's':
- /* |delete_string_ref(user_node_value(p));| *//* if this was mpost .. */
- break;
- case 'd':
- break;
- default:
- {
- const char *hlp[] = {
- "The type of the value in a user defined whatsit node should be one",
- "of 'a' (attribute list), 'd' (number), 'n' (node list), 's' (string),",
- "or 't' (tokenlist). Yours has an unknown type, and therefore I don't",
- "know how to free the node's value. A memory leak may result.",
- NULL
- };
- tex_error("Unidentified user defined whatsit", hlp);
- }
- break;
- }
- break;
-
- default:
- confusion("ext3");
- return;
-
- }
- break;
- case ins_node:
- flush_node_list(ins_ptr(p));
- delete_glue_ref(split_top_ptr(p));
- break;
- case margin_kern_node:
- flush_node(margin_char(p));
- break;
- case mark_node:
- delete_token_ref(mark_ptr(p));
- break;
- case disc_node:
- flush_node_list(vlink(pre_break(p)));
- flush_node_list(vlink(post_break(p)));
- flush_node_list(vlink(no_break(p)));
- break;
- case adjust_node:
- flush_node_list(adjust_ptr(p));
- break;
- case style_node: /* nothing to do */
- break;
- case choice_node:
- flush_node_list(display_mlist(p));
- flush_node_list(text_mlist(p));
- flush_node_list(script_mlist(p));
- flush_node_list(script_script_mlist(p));
- break;
- case simple_noad:
- case radical_noad:
- case accent_noad:
- flush_node_list(nucleus(p));
- flush_node_list(subscr(p));
- flush_node_list(supscr(p));
- if (type(p) == accent_noad) {
- flush_node_list(accent_chr(p));
- flush_node_list(bot_accent_chr(p));
- } else if (type(p) == radical_noad) {
- flush_node(left_delimiter(p));
- flush_node_list(degree(p));
- }
- break;
- case fence_noad:
- flush_node(delimiter(p));
- break;
- case delim_node: /* nothing to do */
- case math_char_node:
- case math_text_char_node:
- break;
- case sub_box_node:
- case sub_mlist_node:
- flush_node_list(math_list(p));
- break;
- case fraction_noad:
- flush_node_list(numerator(p));
- flush_node_list(denominator(p));
- flush_node(left_delimiter(p));
- flush_node(right_delimiter(p));
- break;
- case pseudo_file_node:
- flush_node_list(pseudo_lines(p));
- break;
- case pseudo_line_node:
- case shape_node:
- free_node(p, subtype(p));
- return;
- break;
- case align_stack_node:
- case span_node:
- case movement_node:
- case if_node:
- case nesting_node:
- case unhyphenated_node:
- case hyphenated_node:
- case delta_node:
- case passive_node:
- case action_node:
- case inserting_node:
- case split_up_node:
- case expr_node:
- break;
- default:
- fprintf(stdout, "flush_node: type is %d\n", type(p));
- return;
-
- }
- if (nodetype_has_attributes(type(p)))
- delete_attribute_ref(node_attr(p));
- free_node(p, get_node_size(type(p), subtype(p)));
- return;
-}
-
-@ @c
-void flush_node_list(halfword pp)
-{ /* erase list of nodes starting at |p| */
- register halfword p = pp;
- free_error_seen = 0;
- if (p == null) /* legal, but no-op */
- return;
- if (free_error(p))
- return;
-
- while (p != null) {
- register halfword q = vlink(p);
- flush_node(p);
- p = q;
- }
-}
-
-@ @c
-static int test_count = 1;
-
-#define dorangetest(a,b,c) do { \
- if (!(b>=0 && b<c)) { \
- fprintf(stdout,"For node p:=%d, 0<=%d<%d (l.%d,r.%d)\n", \
- (int)a, (int)b, (int)c, __LINE__,test_count); \
- confusion("dorangetest"); \
- } } while (0)
-
-#define dotest(a,b,c) do { \
- if (b!=c) { \
- fprintf(stdout,"For node p:=%d, %d==%d (l.%d,r.%d)\n", \
- (int)a, (int)b, (int)c, __LINE__,test_count); \
- confusion("dotest"); \
- } } while (0)
-
-#define check_action_ref(a) { dorangetest(p,a,var_mem_max); }
-#define check_glue_ref(a) { dorangetest(p,a,var_mem_max); }
-#define check_attribute_ref(a) { dorangetest(p,a,var_mem_max); }
-#define check_token_ref(a) assert(1)
-
-void check_node(halfword p)
-{
-
- switch (type(p)) {
- case glyph_node:
- dorangetest(p, lig_ptr(p), var_mem_max);
- break;
- case glue_node:
- check_glue_ref(glue_ptr(p));
- dorangetest(p, leader_ptr(p), var_mem_max);
- break;
- case hlist_node:
- case vlist_node:
- case unset_node:
- case align_record_node:
- dorangetest(p, list_ptr(p), var_mem_max);
- break;
- case ins_node:
- dorangetest(p, ins_ptr(p), var_mem_max);
- check_glue_ref(split_top_ptr(p));
- break;
- case whatsit_node:
- switch (subtype(p)) {
- case special_node:
- check_token_ref(write_tokens(p));
- break;
- case pdf_literal_node:
- if (pdf_literal_type(p) == normal)
- check_token_ref(pdf_literal_data(p));
- break;
- case pdf_colorstack_node:
- if (pdf_colorstack_cmd(p) <= colorstack_data)
- check_token_ref(pdf_colorstack_data(p));
- break;
- case pdf_setmatrix_node:
- check_token_ref(pdf_setmatrix_data(p));
- break;
- case late_lua_node:
- if (late_lua_name(p) > 0)
- check_token_ref(late_lua_name(p));
- if (late_lua_type(p) == normal)
- check_token_ref(late_lua_data(p));
- break;
- case pdf_annot_node:
- check_token_ref(pdf_annot_data(p));
- break;
- case pdf_start_link_node:
- if (pdf_link_attr(p) != null)
- check_token_ref(pdf_link_attr(p));
- check_action_ref(pdf_link_action(p));
- break;
- case pdf_dest_node:
- if (pdf_dest_named_id(p) > 0)
- check_token_ref(pdf_dest_id(p));
- break;
- case pdf_thread_node:
- case pdf_start_thread_node:
- if (pdf_thread_named_id(p) > 0)
- check_token_ref(pdf_thread_id(p));
- if (pdf_thread_attr(p) != null)
- check_token_ref(pdf_thread_attr(p));
- break;
- case user_defined_node:
- switch (user_node_type(p)) {
- case 'a':
- check_attribute_ref(user_node_value(p));
- break;
- case 't':
- check_token_ref(user_node_value(p));
- break;
- case 'n':
- dorangetest(p, user_node_value(p), var_mem_max);
- break;
- case 's':
- case 'd':
- break;
- default:
- confusion("extuser");
- break;
- }
- break;
- case dir_node:
- case open_node:
- case write_node:
- case close_node:
- case pdf_save_node:
- case pdf_restore_node:
- case cancel_boundary_node:
- case close_lua_node:
- case pdf_refobj_node:
- case pdf_refxform_node:
- case pdf_refximage_node:
- case pdf_end_link_node:
- case pdf_end_thread_node:
- case pdf_save_pos_node:
- case local_par_node:
- break;
- default:
- confusion("ext3");
- }
- break;
- case margin_kern_node:
- check_node(margin_char(p));
- break;
- case disc_node:
- dorangetest(p, vlink(pre_break(p)), var_mem_max);
- dorangetest(p, vlink(post_break(p)), var_mem_max);
- dorangetest(p, vlink(no_break(p)), var_mem_max);
- break;
- case adjust_node:
- dorangetest(p, adjust_ptr(p), var_mem_max);
- break;
- case pseudo_file_node:
- dorangetest(p, pseudo_lines(p), var_mem_max);
- break;
- case pseudo_line_node:
- case shape_node:
- break;
- case choice_node:
- dorangetest(p, display_mlist(p), var_mem_max);
- dorangetest(p, text_mlist(p), var_mem_max);
- dorangetest(p, script_mlist(p), var_mem_max);
- dorangetest(p, script_script_mlist(p), var_mem_max);
- break;
- case fraction_noad:
- dorangetest(p, numerator(p), var_mem_max);
- dorangetest(p, denominator(p), var_mem_max);
- dorangetest(p, left_delimiter(p), var_mem_max);
- dorangetest(p, right_delimiter(p), var_mem_max);
- break;
- case simple_noad:
- dorangetest(p, nucleus(p), var_mem_max);
- dorangetest(p, subscr(p), var_mem_max);
- dorangetest(p, supscr(p), var_mem_max);
- break;
- case radical_noad:
- dorangetest(p, nucleus(p), var_mem_max);
- dorangetest(p, subscr(p), var_mem_max);
- dorangetest(p, supscr(p), var_mem_max);
- dorangetest(p, degree(p), var_mem_max);
- dorangetest(p, left_delimiter(p), var_mem_max);
- break;
- case accent_noad:
- dorangetest(p, nucleus(p), var_mem_max);
- dorangetest(p, subscr(p), var_mem_max);
- dorangetest(p, supscr(p), var_mem_max);
- dorangetest(p, accent_chr(p), var_mem_max);
- dorangetest(p, bot_accent_chr(p), var_mem_max);
- break;
- case fence_noad:
- dorangetest(p, delimiter(p), var_mem_max);
- break;
- case rule_node:
- case kern_node:
- case math_node:
- case penalty_node:
- case mark_node:
- case style_node:
- case attribute_list_node:
- case attribute_node:
- case glue_spec_node:
- case temp_node:
- case align_stack_node:
- case movement_node:
- case if_node:
- case nesting_node:
- case span_node:
- case unhyphenated_node:
- case hyphenated_node:
- case delta_node:
- case passive_node:
- case expr_node:
- break;
- default:
- fprintf(stdout, "check_node: type is %d\n", type(p));
- }
-}
-
-@ @c
-static void check_static_node_mem(void)
-{
- dotest(zero_glue, width(zero_glue), 0);
- dotest(zero_glue, type(zero_glue), glue_spec_node);
- dotest(zero_glue, vlink(zero_glue), null);
- dotest(zero_glue, stretch(zero_glue), 0);
- dotest(zero_glue, stretch_order(zero_glue), normal);
- dotest(zero_glue, shrink(zero_glue), 0);
- dotest(zero_glue, shrink_order(zero_glue), normal);
-
- dotest(sfi_glue, width(sfi_glue), 0);
- dotest(sfi_glue, type(sfi_glue), glue_spec_node);
- dotest(sfi_glue, vlink(sfi_glue), null);
- dotest(sfi_glue, stretch(sfi_glue), 0);
- dotest(sfi_glue, stretch_order(sfi_glue), sfi);
- dotest(sfi_glue, shrink(sfi_glue), 0);
- dotest(sfi_glue, shrink_order(sfi_glue), normal);
-
- dotest(fil_glue, width(fil_glue), 0);
- dotest(fil_glue, type(fil_glue), glue_spec_node);
- dotest(fil_glue, vlink(fil_glue), null);
- dotest(fil_glue, stretch(fil_glue), unity);
- dotest(fil_glue, stretch_order(fil_glue), fil);
- dotest(fil_glue, shrink(fil_glue), 0);
- dotest(fil_glue, shrink_order(fil_glue), normal);
-
- dotest(fill_glue, width(fill_glue), 0);
- dotest(fill_glue, type(fill_glue), glue_spec_node);
- dotest(fill_glue, vlink(fill_glue), null);
- dotest(fill_glue, stretch(fill_glue), unity);
- dotest(fill_glue, stretch_order(fill_glue), fill);
- dotest(fill_glue, shrink(fill_glue), 0);
- dotest(fill_glue, shrink_order(fill_glue), normal);
-
- dotest(ss_glue, width(ss_glue), 0);
- dotest(ss_glue, type(ss_glue), glue_spec_node);
- dotest(ss_glue, vlink(ss_glue), null);
- dotest(ss_glue, stretch(ss_glue), unity);
- dotest(ss_glue, stretch_order(ss_glue), fil);
- dotest(ss_glue, shrink(ss_glue), unity);
- dotest(ss_glue, shrink_order(ss_glue), fil);
-
- dotest(fil_neg_glue, width(fil_neg_glue), 0);
- dotest(fil_neg_glue, type(fil_neg_glue), glue_spec_node);
- dotest(fil_neg_glue, vlink(fil_neg_glue), null);
- dotest(fil_neg_glue, stretch(fil_neg_glue), -unity);
- dotest(fil_neg_glue, stretch_order(fil_neg_glue), fil);
- dotest(fil_neg_glue, shrink(fil_neg_glue), 0);
- dotest(fil_neg_glue, shrink_order(fil_neg_glue), normal);
-}
-
-@ @c
-void check_node_mem(void)
-{
- int i;
- check_static_node_mem();
-#ifndef NDEBUG
- for (i = (my_prealloc + 1); i < var_mem_max; i++) {
- if (varmem_sizes[i] > 0) {
- check_node(i);
- }
- }
-#endif
- test_count++;
-}
-
-@ @c
-void fix_node_list(halfword head)
-{
- halfword p, q;
- if (head == null)
- return;
- p = head;
- q = vlink(p);
- while (q != null) {
- alink(q) = p;
- p = q;
- q = vlink(p);
- }
-}
-
-@ @c
-halfword get_node(int s)
-{
- register halfword r;
-#if 0
- check_static_node_mem();
-#endif
- assert(s < MAX_CHAIN_SIZE);
-
- r = free_chain[s];
- if (r != null) {
- free_chain[s] = vlink(r);
-#ifndef NDEBUG
- varmem_sizes[r] = (char) s;
-#endif
- vlink(r) = null;
- var_used += s; /* maintain usage statistics */
- return r;
- }
- /* this is the end of the 'inner loop' */
- return slow_get_node(s);
-}
-
-@ @c
-#ifdef DEBUG
-static void print_free_chain(int c)
-{
- halfword p = free_chain[c];
- fprintf(stdout, "\nfree chain[%d] =\n ", c);
- while (p != null) {
- fprintf(stdout, "%d,", (int) p);
- p = vlink(p);
- }
- fprintf(stdout, "null;\n");
-}
-#endif
-
-@ @c
-void free_node(halfword p, int s)
-{
-
- if (p <= my_prealloc) {
- fprintf(stdout, "node %d (type %d) should not be freed!\n", (int) p,
- type(p));
- return;
- }
-#ifndef NDEBUG
- varmem_sizes[p] = 0;
-#endif
- if (s < MAX_CHAIN_SIZE) {
- vlink(p) = free_chain[s];
- free_chain[s] = p;
- } else {
- /* todo ? it is perhaps possible to merge this node with an existing rover */
- node_size(p) = s;
- vlink(p) = rover;
- while (vlink(rover) != vlink(p)) {
- rover = vlink(rover);
- }
- vlink(rover) = p;
- }
- var_used -= s; /* maintain statistics */
-}
-
-@ @c
-static void free_node_chain(halfword q, int s)
-{
- register halfword p = q;
- while (vlink(p) != null) {
-#ifndef NDEBUG
- varmem_sizes[p] = 0;
-#endif
- var_used -= s;
- p = vlink(p);
- }
- var_used -= s;
-#ifndef NDEBUG
- varmem_sizes[p] = 0;
-#endif
- vlink(p) = free_chain[s];
- free_chain[s] = q;
-}
-
-
-@ @c
-void init_node_mem(int t)
-{
- my_prealloc = var_mem_stat_max;
- assert(whatsit_node_data[user_defined_node].id == user_defined_node);
- assert(node_data[passive_node].id == passive_node);
-
- varmem =
- (memory_word *) realloc((void *) varmem,
- sizeof(memory_word) * (unsigned) t);
- if (varmem == NULL) {
- overflow("node memory size", (unsigned) var_mem_max);
- }
- memset((void *) (varmem), 0, (unsigned) t * sizeof(memory_word));
-
-#ifndef NDEBUG
- varmem_sizes = (char *) realloc(varmem_sizes, sizeof(char) * (unsigned) t);
- if (varmem_sizes == NULL) {
- overflow("node memory size", (unsigned) var_mem_max);
- }
- memset((void *) varmem_sizes, 0, sizeof(char) * (unsigned) t);
-#endif
- var_mem_max = t;
- rover = var_mem_stat_max + 1;
- vlink(rover) = rover;
- node_size(rover) = (t - rover);
- var_used = 0;
- /* initialize static glue specs */
- glue_ref_count(zero_glue) = null + 1;
- width(zero_glue) = 0;
- type(zero_glue) = glue_spec_node;
- vlink(zero_glue) = null;
- stretch(zero_glue) = 0;
- stretch_order(zero_glue) = normal;
- shrink(zero_glue) = 0;
- shrink_order(zero_glue) = normal;
- glue_ref_count(sfi_glue) = null + 1;
- width(sfi_glue) = 0;
- type(sfi_glue) = glue_spec_node;
- vlink(sfi_glue) = null;
- stretch(sfi_glue) = 0;
- stretch_order(sfi_glue) = sfi;
- shrink(sfi_glue) = 0;
- shrink_order(sfi_glue) = normal;
- glue_ref_count(fil_glue) = null + 1;
- width(fil_glue) = 0;
- type(fil_glue) = glue_spec_node;
- vlink(fil_glue) = null;
- stretch(fil_glue) = unity;
- stretch_order(fil_glue) = fil;
- shrink(fil_glue) = 0;
- shrink_order(fil_glue) = normal;
- glue_ref_count(fill_glue) = null + 1;
- width(fill_glue) = 0;
- type(fill_glue) = glue_spec_node;
- vlink(fill_glue) = null;
- stretch(fill_glue) = unity;
- stretch_order(fill_glue) = fill;
- shrink(fill_glue) = 0;
- shrink_order(fill_glue) = normal;
- glue_ref_count(ss_glue) = null + 1;
- width(ss_glue) = 0;
- type(ss_glue) = glue_spec_node;
- vlink(ss_glue) = null;
- stretch(ss_glue) = unity;
- stretch_order(ss_glue) = fil;
- shrink(ss_glue) = unity;
- shrink_order(ss_glue) = fil;
- glue_ref_count(fil_neg_glue) = null + 1;
- width(fil_neg_glue) = 0;
- type(fil_neg_glue) = glue_spec_node;
- vlink(fil_neg_glue) = null;
- stretch(fil_neg_glue) = -unity;
- stretch_order(fil_neg_glue) = fil;
- shrink(fil_neg_glue) = 0;
- shrink_order(fil_neg_glue) = normal;
- /* initialize node list heads */
- vinfo(page_ins_head) = 0;
- type(page_ins_head) = temp_node;
- vlink(page_ins_head) = null;
- alink(page_ins_head) = null;
- vinfo(contrib_head) = 0;
- type(contrib_head) = temp_node;
- vlink(contrib_head) = null;
- alink(contrib_head) = null;
- vinfo(page_head) = 0;
- type(page_head) = temp_node;
- vlink(page_head) = null;
- alink(page_head) = null;
- vinfo(temp_head) = 0;
- type(temp_head) = temp_node;
- vlink(temp_head) = null;
- alink(temp_head) = null;
- vinfo(hold_head) = 0;
- type(hold_head) = temp_node;
- vlink(hold_head) = null;
- alink(hold_head) = null;
- vinfo(adjust_head) = 0;
- type(adjust_head) = temp_node;
- vlink(adjust_head) = null;
- alink(adjust_head) = null;
- vinfo(pre_adjust_head) = 0;
- type(pre_adjust_head) = temp_node;
- vlink(pre_adjust_head) = null;
- alink(pre_adjust_head) = null;
- vinfo(active) = 0;
- type(active) = unhyphenated_node;
- vlink(active) = null;
- alink(active) = null;
- vinfo(align_head) = 0;
- type(align_head) = temp_node;
- vlink(align_head) = null;
- alink(align_head) = null;
- vinfo(end_span) = 0;
- type(end_span) = span_node;
- vlink(end_span) = null;
- alink(end_span) = null;
- type(begin_point) = glyph_node;
- subtype(begin_point) = 0;
- vlink(begin_point) = null;
- vinfo(begin_point + 1) = null;
- alink(begin_point) = null;
- font(begin_point) = 0;
- character(begin_point) = '.';
- vinfo(begin_point + 3) = 0;
- vlink(begin_point + 3) = 0;
- vinfo(begin_point + 4) = 0;
- vlink(begin_point + 4) = 0;
- type(end_point) = glyph_node;
- subtype(end_point) = 0;
- vlink(end_point) = null;
- vinfo(end_point + 1) = null;
- alink(end_point) = null;
- font(end_point) = 0;
- character(end_point) = '.';
- vinfo(end_point + 3) = 0;
- vlink(end_point + 3) = 0;
- vinfo(end_point + 4) = 0;
- vlink(end_point + 4) = 0;
-}
-
-@ @c
-void dump_node_mem(void)
-{
- dump_int(var_mem_max);
- dump_int(rover);
- dump_things(varmem[0], var_mem_max);
-#ifndef NDEBUG
- dump_things(varmem_sizes[0], var_mem_max);
-#endif
- dump_things(free_chain[0], MAX_CHAIN_SIZE);
- dump_int(var_used);
- dump_int(my_prealloc);
-}
-
-@ it makes sense to enlarge the varmem array immediately
-@c
-void undump_node_mem(void)
-{
- int x;
- undump_int(x);
- undump_int(rover);
- var_mem_max = (x < 100000 ? 100000 : x);
- varmem = xmallocarray(memory_word, (unsigned) var_mem_max);
-#if 0
- memset ((void *)varmem,0,x*sizeof(memory_word));
-#endif
- undump_things(varmem[0], x);
-#ifndef NDEBUG
- varmem_sizes = xmallocarray(char, (unsigned) var_mem_max);
- memset((void *) varmem_sizes, 0, (unsigned) var_mem_max * sizeof(char));
- undump_things(varmem_sizes[0], x);
-#endif
- undump_things(free_chain[0], MAX_CHAIN_SIZE);
- undump_int(var_used);
- undump_int(my_prealloc);
- if (var_mem_max > x) {
- /* todo ? it is perhaps possible to merge the new node with an existing rover */
- vlink(x) = rover;
- node_size(x) = (var_mem_max - x);
- while (vlink(rover) != vlink(x)) {
- rover = vlink(rover);
- }
- vlink(rover) = x;
- }
-}
-
-#if 0
-void test_rovers(char *s)
-{
- int q = rover;
- int r = q;
- fprintf(stdout, "%s: {rover=%d,size=%d,link=%d}", s, r, node_size(r),
- vlink(r));
- while (vlink(r) != q) {
- r = vlink(r);
- fprintf(stdout, ",{rover=%d,size=%d,link=%d}", r, node_size(r),
- vlink(r));
- }
- fprintf(stdout, "\n");
-}
-#else
-# define test_rovers(a)
-#endif
-
-@ @c
-halfword slow_get_node(int s)
-{
- register int t;
-
- RETRY:
- t = node_size(rover);
- assert(vlink(rover) < var_mem_max);
- assert(vlink(rover) != 0);
- test_rovers("entry");
- if (t > s) {
- register halfword r;
- /* allocating from the bottom helps decrease page faults */
- r = rover;
- rover += s;
- vlink(rover) = vlink(r);
- node_size(rover) = node_size(r) - s;
- if (vlink(rover) != r) { /* list is longer than one */
- halfword q = r;
- while (vlink(q) != r) {
- q = vlink(q);
- }
- vlink(q) += s;
- } else {
- vlink(rover) += s;
- }
- test_rovers("taken");
- assert(vlink(rover) < var_mem_max);
-#ifndef NDEBUG
- varmem_sizes[r] = (char) (s > 127 ? 127 : s);
-#endif
- vlink(r) = null;
- var_used += s; /* maintain usage statistics */
- return r; /* this is the only exit */
- } else {
- int x;
- /* attempt to keep the free list small */
- if (vlink(rover) != rover) {
- if (t < MAX_CHAIN_SIZE) {
- halfword l = vlink(rover);
- vlink(rover) = free_chain[t];
- free_chain[t] = rover;
- rover = l;
- while (vlink(l) != free_chain[t]) {
- l = vlink(l);
- }
- vlink(l) = rover;
- test_rovers("outtake");
- goto RETRY;
- } else {
- halfword l = rover;
- while (vlink(rover) != l) {
- if (node_size(rover) > s) {
- goto RETRY;
- }
- rover = vlink(rover);
- }
- }
- }
- /* if we are still here, it was apparently impossible to get a match */
- x = (var_mem_max >> 2) + s;
- varmem =
- (memory_word *) realloc((void *) varmem,
- sizeof(memory_word) *
- (unsigned) (var_mem_max + x));
- if (varmem == NULL) {
- overflow("node memory size", (unsigned) var_mem_max);
- }
- memset((void *) (varmem + var_mem_max), 0,
- (unsigned) x * sizeof(memory_word));
-
-#ifndef NDEBUG
- varmem_sizes =
- (char *) realloc(varmem_sizes,
- sizeof(char) * (unsigned) (var_mem_max + x));
- if (varmem_sizes == NULL) {
- overflow("node memory size", (unsigned) var_mem_max);
- }
- memset((void *) (varmem_sizes + var_mem_max), 0,
- (unsigned) (x) * sizeof(char));
-#endif
-
- /* todo ? it is perhaps possible to merge the new memory with an existing rover */
- vlink(var_mem_max) = rover;
- node_size(var_mem_max) = x;
- while (vlink(rover) != vlink(var_mem_max)) {
- rover = vlink(rover);
- }
- vlink(rover) = var_mem_max;
- rover = var_mem_max;
- test_rovers("realloc");
- var_mem_max += x;
- goto RETRY;
- }
-}
-
-@ @c
-char *sprint_node_mem_usage(void)
-{
- int i, b;
-
- char *s, *ss;
-#ifndef NDEBUG
- char msg[256];
- int node_counts[last_normal_node + last_whatsit_node + 2] = { 0 };
-
- for (i = (var_mem_max - 1); i > my_prealloc; i--) {
- if (varmem_sizes[i] > 0) {
- if (type(i) > last_normal_node + last_whatsit_node) {
- node_counts[last_normal_node + last_whatsit_node + 1]++;
- } else if (type(i) == whatsit_node) {
- node_counts[(subtype(i) + last_normal_node + 1)]++;
- } else {
- node_counts[type(i)]++;
- }
- }
- }
- s = strdup("");
- b = 0;
- for (i = 0; i < last_normal_node + last_whatsit_node + 2; i++) {
- if (node_counts[i] > 0) {
- int j =
- (i > (last_normal_node + 1) ? (i - last_normal_node - 1) : 0);
- snprintf(msg, 255, "%s%d %s", (b ? ", " : ""), (int) node_counts[i],
- get_node_name((i > last_normal_node ? whatsit_node : i),
- j));
- ss = xmalloc((unsigned) (strlen(s) + strlen(msg) + 1));
- strcpy(ss, s);
- strcat(ss, msg);
- free(s);
- s = ss;
- b = 1;
- }
- }
-#else
- s = strdup("");
-#endif
- return s;
-}
-
-@ @c
-halfword list_node_mem_usage(void)
-{
- halfword i, j;
- halfword p = null, q = null;
-#ifndef NDEBUG
- char *saved_varmem_sizes = xmallocarray(char, (unsigned) var_mem_max);
- memcpy(saved_varmem_sizes, varmem_sizes, (size_t) var_mem_max);
- for (i = my_prealloc + 1; i < (var_mem_max - 1); i++) {
- if (saved_varmem_sizes[i] > 0) {
- j = copy_node(i);
- if (p == null) {
- q = j;
- } else {
- vlink(p) = j;
- }
- p = j;
- }
- }
- free(saved_varmem_sizes);
-#endif
- return q;
-}
-
-@ @c
-void print_node_mem_stats(void)
-{
- int i, b;
- halfword j;
- char msg[256];
- char *s;
- int free_chain_counts[MAX_CHAIN_SIZE] = { 0 };
- snprintf(msg, 255, " %d words of node memory still in use:",
- (int) (var_used + my_prealloc));
- tprint_nl(msg);
- s = sprint_node_mem_usage();
- tprint_nl(" ");
- tprint(s);
- free(s);
- tprint(" nodes");
- tprint_nl(" avail lists: ");
- b = 0;
- for (i = 1; i < MAX_CHAIN_SIZE; i++) {
- for (j = free_chain[i]; j != null; j = vlink(j))
- free_chain_counts[i]++;
- if (free_chain_counts[i] > 0) {
- snprintf(msg, 255, "%s%d:%d", (b ? "," : ""), i,
- (int) free_chain_counts[i]);
- tprint(msg);
- b = 1;
- }
- }
- print_nlp(); /* newline, if needed */
-}
-
-/* this belongs in the web but i couldn't find the correct syntactic place */
-
-halfword new_span_node(halfword n, int s, scaled w)
-{
- halfword p = new_node(span_node, 0);
- span_link(p) = n;
- span_span(p) = s;
- width(p) = w;
- return p;
-}
-
-@* Attribute stuff.
-
-@c
-static halfword new_attribute_node(unsigned int i, int v)
-{
- register halfword r = get_node(attribute_node_size);
- type(r) = attribute_node;
- attribute_id(r) = (halfword) i;
- attribute_value(r) = v;
- return r;
-}
-
-@ @c
-halfword copy_attribute_list(halfword n)
-{
- halfword q = get_node(attribute_node_size);
- register halfword p = q;
- type(p) = attribute_list_node;
- attr_list_ref(p) = 0;
- n = vlink(n);
- while (n != null) {
- register halfword r = get_node(attribute_node_size);
- /* the link will be fixed automatically in the next loop */
- (void) memcpy((void *) (varmem + r), (void *) (varmem + n),
- (sizeof(memory_word) * attribute_node_size));
- vlink(p) = r;
- p = r;
- n = vlink(n);
- }
- return q;
-}
-
-@ @c
-void update_attribute_cache(void)
-{
- halfword p;
- register int i;
- attr_list_cache = get_node(attribute_node_size);
- type(attr_list_cache) = attribute_list_node;
- attr_list_ref(attr_list_cache) = 0;
- p = attr_list_cache;
- for (i = 0; i <= max_used_attr; i++) {
- register int v = attribute(i);
- if (v > UNUSED_ATTRIBUTE) {
- register halfword r = new_attribute_node((unsigned) i, v);
- vlink(p) = r;
- p = r;
- }
- }
- if (vlink(attr_list_cache) == null) {
- free_node(attr_list_cache, attribute_node_size);
- attr_list_cache = null;
- }
- return;
-}
-
-@ @c
-void build_attribute_list(halfword b)
-{
- if (max_used_attr >= 0) {
- if (attr_list_cache == cache_disabled) {
- update_attribute_cache();
- if (attr_list_cache == null)
- return;
- }
- attr_list_ref(attr_list_cache)++;
- node_attr(b) = attr_list_cache;
-#ifdef DEBUG
- fprintf(DEBUG_OUT, "Added attrlist (%d) to node %d (count=%d)\n",
- node_attr(b), b, attr_list_ref(attr_list_cache));
-#endif
- }
-}
-
-@ @c
-void delete_attribute_ref(halfword b)
-{
- if (b != null) {
- assert(type(b) == attribute_list_node);
- attr_list_ref(b)--;
-#ifdef DEBUG
- fprintf(DEBUG_OUT, "Removed attrlistref (%d) (count=%d)\n", b,
- attr_list_ref(b));
-#endif
- if (attr_list_ref(b) == 0) {
- if (b == attr_list_cache)
- attr_list_cache = cache_disabled;
- free_node_chain(b, attribute_node_size);
- }
- /* maintain sanity */
- if (attr_list_ref(b) < 0)
- attr_list_ref(b) = 0;
- }
-}
-
-@ |p| is an attr list head, or zero
-@c
-halfword do_set_attribute(halfword p, int i, int val)
-{
- register halfword q;
- register int j = 0;
- if (p == null) { /* add a new head \& node */
- q = get_node(attribute_node_size);
- type(q) = attribute_list_node;
- attr_list_ref(q) = 1;
- p = new_attribute_node((unsigned) i, val);
- vlink(q) = p;
- return q;
- }
- q = p;
- assert(vlink(p) != null);
- while (vlink(p) != null) {
- int t = attribute_id(vlink(p));
- if (t == i && attribute_value(vlink(p)) == val)
- return q; /* no need to do anything */
- if (t >= i)
- break;
- j++;
- p = vlink(p);
- }
-
- p = q;
- while (j-- > 0)
- p = vlink(p);
- if (attribute_id(vlink(p)) == i) {
- attribute_value(vlink(p)) = val;
- } else { /* add a new node */
- halfword r = new_attribute_node((unsigned) i, val);
- vlink(r) = vlink(p);
- vlink(p) = r;
- }
- return q;
-}
-
-@ @c
-void set_attribute(halfword n, int i, int val)
-{
- register halfword p;
- register int j = 0;
- if (!nodetype_has_attributes(type(n)))
- return;
- p = node_attr(n);
- if (p == null) { /* add a new head \& node */
- p = get_node(attribute_node_size);
- type(p) = attribute_list_node;
- attr_list_ref(p) = 1;
- node_attr(n) = p;
- p = new_attribute_node((unsigned) i, val);
- vlink(node_attr(n)) = p;
- return;
- }
- assert(vlink(p) != null);
- while (vlink(p) != null) {
- int t = attribute_id(vlink(p));
- if (t == i && attribute_value(vlink(p)) == val)
- return;
- if (t >= i)
- break;
- j++;
- p = vlink(p);
- }
- p = node_attr(n);
- if (attr_list_ref(p) != 1) {
- if (attr_list_ref(p) > 1) {
- p = copy_attribute_list(p);
- delete_attribute_ref(node_attr(n));
- node_attr(n) = p;
- } else {
- fprintf(stdout,
- "Node %d has an attribute list that is free already\n",
- (int) n);
- }
- attr_list_ref(p) = 1;
- }
- while (j-- > 0)
- p = vlink(p);
-
- if (attribute_id(vlink(p)) == i) {
- attribute_value(vlink(p)) = val;
- } else { /* add a new node */
- halfword r = new_attribute_node((unsigned) i, val);
- vlink(r) = vlink(p);
- vlink(p) = r;
- }
- return;
-}
-
-
-@ @c
-int unset_attribute(halfword n, int i, int val)
-{
- register halfword p;
- register int t;
- register int j = 0;
-
- if (!nodetype_has_attributes(type(n)))
- return null;
- p = node_attr(n);
- if (p == null)
- return UNUSED_ATTRIBUTE;
- if (attr_list_ref(p) == 0) {
- fprintf(stdout,
- "Node %d has an attribute list that is free already\n",
- (int) n);
- return UNUSED_ATTRIBUTE;
- }
- assert(vlink(p) != null);
- while (vlink(p) != null) {
- t = attribute_id(vlink(p));
- if (t > i)
- return UNUSED_ATTRIBUTE;
- if (t == i) {
- p = vlink(p);
- break;
- }
- j++;
- p = vlink(p);
- }
- if (attribute_id(p) != i)
- return UNUSED_ATTRIBUTE;
- /* if we are still here, the attribute exists */
- p = node_attr(n);
- if (attr_list_ref(p) > 1 || p == attr_list_cache) {
- halfword q = copy_attribute_list(p);
- if (attr_list_ref(p) > 1) {
- delete_attribute_ref(node_attr(n));
- }
- attr_list_ref(q) = 1;
- node_attr(n) = q;
- }
- p = vlink(node_attr(n));
- while (j-- > 0)
- p = vlink(p);
- t = attribute_value(p);
- if (val == UNUSED_ATTRIBUTE || t == val) {
- attribute_value(p) = UNUSED_ATTRIBUTE;
- }
- return t;
-}
-
-@ @c
-int has_attribute(halfword n, int i, int val)
-{
- register halfword p;
- if (!nodetype_has_attributes(type(n)))
- return UNUSED_ATTRIBUTE;
- p = node_attr(n);
- if (p == null || vlink(p) == null)
- return UNUSED_ATTRIBUTE;
- p = vlink(p);
- while (p != null) {
- if (attribute_id(p) == i) {
- int ret = attribute_value(p);
- if (val == UNUSED_ATTRIBUTE || val == ret)
- return ret;
- return UNUSED_ATTRIBUTE;
- } else if (attribute_id(p) > i) {
- return UNUSED_ATTRIBUTE;
- }
- p = vlink(p);
- }
- return UNUSED_ATTRIBUTE;
-}
-
-@ @c
-void print_short_node_contents(halfword p)
-{
- switch (type(p)) {
- case hlist_node:
- case vlist_node:
- case ins_node:
- case whatsit_node:
- case mark_node:
- case adjust_node:
- case unset_node:
- print_char('[');
- print_char(']');
- break;
- case rule_node:
- print_char('|');
- break;
- case glue_node:
- if (glue_ptr(p) != zero_glue)
- print_char(' ');
- break;
- case math_node:
- print_char('$');
- break;
- case disc_node:
- short_display(vlink(pre_break(p)));
- short_display(vlink(post_break(p)));
- break;
- default:
- assert(1);
- break;
- }
-}
-
-
-@ @c
-static void show_pdftex_whatsit_rule_spec(int p)
-{
- tprint("(");
- print_rule_dimen(height(p));
- print_char('+');
- print_rule_dimen(depth(p));
- tprint(")x");
- print_rule_dimen(width(p));
-}
-
-
-
-@ Each new type of node that appears in our data structure must be capable
-of being displayed, copied, destroyed, and so on. The routines that we
-need for write-oriented whatsits are somewhat like those for mark nodes;
-other extensions might, of course, involve more subtlety here.
-
-@c
-static void print_write_whatsit(const char *s, pointer p)
-{
- tprint_esc(s);
- if (write_stream(p) < 16)
- print_int(write_stream(p));
- else if (write_stream(p) == 16)
- print_char('*');
- else
- print_char('-');
-}
-
-
-@ @c
-static void show_whatsit_node(int p)
-{
- switch (subtype(p)) {
- case open_node:
- print_write_whatsit("openout", p);
- print_char('=');
- print_file_name(open_name(p), open_area(p), open_ext(p));
- break;
- case write_node:
- print_write_whatsit("write", p);
- print_mark(write_tokens(p));
- break;
- case close_node:
- print_write_whatsit("closeout", p);
- break;
- case special_node:
- tprint_esc("special");
- print_mark(write_tokens(p));
- break;
- case dir_node:
- if (dir_dir(p) < 0) {
- tprint_esc("enddir");
- print_char(' ');
- print_dir(dir_dir(p) + 64);
- } else {
- tprint_esc("begindir");
- print_char(' ');
- print_dir(dir_dir(p));
- }
- break;
- case local_par_node:
- tprint_esc("whatsit");
- append_char('.');
- print_ln();
- print_current_string();
- tprint_esc("localinterlinepenalty");
- print_char('=');
- print_int(local_pen_inter(p));
- print_ln();
- print_current_string();
- tprint_esc("localbrokenpenalty");
- print_char('=');
- print_int(local_pen_broken(p));
- print_ln();
- print_current_string();
- tprint_esc("localleftbox");
- if (local_box_left(p) == null) {
- tprint("=null");
- } else {
- append_char('.');
- show_node_list(local_box_left(p));
- decr(cur_length);
- }
- print_ln();
- print_current_string();
- tprint_esc("localrightbox");
- if (local_box_right(p) == null) {
- tprint("=null");
- } else {
- append_char('.');
- show_node_list(local_box_right(p));
- decr(cur_length);
- }
- decr(cur_length);
- break;
- case pdf_literal_node:
- show_pdf_literal(p);
- break;
- case pdf_colorstack_node:
- tprint_esc("pdfcolorstack ");
- print_int(pdf_colorstack_stack(p));
- switch (pdf_colorstack_cmd(p)) {
- case colorstack_set:
- tprint(" set ");
- break;
- case colorstack_push:
- tprint(" push ");
- break;
- case colorstack_pop:
- tprint(" pop");
- break;
- case colorstack_current:
- tprint(" current");
- break;
- default:
- confusion("pdfcolorstack");
- break;
- }
- if (pdf_colorstack_cmd(p) <= colorstack_data)
- print_mark(pdf_colorstack_data(p));
- break;
- case pdf_setmatrix_node:
- tprint_esc("pdfsetmatrix");
- print_mark(pdf_setmatrix_data(p));
- break;
- case pdf_save_node:
- tprint_esc("pdfsave");
- break;
- case pdf_restore_node:
- tprint_esc("pdfrestore");
- break;
- case cancel_boundary_node:
- tprint_esc("noboundary");
- break;
- case late_lua_node:
- show_late_lua(p);
- break;
- case close_lua_node:
- tprint_esc("closelua");
- print_int(late_lua_reg(p));
- break;
- case pdf_refobj_node:
- tprint_esc("pdfrefobj");
- if (obj_obj_is_stream(static_pdf, pdf_obj_objnum(p))) {
- if (obj_obj_stream_attr(static_pdf, pdf_obj_objnum(p)) != LUA_NOREF) {
- tprint(" attr");
- lua_rawgeti(Luas, LUA_REGISTRYINDEX,
- obj_obj_stream_attr(static_pdf, pdf_obj_objnum(p)));
- print_char(' ');
- tprint((const char *) lua_tostring(Luas, -1));
- lua_pop(Luas, 1);
- }
- tprint(" stream");
- }
- if (obj_obj_is_file(static_pdf, pdf_obj_objnum(p)))
- tprint(" file");
- if (obj_obj_data(static_pdf, pdf_obj_objnum(p)) != LUA_NOREF) {
- lua_rawgeti(Luas, LUA_REGISTRYINDEX,
- obj_obj_data(static_pdf, pdf_obj_objnum(p)));
- print_char(' ');
- tprint((const char *) lua_tostring(Luas, -1));
- lua_pop(Luas, 1);
- }
- break;
- case pdf_refxform_node:
- case pdf_refximage_node:
- if (subtype(p) == pdf_refxform_node)
- tprint_esc("pdfrefxform");
- else
- tprint_esc("pdfrefximage");
- tprint("(");
- print_scaled(height(p));
- print_char('+');
- print_scaled(depth(p));
- tprint(")x");
- print_scaled(width(p));
- break;
- case pdf_annot_node:
- tprint_esc("pdfannot");
- show_pdftex_whatsit_rule_spec(p);
- print_mark(pdf_annot_data(p));
- break;
- case pdf_start_link_node:
- tprint_esc("pdfstartlink");
- show_pdftex_whatsit_rule_spec(p);
- if (pdf_link_attr(p) != null) {
- tprint(" attr");
- print_mark(pdf_link_attr(p));
- }
- tprint(" action");
- if (pdf_action_type(pdf_link_action(p)) == pdf_action_user) {
- tprint(" user");
- print_mark(pdf_action_tokens(pdf_link_action(p)));
- return;
- }
- if (pdf_action_file(pdf_link_action(p)) != null) {
- tprint(" file");
- print_mark(pdf_action_file(pdf_link_action(p)));
- }
- switch (pdf_action_type(pdf_link_action(p))) {
- case pdf_action_goto:
- if (pdf_action_named_id(pdf_link_action(p)) > 0) {
- tprint(" goto name");
- print_mark(pdf_action_id(pdf_link_action(p)));
- } else {
- tprint(" goto num");
- print_int(pdf_action_id(pdf_link_action(p)));
- }
- break;
- case pdf_action_page:
- tprint(" page");
- print_int(pdf_action_id(pdf_link_action(p)));
- print_mark(pdf_action_tokens(pdf_link_action(p)));
- break;
- case pdf_action_thread:
- if (pdf_action_named_id(pdf_link_action(p)) > 0) {
- tprint(" thread name");
- print_mark(pdf_action_id(pdf_link_action(p)));
- } else {
- tprint(" thread num");
- print_int(pdf_action_id(pdf_link_action(p)));
- }
- break;
- default:
- pdf_error("displaying", "unknown action type");
- break;
- }
- break;
- case pdf_end_link_node:
- tprint_esc("pdfendlink");
- break;
- case pdf_dest_node:
- tprint_esc("pdfdest");
- if (pdf_dest_named_id(p) > 0) {
- tprint(" name");
- print_mark(pdf_dest_id(p));
- } else {
- tprint(" num");
- print_int(pdf_dest_id(p));
- }
- print_char(' ');
- switch (pdf_dest_type(p)) {
- case pdf_dest_xyz:
- tprint("xyz");
- if (pdf_dest_xyz_zoom(p) != null) {
- tprint(" zoom");
- print_int(pdf_dest_xyz_zoom(p));
- }
- break;
- case pdf_dest_fitbh:
- tprint("fitbh");
- break;
- case pdf_dest_fitbv:
- tprint("fitbv");
- break;
- case pdf_dest_fitb:
- tprint("fitb");
- break;
- case pdf_dest_fith:
- tprint("fith");
- break;
- case pdf_dest_fitv:
- tprint("fitv");
- break;
- case pdf_dest_fitr:
- tprint("fitr");
- show_pdftex_whatsit_rule_spec(p);
- break;
- case pdf_dest_fit:
- tprint("fit");
- break;
- default:
- tprint("unknown!");
- break;
- }
- break;
- case pdf_thread_node:
- case pdf_start_thread_node:
- if (subtype(p) == pdf_thread_node)
- tprint_esc("pdfthread");
- else
- tprint_esc("pdfstartthread");
- tprint("(");
- print_rule_dimen(height(p));
- print_char('+');
- print_rule_dimen(depth(p));
- tprint(")x");
- print_rule_dimen(width(p));
- if (pdf_thread_attr(p) != null) {
- tprint(" attr");
- print_mark(pdf_thread_attr(p));
- }
- if (pdf_thread_named_id(p) > 0) {
- tprint(" name");
- print_mark(pdf_thread_id(p));
- } else {
- tprint(" num");
- print_int(pdf_thread_id(p));
- }
- break;
- case pdf_end_thread_node:
- tprint_esc("pdfendthread");
- break;
- case pdf_save_pos_node:
- tprint_esc("pdfsavepos");
- break;
- case user_defined_node:
- tprint_esc("whatsit");
- print_int(user_node_id(p));
- print_char('=');
- switch (user_node_type(p)) {
- case 'a':
- tprint("<>");
- break;
- case 'n':
- tprint("[");
- show_node_list(user_node_value(p));
- tprint("]");
- break;
- case 's':
- print_char('"');
- print(user_node_value(p));
- print_char('"');
- break;
- case 't':
- print_mark(user_node_value(p));
- break;
- default: /* only 'd' */
- print_int(user_node_value(p));
- break;
- }
- break;
- default:
- tprint("whatsit?");
- break;
- }
-}
-
-
-
-@ 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
- 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.
-
-
-@ |str_room| need not be checked; see |show_box|
-
-@ Recursive calls on |show_node_list| therefore use the following pattern:
-@c
-#define node_list_display(A) do { \
- append_char('.'); \
- show_node_list(A); \
- flush_char(); \
-} while (0)
-
-void show_node_list(int p)
-{ /* prints a node list symbolically */
- int n; /* the number of items already printed at this level */
- real g; /* a glue ratio, as a floating point number */
- if ((int) cur_length > depth_threshold) {
- if (p > null)
- tprint(" []"); /* indicate that there's been some truncation */
- return;
- }
- n = 0;
- while (p != null) {
- print_ln();
- print_current_string(); /* display the nesting history */
- if (int_par(tracing_online_code) < -2)
- print_int(p);
- incr(n);
- if (n > breadth_max) { /* time to stop */
- tprint("etc.");
- return;
- }
- /* Display node |p| */
- if (is_char_node(p)) {
- print_font_and_char(p);
- if (is_ligature(p)) {
- /* Display ligature |p|; */
- tprint(" (ligature ");
- if (is_leftboundary(p))
- print_char('|');
- font_in_short_display = font(p);
- short_display(lig_ptr(p));
- if (is_rightboundary(p))
- print_char('|');
- print_char(')');
- }
- } else {
- switch (type(p)) {
- case hlist_node:
- case vlist_node:
- case unset_node:
- /* Display box |p|; */
- if (type(p) == hlist_node)
- tprint_esc("h");
- else if (type(p) == vlist_node)
- tprint_esc("v");
- else
- tprint_esc("unset");
- tprint("box(");
- print_scaled(height(p));
- print_char('+');
- print_scaled(depth(p));
- tprint(")x");
- print_scaled(width(p));
- if (type(p) == unset_node) {
- /* Display special fields of the unset node |p|; */
- if (span_count(p) != min_quarterword) {
- tprint(" (");
- print_int(span_count(p) + 1);
- tprint(" columns)");
- }
- if (glue_stretch(p) != 0) {
- tprint(", stretch ");
- print_glue(glue_stretch(p), glue_order(p), NULL);
- }
- if (glue_shrink(p) != 0) {
- tprint(", shrink ");
- print_glue(glue_shrink(p), glue_sign(p), NULL);
- }
- } else {
- /* Display the value of |glue_set(p)| */
- /* 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.
- */
-
- g = (real) (glue_set(p));
- if ((g != 0.0) && (glue_sign(p) != normal)) {
- tprint(", glue set ");
- if (glue_sign(p) == shrinking)
- tprint("- ");
- if (g > 20000.0 || g < -20000.0) {
- if (g > 0.0)
- print_char('>');
- else
- tprint("< -");
- print_glue(20000 * unity, glue_order(p), NULL);
- } else {
- print_glue(round(unity * g), glue_order(p), NULL);
- }
- }
-
- if (shift_amount(p) != 0) {
- tprint(", shifted ");
- print_scaled(shift_amount(p));
- }
- tprint(", direction ");
- print_dir(box_dir(p));
- }
- node_list_display(list_ptr(p)); /* recursive call */
- break;
- case rule_node:
- /* Display rule |p|; */
- tprint_esc("rule(");
- print_rule_dimen(height(p));
- print_char('+');
- print_rule_dimen(depth(p));
- tprint(")x");
- print_rule_dimen(width(p));
- break;
- case ins_node:
- /* Display insertion |p|; */
- tprint_esc("insert");
- print_int(subtype(p));
- tprint(", natural size ");
- print_scaled(height(p));
- tprint("; split(");
- print_spec(split_top_ptr(p), NULL);
- print_char(',');
- print_scaled(depth(p));
- tprint("); float cost ");
- print_int(float_cost(p));
- node_list_display(ins_ptr(p)); /* recursive call */
- break;
- case whatsit_node:
- show_whatsit_node(p);
- break;
- case glue_node:
- /* Display glue |p|; */
- if (subtype(p) >= a_leaders) {
- /* Display leaders |p|; */
- tprint_esc("");
- switch (subtype(p)) {
- case a_leaders:
- break;
- case c_leaders:
- print_char('c');
- break;
- case x_leaders:
- print_char('x');
- break;
- case g_leaders:
- print_char('g');
- break;
- default:
- assert(0);
- }
- tprint("leaders ");
- print_spec(glue_ptr(p), NULL);
- node_list_display(leader_ptr(p)); /* recursive call */
- } else {
- tprint_esc("glue");
- if (subtype(p) != normal) {
- print_char('(');
- if ((subtype(p) - 1) < thin_mu_skip_code) {
- print_cmd_chr(assign_glue_cmd,
- glue_base + (subtype(p) - 1));
- } else if (subtype(p) < cond_math_glue) {
- print_cmd_chr(assign_mu_glue_cmd,
- glue_base + (subtype(p) - 1));
- } else if (subtype(p) == cond_math_glue) {
- tprint_esc("nonscript");
- } else {
- tprint_esc("mskip");
- }
- print_char(')');
- }
- if (subtype(p) != cond_math_glue) {
- print_char(' ');
- if (subtype(p) < cond_math_glue)
- print_spec(glue_ptr(p), NULL);
- else
- print_spec(glue_ptr(p), "mu");
- }
- }
- break;
- case margin_kern_node:
- tprint_esc("kern");
- print_scaled(width(p));
- if (subtype(p) == left_side)
- tprint(" (left margin)");
- else
- tprint(" (right margin)");
- break;
- case kern_node:
- /* Display kern |p|; */
- /* An ``explicit'' kern value is indicated implicitly by an explicit space. */
- if (subtype(p) != mu_glue) {
- tprint_esc("kern");
- if (subtype(p) != normal)
- print_char(' ');
- print_scaled(width(p));
- if (subtype(p) == acc_kern)
- tprint(" (for accent)");
- } else {
- tprint_esc("mkern");
- print_scaled(width(p));
- tprint("mu");
- }
- break;
- case math_node:
- /* Display math node |p|; */
- tprint_esc("math");
- if (subtype(p) == before)
- tprint("on");
- else
- tprint("off");
- if (width(p) != 0) {
- tprint(", surrounded ");
- print_scaled(width(p));
- }
- break;
- case penalty_node:
- /* Display penalty |p|; */
- tprint_esc("penalty ");
- print_int(penalty(p));
- break;
- case disc_node:
- /* Display discretionary |p|; */
- /* The |post_break| list of a discretionary node is indicated by a prefixed
- `\.{\char'174}' instead of the `\..' before the |pre_break| list. */
- tprint_esc("discretionary");
- if (vlink(no_break(p)) != null) {
- tprint(" replacing ");
- node_list_display(vlink(no_break(p)));
- }
- node_list_display(vlink(pre_break(p))); /* recursive call */
- append_char('|');
- show_node_list(vlink(post_break(p)));
- flush_char(); /* recursive call */
- break;
- case mark_node:
- /* Display mark |p|; */
- tprint_esc("mark");
- if (mark_class(p) != 0) {
- print_char('s');
- print_int(mark_class(p));
- }
- print_mark(mark_ptr(p));
- break;
- case adjust_node:
- /* Display adjustment |p|; */
- tprint_esc("vadjust");
- if (adjust_pre(p) != 0)
- tprint(" pre ");
- node_list_display(adjust_ptr(p)); /* recursive call */
- break;
- case glue_spec_node:
- tprint("<glue_spec ");
- print_spec(p, NULL);
- tprint(">");
- break;
- default:
- show_math_node(p);
- break;
- }
- }
- p = vlink(p);
- }
-}
-
-@ This routine finds the 'base' width of a horizontal box, using the same logic
- that \TeX82 used for \.{\\predisplaywidth} */
-
-@c
-pointer actual_box_width(pointer r, scaled base_width)
-{
- scaled w; /* calculated |size| */
- pointer p; /* current node when calculating |pre_display_size| */
- pointer q; /* glue specification when calculating |pre_display_size| */
- scaled d; /* increment to |v| */
- scaled v; /* |w| plus possible glue amount */
- w = -max_dimen;
- v = shift_amount(r) + base_width;
- p = list_ptr(r);
- while (p != null) {
- if (is_char_node(p)) {
- d = glyph_width(p);
- goto found;
- }
- switch (type(p)) {
- case hlist_node:
- case vlist_node:
- case rule_node:
- d = width(p);
- goto found;
- break;
- case margin_kern_node:
- d = width(p);
- break;
- case kern_node:
- d = width(p);
- break;
- case math_node:
- d = surround(p);
- break;
- case glue_node:
- /* We need to be careful that |w|, |v|, and |d| do not depend on any |glue_set|
- values, since such values are subject to system-dependent rounding.
- System-dependent numbers are not allowed to infiltrate parameters like
- |pre_display_size|, since \TeX82 is supposed to make the same decisions on all
- machines.
- */
- q = glue_ptr(p);
- d = width(q);
- if (glue_sign(r) == stretching) {
- if ((glue_order(r) == stretch_order(q))
- && (stretch(q) != 0))
- v = max_dimen;
- } else if (glue_sign(r) == shrinking) {
- if ((glue_order(r) == shrink_order(q))
- && (shrink(q) != 0))
- v = max_dimen;
- }
- if (subtype(p) >= a_leaders)
- goto found;
- break;
- case whatsit_node:
- if ((subtype(p) == pdf_refxform_node)
- || (subtype(p) == pdf_refximage_node))
- d = width(p);
- else
- d = 0;
- break;
- default:
- d = 0;
- break;
- }
- if (v < max_dimen)
- v = v + d;
- goto not_found;
- found:
- if (v < max_dimen) {
- v = v + d;
- w = v;
- } else {
- w = max_dimen;
- break;
- }
- not_found:
- p = vlink(p);
- }
- return w;
-}
-
-
-@ @c
-halfword tail_of_list(halfword p)
-{
- halfword q = p;
- while (vlink(q) != null)
- q = vlink(q);
- return q;
-}
-
-
-@ |delete_glue_ref| is called when a pointer to a glue
- specification is being withdrawn.
-
-@c
-#define fast_delete_glue_ref(A) do { \
- if (glue_ref_count(A)==null) { \
- flush_node(A); \
- } else { \
- decr(glue_ref_count(A)); \
- } \
- } while (0)
-
-void delete_glue_ref(halfword p)
-{ /* |p| points to a glue specification */
- assert(type(p) == glue_spec_node);
- fast_delete_glue_ref(p);
-}
-
-@ @c
-int var_used;
-halfword temp_ptr; /* a pointer variable for occasional emergency use */
-
-
-@ Attribute lists need two extra globals to increase processing efficiency.
-|max_used_attr| limits the test loop that checks for set attributes, and
-|attr_list_cache| contains a pointer to an already created attribute list. It is
-set to the special value |cache_disabled| when the current value can no longer be
-trusted: after an assignment to an attribute register, and after a group has
-ended.
-
-@c
-int max_used_attr; /* maximum assigned attribute id */
-halfword attr_list_cache;
-
-@ From the computer's standpoint, \TeX's chief mission is to create
-horizontal and vertical lists. We shall now investigate how the elements
-of these lists are represented internally as nodes in the dynamic memory.
-
-A horizontal or vertical list is linked together by |link| fields in
-the first word of each node. Individual nodes represent boxes, glue,
-penalties, or special things like discretionary hyphens; because of this
-variety, some nodes are longer than others, and we must distinguish different
-kinds of nodes. We do this by putting a `|type|' field in the first word,
-together with the link and an optional `|subtype|'.
-
-
-@ Character nodes appear only in horizontal lists, never in vertical lists.
-
-An |hlist_node| stands for a box that was made from a horizontal list.
-Each |hlist_node| is seven words long, and contains the following fields
-(in addition to the mandatory |type| and |link|, which we shall not
-mention explicitly when discussing the other node types): The |height| and
-|width| and |depth| are scaled integers denoting the dimensions of the
-box. There is also a |shift_amount| field, a scaled integer indicating
-how much this box should be lowered (if it appears in a horizontal list),
-or how much it should be moved to the right (if it appears in a vertical
-list). There is a |list_ptr| field, which points to the beginning of the
-list from which this box was fabricated; if |list_ptr| is |null|, the box
-is empty. Finally, there are three fields that represent the setting of
-the glue: |glue_set(p)| is a word of type |glue_ratio| that represents
-the proportionality constant for glue setting; |glue_sign(p)| is
-|stretching| or |shrinking| or |normal| depending on whether or not the
-glue should stretch or shrink or remain rigid; and |glue_order(p)|
-specifies the order of infinity to which glue setting applies (|normal|,
-|sfi|, |fil|, |fill|, or |filll|). The |subtype| field is not used.
-
-@ 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|.
-
-@c
-halfword new_null_box(void)
-{ /* creates a new box node */
- halfword p; /* the new node */
- p = new_node(hlist_node, min_quarterword);
- box_dir(p) = text_direction;
- return p;
-}
-
-
-@ A |vlist_node| is like an |hlist_node| in all respects except that it
-contains a vertical list.
-
-
-@ A |rule_node| stands for a solid black rectangle; it has |width|,
-|depth|, and |height| fields just as in an |hlist_node|. However, if
-any of these dimensions is $-2^{30}$, the actual value will be determined
-by running the rule up to the boundary of the innermost enclosing box.
-This is called a ``running dimension.'' The |width| is never running in
-an hlist; the |height| and |depth| are never running in a~vlist.
-
-@ 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.
-
-@c
-halfword new_rule(void)
-{
- halfword p; /* the new node */
- p = new_node(rule_node, 0); /* the |subtype| is not used */
- return p;
-}
-
-
-@ 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.
-
-@ 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.
-
-@ 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.
-
-@ A |glyph_node|, which occurs only in horizontal lists, specifies a
-glyph in a particular font, along with its attribute list. Older
-versions of \TeX\ could use token memory for characters, because the
-font,char combination would fit in a single word (both values were
-required to be strictly less than $2^{16}$). In LuaTeX, room is
-needed for characters that are larger than that, as well as a pointer
-to a potential attribute list, and the two displacement values.
-
-In turn, that made the node so large that it made sense to merge
-ligature glyphs as well, as that requires only one extra pointer. A
-few extra classes of glyph nodes will be introduced later. The
-unification of all those types makes it easier to manipulate lists of
-glyphs. The subtype differentiates various glyph kinds.
-
-First, here is a function that returns a pointer to a glyph node for a given
-glyph in a given font. If that glyph doesn't exist, |null| is returned
-instead. Nodes of this subtype are directly created only for accents
-and their base (through |make_accent|), and math nucleus items (in the
-conversion from |mlist| to |hlist|).
-
-@c
-halfword new_glyph(int f, int c)
-{
- halfword p = null; /* the new node */
- if ((f == 0) || (char_exists(f, c))) {
- p = new_glyph_node();
- set_to_glyph(p);
- font(p) = f;
- character(p) = c;
- }
- return p;
-}
-
-
-@ A subset of the glyphs nodes represent ligatures: characters
-fabricated from the interaction of two or more actual characters. The
-characters that generated the ligature have not been forgotten, since
-they are needed for diagnostic messages; the |lig_ptr| field points to
-a linked list of character nodes for all original characters that have
-been deleted. (This list might be empty if the characters that
-generated the ligature were retained in other nodes.)
-
-The |subtype| field of these |glyph_node|s is 1, plus 2 and/or 1 if
-the original source of the ligature included implicit left and/or
-right boundaries. These nodes are created by the C function |new_ligkern|.
-
-A third general type of glyphs could be called a character, as it
-only appears in lists that are not yet processed by the ligaturing and
-kerning steps of the program.
-
-|main_control| inserts these, and they are later converted to
-|subtype_normal| by |new_ligkern|.
-
-@c
-quarterword norm_min(int h)
-{
- if (h <= 0)
- return 1;
- else if (h >= 255)
- return 255;
- else
- return (quarterword) h;
-}
-
-halfword new_char(int f, int c)
-{
- halfword p; /* the new node */
- p = new_glyph_node();
- set_to_character(p);
- font(p) = f;
- character(p) = c;
- lang_data(p) =
- make_lang_data(uc_hyph, cur_lang, left_hyphen_min, right_hyphen_min);
- return p;
-}
-
-
-@ Left and right ghost glyph nodes are the result of \.{\\leftghost}
-and \.{\\rightghost}, respectively. They are going to be removed by
-|new_ligkern|, at the end of which they are no longer needed.
-
-@ Here are a few handy helpers used by the list output routines.
-
-@c
-scaled glyph_width(halfword p)
-{
- scaled w;
- w = char_width(font(p), character(p));
- return w;
-}
-
-scaled glyph_height(halfword p)
-{
- scaled w;
- w = char_height(font(p), character(p)) + y_displace(p);
- if (w < 0)
- w = 0;
- return w;
-}
-
-scaled glyph_depth(halfword p)
-{
- scaled w;
- w = char_depth(font(p), character(p));
- if (y_displace(p) > 0)
- w = w - y_displace(p);
- if (w < 0)
- w = 0;
- return w;
-}
-
-
-@ A |disc_node|, which occurs only in horizontal lists, specifies a
-``dis\-cretion\-ary'' line break. If such a break occurs at node |p|, the text
-that starts at |pre_break(p)| will precede the break, the text that starts at
-|post_break(p)| will follow the break, and text that appears in
-|no_break(p)| nodes will be ignored. For example, an ordinary
-discretionary hyphen, indicated by `\.{\\-}', yields a |disc_node| with
-|pre_break| pointing to a |char_node| containing a hyphen, |post_break=null|,
-and |no_break=null|.
-
-{TODO: Knuth said: All three of the discretionary texts must be lists
-that consist entirely of character, kern, box and rule nodes.}
-
-If |subtype(p)=automatic_disc|, the |ex_hyphen_penalty| will be charged for this
-break. Otherwise the |hyphen_penalty| will be charged. The texts will
-actually be substituted into the list by the line-breaking algorithm if it
-decides to make the break, and the discretionary node will disappear at
-that time; thus, the output routine sees only discretionaries that were
-not chosen.
-
-@c
-halfword new_disc(void)
-{ /* creates an empty |disc_node| */
- halfword p; /* the new node */
- p = new_node(disc_node, 0);
- return p;
-}
-
-@ A |whatsit_node| is a wild card reserved for extensions to \TeX. The
-|subtype| field in its first word says what `\\{whatsit}' it is, and
-implicitly determines the node size (which must be 2 or more) and the
-format of the remaining words. When a |whatsit_node| is encountered
-in a list, special actions are invoked; knowledgeable people who are
-careful not to mess up the rest of \TeX\ are able to make \TeX\ do new
-things by adding code at the end of the program. For example, there
-might be a `\TeX nicolor' extension to specify different colors of ink,
-@^extensions to \TeX@>
-and the whatsit node might contain the desired parameters.
-
-The present implementation of \TeX\ treats the features associated with
-`\.{\\write}' and `\.{\\special}' as if they were extensions, in order to
-illustrate how such routines might be coded. We shall defer further
-discussion of extensions until the end of this program.
-
-@ A |math_node|, which occurs only in horizontal lists, appears before and
-after mathematical formulas. The |subtype| field is |before| before the
-formula and |after| after it. There is a |surround| field, which represents
-the amount of surrounding space inserted by \.{\\mathsurround}.
-
-@c
-halfword new_math(scaled w, int s)
-{
- halfword p; /* the new node */
- p = new_node(math_node, s);
- surround(p) = w;
- return p;
-}
-
-@ \TeX\ makes use of the fact that |hlist_node|, |vlist_node|,
-|rule_node|, |ins_node|, |mark_node|, |adjust_node|,
-|disc_node|, |whatsit_node|, and |math_node| are at the low end of the
-type codes, by permitting a break at glue in a list if and only if the
-|type| of the previous node is less than |math_node|. Furthermore, a
-node is discarded after a break if its type is |math_node| or~more.
-
-@ A |glue_node| represents glue in a list. However, it is really only
-a pointer to a separate glue specification, since \TeX\ makes use of the
-fact that many essentially identical nodes of glue are usually present.
-If |p| points to a |glue_node|, |glue_ptr(p)| points to
-another packet of words that specify the stretch and shrink components, etc.
-
-Glue nodes also serve to represent leaders; the |subtype| is used to
-distinguish between ordinary glue (which is called |normal|) and the three
-kinds of leaders (which are called |a_leaders|, |c_leaders|, and |x_leaders|).
-The |leader_ptr| field points to a rule node or to a box node containing the
-leaders; it is set to |null| in ordinary glue nodes.
-
-Many kinds of glue are computed from \TeX's ``skip'' parameters, and
-it is helpful to know which parameter has led to a particular glue node.
-Therefore the |subtype| is set to indicate the source of glue, whenever
-it originated as a parameter. We will be defining symbolic names for the
-parameter numbers later (e.g., |line_skip_code=0|, |baseline_skip_code=1|,
-etc.); it suffices for now to say that the |subtype| of parametric glue
-will be the same as the parameter number, plus~one.
-
-@ In math formulas there are two more possibilities for the |subtype| in a
-glue node: |mu_glue| denotes an \.{\\mskip} (where the units are scaled \.{mu}
-instead of scaled \.{pt}); and |cond_math_glue| denotes the `\.{\\nonscript}'
-feature that cancels the glue node immediately following if it appears
-in a subscript.
-
-@ A glue specification has a halfword reference count in its first word,
-@^reference counts@>
-representing |null| plus the number of glue nodes that point to it (less one).
-Note that the reference count appears in the same position as
-the |link| field in list nodes; this is the field that is initialized
-to |null| when a node is allocated, and it is also the field that is flagged
-by |empty_flag| in empty nodes.
-
-Glue specifications also contain three |scaled| fields, for the |width|,
-|stretch|, and |shrink| dimensions. Finally, there are two one-byte
-fields called |stretch_order| and |shrink_order|; these contain the
-orders of infinity (|normal|, |sfi|, |fil|, |fill|, or |filll|)
-corresponding to the stretch and shrink values.
-
-@ 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.
-
-@c
-halfword new_spec(halfword p)
-{ /* duplicates a glue specification */
- halfword q; /* the new spec */
- q = copy_node(p);
- glue_ref_count(q) = null;
- return q;
-}
-
-@ 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}.
-
-@c
-halfword new_param_glue(int n)
-{
- halfword p; /* the new node */
- halfword q; /* the glue specification */
- p = new_node(glue_node, n + 1);
- q = glue_par(n);
- glue_ptr(p) = q;
- incr(glue_ref_count(q));
- return p;
-}
-
-@ Glue nodes that are more or less anonymous are created by |new_glue|,
-whose argument points to a glue specification.
-
-@c
-halfword new_glue(halfword q)
-{
- halfword p; /* the new node */
- p = new_node(glue_node, normal);
- glue_ptr(p) = q;
- incr(glue_ref_count(q));
- return p;
-}
-
-@ 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.
-
-@c
-halfword new_skip_param(int n)
-{
- halfword p; /* the new node */
- temp_ptr = new_spec(glue_par(n));
- p = new_glue(temp_ptr);
- glue_ref_count(temp_ptr) = null;
- subtype(p) = (quarterword) (n + 1);
- return p;
-}
-
-@ 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).
-
-@ The |new_kern| function creates a kern node having a given width.
-
-@c
-halfword new_kern(scaled w)
-{
- halfword p; /* the new node */
- p = new_node(kern_node, normal);
- width(p) = w;
- return 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.
-
-@ Anyone who has been reading the last few sections of the program will
-be able to guess what comes next.
-
-@c
-halfword new_penalty(int m)
-{
- halfword p; /* the new node */
- p = new_node(penalty_node, 0); /* the |subtype| is not used */
- penalty(p) = m;
- return p;
-}
-
-@ 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.
-
-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@>
+% texnodes.w
+%
+% Copyright 2006-2010 Taco Hoekwater <taco@@luatex.org>
+%
+% This file is part of LuaTeX.
+%
+% LuaTeX is free software; you can redistribute it and/or modify it under
+% the terms of the GNU General Public License as published by the Free
+% Software Foundation; either version 2 of the License, or (at your
+% option) any later version.
+%
+% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
+% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
+% License for more details.
+%
+% You should have received a copy of the GNU General Public License along
+% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
+
+@ @c
+static const char _svn_version[] =
+ "$Id: texnodes.w 4754 2014-01-23 10:01:21Z taco $"
+ "$URL: https://foundry.supelec.fr/svn/luatex/trunk/source/texk/web2c/luatexdir/tex/texnodes.w $";
+
+#include "ptexlib.h"
+#include "lua/luatex-api.h"
+
+@ @c
+#undef name
+
+#define noDEBUG
+#define DEBUG_OUT stdout
+
+#define adjust_pre subtype
+#define attribute(A) eqtb[attribute_base+(A)].cint
+
+#define uc_hyph int_par(uc_hyph_code)
+#define cur_lang int_par(cur_lang_code)
+#define left_hyphen_min int_par(left_hyphen_min_code)
+#define right_hyphen_min int_par(right_hyphen_min_code)
+
+#define text_direction int_par(text_direction_code)
+
+#define MAX_CHAIN_SIZE 13
+
+memory_word *volatile varmem = NULL;
+
+#ifndef NDEBUG
+char *varmem_sizes = NULL;
+#endif
+
+halfword var_mem_max = 0;
+halfword rover = 0;
+
+halfword free_chain[MAX_CHAIN_SIZE] = { null };
+
+static int my_prealloc = 0;
+
+int fix_node_lists = 1;
+
+int free_error_seen = 0;
+int copy_error_seen = 0;
+
+halfword slow_get_node(int s); /* defined below */
+int copy_error(halfword p); /* define below */
+
+#define fake_node 100
+#define fake_node_size 2
+#define fake_node_name "fake"
+
+#define variable_node_size 2
+
+const char *node_fields_list[] =
+ { "attr", "width", "depth", "height", "dir", "shift",
+ "glue_order", "glue_sign", "glue_set", "head", NULL
+};
+const char *node_fields_rule[] =
+ { "attr", "width", "depth", "height", "dir", NULL };
+const char *node_fields_insert[] =
+ { "attr", "cost", "depth", "height", "spec", "head", NULL };
+const char *node_fields_mark[] = { "attr", "class", "mark", NULL };
+const char *node_fields_adjust[] = { "attr", "head", NULL };
+const char *node_fields_disc[] = { "attr", "pre", "post", "replace", NULL };
+const char *node_fields_math[] = { "attr", "surround", NULL };
+const char *node_fields_glue[] = { "attr", "spec", "leader", NULL };
+const char *node_fields_kern[] = { "attr", "kern", "expansion_factor", NULL };
+const char *node_fields_penalty[] = { "attr", "penalty", NULL };
+
+const char *node_fields_unset[] =
+ { "attr", "width", "depth", "height", "dir", "shrink",
+ "glue_order", "glue_sign", "stretch", "span", "head", NULL
+};
+const char *node_fields_margin_kern[] = { "attr", "width", "glyph", NULL };
+
+const char *node_fields_glyph[] =
+ { "attr", "char", "font", "lang", "left", "right", "uchyph",
+ "components", "xoffset", "yoffset", "width", "height", "depth", "expansion_factor", NULL
+};
+const char *node_fields_style[] = { "attr", "style", NULL };
+const char *node_fields_choice[] =
+ { "attr", "display", "text", "script", "scriptscript", NULL };
+const char *node_fields_ord[] = { "attr", "nucleus", "sub", "sup", NULL };
+const char *node_fields_op[] = { "attr", "nucleus", "sub", "sup", NULL };
+const char *node_fields_bin[] = { "attr", "nucleus", "sub", "sup", NULL };
+const char *node_fields_rel[] = { "attr", "nucleus", "sub", "sup", NULL };
+const char *node_fields_open[] = { "attr", "nucleus", "sub", "sup", NULL };
+const char *node_fields_close[] = { "attr", "nucleus", "sub", "sup", NULL };
+const char *node_fields_punct[] = { "attr", "nucleus", "sub", "sup", NULL };
+const char *node_fields_inner[] = { "attr", "nucleus", "sub", "sup", NULL };
+const char *node_fields_under[] = { "attr", "nucleus", "sub", "sup", NULL };
+const char *node_fields_over[] = { "attr", "nucleus", "sub", "sup", NULL };
+const char *node_fields_vcenter[] = { "attr", "nucleus", "sub", "sup", NULL };
+const char *node_fields_radical[] =
+ { "attr", "nucleus", "sub", "sup", "left", "degree", NULL };
+const char *node_fields_fraction[] =
+ { "attr", "width", "num", "denom", "left", "right", NULL };
+const char *node_fields_accent[] =
+ { "attr", "nucleus", "sub", "sup", "accent", "bot_accent", NULL };
+const char *node_fields_fence[] = { "attr", "delim", NULL };
+const char *node_fields_math_char[] = { "attr", "fam", "char", NULL };
+const char *node_fields_sub_box[] = { "attr", "head", NULL };
+const char *node_fields_sub_mlist[] = { "attr", "head", NULL };
+const char *node_fields_math_text_char[] = { "attr", "fam", "char", NULL };
+const char *node_fields_delim[] =
+ { "attr", "small_fam", "small_char", "large_fam", "large_char", NULL };
+
+const char *node_fields_inserting[] =
+ { "height", "last_ins_ptr", "best_ins_ptr", NULL };
+
+const char *node_fields_splitup[] = { "height", "last_ins_ptr", "best_ins_ptr",
+ "broken_ptr", "broken_ins", NULL
+};
+
+const char *node_fields_action[] = { "action_type", "named_id", "action_id",
+ "file", "new_window", "data", "ref_count", NULL
+};
+const char *node_fields_attribute[] = { "number", "value", NULL };
+
+const char *node_fields_glue_spec[] = { "width", "stretch", "shrink",
+ "stretch_order", "shrink_order", "ref_count", "writable", NULL
+};
+const char *node_fields_attribute_list[] = { NULL };
+
+const char *node_fields_whatsit_open[] =
+ { "attr", "stream", "name", "area", "ext", NULL };
+const char *node_fields_whatsit_write[] = { "attr", "stream", "data", NULL };
+const char *node_fields_whatsit_close[] = { "attr", "stream", NULL };
+const char *node_fields_whatsit_special[] = { "attr", "data", NULL };
+
+const char *node_fields_whatsit_local_par[] =
+ { "attr", "pen_inter", "pen_broken", "dir",
+ "box_left", "box_left_width", "box_right", "box_right_width", NULL
+};
+const char *node_fields_whatsit_dir[] =
+ { "attr", "dir", "level", "dvi_ptr", "dvi_h", NULL };
+
+const char *node_fields_whatsit_pdf_literal[] =
+ { "attr", "mode", "data", NULL };
+const char *node_fields_whatsit_pdf_refobj[] = { "attr", "objnum", NULL };
+const char *node_fields_whatsit_pdf_refxform[] =
+ { "attr", "width", "depth", "height", "objnum", NULL };
+const char *node_fields_whatsit_pdf_refximage[] =
+ { "attr", "width", "depth", "height", "transform", "index", NULL };
+const char *node_fields_whatsit_pdf_annot[] =
+ { "attr", "width", "depth", "height", "objnum", "data", NULL };
+const char *node_fields_whatsit_pdf_start_link[] =
+ { "attr", "width", "depth", "height",
+ "objnum", "link_attr", "action", NULL
+};
+const char *node_fields_whatsit_pdf_end_link[] = { "attr", NULL };
+
+const char *node_fields_whatsit_pdf_dest[] =
+ { "attr", "width", "depth", "height",
+ "named_id", "dest_id", "dest_type", "xyz_zoom", "objnum", NULL
+};
+
+const char *node_fields_whatsit_pdf_thread[] =
+ { "attr", "width", "depth", "height",
+ "named_id", "thread_id", "thread_attr", NULL
+};
+
+const char *node_fields_whatsit_pdf_start_thread[] =
+ { "attr", "width", "depth", "height",
+ "named_id", "thread_id", "thread_attr", NULL
+};
+const char *node_fields_whatsit_pdf_end_thread[] = { "attr", NULL };
+const char *node_fields_whatsit_pdf_save_pos[] = { "attr", NULL };
+const char *node_fields_whatsit_late_lua[] =
+ { "attr", "reg", "data", "name", "string", NULL };
+const char *node_fields_whatsit_close_lua[] = { "attr", "reg", NULL };
+const char *node_fields_whatsit_pdf_colorstack[] =
+ { "attr", "stack", "cmd", "data", NULL };
+const char *node_fields_whatsit_pdf_setmatrix[] = { "attr", "data", NULL };
+const char *node_fields_whatsit_pdf_save[] = { "attr", NULL };
+const char *node_fields_whatsit_pdf_restore[] = { "attr", NULL };
+const char *node_fields_whatsit_cancel_boundary[] = { "attr", NULL };
+const char *node_fields_whatsit_user_defined[] =
+ { "attr", "user_id", "type", "value", NULL };
+
+node_info node_data[] = {
+ {hlist_node, box_node_size, node_fields_list, "hlist"},
+ {vlist_node, box_node_size, node_fields_list, "vlist"},
+ {rule_node, rule_node_size, node_fields_rule, "rule"},
+ {ins_node, ins_node_size, node_fields_insert, "ins"},
+ {mark_node, mark_node_size, node_fields_mark, "mark"},
+ {adjust_node, adjust_node_size, node_fields_adjust, "adjust"},
+ {fake_node, fake_node_size, NULL, fake_node_name}, /* don't touch this! */
+ {disc_node, disc_node_size, node_fields_disc, "disc"},
+ {whatsit_node, -1, NULL, "whatsit"},
+ {math_node, math_node_size, node_fields_math, "math"},
+ {glue_node, glue_node_size, node_fields_glue, "glue"},
+ {kern_node, kern_node_size, node_fields_kern, "kern"},
+ {penalty_node, penalty_node_size, node_fields_penalty, "penalty"},
+ {unset_node, box_node_size, node_fields_unset, "unset"},
+ {style_node, style_node_size, node_fields_style, "style"},
+ {choice_node, style_node_size, node_fields_choice, "choice"},
+ {simple_noad, noad_size, node_fields_ord, "noad"},
+ {old_op_noad, noad_size, node_fields_op, "op"},
+ {old_bin_noad, noad_size, node_fields_bin, "bin"},
+ {old_rel_noad, noad_size, node_fields_rel, "rel"},
+ {old_open_noad, noad_size, node_fields_open, "open"},
+ {old_close_noad, noad_size, node_fields_close, "close"},
+ {old_punct_noad, noad_size, node_fields_punct, "punct"},
+ {old_inner_noad, noad_size, node_fields_inner, "inner"},
+ {radical_noad, radical_noad_size, node_fields_radical, "radical"},
+ {fraction_noad, fraction_noad_size, node_fields_fraction, "fraction"},
+ {old_under_noad, noad_size, node_fields_under, "under"},
+ {old_over_noad, noad_size, node_fields_over, "over"},
+ {accent_noad, accent_noad_size, node_fields_accent, "accent"},
+ {old_vcenter_noad, noad_size, node_fields_vcenter, "vcenter"},
+ {fence_noad, fence_noad_size, node_fields_fence, "fence"},
+ {math_char_node, math_kernel_node_size, node_fields_math_char, "math_char"},
+ {sub_box_node, math_kernel_node_size, node_fields_sub_box, "sub_box"},
+ {sub_mlist_node, math_kernel_node_size, node_fields_sub_mlist, "sub_mlist"},
+ {math_text_char_node, math_kernel_node_size, node_fields_math_text_char, "math_text_char"},
+ {delim_node, math_shield_node_size, node_fields_delim, "delim"},
+ {margin_kern_node, margin_kern_node_size, node_fields_margin_kern, "margin_kern"},
+ {glyph_node, glyph_node_size, node_fields_glyph, "glyph"},
+ {align_record_node, box_node_size, NULL, "align_record"},
+ {pseudo_file_node, pseudo_file_node_size, NULL, "pseudo_file"},
+ {pseudo_line_node, variable_node_size, NULL, "pseudo_line"},
+ {inserting_node, page_ins_node_size, node_fields_inserting, "page_insert"},
+ {split_up_node, page_ins_node_size, node_fields_splitup, "split_insert"},
+ {expr_node, expr_node_size, NULL, "expr_stack"},
+ {nesting_node, nesting_node_size, NULL, "nested_list"},
+ {span_node, span_node_size, NULL, "span"},
+ {attribute_node, attribute_node_size, node_fields_attribute, "attribute"},
+ {glue_spec_node, glue_spec_size, node_fields_glue_spec, "glue_spec"},
+ {attribute_list_node, attribute_node_size, node_fields_attribute_list, "attribute_list"},
+ {action_node, pdf_action_size, node_fields_action, "action"},
+ {temp_node, temp_node_size, NULL, "temp"},
+ {align_stack_node, align_stack_node_size, NULL, "align_stack"},
+ {movement_node, movement_node_size, NULL, "movement_stack"},
+ {if_node, if_node_size, NULL, "if_stack"},
+ {unhyphenated_node, active_node_size, NULL, "unhyphenated"},
+ {hyphenated_node, active_node_size, NULL, "hyphenated"},
+ {delta_node, delta_node_size, NULL, "delta"},
+ {passive_node, passive_node_size, NULL, "passive"},
+ {shape_node, variable_node_size, NULL, "shape"},
+ {-1, -1, NULL, NULL}
+};
+
+#define last_normal_node shape_node
+
+node_info whatsit_node_data[] = {
+ {open_node, open_node_size, node_fields_whatsit_open, "open"},
+ {write_node, write_node_size, node_fields_whatsit_write, "write"},
+ {close_node, close_node_size, node_fields_whatsit_close, "close"},
+ {special_node, special_node_size, node_fields_whatsit_special, "special"},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {local_par_node, local_par_size, node_fields_whatsit_local_par,
+ "local_par"},
+ {dir_node, dir_node_size, node_fields_whatsit_dir, "dir"},
+ {pdf_literal_node, write_node_size, node_fields_whatsit_pdf_literal,
+ "pdf_literal"},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {pdf_refobj_node, pdf_refobj_node_size, node_fields_whatsit_pdf_refobj,
+ "pdf_refobj"},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {pdf_refxform_node, pdf_refxform_node_size,
+ node_fields_whatsit_pdf_refxform, "pdf_refxform"},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {pdf_refximage_node, pdf_refximage_node_size,
+ node_fields_whatsit_pdf_refximage, "pdf_refximage"},
+ {pdf_annot_node, pdf_annot_node_size, node_fields_whatsit_pdf_annot,
+ "pdf_annot"},
+ {pdf_start_link_node, pdf_annot_node_size,
+ node_fields_whatsit_pdf_start_link, "pdf_start_link"},
+ {pdf_end_link_node, pdf_end_link_node_size,
+ node_fields_whatsit_pdf_end_link, "pdf_end_link"},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {pdf_dest_node, pdf_dest_node_size, node_fields_whatsit_pdf_dest,
+ "pdf_dest"},
+ {pdf_thread_node, pdf_thread_node_size, node_fields_whatsit_pdf_thread,
+ "pdf_thread"},
+ {pdf_start_thread_node, pdf_thread_node_size,
+ node_fields_whatsit_pdf_start_thread, "pdf_start_thread"},
+ {pdf_end_thread_node, pdf_end_thread_node_size,
+ node_fields_whatsit_pdf_end_thread, "pdf_end_thread"},
+ {pdf_save_pos_node, pdf_save_pos_node_size,
+ node_fields_whatsit_pdf_save_pos, "pdf_save_pos"},
+ {pdf_thread_data_node, pdf_thread_node_size, NULL, "pdf_thread_data"},
+ {pdf_link_data_node, pdf_annot_node_size, NULL, "pdf_link_data"},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {late_lua_node, late_lua_node_size, node_fields_whatsit_late_lua,
+ "late_lua"},
+ {close_lua_node, write_node_size, node_fields_whatsit_close_lua,
+ "close_lua"},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {fake_node, fake_node_size, NULL, fake_node_name},
+ {pdf_colorstack_node, pdf_colorstack_node_size,
+ node_fields_whatsit_pdf_colorstack, "pdf_colorstack"},
+ {pdf_setmatrix_node, pdf_setmatrix_node_size,
+ node_fields_whatsit_pdf_setmatrix, "pdf_setmatrix"},
+ {pdf_save_node, pdf_save_node_size, node_fields_whatsit_pdf_save,
+ "pdf_save"},
+ {pdf_restore_node, pdf_restore_node_size, node_fields_whatsit_pdf_restore,
+ "pdf_restore"},
+ {cancel_boundary_node, cancel_boundary_size,
+ node_fields_whatsit_cancel_boundary, "cancel_boundary"},
+ {user_defined_node, user_defined_node_size,
+ node_fields_whatsit_user_defined, "user_defined"},
+ {-1, -1, NULL, NULL}
+};
+
+#define last_whatsit_node user_defined_node
+
+@ @c
+halfword new_node(int i, int j)
+{
+ int s;
+ halfword n;
+ s = get_node_size(i, j);
+ n = get_node(s);
+ /* it should be possible to do this memset at |free_node()| */
+ /* type() and subtype() will be set below, and vlink() is
+ set to null by |get_node()|, so we can do we clearing one
+ word less than |s| */
+ (void) memset((void *) (varmem + n + 1), 0,
+ (sizeof(memory_word) * ((unsigned) s - 1)));
+ switch (i) {
+ case glyph_node:
+ init_lang_data(n);
+ break;
+ case hlist_node:
+ case vlist_node:
+ box_dir(n) = -1;
+ break;
+ case whatsit_node:
+ if (j == open_node) {
+ open_name(n) = get_nullstr();
+ open_area(n) = open_name(n);
+ open_ext(n) = open_name(n);
+ }
+ break;
+ case disc_node:
+ pre_break(n) = pre_break_head(n);
+ type(pre_break(n)) = nesting_node;
+ subtype(pre_break(n)) = pre_break_head(0);
+ post_break(n) = post_break_head(n);
+ type(post_break(n)) = nesting_node;
+ subtype(post_break(n)) = post_break_head(0);
+ no_break(n) = no_break_head(n);
+ type(no_break(n)) = nesting_node;
+ subtype(no_break(n)) = no_break_head(0);
+ break;
+ case rule_node:
+ depth(n) = null_flag;
+ height(n) = null_flag;
+ rule_dir(n) = -1;
+ /* fall through */
+ case unset_node:
+ width(n) = null_flag;
+ break;
+ case pseudo_line_node:
+ case shape_node:
+ /* this is a trick that makes |pseudo_files| slightly slower,
+ but the overall allocation faster then an explicit test
+ at the top of |new_node()|.
+ */
+ if (j>0) {
+ free_node(n, variable_node_size);
+ n = slow_get_node(j);
+ (void) memset((void *) (varmem + n + 1), 0,
+ (sizeof(memory_word) * ((unsigned) j - 1)));
+ }
+ break;
+ default:
+ break;
+ }
+ /* handle synctex extension */
+ switch (i) {
+ case math_node:
+ synctex_tag_math(n) = cur_input.synctex_tag_field;
+ synctex_line_math(n) = line;
+ break;
+ case glue_node:
+ synctex_tag_glue(n) = cur_input.synctex_tag_field;
+ synctex_line_glue(n) = line;
+ break;
+ case kern_node:
+ /* synctex ignores implicit kerns */
+ if (j != 0) {
+ synctex_tag_kern(n) = cur_input.synctex_tag_field;
+ synctex_line_kern(n) = line;
+ }
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ synctex_tag_box(n) = cur_input.synctex_tag_field;
+ synctex_line_box(n) = line;
+ break;
+ case rule_node:
+ synctex_tag_rule(n) = cur_input.synctex_tag_field;
+ synctex_line_rule(n) = line;
+ break;
+ }
+ /* take care of attributes */
+ if (nodetype_has_attributes(i)) {
+ build_attribute_list(n);
+ }
+ type(n) = (quarterword) i;
+ subtype(n) = (quarterword) j;
+#ifdef DEBUG
+ fprintf(DEBUG_OUT, "Alloc-ing %s node %d\n",
+ get_node_name(type(n), subtype(n)), (int) n);
+#endif
+ return n;
+}
+
+halfword raw_glyph_node(void)
+{
+ register halfword n;
+ n = get_node(glyph_node_size);
+ (void) memset((void *) (varmem + n + 1), 0,
+ (sizeof(memory_word) * (glyph_node_size - 1)));
+ type(n) = glyph_node;
+ subtype(n) = 0;
+ return n;
+}
+
+halfword new_glyph_node(void)
+{
+ register halfword n;
+ n = get_node(glyph_node_size);
+ (void) memset((void *) (varmem + n + 1), 0,
+ (sizeof(memory_word) * (glyph_node_size - 1)));
+ type(n) = glyph_node;
+ subtype(n) = 0;
+ build_attribute_list(n);
+ return n;
+}
+
+
+@ makes a duplicate of the node list that starts at |p| and returns a
+ pointer to the new list
+@c
+halfword do_copy_node_list(halfword p, halfword end)
+{
+ halfword q = null; /* previous position in new list */
+ halfword h = null; /* head of the list */
+ copy_error_seen = 0;
+ while (p != end) {
+ register halfword s = copy_node(p);
+ if (h == null) {
+ h = s;
+ } else {
+ couple_nodes(q, s);
+ }
+ q = s;
+ p = vlink(p);
+ }
+ return h;
+}
+
+halfword copy_node_list(halfword p)
+{
+ return do_copy_node_list(p, null);
+}
+
+@ make a dupe of a single node
+@c
+halfword copy_node(const halfword p)
+{
+ halfword r; /* current node being fabricated for new list */
+ register halfword s; /* a helper variable for copying into variable mem */
+ register int i;
+ if (copy_error(p)) {
+ r = new_node(temp_node, 0);
+ return r;
+ }
+ i = get_node_size(type(p), subtype(p));
+ r = get_node(i);
+
+ (void) memcpy((void *) (varmem + r), (void *) (varmem + p),
+ (sizeof(memory_word) * (unsigned) i));
+
+ /* handle synctex extension */
+ switch (type(p)) {
+ case math_node:
+ synctex_tag_math(r) = cur_input.synctex_tag_field;
+ synctex_line_math(r) = line;
+ break;
+ case kern_node:
+ synctex_tag_kern(r) = cur_input.synctex_tag_field;
+ synctex_line_kern(r) = line;
+ break;
+ }
+
+ if (nodetype_has_attributes(type(p))) {
+ add_node_attr_ref(node_attr(p));
+ alink(r) = null; /* needs checking */
+ }
+ vlink(r) = null;
+
+
+ switch (type(p)) {
+ case glyph_node:
+ s = copy_node_list(lig_ptr(p));
+ lig_ptr(r) = s;
+ break;
+ case glue_node:
+ add_glue_ref(glue_ptr(p));
+ s = copy_node_list(leader_ptr(p));
+ leader_ptr(r) = s;
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ s = copy_node_list(list_ptr(p));
+ list_ptr(r) = s;
+ break;
+ case ins_node:
+ add_glue_ref(split_top_ptr(p));
+ s = copy_node_list(ins_ptr(p));
+ ins_ptr(r) = s;
+ break;
+ case margin_kern_node:
+ s = copy_node(margin_char(p));
+ margin_char(r) = s;
+ break;
+ case disc_node:
+ pre_break(r) = pre_break_head(r);
+ if (vlink_pre_break(p) != null) {
+ s = copy_node_list(vlink_pre_break(p));
+ alink(s) = pre_break(r);
+ tlink_pre_break(r) = tail_of_list(s);
+ vlink_pre_break(r) = s;
+ } else {
+ assert(tlink(pre_break(r)) == null);
+ }
+ post_break(r) = post_break_head(r);
+ if (vlink_post_break(p) != null) {
+ s = copy_node_list(vlink_post_break(p));
+ alink(s) = post_break(r);
+ tlink_post_break(r) = tail_of_list(s);
+ vlink_post_break(r) = s;
+ } else {
+ assert(tlink_post_break(r) == null);
+ }
+ no_break(r) = no_break_head(r);
+ if (vlink(no_break(p)) != null) {
+ s = copy_node_list(vlink_no_break(p));
+ alink(s) = no_break(r);
+ tlink_no_break(r) = tail_of_list(s);
+ vlink_no_break(r) = s;
+ } else {
+ assert(tlink_no_break(r) == null);
+ }
+ break;
+ case mark_node:
+ add_token_ref(mark_ptr(p));
+ break;
+ case adjust_node:
+ s = copy_node_list(adjust_ptr(p));
+ adjust_ptr(r) = s;
+ break;
+
+ case choice_node:
+ s = copy_node_list(display_mlist(p));
+ display_mlist(r) = s;
+ s = copy_node_list(text_mlist(p));
+ text_mlist(r) = s;
+ s = copy_node_list(script_mlist(p));
+ script_mlist(r) = s;
+ s = copy_node_list(script_script_mlist(p));
+ script_script_mlist(r) = s;
+ break;
+ case simple_noad:
+ case radical_noad:
+ case accent_noad:
+ s = copy_node_list(nucleus(p));
+ nucleus(r) = s;
+ s = copy_node_list(subscr(p));
+ subscr(r) = s;
+ s = copy_node_list(supscr(p));
+ supscr(r) = s;
+ if (type(p) == accent_noad) {
+ s = copy_node_list(accent_chr(p));
+ accent_chr(r) = s;
+ s = copy_node_list(bot_accent_chr(p));
+ bot_accent_chr(r) = s;
+ } else if (type(p) == radical_noad) {
+ s = copy_node(left_delimiter(p));
+ left_delimiter(r) = s;
+ s = copy_node_list(degree(p));
+ degree(r) = s;
+ }
+ break;
+ case fence_noad:
+ s = copy_node(delimiter(p));
+ delimiter(r) = s;
+ break;
+ case sub_box_node:
+ case sub_mlist_node:
+ s = copy_node_list(math_list(p));
+ math_list(r) = s;
+ break;
+ case fraction_noad:
+ s = copy_node_list(numerator(p));
+ numerator(r) = s;
+ s = copy_node_list(denominator(p));
+ denominator(r) = s;
+ s = copy_node(left_delimiter(p));
+ left_delimiter(r) = s;
+ s = copy_node(right_delimiter(p));
+ right_delimiter(r) = s;
+ break;
+ case glue_spec_node:
+ glue_ref_count(r) = null;
+ break;
+ case whatsit_node:
+ switch (subtype(p)) {
+ case dir_node:
+ case local_par_node:
+ break;
+ case write_node:
+ case special_node:
+ add_token_ref(write_tokens(p));
+ break;
+ case pdf_literal_node:
+ copy_pdf_literal(r, p);
+ break;
+ case pdf_colorstack_node:
+ if (pdf_colorstack_cmd(p) <= colorstack_data)
+ add_token_ref(pdf_colorstack_data(p));
+ break;
+ case pdf_setmatrix_node:
+ add_token_ref(pdf_setmatrix_data(p));
+ break;
+ case late_lua_node:
+ copy_late_lua(r, p);
+ break;
+ case pdf_annot_node:
+ add_token_ref(pdf_annot_data(p));
+ break;
+ case pdf_start_link_node:
+ if (pdf_link_attr(r) != null)
+ add_token_ref(pdf_link_attr(r));
+ add_action_ref(pdf_link_action(r));
+ break;
+ case pdf_dest_node:
+ if (pdf_dest_named_id(p) > 0)
+ add_token_ref(pdf_dest_id(p));
+ break;
+ case pdf_thread_node:
+ case pdf_start_thread_node:
+ if (pdf_thread_named_id(p) > 0)
+ add_token_ref(pdf_thread_id(p));
+ if (pdf_thread_attr(p) != null)
+ add_token_ref(pdf_thread_attr(p));
+ break;
+ case user_defined_node:
+ switch (user_node_type(p)) {
+ case 'a':
+ add_node_attr_ref(user_node_value(p));
+ break;
+ case 't':
+ add_token_ref(user_node_value(p));
+ break;
+ case 's':
+ /* |add_string_ref(user_node_value(p));| *//* if this was mpost .. */
+ break;
+ case 'n':
+ s = copy_node_list(user_node_value(p));
+ user_node_value(r) = s;
+ break;
+ }
+ break;
+#if 0
+ case style_node:
+ case delim_node:
+ case math_char_node:
+ case math_text_char_node:
+ break;
+#else
+ default:
+#endif
+ break;
+ }
+ break;
+ }
+#ifdef DEBUG
+ fprintf(DEBUG_OUT, "Alloc-ing %s node %d (copy of %d)\n",
+ get_node_name(type(r), subtype(r)), (int) r, (int) p);
+#endif
+ return r;
+}
+
+@ @c
+int valid_node(halfword p)
+{
+ if (p > my_prealloc) {
+ if (p < var_mem_max) {
+#ifndef NDEBUG
+ if (varmem_sizes[p] > 0)
+#endif
+ return 1;
+ }
+ } else {
+ return 0;
+ }
+ return 0;
+}
+
+@ @c
+static void do_free_error(halfword p)
+{
+ halfword r;
+ char errstr[255] = { 0 };
+ const char *errhlp[] = {
+ "When I tried to free the node mentioned in the error message, it turned",
+ "out it was not (or no longer) actually in use.",
+ "Errors such as these are often caused by Lua node list alteration,",
+ "but could also point to a bug in the executable. It should be safe to continue.",
+ NULL
+ };
+
+ check_node_mem();
+ if (free_error_seen)
+ return;
+
+ r = null;
+ free_error_seen = 1;
+ if (type(p) == glyph_node) {
+ snprintf(errstr, 255,
+ "Attempt to double-free glyph (%c) node %d, ignored",
+ (int) character(p), (int) p);
+ } else {
+ snprintf(errstr, 255, "Attempt to double-free %s node %d, ignored",
+ get_node_name(type(p), subtype(p)), (int) p);
+ }
+ tex_error(errstr, errhlp);
+#ifndef NDEBUG
+ for (r = my_prealloc + 1; r < var_mem_max; r++) {
+ if (vlink(r) == p) {
+ halfword s = r;
+ while (s > my_prealloc && varmem_sizes[s] == 0)
+ s--;
+ if (s != null
+ && s != my_prealloc
+ && s != var_mem_max
+ && (r - s) < get_node_size(type(s), subtype(s))
+ && alink(s) != p) {
+
+ if (type(s) == disc_node) {
+ fprintf(stdout,
+ " pointed to from %s node %d (vlink %d, alink %d): ",
+ get_node_name(type(s), subtype(s)), (int) s,
+ (int) vlink(s), (int) alink(s));
+ fprintf(stdout, "pre_break(%d,%d,%d), ",
+ (int) vlink_pre_break(s), (int) tlink(pre_break(s)),
+ (int) alink(pre_break(s)));
+ fprintf(stdout, "post_break(%d,%d,%d), ",
+ (int) vlink_post_break(s),
+ (int) tlink(post_break(s)),
+ (int) alink(post_break(s)));
+ fprintf(stdout, "no_break(%d,%d,%d)",
+ (int) vlink_no_break(s), (int) tlink(no_break(s)),
+ (int) alink(no_break(s)));
+ fprintf(stdout, "\n");
+ } else {
+ if (vlink(s) == p
+ || (type(s) == glyph_node && lig_ptr(s) == p)
+ || (type(s) == vlist_node && list_ptr(s) == p)
+ || (type(s) == hlist_node && list_ptr(s) == p)
+ || (type(s) == unset_node && list_ptr(s) == p)
+ || (type(s) == ins_node && ins_ptr(s) == p)
+ ) {
+ fprintf(stdout,
+ " pointed to from %s node %d (vlink %d, alink %d): ",
+ get_node_name(type(s), subtype(s)), (int) s,
+ (int) vlink(s), (int) alink(s));
+ if (type(s) == glyph_node) {
+ fprintf(stdout, "lig_ptr(%d)", (int) lig_ptr(s));
+ } else if (type(s) == vlist_node
+ || type(s) == hlist_node) {
+ fprintf(stdout, "list_ptr(%d)", (int) list_ptr(s));
+ }
+ fprintf(stdout, "\n");
+ } else {
+ if ((type(s) != penalty_node)
+ && (type(s) != math_node)
+ && (type(s) != kern_node)
+ ) {
+ fprintf(stdout, " pointed to from %s node %d\n",
+ get_node_name(type(s), subtype(s)),
+ (int) s);
+ }
+ }
+ }
+ }
+ }
+ }
+#endif
+}
+
+static int free_error(halfword p)
+{
+ assert(p > my_prealloc);
+ assert(p < var_mem_max);
+#ifndef NDEBUG
+ if (varmem_sizes[p] == 0) {
+ do_free_error(p);
+ return 1; /* double free */
+ }
+#endif
+ return 0;
+}
+
+
+@ @c
+static void do_copy_error(halfword p)
+{
+ char errstr[255] = { 0 };
+ const char *errhlp[] = {
+ "When I tried to copy the node mentioned in the error message, it turned",
+ "out it was not (or no longer) actually in use.",
+ "Errors such as these are often caused by Lua node list alteration,",
+ "but could also point to a bug in the executable. It should be safe to continue.",
+ NULL
+ };
+
+ if (copy_error_seen)
+ return;
+
+ copy_error_seen = 1;
+ if (type(p) == glyph_node) {
+ snprintf(errstr, 255,
+ "Attempt to copy free glyph (%c) node %d, ignored",
+ (int) character(p), (int) p);
+ } else {
+ snprintf(errstr, 255, "Attempt to copy free %s node %d, ignored",
+ get_node_name(type(p), subtype(p)), (int) p);
+ }
+ tex_error(errstr, errhlp);
+}
+
+
+int copy_error(halfword p)
+{
+ assert(p >= 0);
+ assert(p < var_mem_max);
+#ifndef NDEBUG
+ if (p > my_prealloc && varmem_sizes[p] == 0) {
+ do_copy_error(p);
+ return 1; /* copy free node */
+ }
+#endif
+ return 0;
+}
+
+
+@ @c
+void flush_node(halfword p)
+{
+
+ if (p == null) /* legal, but no-op */
+ return;
+
+#ifdef DEBUG
+ fprintf(DEBUG_OUT, "Free-ing %s node %d\n",
+ get_node_name(type(p), subtype(p)), (int) p);
+#endif
+ if (free_error(p))
+ return;
+
+ switch (type(p)) {
+ case glyph_node:
+ flush_node_list(lig_ptr(p));
+ break;
+ case glue_node:
+ delete_glue_ref(glue_ptr(p));
+ flush_node_list(leader_ptr(p));
+ break;
+ case glue_spec_node:
+ /* this allows free-ing of lua-allocated glue specs */
+ if (valid_node(p)) {
+ if (glue_ref_count(p)!=null) {
+ decr(glue_ref_count(p));
+ } else {
+ free_node(p, get_node_size(type(p), subtype(p)));
+ }
+ }
+ return ;
+ break ;
+ case attribute_node:
+ case attribute_list_node:
+ case temp_node:
+ case rule_node:
+ case kern_node:
+ case math_node:
+ case penalty_node:
+ break;
+
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ flush_node_list(list_ptr(p));
+ break;
+ case whatsit_node:
+ switch (subtype(p)) {
+
+ case dir_node:
+ break;
+ case open_node:
+ case write_node:
+ case close_node:
+ case pdf_save_node:
+ case pdf_restore_node:
+ case cancel_boundary_node:
+ case close_lua_node:
+ case pdf_refobj_node:
+ case pdf_refxform_node:
+ case pdf_refximage_node:
+ case pdf_end_link_node:
+ case pdf_end_thread_node:
+ case pdf_save_pos_node:
+ case local_par_node:
+ break;
+
+ case special_node:
+ delete_token_ref(write_tokens(p));
+ break;
+ case pdf_literal_node:
+ free_pdf_literal(p);
+ break;
+ case pdf_colorstack_node:
+ if (pdf_colorstack_cmd(p) <= colorstack_data)
+ delete_token_ref(pdf_colorstack_data(p));
+ break;
+ case pdf_setmatrix_node:
+ delete_token_ref(pdf_setmatrix_data(p));
+ break;
+ case late_lua_node:
+ free_late_lua(p);
+ break;
+ case pdf_annot_node:
+ delete_token_ref(pdf_annot_data(p));
+ break;
+
+ case pdf_link_data_node:
+ break;
+
+ case pdf_start_link_node:
+ if (pdf_link_attr(p) != null)
+ delete_token_ref(pdf_link_attr(p));
+ delete_action_ref(pdf_link_action(p));
+ break;
+ case pdf_dest_node:
+ if (pdf_dest_named_id(p) > 0)
+ delete_token_ref(pdf_dest_id(p));
+ break;
+
+ case pdf_thread_data_node:
+ break;
+
+ case pdf_thread_node:
+ case pdf_start_thread_node:
+ if (pdf_thread_named_id(p) > 0)
+ delete_token_ref(pdf_thread_id(p));
+ if (pdf_thread_attr(p) != null)
+ delete_token_ref(pdf_thread_attr(p));
+ break;
+ case user_defined_node:
+ switch (user_node_type(p)) {
+ case 'a':
+ delete_attribute_ref(user_node_value(p));
+ break;
+ case 't':
+ delete_token_ref(user_node_value(p));
+ break;
+ case 'n':
+ flush_node_list(user_node_value(p));
+ break;
+ case 's':
+ /* |delete_string_ref(user_node_value(p));| *//* if this was mpost .. */
+ break;
+ case 'd':
+ break;
+ default:
+ {
+ const char *hlp[] = {
+ "The type of the value in a user defined whatsit node should be one",
+ "of 'a' (attribute list), 'd' (number), 'n' (node list), 's' (string),",
+ "or 't' (tokenlist). Yours has an unknown type, and therefore I don't",
+ "know how to free the node's value. A memory leak may result.",
+ NULL
+ };
+ tex_error("Unidentified user defined whatsit", hlp);
+ }
+ break;
+ }
+ break;
+
+ default:
+ confusion("ext3");
+ return;
+
+ }
+ break;
+ case ins_node:
+ flush_node_list(ins_ptr(p));
+ delete_glue_ref(split_top_ptr(p));
+ break;
+ case margin_kern_node:
+ flush_node(margin_char(p));
+ break;
+ case mark_node:
+ delete_token_ref(mark_ptr(p));
+ break;
+ case disc_node:
+ flush_node_list(vlink(pre_break(p)));
+ flush_node_list(vlink(post_break(p)));
+ flush_node_list(vlink(no_break(p)));
+ break;
+ case adjust_node:
+ flush_node_list(adjust_ptr(p));
+ break;
+ case style_node: /* nothing to do */
+ break;
+ case choice_node:
+ flush_node_list(display_mlist(p));
+ flush_node_list(text_mlist(p));
+ flush_node_list(script_mlist(p));
+ flush_node_list(script_script_mlist(p));
+ break;
+ case simple_noad:
+ case radical_noad:
+ case accent_noad:
+ flush_node_list(nucleus(p));
+ flush_node_list(subscr(p));
+ flush_node_list(supscr(p));
+ if (type(p) == accent_noad) {
+ flush_node_list(accent_chr(p));
+ flush_node_list(bot_accent_chr(p));
+ } else if (type(p) == radical_noad) {
+ flush_node(left_delimiter(p));
+ flush_node_list(degree(p));
+ }
+ break;
+ case fence_noad:
+ flush_node(delimiter(p));
+ break;
+ case delim_node: /* nothing to do */
+ case math_char_node:
+ case math_text_char_node:
+ break;
+ case sub_box_node:
+ case sub_mlist_node:
+ flush_node_list(math_list(p));
+ break;
+ case fraction_noad:
+ flush_node_list(numerator(p));
+ flush_node_list(denominator(p));
+ flush_node(left_delimiter(p));
+ flush_node(right_delimiter(p));
+ break;
+ case pseudo_file_node:
+ flush_node_list(pseudo_lines(p));
+ break;
+ case pseudo_line_node:
+ case shape_node:
+ free_node(p, subtype(p));
+ return;
+ break;
+ case align_stack_node:
+ case span_node:
+ case movement_node:
+ case if_node:
+ case nesting_node:
+ case unhyphenated_node:
+ case hyphenated_node:
+ case delta_node:
+ case passive_node:
+ case action_node:
+ case inserting_node:
+ case split_up_node:
+ case expr_node:
+ break;
+ default:
+ fprintf(stdout, "flush_node: type is %d\n", type(p));
+ return;
+
+ }
+ if (nodetype_has_attributes(type(p)))
+ delete_attribute_ref(node_attr(p));
+ free_node(p, get_node_size(type(p), subtype(p)));
+ return;
+}
+
+@ @c
+void flush_node_list(halfword pp)
+{ /* erase list of nodes starting at |p| */
+ register halfword p = pp;
+ free_error_seen = 0;
+ if (p == null) /* legal, but no-op */
+ return;
+ if (free_error(p))
+ return;
+
+ while (p != null) {
+ register halfword q = vlink(p);
+ flush_node(p);
+ p = q;
+ }
+}
+
+@ @c
+static int test_count = 1;
+
+#define dorangetest(a,b,c) do { \
+ if (!(b>=0 && b<c)) { \
+ fprintf(stdout,"For node p:=%d, 0<=%d<%d (l.%d,r.%d)\n", \
+ (int)a, (int)b, (int)c, __LINE__,test_count); \
+ confusion("dorangetest"); \
+ } } while (0)
+
+#define dotest(a,b,c) do { \
+ if (b!=c) { \
+ fprintf(stdout,"For node p:=%d, %d==%d (l.%d,r.%d)\n", \
+ (int)a, (int)b, (int)c, __LINE__,test_count); \
+ confusion("dotest"); \
+ } } while (0)
+
+#define check_action_ref(a) { dorangetest(p,a,var_mem_max); }
+#define check_glue_ref(a) { dorangetest(p,a,var_mem_max); }
+#define check_attribute_ref(a) { dorangetest(p,a,var_mem_max); }
+#define check_token_ref(a) assert(1)
+
+void check_node(halfword p)
+{
+
+ switch (type(p)) {
+ case glyph_node:
+ dorangetest(p, lig_ptr(p), var_mem_max);
+ break;
+ case glue_node:
+ check_glue_ref(glue_ptr(p));
+ dorangetest(p, leader_ptr(p), var_mem_max);
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ case align_record_node:
+ dorangetest(p, list_ptr(p), var_mem_max);
+ break;
+ case ins_node:
+ dorangetest(p, ins_ptr(p), var_mem_max);
+ check_glue_ref(split_top_ptr(p));
+ break;
+ case whatsit_node:
+ switch (subtype(p)) {
+ case special_node:
+ check_token_ref(write_tokens(p));
+ break;
+ case pdf_literal_node:
+ if (pdf_literal_type(p) == normal)
+ check_token_ref(pdf_literal_data(p));
+ break;
+ case pdf_colorstack_node:
+ if (pdf_colorstack_cmd(p) <= colorstack_data)
+ check_token_ref(pdf_colorstack_data(p));
+ break;
+ case pdf_setmatrix_node:
+ check_token_ref(pdf_setmatrix_data(p));
+ break;
+ case late_lua_node:
+ if (late_lua_name(p) > 0)
+ check_token_ref(late_lua_name(p));
+ if (late_lua_type(p) == normal)
+ check_token_ref(late_lua_data(p));
+ break;
+ case pdf_annot_node:
+ check_token_ref(pdf_annot_data(p));
+ break;
+ case pdf_start_link_node:
+ if (pdf_link_attr(p) != null)
+ check_token_ref(pdf_link_attr(p));
+ check_action_ref(pdf_link_action(p));
+ break;
+ case pdf_dest_node:
+ if (pdf_dest_named_id(p) > 0)
+ check_token_ref(pdf_dest_id(p));
+ break;
+ case pdf_thread_node:
+ case pdf_start_thread_node:
+ if (pdf_thread_named_id(p) > 0)
+ check_token_ref(pdf_thread_id(p));
+ if (pdf_thread_attr(p) != null)
+ check_token_ref(pdf_thread_attr(p));
+ break;
+ case user_defined_node:
+ switch (user_node_type(p)) {
+ case 'a':
+ check_attribute_ref(user_node_value(p));
+ break;
+ case 't':
+ check_token_ref(user_node_value(p));
+ break;
+ case 'n':
+ dorangetest(p, user_node_value(p), var_mem_max);
+ break;
+ case 's':
+ case 'd':
+ break;
+ default:
+ confusion("extuser");
+ break;
+ }
+ break;
+ case dir_node:
+ case open_node:
+ case write_node:
+ case close_node:
+ case pdf_save_node:
+ case pdf_restore_node:
+ case cancel_boundary_node:
+ case close_lua_node:
+ case pdf_refobj_node:
+ case pdf_refxform_node:
+ case pdf_refximage_node:
+ case pdf_end_link_node:
+ case pdf_end_thread_node:
+ case pdf_save_pos_node:
+ case local_par_node:
+ break;
+ default:
+ confusion("ext3");
+ }
+ break;
+ case margin_kern_node:
+ check_node(margin_char(p));
+ break;
+ case disc_node:
+ dorangetest(p, vlink(pre_break(p)), var_mem_max);
+ dorangetest(p, vlink(post_break(p)), var_mem_max);
+ dorangetest(p, vlink(no_break(p)), var_mem_max);
+ break;
+ case adjust_node:
+ dorangetest(p, adjust_ptr(p), var_mem_max);
+ break;
+ case pseudo_file_node:
+ dorangetest(p, pseudo_lines(p), var_mem_max);
+ break;
+ case pseudo_line_node:
+ case shape_node:
+ break;
+ case choice_node:
+ dorangetest(p, display_mlist(p), var_mem_max);
+ dorangetest(p, text_mlist(p), var_mem_max);
+ dorangetest(p, script_mlist(p), var_mem_max);
+ dorangetest(p, script_script_mlist(p), var_mem_max);
+ break;
+ case fraction_noad:
+ dorangetest(p, numerator(p), var_mem_max);
+ dorangetest(p, denominator(p), var_mem_max);
+ dorangetest(p, left_delimiter(p), var_mem_max);
+ dorangetest(p, right_delimiter(p), var_mem_max);
+ break;
+ case simple_noad:
+ dorangetest(p, nucleus(p), var_mem_max);
+ dorangetest(p, subscr(p), var_mem_max);
+ dorangetest(p, supscr(p), var_mem_max);
+ break;
+ case radical_noad:
+ dorangetest(p, nucleus(p), var_mem_max);
+ dorangetest(p, subscr(p), var_mem_max);
+ dorangetest(p, supscr(p), var_mem_max);
+ dorangetest(p, degree(p), var_mem_max);
+ dorangetest(p, left_delimiter(p), var_mem_max);
+ break;
+ case accent_noad:
+ dorangetest(p, nucleus(p), var_mem_max);
+ dorangetest(p, subscr(p), var_mem_max);
+ dorangetest(p, supscr(p), var_mem_max);
+ dorangetest(p, accent_chr(p), var_mem_max);
+ dorangetest(p, bot_accent_chr(p), var_mem_max);
+ break;
+ case fence_noad:
+ dorangetest(p, delimiter(p), var_mem_max);
+ break;
+ case rule_node:
+ case kern_node:
+ case math_node:
+ case penalty_node:
+ case mark_node:
+ case style_node:
+ case attribute_list_node:
+ case attribute_node:
+ case glue_spec_node:
+ case temp_node:
+ case align_stack_node:
+ case movement_node:
+ case if_node:
+ case nesting_node:
+ case span_node:
+ case unhyphenated_node:
+ case hyphenated_node:
+ case delta_node:
+ case passive_node:
+ case expr_node:
+ break;
+ default:
+ fprintf(stdout, "check_node: type is %d\n", type(p));
+ }
+}
+
+@ @c
+static void check_static_node_mem(void)
+{
+ dotest(zero_glue, width(zero_glue), 0);
+ dotest(zero_glue, type(zero_glue), glue_spec_node);
+ dotest(zero_glue, vlink(zero_glue), null);
+ dotest(zero_glue, stretch(zero_glue), 0);
+ dotest(zero_glue, stretch_order(zero_glue), normal);
+ dotest(zero_glue, shrink(zero_glue), 0);
+ dotest(zero_glue, shrink_order(zero_glue), normal);
+
+ dotest(sfi_glue, width(sfi_glue), 0);
+ dotest(sfi_glue, type(sfi_glue), glue_spec_node);
+ dotest(sfi_glue, vlink(sfi_glue), null);
+ dotest(sfi_glue, stretch(sfi_glue), 0);
+ dotest(sfi_glue, stretch_order(sfi_glue), sfi);
+ dotest(sfi_glue, shrink(sfi_glue), 0);
+ dotest(sfi_glue, shrink_order(sfi_glue), normal);
+
+ dotest(fil_glue, width(fil_glue), 0);
+ dotest(fil_glue, type(fil_glue), glue_spec_node);
+ dotest(fil_glue, vlink(fil_glue), null);
+ dotest(fil_glue, stretch(fil_glue), unity);
+ dotest(fil_glue, stretch_order(fil_glue), fil);
+ dotest(fil_glue, shrink(fil_glue), 0);
+ dotest(fil_glue, shrink_order(fil_glue), normal);
+
+ dotest(fill_glue, width(fill_glue), 0);
+ dotest(fill_glue, type(fill_glue), glue_spec_node);
+ dotest(fill_glue, vlink(fill_glue), null);
+ dotest(fill_glue, stretch(fill_glue), unity);
+ dotest(fill_glue, stretch_order(fill_glue), fill);
+ dotest(fill_glue, shrink(fill_glue), 0);
+ dotest(fill_glue, shrink_order(fill_glue), normal);
+
+ dotest(ss_glue, width(ss_glue), 0);
+ dotest(ss_glue, type(ss_glue), glue_spec_node);
+ dotest(ss_glue, vlink(ss_glue), null);
+ dotest(ss_glue, stretch(ss_glue), unity);
+ dotest(ss_glue, stretch_order(ss_glue), fil);
+ dotest(ss_glue, shrink(ss_glue), unity);
+ dotest(ss_glue, shrink_order(ss_glue), fil);
+
+ dotest(fil_neg_glue, width(fil_neg_glue), 0);
+ dotest(fil_neg_glue, type(fil_neg_glue), glue_spec_node);
+ dotest(fil_neg_glue, vlink(fil_neg_glue), null);
+ dotest(fil_neg_glue, stretch(fil_neg_glue), -unity);
+ dotest(fil_neg_glue, stretch_order(fil_neg_glue), fil);
+ dotest(fil_neg_glue, shrink(fil_neg_glue), 0);
+ dotest(fil_neg_glue, shrink_order(fil_neg_glue), normal);
+}
+
+@ @c
+void check_node_mem(void)
+{
+ int i;
+ check_static_node_mem();
+#ifndef NDEBUG
+ for (i = (my_prealloc + 1); i < var_mem_max; i++) {
+ if (varmem_sizes[i] > 0) {
+ check_node(i);
+ }
+ }
+#endif
+ test_count++;
+}
+
+@ @c
+void fix_node_list(halfword head)
+{
+ halfword p, q;
+ if (head == null)
+ return;
+ p = head;
+ q = vlink(p);
+ while (q != null) {
+ alink(q) = p;
+ p = q;
+ q = vlink(p);
+ }
+}
+
+@ @c
+halfword get_node(int s)
+{
+ register halfword r;
+#if 0
+ check_static_node_mem();
+#endif
+ assert(s < MAX_CHAIN_SIZE);
+
+ r = free_chain[s];
+ if (r != null) {
+ free_chain[s] = vlink(r);
+#ifndef NDEBUG
+ varmem_sizes[r] = (char) s;
+#endif
+ vlink(r) = null;
+ var_used += s; /* maintain usage statistics */
+ return r;
+ }
+ /* this is the end of the 'inner loop' */
+ return slow_get_node(s);
+}
+
+@ @c
+#ifdef DEBUG
+static void print_free_chain(int c)
+{
+ halfword p = free_chain[c];
+ fprintf(stdout, "\nfree chain[%d] =\n ", c);
+ while (p != null) {
+ fprintf(stdout, "%d,", (int) p);
+ p = vlink(p);
+ }
+ fprintf(stdout, "null;\n");
+}
+#endif
+
+@ @c
+void free_node(halfword p, int s)
+{
+
+ if (p <= my_prealloc) {
+ fprintf(stdout, "node %d (type %d) should not be freed!\n", (int) p,
+ type(p));
+ return;
+ }
+#ifndef NDEBUG
+ varmem_sizes[p] = 0;
+#endif
+ if (s < MAX_CHAIN_SIZE) {
+ vlink(p) = free_chain[s];
+ free_chain[s] = p;
+ } else {
+ /* todo ? it is perhaps possible to merge this node with an existing rover */
+ node_size(p) = s;
+ vlink(p) = rover;
+ while (vlink(rover) != vlink(p)) {
+ rover = vlink(rover);
+ }
+ vlink(rover) = p;
+ }
+ var_used -= s; /* maintain statistics */
+}
+
+@ @c
+static void free_node_chain(halfword q, int s)
+{
+ register halfword p = q;
+ while (vlink(p) != null) {
+#ifndef NDEBUG
+ varmem_sizes[p] = 0;
+#endif
+ var_used -= s;
+ p = vlink(p);
+ }
+ var_used -= s;
+#ifndef NDEBUG
+ varmem_sizes[p] = 0;
+#endif
+ vlink(p) = free_chain[s];
+ free_chain[s] = q;
+}
+
+
+@ @c
+void init_node_mem(int t)
+{
+ my_prealloc = var_mem_stat_max;
+ assert(whatsit_node_data[user_defined_node].id == user_defined_node);
+ assert(node_data[passive_node].id == passive_node);
+
+ varmem =
+ (memory_word *) realloc((void *) varmem,
+ sizeof(memory_word) * (unsigned) t);
+ if (varmem == NULL) {
+ overflow("node memory size", (unsigned) var_mem_max);
+ }
+ memset((void *) (varmem), 0, (unsigned) t * sizeof(memory_word));
+
+#ifndef NDEBUG
+ varmem_sizes = (char *) realloc(varmem_sizes, sizeof(char) * (unsigned) t);
+ if (varmem_sizes == NULL) {
+ overflow("node memory size", (unsigned) var_mem_max);
+ }
+ memset((void *) varmem_sizes, 0, sizeof(char) * (unsigned) t);
+#endif
+ var_mem_max = t;
+ rover = var_mem_stat_max + 1;
+ vlink(rover) = rover;
+ node_size(rover) = (t - rover);
+ var_used = 0;
+ /* initialize static glue specs */
+ glue_ref_count(zero_glue) = null + 1;
+ width(zero_glue) = 0;
+ type(zero_glue) = glue_spec_node;
+ vlink(zero_glue) = null;
+ stretch(zero_glue) = 0;
+ stretch_order(zero_glue) = normal;
+ shrink(zero_glue) = 0;
+ shrink_order(zero_glue) = normal;
+ glue_ref_count(sfi_glue) = null + 1;
+ width(sfi_glue) = 0;
+ type(sfi_glue) = glue_spec_node;
+ vlink(sfi_glue) = null;
+ stretch(sfi_glue) = 0;
+ stretch_order(sfi_glue) = sfi;
+ shrink(sfi_glue) = 0;
+ shrink_order(sfi_glue) = normal;
+ glue_ref_count(fil_glue) = null + 1;
+ width(fil_glue) = 0;
+ type(fil_glue) = glue_spec_node;
+ vlink(fil_glue) = null;
+ stretch(fil_glue) = unity;
+ stretch_order(fil_glue) = fil;
+ shrink(fil_glue) = 0;
+ shrink_order(fil_glue) = normal;
+ glue_ref_count(fill_glue) = null + 1;
+ width(fill_glue) = 0;
+ type(fill_glue) = glue_spec_node;
+ vlink(fill_glue) = null;
+ stretch(fill_glue) = unity;
+ stretch_order(fill_glue) = fill;
+ shrink(fill_glue) = 0;
+ shrink_order(fill_glue) = normal;
+ glue_ref_count(ss_glue) = null + 1;
+ width(ss_glue) = 0;
+ type(ss_glue) = glue_spec_node;
+ vlink(ss_glue) = null;
+ stretch(ss_glue) = unity;
+ stretch_order(ss_glue) = fil;
+ shrink(ss_glue) = unity;
+ shrink_order(ss_glue) = fil;
+ glue_ref_count(fil_neg_glue) = null + 1;
+ width(fil_neg_glue) = 0;
+ type(fil_neg_glue) = glue_spec_node;
+ vlink(fil_neg_glue) = null;
+ stretch(fil_neg_glue) = -unity;
+ stretch_order(fil_neg_glue) = fil;
+ shrink(fil_neg_glue) = 0;
+ shrink_order(fil_neg_glue) = normal;
+ /* initialize node list heads */
+ vinfo(page_ins_head) = 0;
+ type(page_ins_head) = temp_node;
+ vlink(page_ins_head) = null;
+ alink(page_ins_head) = null;
+ vinfo(contrib_head) = 0;
+ type(contrib_head) = temp_node;
+ vlink(contrib_head) = null;
+ alink(contrib_head) = null;
+ vinfo(page_head) = 0;
+ type(page_head) = temp_node;
+ vlink(page_head) = null;
+ alink(page_head) = null;
+ vinfo(temp_head) = 0;
+ type(temp_head) = temp_node;
+ vlink(temp_head) = null;
+ alink(temp_head) = null;
+ vinfo(hold_head) = 0;
+ type(hold_head) = temp_node;
+ vlink(hold_head) = null;
+ alink(hold_head) = null;
+ vinfo(adjust_head) = 0;
+ type(adjust_head) = temp_node;
+ vlink(adjust_head) = null;
+ alink(adjust_head) = null;
+ vinfo(pre_adjust_head) = 0;
+ type(pre_adjust_head) = temp_node;
+ vlink(pre_adjust_head) = null;
+ alink(pre_adjust_head) = null;
+ vinfo(active) = 0;
+ type(active) = unhyphenated_node;
+ vlink(active) = null;
+ alink(active) = null;
+ vinfo(align_head) = 0;
+ type(align_head) = temp_node;
+ vlink(align_head) = null;
+ alink(align_head) = null;
+ vinfo(end_span) = 0;
+ type(end_span) = span_node;
+ vlink(end_span) = null;
+ alink(end_span) = null;
+ type(begin_point) = glyph_node;
+ subtype(begin_point) = 0;
+ vlink(begin_point) = null;
+ vinfo(begin_point + 1) = null;
+ alink(begin_point) = null;
+ font(begin_point) = 0;
+ character(begin_point) = '.';
+ vinfo(begin_point + 3) = 0;
+ vlink(begin_point + 3) = 0;
+ vinfo(begin_point + 4) = 0;
+ vlink(begin_point + 4) = 0;
+ type(end_point) = glyph_node;
+ subtype(end_point) = 0;
+ vlink(end_point) = null;
+ vinfo(end_point + 1) = null;
+ alink(end_point) = null;
+ font(end_point) = 0;
+ character(end_point) = '.';
+ vinfo(end_point + 3) = 0;
+ vlink(end_point + 3) = 0;
+ vinfo(end_point + 4) = 0;
+ vlink(end_point + 4) = 0;
+}
+
+@ @c
+void dump_node_mem(void)
+{
+ dump_int(var_mem_max);
+ dump_int(rover);
+ dump_things(varmem[0], var_mem_max);
+#ifndef NDEBUG
+ dump_things(varmem_sizes[0], var_mem_max);
+#endif
+ dump_things(free_chain[0], MAX_CHAIN_SIZE);
+ dump_int(var_used);
+ dump_int(my_prealloc);
+}
+
+@ it makes sense to enlarge the varmem array immediately
+@c
+void undump_node_mem(void)
+{
+ int x;
+ undump_int(x);
+ undump_int(rover);
+ var_mem_max = (x < 100000 ? 100000 : x);
+ varmem = xmallocarray(memory_word, (unsigned) var_mem_max);
+#if 0
+ memset ((void *)varmem,0,x*sizeof(memory_word));
+#endif
+ undump_things(varmem[0], x);
+#ifndef NDEBUG
+ varmem_sizes = xmallocarray(char, (unsigned) var_mem_max);
+ memset((void *) varmem_sizes, 0, (unsigned) var_mem_max * sizeof(char));
+ undump_things(varmem_sizes[0], x);
+#endif
+ undump_things(free_chain[0], MAX_CHAIN_SIZE);
+ undump_int(var_used);
+ undump_int(my_prealloc);
+ if (var_mem_max > x) {
+ /* todo ? it is perhaps possible to merge the new node with an existing rover */
+ vlink(x) = rover;
+ node_size(x) = (var_mem_max - x);
+ while (vlink(rover) != vlink(x)) {
+ rover = vlink(rover);
+ }
+ vlink(rover) = x;
+ }
+}
+
+#if 0
+void test_rovers(char *s)
+{
+ int q = rover;
+ int r = q;
+ fprintf(stdout, "%s: {rover=%d,size=%d,link=%d}", s, r, node_size(r),
+ vlink(r));
+ while (vlink(r) != q) {
+ r = vlink(r);
+ fprintf(stdout, ",{rover=%d,size=%d,link=%d}", r, node_size(r),
+ vlink(r));
+ }
+ fprintf(stdout, "\n");
+}
+#else
+# define test_rovers(a)
+#endif
+
+@ @c
+halfword slow_get_node(int s)
+{
+ register int t;
+
+ RETRY:
+ t = node_size(rover);
+ assert(vlink(rover) < var_mem_max);
+ assert(vlink(rover) != 0);
+ test_rovers("entry");
+ if (t > s) {
+ register halfword r;
+ /* allocating from the bottom helps decrease page faults */
+ r = rover;
+ rover += s;
+ vlink(rover) = vlink(r);
+ node_size(rover) = node_size(r) - s;
+ if (vlink(rover) != r) { /* list is longer than one */
+ halfword q = r;
+ while (vlink(q) != r) {
+ q = vlink(q);
+ }
+ vlink(q) += s;
+ } else {
+ vlink(rover) += s;
+ }
+ test_rovers("taken");
+ assert(vlink(rover) < var_mem_max);
+#ifndef NDEBUG
+ varmem_sizes[r] = (char) (s > 127 ? 127 : s);
+#endif
+ vlink(r) = null;
+ var_used += s; /* maintain usage statistics */
+ return r; /* this is the only exit */
+ } else {
+ int x;
+ /* attempt to keep the free list small */
+ if (vlink(rover) != rover) {
+ if (t < MAX_CHAIN_SIZE) {
+ halfword l = vlink(rover);
+ vlink(rover) = free_chain[t];
+ free_chain[t] = rover;
+ rover = l;
+ while (vlink(l) != free_chain[t]) {
+ l = vlink(l);
+ }
+ vlink(l) = rover;
+ test_rovers("outtake");
+ goto RETRY;
+ } else {
+ halfword l = rover;
+ while (vlink(rover) != l) {
+ if (node_size(rover) > s) {
+ goto RETRY;
+ }
+ rover = vlink(rover);
+ }
+ }
+ }
+ /* if we are still here, it was apparently impossible to get a match */
+ x = (var_mem_max >> 2) + s;
+ varmem =
+ (memory_word *) realloc((void *) varmem,
+ sizeof(memory_word) *
+ (unsigned) (var_mem_max + x));
+ if (varmem == NULL) {
+ overflow("node memory size", (unsigned) var_mem_max);
+ }
+ memset((void *) (varmem + var_mem_max), 0,
+ (unsigned) x * sizeof(memory_word));
+
+#ifndef NDEBUG
+ varmem_sizes =
+ (char *) realloc(varmem_sizes,
+ sizeof(char) * (unsigned) (var_mem_max + x));
+ if (varmem_sizes == NULL) {
+ overflow("node memory size", (unsigned) var_mem_max);
+ }
+ memset((void *) (varmem_sizes + var_mem_max), 0,
+ (unsigned) (x) * sizeof(char));
+#endif
+
+ /* todo ? it is perhaps possible to merge the new memory with an existing rover */
+ vlink(var_mem_max) = rover;
+ node_size(var_mem_max) = x;
+ while (vlink(rover) != vlink(var_mem_max)) {
+ rover = vlink(rover);
+ }
+ vlink(rover) = var_mem_max;
+ rover = var_mem_max;
+ test_rovers("realloc");
+ var_mem_max += x;
+ goto RETRY;
+ }
+}
+
+@ @c
+char *sprint_node_mem_usage(void)
+{
+ int i, b;
+
+ char *s, *ss;
+#ifndef NDEBUG
+ char msg[256];
+ int node_counts[last_normal_node + last_whatsit_node + 2] = { 0 };
+
+ for (i = (var_mem_max - 1); i > my_prealloc; i--) {
+ if (varmem_sizes[i] > 0) {
+ if (type(i) > last_normal_node + last_whatsit_node) {
+ node_counts[last_normal_node + last_whatsit_node + 1]++;
+ } else if (type(i) == whatsit_node) {
+ node_counts[(subtype(i) + last_normal_node + 1)]++;
+ } else {
+ node_counts[type(i)]++;
+ }
+ }
+ }
+ s = strdup("");
+ b = 0;
+ for (i = 0; i < last_normal_node + last_whatsit_node + 2; i++) {
+ if (node_counts[i] > 0) {
+ int j =
+ (i > (last_normal_node + 1) ? (i - last_normal_node - 1) : 0);
+ snprintf(msg, 255, "%s%d %s", (b ? ", " : ""), (int) node_counts[i],
+ get_node_name((i > last_normal_node ? whatsit_node : i),
+ j));
+ ss = xmalloc((unsigned) (strlen(s) + strlen(msg) + 1));
+ strcpy(ss, s);
+ strcat(ss, msg);
+ free(s);
+ s = ss;
+ b = 1;
+ }
+ }
+#else
+ s = strdup("");
+#endif
+ return s;
+}
+
+@ @c
+halfword list_node_mem_usage(void)
+{
+ halfword i, j;
+ halfword p = null, q = null;
+#ifndef NDEBUG
+ char *saved_varmem_sizes = xmallocarray(char, (unsigned) var_mem_max);
+ memcpy(saved_varmem_sizes, varmem_sizes, (size_t) var_mem_max);
+ for (i = my_prealloc + 1; i < (var_mem_max - 1); i++) {
+ if (saved_varmem_sizes[i] > 0) {
+ j = copy_node(i);
+ if (p == null) {
+ q = j;
+ } else {
+ vlink(p) = j;
+ }
+ p = j;
+ }
+ }
+ free(saved_varmem_sizes);
+#endif
+ return q;
+}
+
+@ @c
+void print_node_mem_stats(void)
+{
+ int i, b;
+ halfword j;
+ char msg[256];
+ char *s;
+ int free_chain_counts[MAX_CHAIN_SIZE] = { 0 };
+ snprintf(msg, 255, " %d words of node memory still in use:",
+ (int) (var_used + my_prealloc));
+ tprint_nl(msg);
+ s = sprint_node_mem_usage();
+ tprint_nl(" ");
+ tprint(s);
+ free(s);
+ tprint(" nodes");
+ tprint_nl(" avail lists: ");
+ b = 0;
+ for (i = 1; i < MAX_CHAIN_SIZE; i++) {
+ for (j = free_chain[i]; j != null; j = vlink(j))
+ free_chain_counts[i]++;
+ if (free_chain_counts[i] > 0) {
+ snprintf(msg, 255, "%s%d:%d", (b ? "," : ""), i,
+ (int) free_chain_counts[i]);
+ tprint(msg);
+ b = 1;
+ }
+ }
+ print_nlp(); /* newline, if needed */
+}
+
+/* this belongs in the web but i couldn't find the correct syntactic place */
+
+halfword new_span_node(halfword n, int s, scaled w)
+{
+ halfword p = new_node(span_node, 0);
+ span_link(p) = n;
+ span_span(p) = s;
+ width(p) = w;
+ return p;
+}
+
+@* Attribute stuff.
+
+@c
+static halfword new_attribute_node(unsigned int i, int v)
+{
+ register halfword r = get_node(attribute_node_size);
+ type(r) = attribute_node;
+ attribute_id(r) = (halfword) i;
+ attribute_value(r) = v;
+ return r;
+}
+
+@ @c
+halfword copy_attribute_list(halfword n)
+{
+ halfword q = get_node(attribute_node_size);
+ register halfword p = q;
+ type(p) = attribute_list_node;
+ attr_list_ref(p) = 0;
+ n = vlink(n);
+ while (n != null) {
+ register halfword r = get_node(attribute_node_size);
+ /* the link will be fixed automatically in the next loop */
+ (void) memcpy((void *) (varmem + r), (void *) (varmem + n),
+ (sizeof(memory_word) * attribute_node_size));
+ vlink(p) = r;
+ p = r;
+ n = vlink(n);
+ }
+ return q;
+}
+
+@ @c
+void update_attribute_cache(void)
+{
+ halfword p;
+ register int i;
+ attr_list_cache = get_node(attribute_node_size);
+ type(attr_list_cache) = attribute_list_node;
+ attr_list_ref(attr_list_cache) = 0;
+ p = attr_list_cache;
+ for (i = 0; i <= max_used_attr; i++) {
+ register int v = attribute(i);
+ if (v > UNUSED_ATTRIBUTE) {
+ register halfword r = new_attribute_node((unsigned) i, v);
+ vlink(p) = r;
+ p = r;
+ }
+ }
+ if (vlink(attr_list_cache) == null) {
+ free_node(attr_list_cache, attribute_node_size);
+ attr_list_cache = null;
+ }
+ return;
+}
+
+@ @c
+void build_attribute_list(halfword b)
+{
+ if (max_used_attr >= 0) {
+ if (attr_list_cache == cache_disabled) {
+ update_attribute_cache();
+ if (attr_list_cache == null)
+ return;
+ }
+ attr_list_ref(attr_list_cache)++;
+ node_attr(b) = attr_list_cache;
+#ifdef DEBUG
+ fprintf(DEBUG_OUT, "Added attrlist (%d) to node %d (count=%d)\n",
+ node_attr(b), b, attr_list_ref(attr_list_cache));
+#endif
+ }
+}
+
+@ @c
+void delete_attribute_ref(halfword b)
+{
+ if (b != null) {
+ assert(type(b) == attribute_list_node);
+ attr_list_ref(b)--;
+#ifdef DEBUG
+ fprintf(DEBUG_OUT, "Removed attrlistref (%d) (count=%d)\n", b,
+ attr_list_ref(b));
+#endif
+ if (attr_list_ref(b) == 0) {
+ if (b == attr_list_cache)
+ attr_list_cache = cache_disabled;
+ free_node_chain(b, attribute_node_size);
+ }
+ /* maintain sanity */
+ if (attr_list_ref(b) < 0)
+ attr_list_ref(b) = 0;
+ }
+}
+
+@ |p| is an attr list head, or zero
+@c
+halfword do_set_attribute(halfword p, int i, int val)
+{
+ register halfword q;
+ register int j = 0;
+ if (p == null) { /* add a new head \& node */
+ q = get_node(attribute_node_size);
+ type(q) = attribute_list_node;
+ attr_list_ref(q) = 1;
+ p = new_attribute_node((unsigned) i, val);
+ vlink(q) = p;
+ return q;
+ }
+ q = p;
+ assert(vlink(p) != null);
+ while (vlink(p) != null) {
+ int t = attribute_id(vlink(p));
+ if (t == i && attribute_value(vlink(p)) == val)
+ return q; /* no need to do anything */
+ if (t >= i)
+ break;
+ j++;
+ p = vlink(p);
+ }
+
+ p = q;
+ while (j-- > 0)
+ p = vlink(p);
+ if (attribute_id(vlink(p)) == i) {
+ attribute_value(vlink(p)) = val;
+ } else { /* add a new node */
+ halfword r = new_attribute_node((unsigned) i, val);
+ vlink(r) = vlink(p);
+ vlink(p) = r;
+ }
+ return q;
+}
+
+@ @c
+void set_attribute(halfword n, int i, int val)
+{
+ register halfword p;
+ register int j = 0;
+ if (!nodetype_has_attributes(type(n)))
+ return;
+ p = node_attr(n);
+ if (p == null) { /* add a new head \& node */
+ p = get_node(attribute_node_size);
+ type(p) = attribute_list_node;
+ attr_list_ref(p) = 1;
+ node_attr(n) = p;
+ p = new_attribute_node((unsigned) i, val);
+ vlink(node_attr(n)) = p;
+ return;
+ }
+ assert(vlink(p) != null);
+ while (vlink(p) != null) {
+ int t = attribute_id(vlink(p));
+ if (t == i && attribute_value(vlink(p)) == val)
+ return;
+ if (t >= i)
+ break;
+ j++;
+ p = vlink(p);
+ }
+ p = node_attr(n);
+ if (attr_list_ref(p) != 1) {
+ if (attr_list_ref(p) > 1) {
+ p = copy_attribute_list(p);
+ delete_attribute_ref(node_attr(n));
+ node_attr(n) = p;
+ } else {
+ fprintf(stdout,
+ "Node %d has an attribute list that is free already\n",
+ (int) n);
+ }
+ attr_list_ref(p) = 1;
+ }
+ while (j-- > 0)
+ p = vlink(p);
+
+ if (attribute_id(vlink(p)) == i) {
+ attribute_value(vlink(p)) = val;
+ } else { /* add a new node */
+ halfword r = new_attribute_node((unsigned) i, val);
+ vlink(r) = vlink(p);
+ vlink(p) = r;
+ }
+ return;
+}
+
+
+@ @c
+int unset_attribute(halfword n, int i, int val)
+{
+ register halfword p;
+ register int t;
+ register int j = 0;
+
+ if (!nodetype_has_attributes(type(n)))
+ return null;
+ p = node_attr(n);
+ if (p == null)
+ return UNUSED_ATTRIBUTE;
+ if (attr_list_ref(p) == 0) {
+ fprintf(stdout,
+ "Node %d has an attribute list that is free already\n",
+ (int) n);
+ return UNUSED_ATTRIBUTE;
+ }
+ assert(vlink(p) != null);
+ while (vlink(p) != null) {
+ t = attribute_id(vlink(p));
+ if (t > i)
+ return UNUSED_ATTRIBUTE;
+ if (t == i) {
+ p = vlink(p);
+ break;
+ }
+ j++;
+ p = vlink(p);
+ }
+ if (attribute_id(p) != i)
+ return UNUSED_ATTRIBUTE;
+ /* if we are still here, the attribute exists */
+ p = node_attr(n);
+ if (attr_list_ref(p) > 1 || p == attr_list_cache) {
+ halfword q = copy_attribute_list(p);
+ if (attr_list_ref(p) > 1) {
+ delete_attribute_ref(node_attr(n));
+ }
+ attr_list_ref(q) = 1;
+ node_attr(n) = q;
+ }
+ p = vlink(node_attr(n));
+ while (j-- > 0)
+ p = vlink(p);
+ t = attribute_value(p);
+ if (val == UNUSED_ATTRIBUTE || t == val) {
+ attribute_value(p) = UNUSED_ATTRIBUTE;
+ }
+ return t;
+}
+
+@ @c
+int has_attribute(halfword n, int i, int val)
+{
+ register halfword p;
+ if (!nodetype_has_attributes(type(n)))
+ return UNUSED_ATTRIBUTE;
+ p = node_attr(n);
+ if (p == null || vlink(p) == null)
+ return UNUSED_ATTRIBUTE;
+ p = vlink(p);
+ while (p != null) {
+ if (attribute_id(p) == i) {
+ int ret = attribute_value(p);
+ if (val == UNUSED_ATTRIBUTE || val == ret)
+ return ret;
+ return UNUSED_ATTRIBUTE;
+ } else if (attribute_id(p) > i) {
+ return UNUSED_ATTRIBUTE;
+ }
+ p = vlink(p);
+ }
+ return UNUSED_ATTRIBUTE;
+}
+
+@ @c
+void print_short_node_contents(halfword p)
+{
+ switch (type(p)) {
+ case hlist_node:
+ case vlist_node:
+ case ins_node:
+ case whatsit_node:
+ case mark_node:
+ case adjust_node:
+ case unset_node:
+ print_char('[');
+ print_char(']');
+ break;
+ case rule_node:
+ print_char('|');
+ break;
+ case glue_node:
+ if (glue_ptr(p) != zero_glue)
+ print_char(' ');
+ break;
+ case math_node:
+ print_char('$');
+ break;
+ case disc_node:
+ short_display(vlink(pre_break(p)));
+ short_display(vlink(post_break(p)));
+ break;
+ default:
+ assert(1);
+ break;
+ }
+}
+
+
+@ @c
+static void show_pdftex_whatsit_rule_spec(int p)
+{
+ tprint("(");
+ print_rule_dimen(height(p));
+ print_char('+');
+ print_rule_dimen(depth(p));
+ tprint(")x");
+ print_rule_dimen(width(p));
+}
+
+
+
+@ Each new type of node that appears in our data structure must be capable
+of being displayed, copied, destroyed, and so on. The routines that we
+need for write-oriented whatsits are somewhat like those for mark nodes;
+other extensions might, of course, involve more subtlety here.
+
+@c
+static void print_write_whatsit(const char *s, pointer p)
+{
+ tprint_esc(s);
+ if (write_stream(p) < 16)
+ print_int(write_stream(p));
+ else if (write_stream(p) == 16)
+ print_char('*');
+ else
+ print_char('-');
+}
+
+
+@ @c
+static void show_whatsit_node(int p)
+{
+ switch (subtype(p)) {
+ case open_node:
+ print_write_whatsit("openout", p);
+ print_char('=');
+ print_file_name(open_name(p), open_area(p), open_ext(p));
+ break;
+ case write_node:
+ print_write_whatsit("write", p);
+ print_mark(write_tokens(p));
+ break;
+ case close_node:
+ print_write_whatsit("closeout", p);
+ break;
+ case special_node:
+ tprint_esc("special");
+ print_mark(write_tokens(p));
+ break;
+ case dir_node:
+ if (dir_dir(p) < 0) {
+ tprint_esc("enddir");
+ print_char(' ');
+ print_dir(dir_dir(p) + 64);
+ } else {
+ tprint_esc("begindir");
+ print_char(' ');
+ print_dir(dir_dir(p));
+ }
+ break;
+ case local_par_node:
+ tprint_esc("whatsit");
+ append_char('.');
+ print_ln();
+ print_current_string();
+ tprint_esc("localinterlinepenalty");
+ print_char('=');
+ print_int(local_pen_inter(p));
+ print_ln();
+ print_current_string();
+ tprint_esc("localbrokenpenalty");
+ print_char('=');
+ print_int(local_pen_broken(p));
+ print_ln();
+ print_current_string();
+ tprint_esc("localleftbox");
+ if (local_box_left(p) == null) {
+ tprint("=null");
+ } else {
+ append_char('.');
+ show_node_list(local_box_left(p));
+ decr(cur_length);
+ }
+ print_ln();
+ print_current_string();
+ tprint_esc("localrightbox");
+ if (local_box_right(p) == null) {
+ tprint("=null");
+ } else {
+ append_char('.');
+ show_node_list(local_box_right(p));
+ decr(cur_length);
+ }
+ decr(cur_length);
+ break;
+ case pdf_literal_node:
+ show_pdf_literal(p);
+ break;
+ case pdf_colorstack_node:
+ tprint_esc("pdfcolorstack ");
+ print_int(pdf_colorstack_stack(p));
+ switch (pdf_colorstack_cmd(p)) {
+ case colorstack_set:
+ tprint(" set ");
+ break;
+ case colorstack_push:
+ tprint(" push ");
+ break;
+ case colorstack_pop:
+ tprint(" pop");
+ break;
+ case colorstack_current:
+ tprint(" current");
+ break;
+ default:
+ confusion("pdfcolorstack");
+ break;
+ }
+ if (pdf_colorstack_cmd(p) <= colorstack_data)
+ print_mark(pdf_colorstack_data(p));
+ break;
+ case pdf_setmatrix_node:
+ tprint_esc("pdfsetmatrix");
+ print_mark(pdf_setmatrix_data(p));
+ break;
+ case pdf_save_node:
+ tprint_esc("pdfsave");
+ break;
+ case pdf_restore_node:
+ tprint_esc("pdfrestore");
+ break;
+ case cancel_boundary_node:
+ tprint_esc("noboundary");
+ break;
+ case late_lua_node:
+ show_late_lua(p);
+ break;
+ case close_lua_node:
+ tprint_esc("closelua");
+ print_int(late_lua_reg(p));
+ break;
+ case pdf_refobj_node:
+ tprint_esc("pdfrefobj");
+ if (obj_obj_is_stream(static_pdf, pdf_obj_objnum(p))) {
+ if (obj_obj_stream_attr(static_pdf, pdf_obj_objnum(p)) != LUA_NOREF) {
+ tprint(" attr");
+ lua_rawgeti(Luas, LUA_REGISTRYINDEX,
+ obj_obj_stream_attr(static_pdf, pdf_obj_objnum(p)));
+ print_char(' ');
+ tprint((const char *) lua_tostring(Luas, -1));
+ lua_pop(Luas, 1);
+ }
+ tprint(" stream");
+ }
+ if (obj_obj_is_file(static_pdf, pdf_obj_objnum(p)))
+ tprint(" file");
+ if (obj_obj_data(static_pdf, pdf_obj_objnum(p)) != LUA_NOREF) {
+ lua_rawgeti(Luas, LUA_REGISTRYINDEX,
+ obj_obj_data(static_pdf, pdf_obj_objnum(p)));
+ print_char(' ');
+ tprint((const char *) lua_tostring(Luas, -1));
+ lua_pop(Luas, 1);
+ }
+ break;
+ case pdf_refxform_node:
+ case pdf_refximage_node:
+ if (subtype(p) == pdf_refxform_node)
+ tprint_esc("pdfrefxform");
+ else
+ tprint_esc("pdfrefximage");
+ tprint("(");
+ print_scaled(height(p));
+ print_char('+');
+ print_scaled(depth(p));
+ tprint(")x");
+ print_scaled(width(p));
+ break;
+ case pdf_annot_node:
+ tprint_esc("pdfannot");
+ show_pdftex_whatsit_rule_spec(p);
+ print_mark(pdf_annot_data(p));
+ break;
+ case pdf_start_link_node:
+ tprint_esc("pdfstartlink");
+ show_pdftex_whatsit_rule_spec(p);
+ if (pdf_link_attr(p) != null) {
+ tprint(" attr");
+ print_mark(pdf_link_attr(p));
+ }
+ tprint(" action");
+ if (pdf_action_type(pdf_link_action(p)) == pdf_action_user) {
+ tprint(" user");
+ print_mark(pdf_action_tokens(pdf_link_action(p)));
+ return;
+ }
+ if (pdf_action_file(pdf_link_action(p)) != null) {
+ tprint(" file");
+ print_mark(pdf_action_file(pdf_link_action(p)));
+ }
+ switch (pdf_action_type(pdf_link_action(p))) {
+ case pdf_action_goto:
+ if (pdf_action_named_id(pdf_link_action(p)) > 0) {
+ tprint(" goto name");
+ print_mark(pdf_action_id(pdf_link_action(p)));
+ } else {
+ tprint(" goto num");
+ print_int(pdf_action_id(pdf_link_action(p)));
+ }
+ break;
+ case pdf_action_page:
+ tprint(" page");
+ print_int(pdf_action_id(pdf_link_action(p)));
+ print_mark(pdf_action_tokens(pdf_link_action(p)));
+ break;
+ case pdf_action_thread:
+ if (pdf_action_named_id(pdf_link_action(p)) > 0) {
+ tprint(" thread name");
+ print_mark(pdf_action_id(pdf_link_action(p)));
+ } else {
+ tprint(" thread num");
+ print_int(pdf_action_id(pdf_link_action(p)));
+ }
+ break;
+ default:
+ pdf_error("displaying", "unknown action type");
+ break;
+ }
+ break;
+ case pdf_end_link_node:
+ tprint_esc("pdfendlink");
+ break;
+ case pdf_dest_node:
+ tprint_esc("pdfdest");
+ if (pdf_dest_named_id(p) > 0) {
+ tprint(" name");
+ print_mark(pdf_dest_id(p));
+ } else {
+ tprint(" num");
+ print_int(pdf_dest_id(p));
+ }
+ print_char(' ');
+ switch (pdf_dest_type(p)) {
+ case pdf_dest_xyz:
+ tprint("xyz");
+ if (pdf_dest_xyz_zoom(p) != null) {
+ tprint(" zoom");
+ print_int(pdf_dest_xyz_zoom(p));
+ }
+ break;
+ case pdf_dest_fitbh:
+ tprint("fitbh");
+ break;
+ case pdf_dest_fitbv:
+ tprint("fitbv");
+ break;
+ case pdf_dest_fitb:
+ tprint("fitb");
+ break;
+ case pdf_dest_fith:
+ tprint("fith");
+ break;
+ case pdf_dest_fitv:
+ tprint("fitv");
+ break;
+ case pdf_dest_fitr:
+ tprint("fitr");
+ show_pdftex_whatsit_rule_spec(p);
+ break;
+ case pdf_dest_fit:
+ tprint("fit");
+ break;
+ default:
+ tprint("unknown!");
+ break;
+ }
+ break;
+ case pdf_thread_node:
+ case pdf_start_thread_node:
+ if (subtype(p) == pdf_thread_node)
+ tprint_esc("pdfthread");
+ else
+ tprint_esc("pdfstartthread");
+ tprint("(");
+ print_rule_dimen(height(p));
+ print_char('+');
+ print_rule_dimen(depth(p));
+ tprint(")x");
+ print_rule_dimen(width(p));
+ if (pdf_thread_attr(p) != null) {
+ tprint(" attr");
+ print_mark(pdf_thread_attr(p));
+ }
+ if (pdf_thread_named_id(p) > 0) {
+ tprint(" name");
+ print_mark(pdf_thread_id(p));
+ } else {
+ tprint(" num");
+ print_int(pdf_thread_id(p));
+ }
+ break;
+ case pdf_end_thread_node:
+ tprint_esc("pdfendthread");
+ break;
+ case pdf_save_pos_node:
+ tprint_esc("pdfsavepos");
+ break;
+ case user_defined_node:
+ tprint_esc("whatsit");
+ print_int(user_node_id(p));
+ print_char('=');
+ switch (user_node_type(p)) {
+ case 'a':
+ tprint("<>");
+ break;
+ case 'n':
+ tprint("[");
+ show_node_list(user_node_value(p));
+ tprint("]");
+ break;
+ case 's':
+ print_char('"');
+ print(user_node_value(p));
+ print_char('"');
+ break;
+ case 't':
+ print_mark(user_node_value(p));
+ break;
+ default: /* only 'd' */
+ print_int(user_node_value(p));
+ break;
+ }
+ break;
+ default:
+ tprint("whatsit?");
+ break;
+ }
+}
+
+
+
+@ 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
+ 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.
+
+
+@ |str_room| need not be checked; see |show_box|
+
+@ Recursive calls on |show_node_list| therefore use the following pattern:
+@c
+#define node_list_display(A) do { \
+ append_char('.'); \
+ show_node_list(A); \
+ flush_char(); \
+} while (0)
+
+void show_node_list(int p)
+{ /* prints a node list symbolically */
+ int n; /* the number of items already printed at this level */
+ real g; /* a glue ratio, as a floating point number */
+ if ((int) cur_length > depth_threshold) {
+ if (p > null)
+ tprint(" []"); /* indicate that there's been some truncation */
+ return;
+ }
+ n = 0;
+ while (p != null) {
+ print_ln();
+ print_current_string(); /* display the nesting history */
+ if (int_par(tracing_online_code) < -2)
+ print_int(p);
+ incr(n);
+ if (n > breadth_max) { /* time to stop */
+ tprint("etc.");
+ return;
+ }
+ /* Display node |p| */
+ if (is_char_node(p)) {
+ print_font_and_char(p);
+ if (is_ligature(p)) {
+ /* Display ligature |p|; */
+ tprint(" (ligature ");
+ if (is_leftboundary(p))
+ print_char('|');
+ font_in_short_display = font(p);
+ short_display(lig_ptr(p));
+ if (is_rightboundary(p))
+ print_char('|');
+ print_char(')');
+ }
+ } else {
+ switch (type(p)) {
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ /* Display box |p|; */
+ if (type(p) == hlist_node)
+ tprint_esc("h");
+ else if (type(p) == vlist_node)
+ tprint_esc("v");
+ else
+ tprint_esc("unset");
+ tprint("box(");
+ print_scaled(height(p));
+ print_char('+');
+ print_scaled(depth(p));
+ tprint(")x");
+ print_scaled(width(p));
+ if (type(p) == unset_node) {
+ /* Display special fields of the unset node |p|; */
+ if (span_count(p) != min_quarterword) {
+ tprint(" (");
+ print_int(span_count(p) + 1);
+ tprint(" columns)");
+ }
+ if (glue_stretch(p) != 0) {
+ tprint(", stretch ");
+ print_glue(glue_stretch(p), glue_order(p), NULL);
+ }
+ if (glue_shrink(p) != 0) {
+ tprint(", shrink ");
+ print_glue(glue_shrink(p), glue_sign(p), NULL);
+ }
+ } else {
+ /* Display the value of |glue_set(p)| */
+ /* 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.
+ */
+
+ g = (real) (glue_set(p));
+ if ((g != 0.0) && (glue_sign(p) != normal)) {
+ tprint(", glue set ");
+ if (glue_sign(p) == shrinking)
+ tprint("- ");
+ if (g > 20000.0 || g < -20000.0) {
+ if (g > 0.0)
+ print_char('>');
+ else
+ tprint("< -");
+ print_glue(20000 * unity, glue_order(p), NULL);
+ } else {
+ print_glue(round(unity * g), glue_order(p), NULL);
+ }
+ }
+
+ if (shift_amount(p) != 0) {
+ tprint(", shifted ");
+ print_scaled(shift_amount(p));
+ }
+ tprint(", direction ");
+ print_dir(box_dir(p));
+ }
+ node_list_display(list_ptr(p)); /* recursive call */
+ break;
+ case rule_node:
+ /* Display rule |p|; */
+ tprint_esc("rule(");
+ print_rule_dimen(height(p));
+ print_char('+');
+ print_rule_dimen(depth(p));
+ tprint(")x");
+ print_rule_dimen(width(p));
+ break;
+ case ins_node:
+ /* Display insertion |p|; */
+ tprint_esc("insert");
+ print_int(subtype(p));
+ tprint(", natural size ");
+ print_scaled(height(p));
+ tprint("; split(");
+ print_spec(split_top_ptr(p), NULL);
+ print_char(',');
+ print_scaled(depth(p));
+ tprint("); float cost ");
+ print_int(float_cost(p));
+ node_list_display(ins_ptr(p)); /* recursive call */
+ break;
+ case whatsit_node:
+ show_whatsit_node(p);
+ break;
+ case glue_node:
+ /* Display glue |p|; */
+ if (subtype(p) >= a_leaders) {
+ /* Display leaders |p|; */
+ tprint_esc("");
+ switch (subtype(p)) {
+ case a_leaders:
+ break;
+ case c_leaders:
+ print_char('c');
+ break;
+ case x_leaders:
+ print_char('x');
+ break;
+ case g_leaders:
+ print_char('g');
+ break;
+ default:
+ assert(0);
+ }
+ tprint("leaders ");
+ print_spec(glue_ptr(p), NULL);
+ node_list_display(leader_ptr(p)); /* recursive call */
+ } else {
+ tprint_esc("glue");
+ if (subtype(p) != normal) {
+ print_char('(');
+ if ((subtype(p) - 1) < thin_mu_skip_code) {
+ print_cmd_chr(assign_glue_cmd,
+ glue_base + (subtype(p) - 1));
+ } else if (subtype(p) < cond_math_glue) {
+ print_cmd_chr(assign_mu_glue_cmd,
+ glue_base + (subtype(p) - 1));
+ } else if (subtype(p) == cond_math_glue) {
+ tprint_esc("nonscript");
+ } else {
+ tprint_esc("mskip");
+ }
+ print_char(')');
+ }
+ if (subtype(p) != cond_math_glue) {
+ print_char(' ');
+ if (subtype(p) < cond_math_glue)
+ print_spec(glue_ptr(p), NULL);
+ else
+ print_spec(glue_ptr(p), "mu");
+ }
+ }
+ break;
+ case margin_kern_node:
+ tprint_esc("kern");
+ print_scaled(width(p));
+ if (subtype(p) == left_side)
+ tprint(" (left margin)");
+ else
+ tprint(" (right margin)");
+ break;
+ case kern_node:
+ /* Display kern |p|; */
+ /* An ``explicit'' kern value is indicated implicitly by an explicit space. */
+ if (subtype(p) != mu_glue) {
+ tprint_esc("kern");
+ if (subtype(p) != normal)
+ print_char(' ');
+ print_scaled(width(p));
+ if (subtype(p) == acc_kern)
+ tprint(" (for accent)");
+ } else {
+ tprint_esc("mkern");
+ print_scaled(width(p));
+ tprint("mu");
+ }
+ break;
+ case math_node:
+ /* Display math node |p|; */
+ tprint_esc("math");
+ if (subtype(p) == before)
+ tprint("on");
+ else
+ tprint("off");
+ if (width(p) != 0) {
+ tprint(", surrounded ");
+ print_scaled(width(p));
+ }
+ break;
+ case penalty_node:
+ /* Display penalty |p|; */
+ tprint_esc("penalty ");
+ print_int(penalty(p));
+ break;
+ case disc_node:
+ /* Display discretionary |p|; */
+ /* The |post_break| list of a discretionary node is indicated by a prefixed
+ `\.{\char'174}' instead of the `\..' before the |pre_break| list. */
+ tprint_esc("discretionary");
+ if (vlink(no_break(p)) != null) {
+ tprint(" replacing ");
+ node_list_display(vlink(no_break(p)));
+ }
+ node_list_display(vlink(pre_break(p))); /* recursive call */
+ append_char('|');
+ show_node_list(vlink(post_break(p)));
+ flush_char(); /* recursive call */
+ break;
+ case mark_node:
+ /* Display mark |p|; */
+ tprint_esc("mark");
+ if (mark_class(p) != 0) {
+ print_char('s');
+ print_int(mark_class(p));
+ }
+ print_mark(mark_ptr(p));
+ break;
+ case adjust_node:
+ /* Display adjustment |p|; */
+ tprint_esc("vadjust");
+ if (adjust_pre(p) != 0)
+ tprint(" pre ");
+ node_list_display(adjust_ptr(p)); /* recursive call */
+ break;
+ case glue_spec_node:
+ tprint("<glue_spec ");
+ print_spec(p, NULL);
+ tprint(">");
+ break;
+ default:
+ show_math_node(p);
+ break;
+ }
+ }
+ p = vlink(p);
+ }
+}
+
+@ This routine finds the 'base' width of a horizontal box, using the same logic
+ that \TeX82 used for \.{\\predisplaywidth} */
+
+@c
+pointer actual_box_width(pointer r, scaled base_width)
+{
+ scaled w; /* calculated |size| */
+ pointer p; /* current node when calculating |pre_display_size| */
+ pointer q; /* glue specification when calculating |pre_display_size| */
+ scaled d; /* increment to |v| */
+ scaled v; /* |w| plus possible glue amount */
+ w = -max_dimen;
+ v = shift_amount(r) + base_width;
+ p = list_ptr(r);
+ while (p != null) {
+ if (is_char_node(p)) {
+ d = glyph_width(p);
+ goto found;
+ }
+ switch (type(p)) {
+ case hlist_node:
+ case vlist_node:
+ case rule_node:
+ d = width(p);
+ goto found;
+ break;
+ case margin_kern_node:
+ d = width(p);
+ break;
+ case kern_node:
+ d = width(p);
+ break;
+ case math_node:
+ d = surround(p);
+ break;
+ case glue_node:
+ /* We need to be careful that |w|, |v|, and |d| do not depend on any |glue_set|
+ values, since such values are subject to system-dependent rounding.
+ System-dependent numbers are not allowed to infiltrate parameters like
+ |pre_display_size|, since \TeX82 is supposed to make the same decisions on all
+ machines.
+ */
+ q = glue_ptr(p);
+ d = width(q);
+ if (glue_sign(r) == stretching) {
+ if ((glue_order(r) == stretch_order(q))
+ && (stretch(q) != 0))
+ v = max_dimen;
+ } else if (glue_sign(r) == shrinking) {
+ if ((glue_order(r) == shrink_order(q))
+ && (shrink(q) != 0))
+ v = max_dimen;
+ }
+ if (subtype(p) >= a_leaders)
+ goto found;
+ break;
+ case whatsit_node:
+ if ((subtype(p) == pdf_refxform_node)
+ || (subtype(p) == pdf_refximage_node))
+ d = width(p);
+ else
+ d = 0;
+ break;
+ default:
+ d = 0;
+ break;
+ }
+ if (v < max_dimen)
+ v = v + d;
+ goto not_found;
+ found:
+ if (v < max_dimen) {
+ v = v + d;
+ w = v;
+ } else {
+ w = max_dimen;
+ break;
+ }
+ not_found:
+ p = vlink(p);
+ }
+ return w;
+}
+
+
+@ @c
+halfword tail_of_list(halfword p)
+{
+ halfword q = p;
+ while (vlink(q) != null)
+ q = vlink(q);
+ return q;
+}
+
+
+@ |delete_glue_ref| is called when a pointer to a glue
+ specification is being withdrawn.
+
+@c
+#define fast_delete_glue_ref(A) do { \
+ if (glue_ref_count(A)==null) { \
+ flush_node(A); \
+ } else { \
+ decr(glue_ref_count(A)); \
+ } \
+ } while (0)
+
+void delete_glue_ref(halfword p)
+{ /* |p| points to a glue specification */
+ assert(type(p) == glue_spec_node);
+ fast_delete_glue_ref(p);
+}
+
+@ @c
+int var_used;
+halfword temp_ptr; /* a pointer variable for occasional emergency use */
+
+
+@ Attribute lists need two extra globals to increase processing efficiency.
+|max_used_attr| limits the test loop that checks for set attributes, and
+|attr_list_cache| contains a pointer to an already created attribute list. It is
+set to the special value |cache_disabled| when the current value can no longer be
+trusted: after an assignment to an attribute register, and after a group has
+ended.
+
+@c
+int max_used_attr; /* maximum assigned attribute id */
+halfword attr_list_cache;
+
+@ From the computer's standpoint, \TeX's chief mission is to create
+horizontal and vertical lists. We shall now investigate how the elements
+of these lists are represented internally as nodes in the dynamic memory.
+
+A horizontal or vertical list is linked together by |link| fields in
+the first word of each node. Individual nodes represent boxes, glue,
+penalties, or special things like discretionary hyphens; because of this
+variety, some nodes are longer than others, and we must distinguish different
+kinds of nodes. We do this by putting a `|type|' field in the first word,
+together with the link and an optional `|subtype|'.
+
+
+@ Character nodes appear only in horizontal lists, never in vertical lists.
+
+An |hlist_node| stands for a box that was made from a horizontal list.
+Each |hlist_node| is seven words long, and contains the following fields
+(in addition to the mandatory |type| and |link|, which we shall not
+mention explicitly when discussing the other node types): The |height| and
+|width| and |depth| are scaled integers denoting the dimensions of the
+box. There is also a |shift_amount| field, a scaled integer indicating
+how much this box should be lowered (if it appears in a horizontal list),
+or how much it should be moved to the right (if it appears in a vertical
+list). There is a |list_ptr| field, which points to the beginning of the
+list from which this box was fabricated; if |list_ptr| is |null|, the box
+is empty. Finally, there are three fields that represent the setting of
+the glue: |glue_set(p)| is a word of type |glue_ratio| that represents
+the proportionality constant for glue setting; |glue_sign(p)| is
+|stretching| or |shrinking| or |normal| depending on whether or not the
+glue should stretch or shrink or remain rigid; and |glue_order(p)|
+specifies the order of infinity to which glue setting applies (|normal|,
+|sfi|, |fil|, |fill|, or |filll|). The |subtype| field is not used.
+
+@ 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|.
+
+@c
+halfword new_null_box(void)
+{ /* creates a new box node */
+ halfword p; /* the new node */
+ p = new_node(hlist_node, min_quarterword);
+ box_dir(p) = text_direction;
+ return p;
+}
+
+
+@ A |vlist_node| is like an |hlist_node| in all respects except that it
+contains a vertical list.
+
+
+@ A |rule_node| stands for a solid black rectangle; it has |width|,
+|depth|, and |height| fields just as in an |hlist_node|. However, if
+any of these dimensions is $-2^{30}$, the actual value will be determined
+by running the rule up to the boundary of the innermost enclosing box.
+This is called a ``running dimension.'' The |width| is never running in
+an hlist; the |height| and |depth| are never running in a~vlist.
+
+@ 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.
+
+@c
+halfword new_rule(void)
+{
+ halfword p; /* the new node */
+ p = new_node(rule_node, 0); /* the |subtype| is not used */
+ return p;
+}
+
+
+@ 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.
+
+@ 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.
+
+@ 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.
+
+@ A |glyph_node|, which occurs only in horizontal lists, specifies a
+glyph in a particular font, along with its attribute list. Older
+versions of \TeX\ could use token memory for characters, because the
+font,char combination would fit in a single word (both values were
+required to be strictly less than $2^{16}$). In LuaTeX, room is
+needed for characters that are larger than that, as well as a pointer
+to a potential attribute list, and the two displacement values.
+
+In turn, that made the node so large that it made sense to merge
+ligature glyphs as well, as that requires only one extra pointer. A
+few extra classes of glyph nodes will be introduced later. The
+unification of all those types makes it easier to manipulate lists of
+glyphs. The subtype differentiates various glyph kinds.
+
+First, here is a function that returns a pointer to a glyph node for a given
+glyph in a given font. If that glyph doesn't exist, |null| is returned
+instead. Nodes of this subtype are directly created only for accents
+and their base (through |make_accent|), and math nucleus items (in the
+conversion from |mlist| to |hlist|).
+
+@c
+halfword new_glyph(int f, int c)
+{
+ halfword p = null; /* the new node */
+ if ((f == 0) || (char_exists(f, c))) {
+ p = new_glyph_node();
+ set_to_glyph(p);
+ font(p) = f;
+ character(p) = c;
+ }
+ return p;
+}
+
+
+@ A subset of the glyphs nodes represent ligatures: characters
+fabricated from the interaction of two or more actual characters. The
+characters that generated the ligature have not been forgotten, since
+they are needed for diagnostic messages; the |lig_ptr| field points to
+a linked list of character nodes for all original characters that have
+been deleted. (This list might be empty if the characters that
+generated the ligature were retained in other nodes.)
+
+The |subtype| field of these |glyph_node|s is 1, plus 2 and/or 1 if
+the original source of the ligature included implicit left and/or
+right boundaries. These nodes are created by the C function |new_ligkern|.
+
+A third general type of glyphs could be called a character, as it
+only appears in lists that are not yet processed by the ligaturing and
+kerning steps of the program.
+
+|main_control| inserts these, and they are later converted to
+|subtype_normal| by |new_ligkern|.
+
+@c
+quarterword norm_min(int h)
+{
+ if (h <= 0)
+ return 1;
+ else if (h >= 255)
+ return 255;
+ else
+ return (quarterword) h;
+}
+
+halfword new_char(int f, int c)
+{
+ halfword p; /* the new node */
+ p = new_glyph_node();
+ set_to_character(p);
+ font(p) = f;
+ character(p) = c;
+ lang_data(p) =
+ make_lang_data(uc_hyph, cur_lang, left_hyphen_min, right_hyphen_min);
+ return p;
+}
+
+
+@ Left and right ghost glyph nodes are the result of \.{\\leftghost}
+and \.{\\rightghost}, respectively. They are going to be removed by
+|new_ligkern|, at the end of which they are no longer needed.
+
+@ Here are a few handy helpers used by the list output routines.
+
+@c
+scaled glyph_width(halfword p)
+{
+ scaled w;
+ w = char_width(font(p), character(p));
+ return w;
+}
+
+scaled glyph_height(halfword p)
+{
+ scaled w;
+ w = char_height(font(p), character(p)) + y_displace(p);
+ if (w < 0)
+ w = 0;
+ return w;
+}
+
+scaled glyph_depth(halfword p)
+{
+ scaled w;
+ w = char_depth(font(p), character(p));
+ if (y_displace(p) > 0)
+ w = w - y_displace(p);
+ if (w < 0)
+ w = 0;
+ return w;
+}
+
+
+@ A |disc_node|, which occurs only in horizontal lists, specifies a
+``dis\-cretion\-ary'' line break. If such a break occurs at node |p|, the text
+that starts at |pre_break(p)| will precede the break, the text that starts at
+|post_break(p)| will follow the break, and text that appears in
+|no_break(p)| nodes will be ignored. For example, an ordinary
+discretionary hyphen, indicated by `\.{\\-}', yields a |disc_node| with
+|pre_break| pointing to a |char_node| containing a hyphen, |post_break=null|,
+and |no_break=null|.
+
+{TODO: Knuth said: All three of the discretionary texts must be lists
+that consist entirely of character, kern, box and rule nodes.}
+
+If |subtype(p)=automatic_disc|, the |ex_hyphen_penalty| will be charged for this
+break. Otherwise the |hyphen_penalty| will be charged. The texts will
+actually be substituted into the list by the line-breaking algorithm if it
+decides to make the break, and the discretionary node will disappear at
+that time; thus, the output routine sees only discretionaries that were
+not chosen.
+
+@c
+halfword new_disc(void)
+{ /* creates an empty |disc_node| */
+ halfword p; /* the new node */
+ p = new_node(disc_node, 0);
+ return p;
+}
+
+@ A |whatsit_node| is a wild card reserved for extensions to \TeX. The
+|subtype| field in its first word says what `\\{whatsit}' it is, and
+implicitly determines the node size (which must be 2 or more) and the
+format of the remaining words. When a |whatsit_node| is encountered
+in a list, special actions are invoked; knowledgeable people who are
+careful not to mess up the rest of \TeX\ are able to make \TeX\ do new
+things by adding code at the end of the program. For example, there
+might be a `\TeX nicolor' extension to specify different colors of ink,
+@^extensions to \TeX@>
+and the whatsit node might contain the desired parameters.
+
+The present implementation of \TeX\ treats the features associated with
+`\.{\\write}' and `\.{\\special}' as if they were extensions, in order to
+illustrate how such routines might be coded. We shall defer further
+discussion of extensions until the end of this program.
+
+@ A |math_node|, which occurs only in horizontal lists, appears before and
+after mathematical formulas. The |subtype| field is |before| before the
+formula and |after| after it. There is a |surround| field, which represents
+the amount of surrounding space inserted by \.{\\mathsurround}.
+
+@c
+halfword new_math(scaled w, int s)
+{
+ halfword p; /* the new node */
+ p = new_node(math_node, s);
+ surround(p) = w;
+ return p;
+}
+
+@ \TeX\ makes use of the fact that |hlist_node|, |vlist_node|,
+|rule_node|, |ins_node|, |mark_node|, |adjust_node|,
+|disc_node|, |whatsit_node|, and |math_node| are at the low end of the
+type codes, by permitting a break at glue in a list if and only if the
+|type| of the previous node is less than |math_node|. Furthermore, a
+node is discarded after a break if its type is |math_node| or~more.
+
+@ A |glue_node| represents glue in a list. However, it is really only
+a pointer to a separate glue specification, since \TeX\ makes use of the
+fact that many essentially identical nodes of glue are usually present.
+If |p| points to a |glue_node|, |glue_ptr(p)| points to
+another packet of words that specify the stretch and shrink components, etc.
+
+Glue nodes also serve to represent leaders; the |subtype| is used to
+distinguish between ordinary glue (which is called |normal|) and the three
+kinds of leaders (which are called |a_leaders|, |c_leaders|, and |x_leaders|).
+The |leader_ptr| field points to a rule node or to a box node containing the
+leaders; it is set to |null| in ordinary glue nodes.
+
+Many kinds of glue are computed from \TeX's ``skip'' parameters, and
+it is helpful to know which parameter has led to a particular glue node.
+Therefore the |subtype| is set to indicate the source of glue, whenever
+it originated as a parameter. We will be defining symbolic names for the
+parameter numbers later (e.g., |line_skip_code=0|, |baseline_skip_code=1|,
+etc.); it suffices for now to say that the |subtype| of parametric glue
+will be the same as the parameter number, plus~one.
+
+@ In math formulas there are two more possibilities for the |subtype| in a
+glue node: |mu_glue| denotes an \.{\\mskip} (where the units are scaled \.{mu}
+instead of scaled \.{pt}); and |cond_math_glue| denotes the `\.{\\nonscript}'
+feature that cancels the glue node immediately following if it appears
+in a subscript.
+
+@ A glue specification has a halfword reference count in its first word,
+@^reference counts@>
+representing |null| plus the number of glue nodes that point to it (less one).
+Note that the reference count appears in the same position as
+the |link| field in list nodes; this is the field that is initialized
+to |null| when a node is allocated, and it is also the field that is flagged
+by |empty_flag| in empty nodes.
+
+Glue specifications also contain three |scaled| fields, for the |width|,
+|stretch|, and |shrink| dimensions. Finally, there are two one-byte
+fields called |stretch_order| and |shrink_order|; these contain the
+orders of infinity (|normal|, |sfi|, |fil|, |fill|, or |filll|)
+corresponding to the stretch and shrink values.
+
+@ 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.
+
+@c
+halfword new_spec(halfword p)
+{ /* duplicates a glue specification */
+ halfword q; /* the new spec */
+ q = copy_node(p);
+ glue_ref_count(q) = null;
+ return q;
+}
+
+@ 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}.
+
+@c
+halfword new_param_glue(int n)
+{
+ halfword p; /* the new node */
+ halfword q; /* the glue specification */
+ p = new_node(glue_node, n + 1);
+ q = glue_par(n);
+ glue_ptr(p) = q;
+ incr(glue_ref_count(q));
+ return p;
+}
+
+@ Glue nodes that are more or less anonymous are created by |new_glue|,
+whose argument points to a glue specification.
+
+@c
+halfword new_glue(halfword q)
+{
+ halfword p; /* the new node */
+ p = new_node(glue_node, normal);
+ glue_ptr(p) = q;
+ incr(glue_ref_count(q));
+ return p;
+}
+
+@ 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.
+
+@c
+halfword new_skip_param(int n)
+{
+ halfword p; /* the new node */
+ temp_ptr = new_spec(glue_par(n));
+ p = new_glue(temp_ptr);
+ glue_ref_count(temp_ptr) = null;
+ subtype(p) = (quarterword) (n + 1);
+ return p;
+}
+
+@ 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).
+
+@ The |new_kern| function creates a kern node having a given width.
+
+@c
+halfword new_kern(scaled w)
+{
+ halfword p; /* the new node */
+ p = new_node(kern_node, normal);
+ width(p) = w;
+ return 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.
+
+@ Anyone who has been reading the last few sections of the program will
+be able to guess what comes next.
+
+@c
+halfword new_penalty(int m)
+{
+ halfword p; /* the new node */
+ p = new_node(penalty_node, 0); /* the |subtype| is not used */
+ penalty(p) = m;
+ return p;
+}
+
+@ 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.
+
+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@>
diff --git a/Build/source/texk/web2c/luatexdir/tex/textoken.w b/Build/source/texk/web2c/luatexdir/tex/textoken.w
index d120303ee66..8c12c6d8820 100644
--- a/Build/source/texk/web2c/luatexdir/tex/textoken.w
+++ b/Build/source/texk/web2c/luatexdir/tex/textoken.w
@@ -1,2413 +1,2412 @@
-% textoken.w
-%
-% Copyright 2006-2011 Taco Hoekwater <taco@@luatex.org>
-%
-% This file is part of LuaTeX.
-%
-% LuaTeX is free software; you can redistribute it and/or modify it under
-% the terms of the GNU General Public License as published by the Free
-% Software Foundation; either version 2 of the License, or (at your
-% option) any later version.
-%
-% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
-% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
-% License for more details.
-%
-% You should have received a copy of the GNU General Public License along
-% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
-
-@ @c
-static const char _svn_version[] =
- "$Id: textoken.w 4634 2013-04-21 14:45:45Z hhenkel $"
- "$URL: https://foundry.supelec.fr/svn/luatex/branches/ex-glyph/source/texk/web2c/luatexdir/tex/textoken.w $";
-
-#include "ptexlib.h"
-
-@ @c
-#define pausing int_par(pausing_code)
-#define cat_code_table int_par(cat_code_table_code)
-#define tracing_nesting int_par(tracing_nesting_code)
-#define end_line_char int_par(end_line_char_code)
-#define suppress_outer_error int_par(suppress_outer_error_code)
-
-#define every_eof equiv(every_eof_loc)
-#define box(A) equiv(box_base+(A))
-
-#define detokenized_line() (line_catcode_table==NO_CAT_TABLE)
-
-#define do_get_cat_code(a,b) do { \
- if (line_catcode_table!=DEFAULT_CAT_TABLE) \
- a=get_cat_code(line_catcode_table,b); \
- else \
- a=get_cat_code(cat_code_table,b); \
- } while (0)
-
-
-@ The \TeX\ system does nearly all of its own memory allocation, so that it
-can readily be transported into environments that do not have automatic
-facilities for strings, garbage collection, etc., and so that it can be in
-control of what error messages the user receives. The dynamic storage
-requirements of \TeX\ are handled by providing two large arrays called
-|fixmem| and |varmem| in which consecutive blocks of words are used as
-nodes by the \TeX\ routines.
-
-Pointer variables are indices into this array, or into another array
-called |eqtb| that will be explained later. A pointer variable might
-also be a special flag that lies outside the bounds of |mem|, so we
-allow pointers to assume any |halfword| value. The minimum halfword
-value represents a null pointer. \TeX\ does not assume that |mem[null]| exists.
-
-
-
-@ Locations in |fixmem| are used for storing one-word records; a conventional
-\.{AVAIL} stack is used for allocation in this array.
-
-@c
-smemory_word *fixmem; /* the big dynamic storage area */
-unsigned fix_mem_min; /* the smallest location of one-word memory in use */
-unsigned fix_mem_max; /* the largest location of one-word memory in use */
-
-
-@ In order to study the memory requirements of particular applications, it
-is possible to prepare a version of \TeX\ that keeps track of current and
-maximum memory usage. When code between the delimiters |@!stat| $\ldots$
-|tats| is not ``commented out,'' \TeX\ will run a bit slower but it will
-report these statistics when |tracing_stats| is sufficiently large.
-
-@c
-int var_used, dyn_used; /* how much memory is in use */
-
-halfword avail; /* head of the list of available one-word nodes */
-unsigned fix_mem_end; /* the last one-word node used in |mem| */
-
-halfword garbage; /* head of a junk list, write only */
-halfword temp_token_head; /* head of a temporary list of some kind */
-halfword hold_token_head; /* head of a temporary list of another kind */
-halfword omit_template; /* a constant token list */
-halfword null_list; /* permanently empty list */
-halfword backup_head; /* head of token list built by |scan_keyword| */
-
-@ @c
-void initialize_tokens(void)
-{
- halfword p;
- avail = null;
- fix_mem_end = 0;
- p = get_avail();
- temp_token_head = p;
- set_token_info(temp_token_head, 0);
- p = get_avail();
- hold_token_head = p;
- set_token_info(hold_token_head, 0);
- p = get_avail();
- omit_template = p;
- set_token_info(omit_template, 0);
- p = get_avail();
- null_list = p;
- set_token_info(null_list, 0);
- p = get_avail();
- backup_head = p;
- set_token_info(backup_head, 0);
- p = get_avail();
- garbage = p;
- set_token_info(garbage, 0);
- dyn_used = 0; /* initialize statistics */
-}
-
-@ The function |get_avail| returns a pointer to a new one-word node whose
-|link| field is null. However, \TeX\ will halt if there is no more room left.
-@^inner loop@>
-
-If the available-space list is empty, i.e., if |avail=null|,
-we try first to increase |fix_mem_end|. If that cannot be done, i.e., if
-|fix_mem_end=fix_mem_max|, we try to reallocate array |fixmem|.
-If, that doesn't work, we have to quit.
-
-@c
-halfword get_avail(void)
-{ /* single-word node allocation */
- unsigned p; /* the new node being got */
- unsigned t;
- p = (unsigned) avail; /* get top location in the |avail| stack */
- if (p != null) {
- avail = token_link(avail); /* and pop it off */
- } else if (fix_mem_end < fix_mem_max) { /* or go into virgin territory */
- incr(fix_mem_end);
- p = fix_mem_end;
- } else {
- smemory_word *new_fixmem; /* the big dynamic storage area */
- t = (fix_mem_max / 5);
- new_fixmem =
- fixmemcast(realloc
- (fixmem, sizeof(smemory_word) * (fix_mem_max + t + 1)));
- if (new_fixmem == NULL) {
- runaway(); /* if memory is exhausted, display possible runaway text */
- overflow("token memory size", fix_mem_max);
- } else {
- fixmem = new_fixmem;
- }
- memset(voidcast(fixmem + fix_mem_max + 1), 0, t * sizeof(smemory_word));
- fix_mem_max += t;
- p = ++fix_mem_end;
- }
- token_link(p) = null; /* provide an oft-desired initialization of the new node */
- incr(dyn_used); /* maintain statistics */
- return (halfword) p;
-}
-
-
-@ The procedure |flush_list(p)| frees an entire linked list of
-one-word nodes that starts at position |p|.
-@^inner loop@>
-
-@c
-void flush_list(halfword p)
-{ /* makes list of single-word nodes available */
- halfword q, r; /* list traversers */
- if (p != null) {
- r = p;
- do {
- q = r;
- r = token_link(r);
- decr(dyn_used);
- } while (r != null); /* now |q| is the last node on the list */
- token_link(q) = avail;
- avail = p;
- }
-}
-
-@ A \TeX\ token is either a character or a control sequence, and it is
-@^token@>
-represented internally in one of two ways: (1)~A character whose ASCII
-code number is |c| and whose command code is |m| is represented as the
-number $2^{21}m+c$; the command code is in the range |1<=m<=14|. (2)~A control
-sequence whose |eqtb| address is |p| is represented as the number
-|cs_token_flag+p|. Here |cs_token_flag=@t$2^{25}-1$@>| is larger than
-$2^{21}m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|;
-thus, a token fits comfortably in a halfword.
-
-A token |t| represents a |left_brace| command if and only if
-|t<left_brace_limit|; it represents a |right_brace| command if and only if
-we have |left_brace_limit<=t<right_brace_limit|; and it represents a |match| or
-|end_match| command if and only if |match_token<=t<=end_match_token|.
-The following definitions take care of these token-oriented constants
-and a few others.
-
-@ 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 |print_meaning| subroutine displays |cur_cmd| and |cur_chr| in
-symbolic form, including the expansion of a macro or mark.
-
-@c
-void print_meaning(void)
-{
- print_cmd_chr((quarterword) cur_cmd, cur_chr);
- if (cur_cmd >= call_cmd) {
- print_char(':');
- print_ln();
- token_show(cur_chr);
- } else {
- /* Show the meaning of a mark node */
- if ((cur_cmd == top_bot_mark_cmd) && (cur_chr < marks_code)) {
- print_char(':');
- print_ln();
- switch (cur_chr) {
- case first_mark_code:
- token_show(first_mark(0));
- break;
- case bot_mark_code:
- token_show(bot_mark(0));
- break;
- case split_first_mark_code:
- token_show(split_first_mark(0));
- break;
- case split_bot_mark_code:
- token_show(split_bot_mark(0));
- break;
- default:
- token_show(top_mark(0));
- break;
- }
- }
- }
-}
-
-
-@ 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\ }'.
-
-@c
-void show_token_list(int p, int q, int l)
-{
- int m, c; /* pieces of a token */
- ASCII_code match_chr; /* character used in a `|match|' */
- ASCII_code n; /* the highest parameter number, as an ASCII digit */
- match_chr = '#';
- n = '0';
- tally = 0;
- if (l < 0)
- l = 0x3FFFFFFF;
- while ((p != null) && (tally < l)) {
- if (p == q) {
- /* Do magic computation */
- set_trick_count();
- }
- /* Display token |p|, and |return| if there are problems */
- if ((p < (int) fix_mem_min) || (p > (int) fix_mem_end)) {
- tprint_esc("CLOBBERED.");
- return;
- }
- if (token_info(p) >= cs_token_flag) {
- if (!((inhibit_par_tokens) && (token_info(p) == par_token)))
- print_cs(token_info(p) - cs_token_flag);
- } else {
- m = token_cmd(token_info(p));
- c = token_chr(token_info(p));
- if (token_info(p) < 0) {
- tprint_esc("BAD.");
- } else {
- /* Display the token $(|m|,|c|)$ */
- /* 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. */
- switch (m) {
- case left_brace_cmd:
- case right_brace_cmd:
- case math_shift_cmd:
- case tab_mark_cmd:
- case sup_mark_cmd:
- case sub_mark_cmd:
- case spacer_cmd:
- case letter_cmd:
- case other_char_cmd:
- print(c);
- break;
- case mac_param_cmd:
- if (!in_lua_escape)
- print(c);
- print(c);
- break;
- case out_param_cmd:
- print(match_chr);
- if (c <= 9) {
- print_char(c + '0');
- } else {
- print_char('!');
- return;
- }
- break;
- case match_cmd:
- match_chr = c;
- print(c);
- incr(n);
- print_char(n);
- if (n > '9')
- return;
- break;
- case end_match_cmd:
- if (c == 0)
- tprint("->");
- break;
- default:
- tprint_esc("BAD.");
- break;
- }
- }
- }
- p = token_link(p);
- }
- if (p != null)
- tprint_esc("ETC.");
-}
-
-@ @c
-#define do_buffer_to_unichar(a,b) do { \
- a = (halfword)str2uni(buffer+b); \
- b += utf8_size(a); \
- } while (0)
-
-
-@ Here's the way we sometimes want to display a token list, given a pointer
-to its reference count; the pointer may be null.
-
-@c
-void token_show(halfword p)
-{
- if (p != null)
- show_token_list(token_link(p), null, 10000000);
-}
-
-
-
-@ |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@>
-
-@c
-void delete_token_ref(halfword p)
-{ /* |p| points to the reference count
- of a token list that is losing one reference */
- assert(token_ref_count(p) >= 0);
- if (token_ref_count(p) == 0)
- flush_list(p);
- else
- decr(token_ref_count(p));
-}
-
-@ @c
-int get_char_cat_code(int curchr)
-{
- int a;
- do_get_cat_code(a,curchr);
- return a;
-}
-
-@ @c
-static void invalid_character_error(void)
-{
- const char *hlp[] =
- { "A funny symbol that I can't read has just been input.",
- "Continue, and I'll forget that it ever happened.",
- NULL
- };
- deletions_allowed = false;
- tex_error("Text line contains an invalid character", hlp);
- deletions_allowed = true;
-}
-
-@ @c
-static boolean process_sup_mark(void); /* below */
-
-static int scan_control_sequence(void); /* below */
-
-typedef enum { next_line_ok, next_line_return,
- next_line_restart
-} next_line_retval;
-
-static next_line_retval next_line(void); /* below */
-
-
-@ In case you are getting bored, here is a slightly less trivial routine:
- Given a string of lowercase letters, like `\.{pt}' or `\.{plus}' or
- `\.{width}', the |scan_keyword| routine checks to see whether the next
- tokens of input match this string. The match must be exact, except that
- uppercase letters will match their lowercase counterparts; uppercase
- equivalents are determined by subtracting |"a"-"A"|, rather than using the
- |uc_code| table, since \TeX\ uses this routine only for its own limited
- set of keywords.
-
- If a match is found, the characters are effectively removed from the input
- and |true| is returned. Otherwise |false| is returned, and the input
- is left essentially unchanged (except for the fact that some macros
- may have been expanded, etc.).
- @^inner loop@>
-
-@c
-boolean scan_keyword(const char *s)
-{ /* look for a given string */
- halfword p; /* tail of the backup list */
- halfword q; /* new node being added to the token list via |store_new_token| */
- const char *k; /* index into |str_pool| */
- halfword save_cur_cs = cur_cs;
- int saved_align_state = align_state;
- assert (strlen(s) > 1);
- p = backup_head;
- token_link(p) = null;
- k = s;
- while (*k) {
- get_x_token(); /* recursion is possible here */
- if ((cur_cs == 0) &&
- ((cur_chr == *k) || (cur_chr == *k - 'a' + 'A'))) {
- store_new_token(cur_tok);
- k++;
- } else if ((cur_cmd != spacer_cmd) || (p != backup_head)) {
- if (p != backup_head) {
- q = get_avail();
- token_info(q) = cur_tok;
- token_link(q) = null;
- token_link(p) = q;
- begin_token_list(token_link(backup_head), backed_up);
- if (cur_cmd != endv_cmd)
- align_state = saved_align_state;
- } else {
- back_input();
- }
- cur_cs = save_cur_cs;
- return false;
- }
- }
- flush_list(token_link(backup_head));
- cur_cs = save_cur_cs;
- if (cur_cmd != endv_cmd)
- align_state = saved_align_state;
- return true;
-}
-
-@ We can not return |undefined_control_sequence| under some conditions
- (inside |shift_case|, for example). This needs thinking.
-
-@c
-halfword active_to_cs(int curchr, int force)
-{
- halfword curcs;
- char *a, *b;
- char *utfbytes = xmalloc(10);
- int nncs = no_new_control_sequence;
- a = (char *) uni2str(0xFFFF);
- utfbytes = strcpy(utfbytes, a);
- if (force)
- no_new_control_sequence = false;
- if (curchr > 0) {
- b = (char *) uni2str((unsigned) curchr);
- utfbytes = strcat(utfbytes, b);
- free(b);
- curcs = string_lookup(utfbytes, strlen(utfbytes));
- } else {
- utfbytes[3] = '\0';
- curcs = string_lookup(utfbytes, 4);
- }
- no_new_control_sequence = nncs;
- free(a);
- free(utfbytes);
- return curcs;
-}
-
-@ TODO this function should listen to \.{\\escapechar}
-
-@c
-static char *cs_to_string(halfword p)
-{ /* prints a control sequence */
- const char *s;
- char *sh;
- int k = 0;
- static char ret[256] = { 0 };
- if (p == 0 || p == null_cs) {
- ret[k++] = '\\';
- s = "csname";
- while (*s) {
- ret[k++] = *s++;
- }
- ret[k++] = '\\';
- s = "endcsname";
- while (*s) {
- ret[k++] = *s++;
- }
- ret[k] = 0;
-
- } else {
- str_number txt = cs_text(p);
- sh = makecstring(txt);
- s = sh;
- if (is_active_cs(txt)) {
- s = s + 3;
- while (*s) {
- ret[k++] = *s++;
- }
- ret[k] = 0;
- } else {
- ret[k++] = '\\';
- while (*s) {
- ret[k++] = *s++;
- }
- ret[k] = 0;
- }
- free(sh);
- }
- return (char *) ret;
-}
-
-@ TODO this is a quick hack, will be solved differently soon
-
-@c
-static char *cmd_chr_to_string(int cmd, int chr)
-{
- char *s;
- str_number str;
- int sel = selector;
- selector = new_string;
- print_cmd_chr((quarterword) cmd, chr);
- str = make_string();
- s = makecstring(str);
- selector = sel;
- flush_str(str);
- return s;
-}
-
-@ The heart of \TeX's input mechanism is the |get_next| procedure, which
-we shall develop in the next few sections of the program. Perhaps we
-shouldn't actually call it the ``heart,'' however, because it really acts
-as \TeX's eyes and mouth, reading the source files and gobbling them up.
-And it also helps \TeX\ to regurgitate stored token lists that are to be
-processed again.
-@^eyes and mouth@>
-
-The main duty of |get_next| is to input one token and to set |cur_cmd|
-and |cur_chr| to that token's command code and modifier. Furthermore, if
-the input token is a control sequence, the |eqtb| location of that control
-sequence is stored in |cur_cs|; otherwise |cur_cs| is set to zero.
-
-Underlying this simple description is a certain amount of complexity
-because of all the cases that need to be handled.
-However, the inner loop of |get_next| is reasonably short and fast.
-
-When |get_next| is asked to get the next token of a \.{\\read} line,
-it sets |cur_cmd=cur_chr=cur_cs=0| in the case that no more tokens
-appear on that line. (There might not be any tokens at all, if the
-|end_line_char| has |ignore| as its catcode.)
-
-
-@ The value of |par_loc| is the |eqtb| address of `\.{\\par}'. This quantity
-is needed because a blank line of input is supposed to be exactly equivalent
-to the appearance of \.{\\par}; we must set |cur_cs:=par_loc|
-when detecting a blank line.
-
-@c
-halfword par_loc; /* location of `\.{\\par}' in |eqtb| */
-halfword par_token; /* token representing `\.{\\par}' */
-
-
-@ Parts |get_next| are executed more often than any other instructions of \TeX.
-@^mastication@>@^inner loop@>
-
-
-
-@ The global variable |force_eof| is normally |false|; it is set |true|
-by an \.{\\endinput} command. |luacstrings| is the number of lua print
-statements waiting to be input, it is changed by |luatokencall|.
-
-@c
-boolean force_eof; /* should the next \.{\\input} be aborted early? */
-int luacstrings; /* how many lua strings are waiting to be input? */
-
-
-@ If the user has set the |pausing| parameter to some positive value,
-and if nonstop mode has not been selected, each line of input is displayed
-on the terminal and the transcript file, followed by `\.{=>}'.
-\TeX\ waits for a response. If the response is simply |carriage_return|, the
-line is accepted as it stands, otherwise the line typed is
-used instead of the line in the file.
-
-@c
-void firm_up_the_line(void)
-{
- int k; /* an index into |buffer| */
- ilimit = last;
- if (pausing > 0) {
- if (interaction > nonstop_mode) {
- wake_up_terminal();
- print_ln();
- if (istart < ilimit) {
- for (k = istart; k <= ilimit - 1; k++)
- print_char(buffer[k]);
- }
- first = ilimit;
- prompt_input("=>"); /* wait for user response */
- if (last > first) {
- for (k = first; k < +last - 1; k++) /* move line down in buffer */
- buffer[k + istart - first] = buffer[k];
- ilimit = istart + last - first;
- }
- }
- }
-}
-
-
-
-@ Before getting into |get_next|, let's consider the subroutine that
- is called when an `\.{\\outer}' control sequence has been scanned or
- when the end of a file has been reached. These two cases are distinguished
- by |cur_cs|, which is zero at the end of a file.
-
-@c
-void check_outer_validity(void)
-{
- halfword p; /* points to inserted token list */
- halfword q; /* auxiliary pointer */
- if (suppress_outer_error)
- return;
- if (scanner_status != normal) {
- deletions_allowed = false;
- /* Back up an outer control sequence so that it can be reread; */
- /* An outer control sequence that occurs in a \.{\\read} will not be reread,
- since the error recovery for \.{\\read} is not very powerful. */
- if (cur_cs != 0) {
- if ((istate == token_list) || (iname < 1) || (iname > 17)) {
- p = get_avail();
- token_info(p) = cs_token_flag + cur_cs;
- begin_token_list(p, backed_up); /* prepare to read the control sequence again */
- }
- cur_cmd = spacer_cmd;
- cur_chr = ' '; /* replace it by a space */
- }
- if (scanner_status > skipping) {
- const char *errhlp[] =
- { "I suspect you have forgotten a `}', causing me",
- "to read past where you wanted me to stop.",
- "I'll try to recover; but if the error is serious,",
- "you'd better type `E' or `X' now and fix your file.",
- NULL
- };
- char errmsg[256];
- const char *startmsg;
- const char *scannermsg;
- /* Tell the user what has run away and try to recover */
- runaway(); /* print a definition, argument, or preamble */
- if (cur_cs == 0) {
- startmsg = "File ended";
- } else {
- cur_cs = 0;
- startmsg = "Forbidden control sequence found";
- }
- /* Print either `\.{definition}' or `\.{use}' or `\.{preamble}' or `\.{text}',
- and insert tokens that should lead to recovery; */
- /* The recovery procedure can't be fully understood without knowing more
- about the \TeX\ routines that should be aborted, but we can sketch the
- ideas here: For a runaway definition we will insert a right brace; for a
- runaway preamble, we will insert a special \.{\\cr} token and a right
- brace; and for a runaway argument, we will set |long_state| to
- |outer_call| and insert \.{\\par}. */
- p = get_avail();
- switch (scanner_status) {
- case defining:
- scannermsg = "definition";
- token_info(p) = right_brace_token + '}';
- break;
- case matching:
- scannermsg = "use";
- token_info(p) = par_token;
- long_state = outer_call_cmd;
- break;
- case aligning:
- scannermsg = "preamble";
- token_info(p) = right_brace_token + '}';
- q = p;
- p = get_avail();
- token_link(p) = q;
- token_info(p) = cs_token_flag + frozen_cr;
- align_state = -1000000;
- break;
- case absorbing:
- scannermsg = "text";
- token_info(p) = right_brace_token + '}';
- break;
- default: /* can't happen */
- scannermsg = "unknown";
- break;
- } /*there are no other cases */
- begin_token_list(p, inserted);
- snprintf(errmsg, 255, "%s while scanning %s of %s",
- startmsg, scannermsg, cs_to_string(warning_index));
- tex_error(errmsg, errhlp);
- } else {
- char errmsg[256];
- const char *errhlp_no[] =
- { "The file ended while I was skipping conditional text.",
- "This kind of error happens when you say `\\if...' and forget",
- "the matching `\\fi'. I've inserted a `\\fi'; this might work.",
- NULL
- };
- const char *errhlp_cs[] =
- { "A forbidden control sequence occurred in skipped text.",
- "This kind of error happens when you say `\\if...' and forget",
- "the matching `\\fi'. I've inserted a `\\fi'; this might work.",
- NULL
- };
- const char **errhlp = (const char **) errhlp_no;
- char *ss;
- if (cur_cs != 0) {
- errhlp = errhlp_cs;
- cur_cs = 0;
- }
- ss = cmd_chr_to_string(if_test_cmd, cur_if);
- snprintf(errmsg, 255,
- "Incomplete %s; all text was ignored after line %d",
- ss, (int) skip_line);
- free(ss);
- /* Incomplete \\if... */
- cur_tok = cs_token_flag + frozen_fi;
- /* back up one inserted token and call |error| */
- {
- OK_to_interrupt = false;
- back_input();
- token_type = inserted;
- OK_to_interrupt = true;
- tex_error(errmsg, errhlp);
- }
- }
- deletions_allowed = true;
- }
-}
-
-@ @c
-static boolean get_next_file(void)
-{
- SWITCH:
- if (iloc <= ilimit) { /* current line not yet finished */
- do_buffer_to_unichar(cur_chr, iloc);
-
- RESWITCH:
- if (detokenized_line()) {
- cur_cmd = (cur_chr == ' ' ? 10 : 12);
- } else {
- do_get_cat_code(cur_cmd, cur_chr);
- }
- /*
- Change state if necessary, and |goto switch| if the current
- character should be ignored, or |goto reswitch| if the current
- character changes to another;
- */
- /* The following 48-way switch accomplishes the scanning quickly, assuming
- that a decent C compiler has translated the code. Note that the numeric
- values for |mid_line|, |skip_blanks|, and |new_line| are spaced
- apart from each other by |max_char_code+1|, so we can add a character's
- command code to the state to get a single number that characterizes both.
- */
- switch (istate + cur_cmd) {
- case mid_line + ignore_cmd:
- case skip_blanks + ignore_cmd:
- case new_line + ignore_cmd:
- case skip_blanks + spacer_cmd:
- case new_line + spacer_cmd: /* Cases where character is ignored */
- goto SWITCH;
- break;
- case mid_line + escape_cmd:
- case new_line + escape_cmd:
- case skip_blanks + escape_cmd: /* Scan a control sequence ...; */
- istate = (unsigned char) scan_control_sequence();
- if (cur_cmd >= outer_call_cmd)
- check_outer_validity();
- break;
- case mid_line + active_char_cmd:
- case new_line + active_char_cmd:
- case skip_blanks + active_char_cmd: /* Process an active-character */
- cur_cs = active_to_cs(cur_chr, false);
- cur_cmd = eq_type(cur_cs);
- cur_chr = equiv(cur_cs);
- istate = mid_line;
- if (cur_cmd >= outer_call_cmd)
- check_outer_validity();
- break;
- case mid_line + sup_mark_cmd:
- case new_line + sup_mark_cmd:
- case skip_blanks + sup_mark_cmd: /* If this |sup_mark| starts */
- if (process_sup_mark())
- goto RESWITCH;
- else
- istate = mid_line;
- break;
- case mid_line + invalid_char_cmd:
- case new_line + invalid_char_cmd:
- case skip_blanks + invalid_char_cmd: /* Decry the invalid character and |goto restart|; */
- invalid_character_error();
- return false; /* because state may be |token_list| now */
- break;
- case mid_line + spacer_cmd: /* Enter |skip_blanks| state, emit a space; */
- istate = skip_blanks;
- cur_chr = ' ';
- break;
- case mid_line + car_ret_cmd: /* Finish line, emit a space; */
- /* When a character of type |spacer| gets through, its character code is
- changed to $\.{"\ "}=040$. This means that the ASCII codes for tab and space,
- and for the space inserted at the end of a line, will
- be treated alike when macro parameters are being matched. We do this
- since such characters are indistinguishable on most computer terminal displays.
- */
- iloc = ilimit + 1;
- cur_cmd = spacer_cmd;
- cur_chr = ' ';
- break;
- case skip_blanks + car_ret_cmd:
- case mid_line + comment_cmd:
- case new_line + comment_cmd:
- case skip_blanks + comment_cmd: /* Finish line, |goto switch|; */
- iloc = ilimit + 1;
- goto SWITCH;
- break;
- case new_line + car_ret_cmd: /* Finish line, emit a \.{\\par}; */
- iloc = ilimit + 1;
- cur_cs = par_loc;
- cur_cmd = eq_type(cur_cs);
- cur_chr = equiv(cur_cs);
- if (cur_cmd >= outer_call_cmd)
- check_outer_validity();
- break;
- case skip_blanks + left_brace_cmd:
- case new_line + left_brace_cmd:
- istate = mid_line; /* fall through */
- case mid_line + left_brace_cmd:
- align_state++;
- break;
- case skip_blanks + right_brace_cmd:
- case new_line + right_brace_cmd:
- istate = mid_line; /* fall through */
- case mid_line + right_brace_cmd:
- align_state--;
- break;
- case mid_line + math_shift_cmd:
- case mid_line + tab_mark_cmd:
- case mid_line + mac_param_cmd:
- case mid_line + sub_mark_cmd:
- case mid_line + letter_cmd:
- case mid_line + other_char_cmd:
- break;
-#if 0
- case skip_blanks + math_shift:
- case skip_blanks + tab_mark:
- case skip_blanks + mac_param:
- case skip_blanks + sub_mark:
- case skip_blanks + letter:
- case skip_blanks + other_char:
- case new_line + math_shift:
- case new_line + tab_mark:
- case new_line + mac_param:
- case new_line + sub_mark:
- case new_line + letter:
- case new_line + other_char:
-#else
- default:
-#endif
- istate = mid_line;
- break;
- }
- } else {
- if (iname != 21)
- istate = new_line;
-
- /*
- Move to next line of file,
- or |goto restart| if there is no next line,
- or |return| if a \.{\\read} line has finished;
- */
- do {
- next_line_retval r = next_line();
- if (r == next_line_return) {
- return true;
- } else if (r == next_line_restart) {
- return false;
- }
- } while (0);
- check_interrupt();
- goto SWITCH;
- }
- return true;
-}
-
-@ @c
-#define is_hex(a) ((a>='0'&&a<='9')||(a>='a'&&a<='f'))
-
-#define add_nybble(a) do { \
- if (a<='9') cur_chr=(cur_chr<<4)+a-'0'; \
- else cur_chr=(cur_chr<<4)+a-'a'+10; \
- } while (0)
-
-#define hex_to_cur_chr do { \
- if (c<='9') cur_chr=c-'0'; \
- else cur_chr=c-'a'+10; \
- add_nybble(cc); \
- } while (0)
-
-#define four_hex_to_cur_chr do { \
- hex_to_cur_chr; \
- add_nybble(ccc); add_nybble(cccc); \
- } while (0)
-
-#define five_hex_to_cur_chr do { \
- four_hex_to_cur_chr; \
- add_nybble(ccccc); \
- } while (0)
-
-#define six_hex_to_cur_chr do { \
- five_hex_to_cur_chr; \
- add_nybble(cccccc); \
- } while (0)
-
-
-@ Notice that a code like \.{\^\^8} becomes \.x if not followed by a hex digit.
-
-@c
-static boolean process_sup_mark(void)
-{
- if (cur_chr == buffer[iloc]) {
- int c, cc;
- if (iloc < ilimit) {
- if ((cur_chr == buffer[iloc + 1]) && (cur_chr == buffer[iloc + 2])
- && (cur_chr == buffer[iloc + 3])
- && (cur_chr == buffer[iloc + 4])
- && ((iloc + 10) <= ilimit)) {
- int ccc, cccc, ccccc, cccccc; /* constituents of a possible expanded code */
- c = buffer[iloc + 5];
- cc = buffer[iloc + 6];
- ccc = buffer[iloc + 7];
- cccc = buffer[iloc + 8];
- ccccc = buffer[iloc + 9];
- cccccc = buffer[iloc + 10];
- if ((is_hex(c)) && (is_hex(cc)) && (is_hex(ccc))
- && (is_hex(cccc))
- && (is_hex(ccccc)) && (is_hex(cccccc))) {
- iloc = iloc + 11;
- six_hex_to_cur_chr;
- return true;
- }
- }
- if ((cur_chr == buffer[iloc + 1]) && (cur_chr == buffer[iloc + 2])
- && (cur_chr == buffer[iloc + 3]) && ((iloc + 8) <= ilimit)) {
- int ccc, cccc, ccccc; /* constituents of a possible expanded code */
- c = buffer[iloc + 4];
- cc = buffer[iloc + 5];
- ccc = buffer[iloc + 6];
- cccc = buffer[iloc + 7];
- ccccc = buffer[iloc + 8];
- if ((is_hex(c)) && (is_hex(cc)) && (is_hex(ccc))
- && (is_hex(cccc)) && (is_hex(ccccc))) {
- iloc = iloc + 9;
- five_hex_to_cur_chr;
- return true;
- }
- }
- if ((cur_chr == buffer[iloc + 1]) && (cur_chr == buffer[iloc + 2])
- && ((iloc + 6) <= ilimit)) {
- int ccc, cccc; /* constituents of a possible expanded code */
- c = buffer[iloc + 3];
- cc = buffer[iloc + 4];
- ccc = buffer[iloc + 5];
- cccc = buffer[iloc + 6];
- if ((is_hex(c)) && (is_hex(cc)) && (is_hex(ccc))
- && (is_hex(cccc))) {
- iloc = iloc + 7;
- four_hex_to_cur_chr;
- return true;
- }
- }
- c = buffer[iloc + 1];
- if (c < 0200) { /* yes we have an expanded char */
- iloc = iloc + 2;
- if (is_hex(c) && iloc <= ilimit) {
- cc = buffer[iloc];
- if (is_hex(cc)) {
- incr(iloc);
- hex_to_cur_chr;
- return true;
- }
- }
- cur_chr = (c < 0100 ? c + 0100 : c - 0100);
- return true;
- }
- }
- }
- return false;
-}
-
-@ Control sequence names are scanned only when they appear in some line of
- a file; once they have been scanned the first time, their |eqtb| location
- serves as a unique identification, so \TeX\ doesn't need to refer to the
- original name any more except when it prints the equivalent in symbolic form.
-
- The program that scans a control sequence has been written carefully
- in order to avoid the blowups that might otherwise occur if a malicious
- user tried something like `\.{\\catcode\'15=0}'. The algorithm might
- look at |buffer[ilimit+1]|, but it never looks at |buffer[ilimit+2]|.
-
- If expanded characters like `\.{\^\^A}' or `\.{\^\^df}'
- appear in or just following
- a control sequence name, they are converted to single characters in the
- buffer and the process is repeated, slowly but surely.
-
-@c
-static boolean check_expanded_code(int *kk); /* below */
-
-static int scan_control_sequence(void)
-{
- int retval = mid_line;
- if (iloc > ilimit) {
- cur_cs = null_cs; /* |state| is irrelevant in this case */
- } else {
- register int cat; /* |cat_code(cur_chr)|, usually */
- while (1) {
- int k = iloc;
- do_buffer_to_unichar(cur_chr, k);
- do_get_cat_code(cat, cur_chr);
- if (cat != letter_cmd || k > ilimit) {
- retval = (cat == spacer_cmd ? skip_blanks : mid_line);
- if (cat == sup_mark_cmd && check_expanded_code(&k)) /* If an expanded...; */
- continue;
- } else {
- retval = skip_blanks;
- do {
- do_buffer_to_unichar(cur_chr, k);
- do_get_cat_code(cat, cur_chr);
- } while (cat == letter_cmd && k <= ilimit);
-
- if (cat == sup_mark_cmd && check_expanded_code(&k)) /* If an expanded...; */
- continue;
- if (cat != letter_cmd) {
- decr(k);
- if (cur_chr > 0xFFFF)
- decr(k);
- if (cur_chr > 0x7FF)
- decr(k);
- if (cur_chr > 0x7F)
- decr(k);
- } /* now |k| points to first nonletter */
- }
- cur_cs = id_lookup(iloc, k - iloc);
- iloc = k;
- break;
- }
- }
- cur_cmd = eq_type(cur_cs);
- cur_chr = equiv(cur_cs);
- return retval;
-}
-
-@ Whenever we reach the following piece of code, we will have
- |cur_chr=buffer[k-1]| and |k<=ilimit+1| and |cat=get_cat_code(cat_code_table,cur_chr)|. If an
- expanded code like \.{\^\^A} or \.{\^\^df} appears in |buffer[(k-1)..(k+1)]|
- or |buffer[(k-1)..(k+2)]|, we
- will store the corresponding code in |buffer[k-1]| and shift the rest of
- the buffer left two or three places.
-
-@c
-static boolean check_expanded_code(int *kk)
-{
- int l;
- int k = *kk;
- int d = 1; /* number of excess characters in an expanded code */
- int c, cc, ccc, cccc, ccccc, cccccc; /* constituents of a possible expanded code */
- if (buffer[k] == cur_chr && k < ilimit) {
- if ((cur_chr == buffer[k + 1]) && (cur_chr == buffer[k + 2])
- && ((k + 6) <= ilimit)) {
- d = 4;
- if ((cur_chr == buffer[k + 3]) && ((k + 8) <= ilimit))
- d = 5;
- if ((cur_chr == buffer[k + 4]) && ((k + 10) <= ilimit))
- d = 6;
- c = buffer[k + d - 1];
- cc = buffer[k + d];
- ccc = buffer[k + d + 1];
- cccc = buffer[k + d + 2];
- if (d == 6) {
- ccccc = buffer[k + d + 3];
- cccccc = buffer[k + d + 4];
- if (is_hex(c) && is_hex(cc) && is_hex(ccc) && is_hex(cccc)
- && is_hex(ccccc) && is_hex(cccccc))
- six_hex_to_cur_chr;
- } else if (d == 5) {
- ccccc = buffer[k + d + 3];
- if (is_hex(c) && is_hex(cc) && is_hex(ccc) && is_hex(cccc)
- && is_hex(ccccc))
- five_hex_to_cur_chr;
- } else {
- if (is_hex(c) && is_hex(cc) && is_hex(ccc) && is_hex(cccc))
- four_hex_to_cur_chr;
- }
- } else {
- c = buffer[k + 1];
- if (c < 0200) {
- d = 1;
- if (is_hex(c) && (k + 2) <= ilimit) {
- cc = buffer[k + 2];
- if (is_hex(c) && is_hex(cc)) {
- d = 2;
- hex_to_cur_chr;
- }
- } else if (c < 0100) {
- cur_chr = c + 0100;
- } else {
- cur_chr = c - 0100;
- }
- }
- }
- if (d > 2)
- d = 2 * d - 1;
- else
- d++;
- if (cur_chr <= 0x7F) {
- buffer[k - 1] = (packed_ASCII_code) cur_chr;
- } else if (cur_chr <= 0x7FF) {
- buffer[k - 1] = (packed_ASCII_code) (0xC0 + cur_chr / 0x40);
- k++;
- d--;
- buffer[k - 1] = (packed_ASCII_code) (0x80 + cur_chr % 0x40);
- } else if (cur_chr <= 0xFFFF) {
- buffer[k - 1] = (packed_ASCII_code) (0xE0 + cur_chr / 0x1000);
- k++;
- d--;
- buffer[k - 1] =
- (packed_ASCII_code) (0x80 + (cur_chr % 0x1000) / 0x40);
- k++;
- d--;
- buffer[k - 1] =
- (packed_ASCII_code) (0x80 + (cur_chr % 0x1000) % 0x40);
- } else {
- buffer[k - 1] = (packed_ASCII_code) (0xF0 + cur_chr / 0x40000);
- k++;
- d--;
- buffer[k - 1] =
- (packed_ASCII_code) (0x80 + (cur_chr % 0x40000) / 0x1000);
- k++;
- d--;
- buffer[k - 1] =
- (packed_ASCII_code) (0x80 +
- ((cur_chr % 0x40000) % 0x1000) / 0x40);
- k++;
- d--;
- buffer[k - 1] =
- (packed_ASCII_code) (0x80 +
- ((cur_chr % 0x40000) % 0x1000) % 0x40);
- }
- l = k;
- ilimit = ilimit - d;
- while (l <= ilimit) {
- buffer[l] = buffer[l + d];
- l++;
- }
- *kk = k;
- return true;
- }
- return false;
-}
-
-@ todo: this is a function because it is still used from the converted pascal.
- once that is gone, it can be a \#define again
-
-@c
-boolean end_line_char_inactive(void)
-{
- return ((end_line_char < 0) || (end_line_char > 127));
-}
-
-@ All of the easy branches of |get_next| have now been taken care of.
- There is one more branch.
-
-@c
-static next_line_retval next_line(void)
-{
- boolean inhibit_eol = false; /* a way to end a pseudo file without trailing space */
- if (iname > 17) {
- /* Read next line of file into |buffer|, or |goto restart| if the file has ended */
- incr(line);
- first = istart;
- if (!force_eof) {
- if (iname <= 20) {
- if (pseudo_input()) { /* not end of file */
- firm_up_the_line(); /* this sets |ilimit| */
- line_catcode_table = DEFAULT_CAT_TABLE;
- if ((iname == 19) && (pseudo_lines(pseudo_files) == null))
- inhibit_eol = true;
- } else if ((every_eof != null) && !eof_seen[iindex]) {
- ilimit = first - 1;
- eof_seen[iindex] = true; /* fake one empty line */
- if (iname != 19)
- begin_token_list(every_eof, every_eof_text);
- return next_line_restart;
- } else {
- force_eof = true;
- }
- } else {
- if (iname == 21) {
- if (luacstring_input()) { /* not end of strings */
- firm_up_the_line();
- line_catcode_table = (short) luacstring_cattable();
- line_partial = (signed char) luacstring_partial();
- if (luacstring_final_line() || line_partial
- || line_catcode_table == NO_CAT_TABLE)
- inhibit_eol = true;
- if (!line_partial)
- istate = new_line;
- } else {
- force_eof = true;
- }
- } else {
- if (lua_input_ln(cur_file, 0, true)) { /* not end of file */
- firm_up_the_line(); /* this sets |ilimit| */
- line_catcode_table = DEFAULT_CAT_TABLE;
- } else if ((every_eof != null) && (!eof_seen[iindex])) {
- ilimit = first - 1;
- eof_seen[iindex] = true; /* fake one empty line */
- begin_token_list(every_eof, every_eof_text);
- return next_line_restart;
- } else {
- force_eof = true;
- }
- }
- }
- }
- if (force_eof) {
- if (tracing_nesting > 0)
- if ((grp_stack[in_open] != cur_boundary)
- || (if_stack[in_open] != cond_ptr))
- if (!((iname == 19) || (iname == 21)))
- file_warning(); /* give warning for some unfinished groups and/or conditionals */
- if ((iname > 21) || (iname == 20)) {
- if (tracefilenames)
- print_char(')');
- open_parens--;
-#if 0
- update_terminal(); /* show user that file has been read */
-#endif
- }
- force_eof = false;
- if (iname == 21 || /* lua input */
- iname == 19) { /* \.{\\scantextokens} */
- end_file_reading();
- } else {
- end_file_reading();
- check_outer_validity();
- }
- return next_line_restart;
- }
- if (inhibit_eol || end_line_char_inactive())
- ilimit--;
- else
- buffer[ilimit] = (packed_ASCII_code) end_line_char;
- first = ilimit + 1;
- iloc = istart; /* ready to read */
- } else {
- if (!terminal_input) { /* \.{\\read} line has ended */
- cur_cmd = 0;
- cur_chr = 0;
- return next_line_return; /* OUTER */
- }
- if (input_ptr > 0) { /* text was inserted during error recovery */
- end_file_reading();
- return next_line_restart; /* resume previous level */
- }
- if (selector < log_only)
- open_log_file();
- if (interaction > nonstop_mode) {
- if (end_line_char_inactive())
- ilimit++;
- if (ilimit == istart) { /* previous line was empty */
- tprint_nl("(Please type a command or say `\\end')");
- }
- print_ln();
- first = istart;
- prompt_input("*"); /* input on-line into |buffer| */
- ilimit = last;
- if (end_line_char_inactive())
- ilimit--;
- else
- buffer[ilimit] = (packed_ASCII_code) end_line_char;
- first = ilimit + 1;
- iloc = istart;
- } else {
- fatal_error("*** (job aborted, no legal \\end found)");
- /* nonstop mode, which is intended for overnight batch processing,
- never waits for on-line input */
- }
- }
- return next_line_ok;
-}
-
-@ Let's consider now what happens when |get_next| is looking at a token list.
-
-@c
-static boolean get_next_tokenlist(void)
-{
- register halfword t; /* a token */
- t = token_info(iloc);
- iloc = token_link(iloc); /* move to next */
- if (t >= cs_token_flag) { /* a control sequence token */
- cur_cs = t - cs_token_flag;
- cur_cmd = eq_type(cur_cs);
- if (cur_cmd >= outer_call_cmd) {
- if (cur_cmd == dont_expand_cmd) { /* Get the next token, suppressing expansion */
- /* The present point in the program is reached only when the |expand|
- routine has inserted a special marker into the input. In this special
- case, |token_info(iloc)| is known to be a control sequence token, and |token_link(iloc)=null|.
- */
- cur_cs = token_info(iloc) - cs_token_flag;
- iloc = null;
- cur_cmd = eq_type(cur_cs);
- if (cur_cmd > max_command_cmd) {
- cur_cmd = relax_cmd;
- cur_chr = no_expand_flag;
- return true;
- }
- } else {
- check_outer_validity();
- }
- }
- cur_chr = equiv(cur_cs);
- } else {
- cur_cmd = token_cmd(t);
- cur_chr = token_chr(t);
- switch (cur_cmd) {
- case left_brace_cmd:
- align_state++;
- break;
- case right_brace_cmd:
- align_state--;
- break;
- case out_param_cmd: /* Insert macro parameter and |goto restart|; */
- begin_token_list(param_stack[param_start + cur_chr - 1], parameter);
- return false;
- break;
- }
- }
- return true;
-}
-
-@ Now we're ready to take the plunge into |get_next| itself. Parts of
- this routine are executed more often than any other instructions of \TeX.
- @^mastication@>@^inner loop@>
-
-@ sets |cur_cmd|, |cur_chr|, |cur_cs| to next token
-
-@c
-void get_next(void)
-{
- RESTART:
- cur_cs = 0;
- if (istate != token_list) {
- /* Input from external file, |goto restart| if no input found */
- if (!get_next_file())
- goto RESTART;
- } else {
- if (iloc == null) {
- end_token_list();
- goto RESTART; /* list exhausted, resume previous level */
- } else if (!get_next_tokenlist()) {
- goto RESTART; /* parameter needs to be expanded */
- }
- }
- /* If an alignment entry has just ended, take appropriate action */
- if ((cur_cmd == tab_mark_cmd || cur_cmd == car_ret_cmd) && align_state == 0) {
- insert_vj_template();
- goto RESTART;
- }
-}
-
-
-@ Since |get_next| is used so frequently in \TeX, it is convenient
-to define three related procedures that do a little more:
-
-\yskip\hang|get_token| not only sets |cur_cmd| and |cur_chr|, it
-also sets |cur_tok|, a packed halfword version of the current token.
-
-\yskip\hang|get_x_token|, meaning ``get an expanded token,'' is like
-|get_token|, but if the current token turns out to be a user-defined
-control sequence (i.e., a macro call), or a conditional,
-or something like \.{\\topmark} or \.{\\expandafter} or \.{\\csname},
-it is eliminated from the input by beginning the expansion of the macro
-or the evaluation of the conditional.
-
-\yskip\hang|x_token| is like |get_x_token| except that it assumes that
-|get_next| has already been called.
-
-\yskip\noindent
-In fact, these three procedures account for almost every use of |get_next|.
-
-No new control sequences will be defined except during a call of
-|get_token|, or when \.{\\csname} compresses a token list, because
-|no_new_control_sequence| is always |true| at other times.
-
-@c
-void get_token(void)
-{ /* sets |cur_cmd|, |cur_chr|, |cur_tok| */
- no_new_control_sequence = false;
- get_token_lua();
- no_new_control_sequence = true;
- if (cur_cs == 0)
- cur_tok = token_val(cur_cmd, cur_chr);
- else
- cur_tok = cs_token_flag + cur_cs;
-}
-
-@ @c
-void get_token_lua(void)
-{
- register int callback_id;
- callback_id = callback_defined(token_filter_callback);
- if (callback_id > 0) {
- while (istate == token_list && iloc == null && iindex != v_template)
- end_token_list();
- /* there is some stuff we don't want to see inside the callback */
- if (!(istate == token_list &&
- ((nofilter == true) || (iindex == backed_up && iloc != null)))) {
- do_get_token_lua(callback_id);
- return;
- }
- }
- get_next();
-}
-
-
-@ changes the string |s| to a token list
-@c
-halfword string_to_toks(char *ss)
-{
- halfword p; /* tail of the token list */
- halfword q; /* new node being added to the token list via |store_new_token| */
- halfword t; /* token being appended */
- char *s = ss, *se = ss + strlen(s);
- p = temp_token_head;
- set_token_link(p, null);
- while (s < se) {
- t = (halfword) str2uni((unsigned char *) s);
- s += utf8_size(t);
- if (t == ' ')
- t = space_token;
- else
- t = other_token + t;
- fast_store_new_token(t);
- }
- return token_link(temp_token_head);
-}
-
-@ The token lists for macros and for other things like \.{\\mark} and \.{\\output}
-and \.{\\write} are produced by a procedure called |scan_toks|.
-
-Before we get into the details of |scan_toks|, let's consider a much
-simpler task, that of converting the current string into a token list.
-The |str_toks| function does this; it classifies spaces as type |spacer|
-and everything else as type |other_char|.
-
-The token list created by |str_toks| begins at |link(temp_token_head)| and ends
-at the value |p| that is returned. (If |p=temp_token_head|, the list is empty.)
-
-|lua_str_toks| is almost identical, but it also escapes the three
-symbols that |lua| considers special while scanning a literal string
-
-@c
-static halfword lua_str_toks(lstring b)
-{ /* changes the string |str_pool[b..pool_ptr]| to a token list */
- halfword p; /* tail of the token list */
- halfword q; /* new node being added to the token list via |store_new_token| */
- halfword t; /* token being appended */
- unsigned char *k; /* index into string */
- p = temp_token_head;
- set_token_link(p, null);
- k = (unsigned char *) b.s;
- while (k < (unsigned char *) b.s + b.l) {
- t = pool_to_unichar(k);
- k += utf8_size(t);
- if (t == ' ') {
- t = space_token;
- } else {
- if ((t == '\\') || (t == '"') || (t == '\'') || (t == 10)
- || (t == 13))
- fast_store_new_token(other_token + '\\');
- if (t == 10)
- t = 'n';
- if (t == 13)
- t = 'r';
- t = other_token + t;
- }
- fast_store_new_token(t);
- }
- return p;
-}
-
-
-@ Incidentally, the main reason for wanting |str_toks| is the function |the_toks|,
-which has similar input/output characteristics.
-
-@c
-halfword str_toks(lstring s)
-{ /* changes the string |str_pool[b..pool_ptr]| to a token list */
- halfword p; /* tail of the token list */
- halfword q; /* new node being added to the token list via |store_new_token| */
- halfword t; /* token being appended */
- unsigned char *k, *l; /* index into string */
- p = temp_token_head;
- set_token_link(p, null);
- k = s.s;
- l = k + s.l;
- while (k < l) {
- t = pool_to_unichar(k);
- k += utf8_size(t);
- if (t == ' ')
- t = space_token;
- else
- t = other_token + t;
- fast_store_new_token(t);
- }
- return p;
-}
-
-@ Here's part of the |expand| subroutine that we are now ready to complete:
-@c
-void ins_the_toks(void)
-{
- (void) the_toks();
- ins_list(token_link(temp_token_head));
-}
-
-@ This routine, used in the next one, prints the job name, possibly
-modified by the |process_jobname| callback.
-
-@c
-static void print_job_name(void)
-{
- if (job_name) {
- char *s, *ss; /* C strings for jobname before and after processing */
- int callback_id, lua_retval;
- s = (char*)str_string(job_name);
- callback_id = callback_defined(process_jobname_callback);
- if (callback_id > 0) {
- lua_retval = run_callback(callback_id, "S->S", s, &ss);
- if ((lua_retval == true) && (ss != NULL))
- s = ss;
- }
- tprint(s);
- } else {
- print(job_name);
- }
-}
-
-@ Here is a routine that print the result of a convert command, using
- the argument |i|. It returns |false | if it does not know to print
- the code |c|. The function exists because lua code and tex code can
- both call it to convert something.
-
-@c
-static boolean print_convert_string(halfword c, int i)
-{
- int ff; /* for use with |set_ff| */
- boolean ret = true;
- switch (c) {
- case number_code:
- print_int(i);
- break;
- case uchar_code:
- print(i);
- break;
- case roman_numeral_code:
- print_roman_int(i);
- break;
- case etex_code:
- tprint(eTeX_version_string);
- break;
- case pdftex_revision_code:
- tprint(pdftex_revision);
- break;
- case luatex_revision_code:
- print(get_luatexrevision());
- break;
- case luatex_date_code:
- print_int(get_luatex_date_info());
- break;
- case pdftex_banner_code:
- tprint(pdftex_banner);
- break;
- case uniform_deviate_code:
- print_int(unif_rand(i));
- break;
- case normal_deviate_code:
- print_int(norm_rand());
- break;
- case format_name_code:
- print(format_name);
- break;
- case job_name_code:
- print_job_name();
- break;
- case font_name_code:
- append_string((unsigned char *) font_name(i),
- (unsigned) strlen(font_name(i)));
- if (font_size(i) != font_dsize(i)) {
- tprint(" at ");
- print_scaled(font_size(i));
- tprint("pt");
- }
- break;
- case font_id_code:
- print_int(i);
- break;
- case math_style_code:
- print_math_style();
- break;
- case pdf_font_name_code:
- case pdf_font_objnum_code:
- set_ff(i);
- if (c == pdf_font_name_code)
- print_int(obj_info(static_pdf, pdf_font_num(ff)));
- else
- print_int(pdf_font_num(ff));
- break;
- case pdf_font_size_code:
- print_scaled(font_size(i));
- tprint("pt");
- break;
- case pdf_page_ref_code:
- print_int(pdf_get_obj(static_pdf, obj_type_page, i, false));
- break;
- case pdf_xform_name_code:
- print_int(obj_info(static_pdf, i));
- break;
- case eTeX_revision_code:
- tprint(eTeX_revision);
- break;
- default:
- ret = false;
- break;
- }
- return ret;
-}
-
-@ @c
-int scan_lua_state(void)
-{
- int sn = 0;
- if (scan_keyword("name")) {
- scan_pdf_ext_toks();
- sn = def_ref;
- }
- /* Parse optional lua state integer, or an instance name to be stored in |sn| */
- /* Get the next non-blank non-relax non-call token */
- do {
- get_x_token();
- } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
-
- back_input(); /* have to push it back, whatever it is */
- if (cur_cmd != left_brace_cmd) {
- scan_register_num();
- if (get_lua_name(cur_val))
- sn = (cur_val - 65536);
- }
- return sn;
-}
-
-
-@ The procedure |conv_toks| uses |str_toks| to insert the token list
-for |convert| functions into the scanner; `\.{\\outer}' control sequences
-are allowed to follow `\.{\\string}' and `\.{\\meaning}'.
-
-The extra temp string |u| is needed because |pdf_scan_ext_toks| incorporates
-any pending string in its output. In order to save such a pending string,
-we have to create a temporary string that is destroyed immediately after.
-
-@c
-void conv_toks(void)
-{
- int old_setting; /* holds |selector| setting */
- halfword p, q;
- int save_scanner_status; /* |scanner_status| upon entry */
- halfword save_def_ref; /* |def_ref| upon entry, important if inside `\.{\\message}' */
- halfword save_warning_index;
- boolean bool; /* temp boolean */
- str_number s; /* first temp string */
- int sn; /* lua chunk name */
- str_number u = 0; /* third temp string, will become non-nil if a string is already being built */
- int i = 0; /* first temp integer */
- int j = 0; /* second temp integer */
- int c = cur_chr; /* desired type of conversion */
- str_number str;
- /* Scan the argument for command |c| */
- switch (c) {
- case uchar_code:
- scan_char_num();
- break;
- case number_code:
- case roman_numeral_code:
- scan_int();
- break;
- case string_code:
- case meaning_code:
- save_scanner_status = scanner_status;
- scanner_status = normal;
- get_token();
- scanner_status = save_scanner_status;
- break;
- case etex_code:
- break;
- case font_name_code:
- case font_id_code:
- scan_font_ident();
- break;
- case pdftex_revision_code:
- case luatex_revision_code:
- case luatex_date_code:
- case pdftex_banner_code:
- break;
- case pdf_font_name_code:
- case pdf_font_objnum_code:
- case pdf_font_size_code:
- scan_font_ident();
- if (cur_val == null_font)
- pdf_error("font", "invalid font identifier");
- if (c != pdf_font_size_code) {
- pdf_check_vf(cur_val);
- if (!font_used(cur_val))
- pdf_init_font(static_pdf, cur_val);
- }
- break;
- case pdf_page_ref_code:
- scan_int();
- if (cur_val <= 0)
- pdf_error("pageref", "invalid page number");
- break;
- case left_margin_kern_code:
- case right_margin_kern_code:
- scan_int();
- if ((box(cur_val) == null) || (type(box(cur_val)) != hlist_node))
- pdf_error("marginkern", "a non-empty hbox expected");
- break;
- case pdf_xform_name_code:
- scan_int();
- check_obj_type(static_pdf, obj_type_xform, cur_val);
- break;
- case pdf_creation_date_code:
- ins_list(string_to_toks(getcreationdate(static_pdf)));
- return;
- break;
- case format_name_code:
- case job_name_code:
- if (job_name == 0)
- open_log_file();
- break;
- case pdf_colorstack_init_code:
- bool = scan_keyword("page");
- if (scan_keyword("direct"))
- cur_val = direct_always;
- else if (scan_keyword("page"))
- cur_val = direct_page;
- else
- cur_val = set_origin;
- save_scanner_status = scanner_status;
- save_warning_index = warning_index;
- save_def_ref = def_ref;
- u = save_cur_string();
- scan_pdf_ext_toks();
- s = tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- def_ref = save_def_ref;
- warning_index = save_warning_index;
- scanner_status = save_scanner_status;
- cur_val = newcolorstack(s, cur_val, bool);
- flush_str(s);
- cur_val_level = int_val_level;
- if (cur_val < 0) {
- print_err("Too many color stacks");
- help2("The number of color stacks is limited to 32768.",
- "I'll use the default color stack 0 here.");
- error();
- cur_val = 0;
- restore_cur_string(u);
- }
- break;
- case uniform_deviate_code:
- scan_int();
- break;
- case normal_deviate_code:
- break;
- case lua_escape_string_code:
- {
- lstring escstr;
- int l = 0;
- save_scanner_status = scanner_status;
- save_def_ref = def_ref;
- save_warning_index = warning_index;
- scan_pdf_ext_toks();
- bool = in_lua_escape;
- in_lua_escape = true;
- escstr.s = (unsigned char *) tokenlist_to_cstring(def_ref, false, &l);
- escstr.l = (unsigned) l;
- in_lua_escape = bool;
- delete_token_ref(def_ref);
- def_ref = save_def_ref;
- warning_index = save_warning_index;
- scanner_status = save_scanner_status;
- (void) lua_str_toks(escstr);
- ins_list(token_link(temp_token_head));
- free(escstr.s);
- return;
- }
- break;
- case math_style_code:
- break;
- case expanded_code:
- save_scanner_status = scanner_status;
- save_warning_index = warning_index;
- save_def_ref = def_ref;
- u = save_cur_string();
- scan_pdf_ext_toks();
- warning_index = save_warning_index;
- scanner_status = save_scanner_status;
- ins_list(token_link(def_ref));
- def_ref = save_def_ref;
- restore_cur_string(u);
- return;
- break;
- case lua_code:
- u = save_cur_string();
- save_scanner_status = scanner_status;
- save_def_ref = def_ref;
- save_warning_index = warning_index;
- sn = scan_lua_state();
- scan_pdf_ext_toks();
- s = def_ref;
- warning_index = save_warning_index;
- def_ref = save_def_ref;
- scanner_status = save_scanner_status;
- luacstrings = 0;
- luatokencall(s, sn);
- delete_token_ref(s);
- restore_cur_string(u); /* TODO: check this, was different */
- if (luacstrings > 0)
- lua_string_start();
- return;
- break;
- case pdf_insert_ht_code:
- scan_register_num();
- break;
- case pdf_ximage_bbox_code:
- scan_int();
- check_obj_type(static_pdf, obj_type_ximage, cur_val);
- i = obj_data_ptr(static_pdf, cur_val);
- scan_int();
- j = cur_val;
- if ((j < 1) || (j > 4))
- pdf_error("pdfximagebbox", "invalid parameter");
- break;
- /* Cases of 'Scan the argument for command |c|' */
- case eTeX_revision_code:
- break;
- default:
- confusion("convert");
- break;
- }
-
- old_setting = selector;
- selector = new_string;
-
- /* Print the result of command |c| */
- if (!print_convert_string(c, cur_val)) {
- switch (c) {
- case string_code:
- if (cur_cs != 0)
- sprint_cs(cur_cs);
- else
- print(cur_chr);
- break;
- case meaning_code:
- print_meaning();
- break;
- case left_margin_kern_code:
- p = list_ptr(box(cur_val));
- if ((p != null) && (!is_char_node(p)) &&
- (type(p) == glue_node) && (subtype(p) == left_skip_code + 1))
- p = vlink(p);
- if ((p != null) && (!is_char_node(p)) &&
- (type(p) == margin_kern_node) && (subtype(p) == left_side))
- print_scaled(width(p));
- else
- print_char('0');
- tprint("pt");
- break;
- case right_margin_kern_code:
- q = list_ptr(box(cur_val));
- p = null;
- if (q != null) {
- p = prev_rightmost(q, null);
- if ((p != null) && (!is_char_node(p)) && (type(p) == glue_node)
- && (subtype(p) == right_skip_code + 1))
- p = prev_rightmost(q, p);
- }
- if ((p != null) && (!is_char_node(p)) &&
- (type(p) == margin_kern_node) && (subtype(p) == right_side))
- print_scaled(width(p));
- else
- print_char('0');
- tprint("pt");
- break;
- case pdf_colorstack_init_code:
- print_int(cur_val);
- break;
- case pdf_insert_ht_code:
- i = cur_val;
- p = page_ins_head;
- while (i >= subtype(vlink(p)))
- p = vlink(p);
- if (subtype(p) == i)
- print_scaled(height(p));
- else
- print_char('0');
- tprint("pt");
- break;
- case pdf_ximage_bbox_code:
- if (is_pdf_image(i)) {
- switch (j) {
- case 1:
- print_scaled(epdf_orig_x(i));
- break;
- case 2:
- print_scaled(epdf_orig_y(i));
- break;
- case 3:
- print_scaled(epdf_orig_x(i) + epdf_xsize(i));
- break;
- case 4:
- print_scaled(epdf_orig_y(i) + epdf_ysize(i));
- break;
- }
- } else {
- print_scaled(0);
- }
- tprint("pt");
- break;
- case pdf_creation_date_code:
- case lua_escape_string_code:
- case lua_code:
- case expanded_code:
- break;
- default:
- confusion("convert");
- break;
- }
- }
-
- selector = old_setting;
- str = make_string();
- (void) str_toks(str_lstring(str));
- flush_str(str);
- ins_list(token_link(temp_token_head));
-}
-
-@ This boolean is keeping track of the lua string escape state
-@c
-boolean in_lua_escape;
-
-@ probably not needed anymore
-@c
-boolean is_convert(halfword c)
-{
- return (c == convert_cmd);
-}
-
-str_number the_convert_string(halfword c, int i)
-{
- int old_setting; /* saved |selector| setting */
- str_number ret = 0;
- old_setting = selector;
- selector = new_string;
- if (print_convert_string(c, i)) {
- ret = make_string();
- } else if (c == font_identifier_code) {
- print_font_identifier(i);
- ret = make_string();
- }
- selector = old_setting;
- return ret;
-}
-
-@ Another way to create a token list is via the \.{\\read} command. The
-sixteen files potentially usable for reading appear in the following
-global variables. The value of |read_open[n]| will be |closed| if
-stream number |n| has not been opened or if it has been fully read;
-|just_open| if an \.{\\openin} but not a \.{\\read} has been done;
-and |normal| if it is open and ready to read the next line.
-
-@c
-FILE *read_file[16]; /* used for \.{\\read} */
-int read_open[17]; /* state of |read_file[n]| */
-
-void initialize_read(void)
-{
- int k;
- for (k = 0; k <= 16; k++)
- read_open[k] = closed;
-}
-
-@ The |read_toks| procedure constructs a token list like that for any
-macro definition, and makes |cur_val| point to it. Parameter |r| points
-to the control sequence that will receive this token list.
-
-@c
-void read_toks(int n, halfword r, halfword j)
-{
- halfword p; /* tail of the token list */
- halfword q; /* new node being added to the token list via |store_new_token| */
- int s; /* saved value of |align_state| */
- int m; /* stream number */
- scanner_status = defining;
- warning_index = r;
- p = get_avail();
- def_ref = p;
- set_token_ref_count(def_ref, 0);
- p = def_ref; /* the reference count */
- store_new_token(end_match_token);
- if ((n < 0) || (n > 15))
- m = 16;
- else
- m = n;
- s = align_state;
- align_state = 1000000; /* disable tab marks, etc. */
- do {
- /* Input and store tokens from the next line of the file */
- begin_file_reading();
- iname = m + 1;
- if (read_open[m] == closed) {
- /* Input for \.{\\read} from the terminal */
- /* Here we input on-line into the |buffer| array, prompting the user explicitly
- if |n>=0|. The value of |n| is set negative so that additional prompts
- will not be given in the case of multi-line input. */
- if (interaction > nonstop_mode) {
- if (n < 0) {
- prompt_input("");
- } else {
- wake_up_terminal();
- print_ln();
- sprint_cs(r);
- prompt_input(" =");
- n = -1;
- }
- } else {
- fatal_error
- ("*** (cannot \\read from terminal in nonstop modes)");
- }
-
- } else if (read_open[m] == just_open) {
- /* Input the first line of |read_file[m]| */
- /* The first line of a file must be treated specially, since |lua_input_ln|
- must be told not to start with |get|. */
- if (lua_input_ln(read_file[m], (m + 1), false)) {
- read_open[m] = normal;
- } else {
- lua_a_close_in(read_file[m], (m + 1));
- read_open[m] = closed;
- }
-
- } else {
- /* Input the next line of |read_file[m]| */
- /* An empty line is appended at the end of a |read_file|. */
- if (!lua_input_ln(read_file[m], (m + 1), true)) {
- lua_a_close_in(read_file[m], (m + 1));
- read_open[m] = closed;
- if (align_state != 1000000) {
- runaway();
- print_err("File ended within \\read");
- help1("This \\read has unbalanced braces.");
- align_state = 1000000;
- error();
- }
- }
-
- }
- ilimit = last;
- if (end_line_char_inactive())
- decr(ilimit);
- else
- buffer[ilimit] = (packed_ASCII_code) int_par(end_line_char_code);
- first = ilimit + 1;
- iloc = istart;
- istate = new_line;
- /* Handle \.{\\readline} and |goto done|; */
- if (j == 1) {
- while (iloc <= ilimit) { /* current line not yet finished */
- cur_chr = buffer[iloc];
- incr(iloc);
- if (cur_chr == ' ')
- cur_tok = space_token;
- else
- cur_tok = cur_chr + other_token;
- store_new_token(cur_tok);
- }
- } else {
- while (1) {
- get_token();
- if (cur_tok == 0)
- break; /* |cur_cmd=cur_chr=0| will occur at the end of the line */
- if (align_state < 1000000) { /* unmatched `\.\}' aborts the line */
- do {
- get_token();
- } while (cur_tok != 0);
- align_state = 1000000;
- break;
- }
- store_new_token(cur_tok);
- }
- }
- end_file_reading();
-
- } while (align_state != 1000000);
- cur_val = def_ref;
- scanner_status = normal;
- align_state = s;
-}
-
-@ @c
-str_number tokens_to_string(halfword p)
-{ /* return a string from tokens list */
- int old_setting;
- if (selector == new_string)
- pdf_error("tokens",
- "tokens_to_string() called while selector = new_string");
- old_setting = selector;
- selector = new_string;
- show_token_list(token_link(p), null, -1);
- selector = old_setting;
- return make_string();
-}
-
-@ @c
-#define make_room(a) \
- if ((unsigned)i+a+1>alloci) { \
- ret = xrealloc(ret,(alloci+64)); \
- alloci = alloci + 64; \
- }
-
-
-#define append_i_byte(a) ret[i++] = (char)(a)
-
-#define Print_char(a) make_room(1); append_i_byte(a)
-
-#define Print_uchar(s) { \
- make_room(4); \
- if (s<=0x7F) { \
- append_i_byte(s); \
- } else if (s<=0x7FF) { \
- append_i_byte(0xC0 + (s / 0x40)); \
- append_i_byte(0x80 + (s % 0x40)); \
- } else if (s<=0xFFFF) { \
- append_i_byte(0xE0 + (s / 0x1000)); \
- append_i_byte(0x80 + ((s % 0x1000) / 0x40)); \
- append_i_byte(0x80 + ((s % 0x1000) % 0x40)); \
- } else if (s>=0x110000) { \
- append_i_byte(s-0x11000); \
- } else { \
- append_i_byte(0xF0 + (s / 0x40000)); \
- append_i_byte(0x80 + ((s % 0x40000) / 0x1000)); \
- append_i_byte(0x80 + (((s % 0x40000) % 0x1000) / 0x40)); \
- append_i_byte(0x80 + (((s % 0x40000) % 0x1000) % 0x40)); \
- } }
-
-
-#define Print_esc(b) { \
- const char *v = b; \
- if (e>0 && e<STRING_OFFSET) { \
- Print_uchar (e); \
- } \
- make_room(strlen(v)); \
- while (*v) { append_i_byte(*v); v++; } \
- }
-
-#define is_cat_letter(a) \
- (get_char_cat_code(pool_to_unichar(str_string((a)))) == 11)
-
-@ the actual token conversion in this function is now functionally
- equivalent to |show_token_list|, except that it always prints the
- whole token list.
- TODO: check whether this causes problems in the lua library.
-
-@c
-char *tokenlist_to_cstring(int pp, int inhibit_par, int *siz)
-{
- register int p, c, m;
- int q;
- int infop;
- char *s, *sh;
- int e = 0;
- char *ret;
- int match_chr = '#';
- int n = '0';
- unsigned alloci = 1024;
- int i = 0;
- p = pp;
- if (p == null) {
- if (siz != NULL)
- *siz = 0;
- return NULL;
- }
- ret = xmalloc(alloci);
- p = token_link(p); /* skip refcount */
- if (p != null) {
- e = int_par(escape_char_code);
- }
- while (p != null) {
- if (p < (int) fix_mem_min || p > (int) fix_mem_end) {
- Print_esc("CLOBBERED.");
- break;
- }
- infop = token_info(p);
- if (infop >= cs_token_flag) {
- if (!(inhibit_par && infop == par_token)) {
- q = infop - cs_token_flag;
- if (q < hash_base) {
- if (q == null_cs) {
- Print_esc("csname");
- Print_esc("endcsname");
- } else {
- Print_esc("IMPOSSIBLE.");
- }
- } else if ((q >= undefined_control_sequence)
- && ((q <= eqtb_size)
- || (q > eqtb_size + hash_extra))) {
- Print_esc("IMPOSSIBLE.");
- } else if ((cs_text(q) < 0) || (cs_text(q) >= str_ptr)) {
- Print_esc("NONEXISTENT.");
- } else {
- str_number txt = cs_text(q);
- sh = makecstring(txt);
- s = sh;
- if (is_active_cs(txt)) {
- s = s + 3;
- while (*s) {
- Print_char(*s);
- s++;
- }
- } else {
- Print_uchar(e);
- while (*s) {
- Print_char(*s);
- s++;
- }
- if ((!single_letter(txt)) || is_cat_letter(txt)) {
- Print_char(' ');
- }
- }
- free(sh);
- }
- }
- } else {
- if (infop < 0) {
- Print_esc("BAD.");
- } else {
- m = token_cmd(infop);
- c = token_chr(infop);
- switch (m) {
- case left_brace_cmd:
- case right_brace_cmd:
- case math_shift_cmd:
- case tab_mark_cmd:
- case sup_mark_cmd:
- case sub_mark_cmd:
- case spacer_cmd:
- case letter_cmd:
- case other_char_cmd:
- Print_uchar(c);
- break;
- case mac_param_cmd:
- if (!in_lua_escape)
- Print_uchar(c);
- Print_uchar(c);
- break;
- case out_param_cmd:
- Print_uchar(match_chr);
- if (c <= 9) {
- Print_char(c + '0');
- } else {
- Print_char('!');
- goto EXIT;
- }
- break;
- case match_cmd:
- match_chr = c;
- Print_uchar(c);
- n++;
- Print_char(n);
- if (n > '9')
- goto EXIT;
- break;
- case end_match_cmd:
- if (c == 0) {
- Print_char('-');
- Print_char('>');
- }
- break;
- default:
- Print_esc("BAD.");
- break;
- }
- }
- }
- p = token_link(p);
- }
- EXIT:
- ret[i] = '\0';
- if (siz != NULL)
- *siz = i;
- return ret;
-}
-
-@ @c
-lstring *tokenlist_to_lstring(int pp, int inhibit_par)
-{
- int siz;
- lstring *ret = xmalloc(sizeof(lstring));
- ret->s = (unsigned char *) tokenlist_to_cstring(pp, inhibit_par, &siz);
- ret->l = (size_t) siz;
- return ret;
-}
-
-@ @c
-void free_lstring(lstring * ls)
-{
- if (ls == NULL)
- return;
- if (ls->s != NULL)
- free(ls->s);
- free(ls);
-}
+% textoken.w
+%
+% Copyright 2006-2011 Taco Hoekwater <taco@@luatex.org>
+%
+% This file is part of LuaTeX.
+%
+% LuaTeX is free software; you can redistribute it and/or modify it under
+% the terms of the GNU General Public License as published by the Free
+% Software Foundation; either version 2 of the License, or (at your
+% option) any later version.
+%
+% LuaTeX is distributed in the hope that it will be useful, but WITHOUT
+% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+% FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
+% License for more details.
+%
+% You should have received a copy of the GNU General Public License along
+% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
+
+@ @c
+static const char _svn_version[] =
+ "$Id: textoken.w 4786 2014-02-10 13:17:44Z taco $"
+ "$URL: https://foundry.supelec.fr/svn/luatex/trunk/source/texk/web2c/luatexdir/tex/textoken.w $";
+
+#include "ptexlib.h"
+
+@ @c
+#define pausing int_par(pausing_code)
+#define cat_code_table int_par(cat_code_table_code)
+#define tracing_nesting int_par(tracing_nesting_code)
+#define end_line_char int_par(end_line_char_code)
+#define suppress_outer_error int_par(suppress_outer_error_code)
+
+#define every_eof equiv(every_eof_loc)
+#define box(A) equiv(box_base+(A))
+
+#define detokenized_line() (line_catcode_table==NO_CAT_TABLE)
+
+#define do_get_cat_code(a,b) do { \
+ if (line_catcode_table!=DEFAULT_CAT_TABLE) \
+ a=get_cat_code(line_catcode_table,b); \
+ else \
+ a=get_cat_code(cat_code_table,b); \
+ } while (0)
+
+
+@ The \TeX\ system does nearly all of its own memory allocation, so that it
+can readily be transported into environments that do not have automatic
+facilities for strings, garbage collection, etc., and so that it can be in
+control of what error messages the user receives. The dynamic storage
+requirements of \TeX\ are handled by providing two large arrays called
+|fixmem| and |varmem| in which consecutive blocks of words are used as
+nodes by the \TeX\ routines.
+
+Pointer variables are indices into this array, or into another array
+called |eqtb| that will be explained later. A pointer variable might
+also be a special flag that lies outside the bounds of |mem|, so we
+allow pointers to assume any |halfword| value. The minimum halfword
+value represents a null pointer. \TeX\ does not assume that |mem[null]| exists.
+
+
+
+@ Locations in |fixmem| are used for storing one-word records; a conventional
+\.{AVAIL} stack is used for allocation in this array.
+
+@c
+smemory_word *fixmem; /* the big dynamic storage area */
+unsigned fix_mem_min; /* the smallest location of one-word memory in use */
+unsigned fix_mem_max; /* the largest location of one-word memory in use */
+
+
+@ In order to study the memory requirements of particular applications, it
+is possible to prepare a version of \TeX\ that keeps track of current and
+maximum memory usage. When code between the delimiters |@!stat| $\ldots$
+|tats| is not ``commented out,'' \TeX\ will run a bit slower but it will
+report these statistics when |tracing_stats| is sufficiently large.
+
+@c
+int var_used, dyn_used; /* how much memory is in use */
+
+halfword avail; /* head of the list of available one-word nodes */
+unsigned fix_mem_end; /* the last one-word node used in |mem| */
+
+halfword garbage; /* head of a junk list, write only */
+halfword temp_token_head; /* head of a temporary list of some kind */
+halfword hold_token_head; /* head of a temporary list of another kind */
+halfword omit_template; /* a constant token list */
+halfword null_list; /* permanently empty list */
+halfword backup_head; /* head of token list built by |scan_keyword| */
+
+@ @c
+void initialize_tokens(void)
+{
+ halfword p;
+ avail = null;
+ fix_mem_end = 0;
+ p = get_avail();
+ temp_token_head = p;
+ set_token_info(temp_token_head, 0);
+ p = get_avail();
+ hold_token_head = p;
+ set_token_info(hold_token_head, 0);
+ p = get_avail();
+ omit_template = p;
+ set_token_info(omit_template, 0);
+ p = get_avail();
+ null_list = p;
+ set_token_info(null_list, 0);
+ p = get_avail();
+ backup_head = p;
+ set_token_info(backup_head, 0);
+ p = get_avail();
+ garbage = p;
+ set_token_info(garbage, 0);
+ dyn_used = 0; /* initialize statistics */
+}
+
+@ The function |get_avail| returns a pointer to a new one-word node whose
+|link| field is null. However, \TeX\ will halt if there is no more room left.
+@^inner loop@>
+
+If the available-space list is empty, i.e., if |avail=null|,
+we try first to increase |fix_mem_end|. If that cannot be done, i.e., if
+|fix_mem_end=fix_mem_max|, we try to reallocate array |fixmem|.
+If, that doesn't work, we have to quit.
+
+@c
+halfword get_avail(void)
+{ /* single-word node allocation */
+ unsigned p; /* the new node being got */
+ unsigned t;
+ p = (unsigned) avail; /* get top location in the |avail| stack */
+ if (p != null) {
+ avail = token_link(avail); /* and pop it off */
+ } else if (fix_mem_end < fix_mem_max) { /* or go into virgin territory */
+ incr(fix_mem_end);
+ p = fix_mem_end;
+ } else {
+ smemory_word *new_fixmem; /* the big dynamic storage area */
+ t = (fix_mem_max / 5);
+ new_fixmem =
+ fixmemcast(realloc
+ (fixmem, sizeof(smemory_word) * (fix_mem_max + t + 1)));
+ if (new_fixmem == NULL) {
+ runaway(); /* if memory is exhausted, display possible runaway text */
+ overflow("token memory size", fix_mem_max);
+ } else {
+ fixmem = new_fixmem;
+ }
+ memset(voidcast(fixmem + fix_mem_max + 1), 0, t * sizeof(smemory_word));
+ fix_mem_max += t;
+ p = ++fix_mem_end;
+ }
+ token_link(p) = null; /* provide an oft-desired initialization of the new node */
+ incr(dyn_used); /* maintain statistics */
+ return (halfword) p;
+}
+
+
+@ The procedure |flush_list(p)| frees an entire linked list of
+one-word nodes that starts at position |p|.
+@^inner loop@>
+
+@c
+void flush_list(halfword p)
+{ /* makes list of single-word nodes available */
+ halfword q, r; /* list traversers */
+ if (p != null) {
+ r = p;
+ do {
+ q = r;
+ r = token_link(r);
+ decr(dyn_used);
+ } while (r != null); /* now |q| is the last node on the list */
+ token_link(q) = avail;
+ avail = p;
+ }
+}
+
+@ A \TeX\ token is either a character or a control sequence, and it is
+@^token@>
+represented internally in one of two ways: (1)~A character whose ASCII
+code number is |c| and whose command code is |m| is represented as the
+number $2^{21}m+c$; the command code is in the range |1<=m<=14|. (2)~A control
+sequence whose |eqtb| address is |p| is represented as the number
+|cs_token_flag+p|. Here |cs_token_flag=@t$2^{25}-1$@>| is larger than
+$2^{21}m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|;
+thus, a token fits comfortably in a halfword.
+
+A token |t| represents a |left_brace| command if and only if
+|t<left_brace_limit|; it represents a |right_brace| command if and only if
+we have |left_brace_limit<=t<right_brace_limit|; and it represents a |match| or
+|end_match| command if and only if |match_token<=t<=end_match_token|.
+The following definitions take care of these token-oriented constants
+and a few others.
+
+@ 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 |print_meaning| subroutine displays |cur_cmd| and |cur_chr| in
+symbolic form, including the expansion of a macro or mark.
+
+@c
+void print_meaning(void)
+{
+ print_cmd_chr((quarterword) cur_cmd, cur_chr);
+ if (cur_cmd >= call_cmd) {
+ print_char(':');
+ print_ln();
+ token_show(cur_chr);
+ } else {
+ /* Show the meaning of a mark node */
+ if ((cur_cmd == top_bot_mark_cmd) && (cur_chr < marks_code)) {
+ print_char(':');
+ print_ln();
+ switch (cur_chr) {
+ case first_mark_code:
+ token_show(first_mark(0));
+ break;
+ case bot_mark_code:
+ token_show(bot_mark(0));
+ break;
+ case split_first_mark_code:
+ token_show(split_first_mark(0));
+ break;
+ case split_bot_mark_code:
+ token_show(split_bot_mark(0));
+ break;
+ default:
+ token_show(top_mark(0));
+ break;
+ }
+ }
+ }
+}
+
+
+@ 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\ }'.
+
+@c
+void show_token_list(int p, int q, int l)
+{
+ int m, c; /* pieces of a token */
+ ASCII_code match_chr; /* character used in a `|match|' */
+ ASCII_code n; /* the highest parameter number, as an ASCII digit */
+ match_chr = '#';
+ n = '0';
+ tally = 0;
+ if (l < 0)
+ l = 0x3FFFFFFF;
+ while ((p != null) && (tally < l)) {
+ if (p == q) {
+ /* Do magic computation */
+ set_trick_count();
+ }
+ /* Display token |p|, and |return| if there are problems */
+ if ((p < (int) fix_mem_min) || (p > (int) fix_mem_end)) {
+ tprint_esc("CLOBBERED.");
+ return;
+ }
+ if (token_info(p) >= cs_token_flag) {
+ if (!((inhibit_par_tokens) && (token_info(p) == par_token)))
+ print_cs(token_info(p) - cs_token_flag);
+ } else {
+ m = token_cmd(token_info(p));
+ c = token_chr(token_info(p));
+ if (token_info(p) < 0) {
+ tprint_esc("BAD.");
+ } else {
+ /* Display the token $(|m|,|c|)$ */
+ /* 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. */
+ switch (m) {
+ case left_brace_cmd:
+ case right_brace_cmd:
+ case math_shift_cmd:
+ case tab_mark_cmd:
+ case sup_mark_cmd:
+ case sub_mark_cmd:
+ case spacer_cmd:
+ case letter_cmd:
+ case other_char_cmd:
+ print(c);
+ break;
+ case mac_param_cmd:
+ if (!in_lua_escape)
+ print(c);
+ print(c);
+ break;
+ case out_param_cmd:
+ print(match_chr);
+ if (c <= 9) {
+ print_char(c + '0');
+ } else {
+ print_char('!');
+ return;
+ }
+ break;
+ case match_cmd:
+ match_chr = c;
+ print(c);
+ incr(n);
+ print_char(n);
+ if (n > '9')
+ return;
+ break;
+ case end_match_cmd:
+ if (c == 0)
+ tprint("->");
+ break;
+ default:
+ tprint_esc("BAD.");
+ break;
+ }
+ }
+ }
+ p = token_link(p);
+ }
+ if (p != null)
+ tprint_esc("ETC.");
+}
+
+@ @c
+#define do_buffer_to_unichar(a,b) do { \
+ a = (halfword)str2uni(buffer+b); \
+ b += utf8_size(a); \
+ } while (0)
+
+
+@ Here's the way we sometimes want to display a token list, given a pointer
+to its reference count; the pointer may be null.
+
+@c
+void token_show(halfword p)
+{
+ if (p != null)
+ show_token_list(token_link(p), null, 10000000);
+}
+
+
+
+@ |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@>
+
+@c
+void delete_token_ref(halfword p)
+{ /* |p| points to the reference count
+ of a token list that is losing one reference */
+ assert(token_ref_count(p) >= 0);
+ if (token_ref_count(p) == 0)
+ flush_list(p);
+ else
+ decr(token_ref_count(p));
+}
+
+@ @c
+int get_char_cat_code(int curchr)
+{
+ int a;
+ do_get_cat_code(a,curchr);
+ return a;
+}
+
+@ @c
+static void invalid_character_error(void)
+{
+ const char *hlp[] =
+ { "A funny symbol that I can't read has just been input.",
+ "Continue, and I'll forget that it ever happened.",
+ NULL
+ };
+ deletions_allowed = false;
+ tex_error("Text line contains an invalid character", hlp);
+ deletions_allowed = true;
+}
+
+@ @c
+static boolean process_sup_mark(void); /* below */
+
+static int scan_control_sequence(void); /* below */
+
+typedef enum { next_line_ok, next_line_return,
+ next_line_restart
+} next_line_retval;
+
+static next_line_retval next_line(void); /* below */
+
+
+@ In case you are getting bored, here is a slightly less trivial routine:
+ Given a string of lowercase letters, like `\.{pt}' or `\.{plus}' or
+ `\.{width}', the |scan_keyword| routine checks to see whether the next
+ tokens of input match this string. The match must be exact, except that
+ uppercase letters will match their lowercase counterparts; uppercase
+ equivalents are determined by subtracting |"a"-"A"|, rather than using the
+ |uc_code| table, since \TeX\ uses this routine only for its own limited
+ set of keywords.
+
+ If a match is found, the characters are effectively removed from the input
+ and |true| is returned. Otherwise |false| is returned, and the input
+ is left essentially unchanged (except for the fact that some macros
+ may have been expanded, etc.).
+ @^inner loop@>
+
+@c
+boolean scan_keyword(const char *s)
+{ /* look for a given string */
+ halfword p; /* tail of the backup list */
+ halfword q; /* new node being added to the token list via |store_new_token| */
+ const char *k; /* index into |str_pool| */
+ halfword save_cur_cs = cur_cs;
+ int saved_align_state = align_state;
+ assert (strlen(s) > 1);
+ p = backup_head;
+ token_link(p) = null;
+ k = s;
+ while (*k) {
+ get_x_token(); /* recursion is possible here */
+ if ((cur_cs == 0) &&
+ ((cur_chr == *k) || (cur_chr == *k - 'a' + 'A'))) {
+ store_new_token(cur_tok);
+ k++;
+ } else if ((cur_cmd != spacer_cmd) || (p != backup_head)) {
+ if (p != backup_head) {
+ q = get_avail();
+ token_info(q) = cur_tok;
+ token_link(q) = null;
+ token_link(p) = q;
+ begin_token_list(token_link(backup_head), backed_up);
+ if (cur_cmd != endv_cmd)
+ align_state = saved_align_state;
+ } else {
+ back_input();
+ }
+ cur_cs = save_cur_cs;
+ return false;
+ }
+ }
+ flush_list(token_link(backup_head));
+ cur_cs = save_cur_cs;
+ if (cur_cmd != endv_cmd)
+ align_state = saved_align_state;
+ return true;
+}
+
+@ We can not return |undefined_control_sequence| under some conditions
+ (inside |shift_case|, for example). This needs thinking.
+
+@c
+halfword active_to_cs(int curchr, int force)
+{
+ halfword curcs;
+ char *a, *b;
+ char *utfbytes = xmalloc(10);
+ int nncs = no_new_control_sequence;
+ a = (char *) uni2str(0xFFFF);
+ utfbytes = strcpy(utfbytes, a);
+ if (force)
+ no_new_control_sequence = false;
+ if (curchr > 0) {
+ b = (char *) uni2str((unsigned) curchr);
+ utfbytes = strcat(utfbytes, b);
+ free(b);
+ curcs = string_lookup(utfbytes, strlen(utfbytes));
+ } else {
+ utfbytes[3] = '\0';
+ curcs = string_lookup(utfbytes, 4);
+ }
+ no_new_control_sequence = nncs;
+ free(a);
+ free(utfbytes);
+ return curcs;
+}
+
+@ TODO this function should listen to \.{\\escapechar}
+
+@c
+static char *cs_to_string(halfword p)
+{ /* prints a control sequence */
+ const char *s;
+ char *sh;
+ int k = 0;
+ static char ret[256] = { 0 };
+ if (p == 0 || p == null_cs) {
+ ret[k++] = '\\';
+ s = "csname";
+ while (*s) {
+ ret[k++] = *s++;
+ }
+ ret[k++] = '\\';
+ s = "endcsname";
+ while (*s) {
+ ret[k++] = *s++;
+ }
+ ret[k] = 0;
+
+ } else {
+ str_number txt = cs_text(p);
+ sh = makecstring(txt);
+ s = sh;
+ if (is_active_cs(txt)) {
+ s = s + 3;
+ while (*s) {
+ ret[k++] = *s++;
+ }
+ ret[k] = 0;
+ } else {
+ ret[k++] = '\\';
+ while (*s) {
+ ret[k++] = *s++;
+ }
+ ret[k] = 0;
+ }
+ free(sh);
+ }
+ return (char *) ret;
+}
+
+@ TODO this is a quick hack, will be solved differently soon
+
+@c
+static char *cmd_chr_to_string(int cmd, int chr)
+{
+ char *s;
+ str_number str;
+ int sel = selector;
+ selector = new_string;
+ print_cmd_chr((quarterword) cmd, chr);
+ str = make_string();
+ s = makecstring(str);
+ selector = sel;
+ flush_str(str);
+ return s;
+}
+
+@ The heart of \TeX's input mechanism is the |get_next| procedure, which
+we shall develop in the next few sections of the program. Perhaps we
+shouldn't actually call it the ``heart,'' however, because it really acts
+as \TeX's eyes and mouth, reading the source files and gobbling them up.
+And it also helps \TeX\ to regurgitate stored token lists that are to be
+processed again.
+@^eyes and mouth@>
+
+The main duty of |get_next| is to input one token and to set |cur_cmd|
+and |cur_chr| to that token's command code and modifier. Furthermore, if
+the input token is a control sequence, the |eqtb| location of that control
+sequence is stored in |cur_cs|; otherwise |cur_cs| is set to zero.
+
+Underlying this simple description is a certain amount of complexity
+because of all the cases that need to be handled.
+However, the inner loop of |get_next| is reasonably short and fast.
+
+When |get_next| is asked to get the next token of a \.{\\read} line,
+it sets |cur_cmd=cur_chr=cur_cs=0| in the case that no more tokens
+appear on that line. (There might not be any tokens at all, if the
+|end_line_char| has |ignore| as its catcode.)
+
+
+@ The value of |par_loc| is the |eqtb| address of `\.{\\par}'. This quantity
+is needed because a blank line of input is supposed to be exactly equivalent
+to the appearance of \.{\\par}; we must set |cur_cs:=par_loc|
+when detecting a blank line.
+
+@c
+halfword par_loc; /* location of `\.{\\par}' in |eqtb| */
+halfword par_token; /* token representing `\.{\\par}' */
+
+
+@ Parts |get_next| are executed more often than any other instructions of \TeX.
+@^mastication@>@^inner loop@>
+
+
+
+@ The global variable |force_eof| is normally |false|; it is set |true|
+by an \.{\\endinput} command. |luacstrings| is the number of lua print
+statements waiting to be input, it is changed by |luatokencall|.
+
+@c
+boolean force_eof; /* should the next \.{\\input} be aborted early? */
+int luacstrings; /* how many lua strings are waiting to be input? */
+
+
+@ If the user has set the |pausing| parameter to some positive value,
+and if nonstop mode has not been selected, each line of input is displayed
+on the terminal and the transcript file, followed by `\.{=>}'.
+\TeX\ waits for a response. If the response is simply |carriage_return|, the
+line is accepted as it stands, otherwise the line typed is
+used instead of the line in the file.
+
+@c
+void firm_up_the_line(void)
+{
+ int k; /* an index into |buffer| */
+ ilimit = last;
+ if (pausing > 0) {
+ if (interaction > nonstop_mode) {
+ wake_up_terminal();
+ print_ln();
+ if (istart < ilimit) {
+ for (k = istart; k <= ilimit - 1; k++)
+ print_char(buffer[k]);
+ }
+ first = ilimit;
+ prompt_input("=>"); /* wait for user response */
+ if (last > first) {
+ for (k = first; k < +last - 1; k++) /* move line down in buffer */
+ buffer[k + istart - first] = buffer[k];
+ ilimit = istart + last - first;
+ }
+ }
+ }
+}
+
+
+
+@ Before getting into |get_next|, let's consider the subroutine that
+ is called when an `\.{\\outer}' control sequence has been scanned or
+ when the end of a file has been reached. These two cases are distinguished
+ by |cur_cs|, which is zero at the end of a file.
+
+@c
+void check_outer_validity(void)
+{
+ halfword p; /* points to inserted token list */
+ halfword q; /* auxiliary pointer */
+ if (suppress_outer_error)
+ return;
+ if (scanner_status != normal) {
+ deletions_allowed = false;
+ /* Back up an outer control sequence so that it can be reread; */
+ /* An outer control sequence that occurs in a \.{\\read} will not be reread,
+ since the error recovery for \.{\\read} is not very powerful. */
+ if (cur_cs != 0) {
+ if ((istate == token_list) || (iname < 1) || (iname > 17)) {
+ p = get_avail();
+ token_info(p) = cs_token_flag + cur_cs;
+ begin_token_list(p, backed_up); /* prepare to read the control sequence again */
+ }
+ cur_cmd = spacer_cmd;
+ cur_chr = ' '; /* replace it by a space */
+ }
+ if (scanner_status > skipping) {
+ const char *errhlp[] =
+ { "I suspect you have forgotten a `}', causing me",
+ "to read past where you wanted me to stop.",
+ "I'll try to recover; but if the error is serious,",
+ "you'd better type `E' or `X' now and fix your file.",
+ NULL
+ };
+ char errmsg[256];
+ const char *startmsg;
+ const char *scannermsg;
+ /* Tell the user what has run away and try to recover */
+ runaway(); /* print a definition, argument, or preamble */
+ if (cur_cs == 0) {
+ startmsg = "File ended";
+ } else {
+ cur_cs = 0;
+ startmsg = "Forbidden control sequence found";
+ }
+ /* Print either `\.{definition}' or `\.{use}' or `\.{preamble}' or `\.{text}',
+ and insert tokens that should lead to recovery; */
+ /* The recovery procedure can't be fully understood without knowing more
+ about the \TeX\ routines that should be aborted, but we can sketch the
+ ideas here: For a runaway definition we will insert a right brace; for a
+ runaway preamble, we will insert a special \.{\\cr} token and a right
+ brace; and for a runaway argument, we will set |long_state| to
+ |outer_call| and insert \.{\\par}. */
+ p = get_avail();
+ switch (scanner_status) {
+ case defining:
+ scannermsg = "definition";
+ token_info(p) = right_brace_token + '}';
+ break;
+ case matching:
+ scannermsg = "use";
+ token_info(p) = par_token;
+ long_state = outer_call_cmd;
+ break;
+ case aligning:
+ scannermsg = "preamble";
+ token_info(p) = right_brace_token + '}';
+ q = p;
+ p = get_avail();
+ token_link(p) = q;
+ token_info(p) = cs_token_flag + frozen_cr;
+ align_state = -1000000;
+ break;
+ case absorbing:
+ scannermsg = "text";
+ token_info(p) = right_brace_token + '}';
+ break;
+ default: /* can't happen */
+ scannermsg = "unknown";
+ break;
+ } /*there are no other cases */
+ begin_token_list(p, inserted);
+ snprintf(errmsg, 255, "%s while scanning %s of %s",
+ startmsg, scannermsg, cs_to_string(warning_index));
+ tex_error(errmsg, errhlp);
+ } else {
+ char errmsg[256];
+ const char *errhlp_no[] =
+ { "The file ended while I was skipping conditional text.",
+ "This kind of error happens when you say `\\if...' and forget",
+ "the matching `\\fi'. I've inserted a `\\fi'; this might work.",
+ NULL
+ };
+ const char *errhlp_cs[] =
+ { "A forbidden control sequence occurred in skipped text.",
+ "This kind of error happens when you say `\\if...' and forget",
+ "the matching `\\fi'. I've inserted a `\\fi'; this might work.",
+ NULL
+ };
+ const char **errhlp = (const char **) errhlp_no;
+ char *ss;
+ if (cur_cs != 0) {
+ errhlp = errhlp_cs;
+ cur_cs = 0;
+ }
+ ss = cmd_chr_to_string(if_test_cmd, cur_if);
+ snprintf(errmsg, 255,
+ "Incomplete %s; all text was ignored after line %d",
+ ss, (int) skip_line);
+ free(ss);
+ /* Incomplete \\if... */
+ cur_tok = cs_token_flag + frozen_fi;
+ /* back up one inserted token and call |error| */
+ {
+ OK_to_interrupt = false;
+ back_input();
+ token_type = inserted;
+ OK_to_interrupt = true;
+ tex_error(errmsg, errhlp);
+ }
+ }
+ deletions_allowed = true;
+ }
+}
+
+@ @c
+static boolean get_next_file(void)
+{
+ SWITCH:
+ if (iloc <= ilimit) { /* current line not yet finished */
+ do_buffer_to_unichar(cur_chr, iloc);
+
+ RESWITCH:
+ if (detokenized_line()) {
+ cur_cmd = (cur_chr == ' ' ? 10 : 12);
+ } else {
+ do_get_cat_code(cur_cmd, cur_chr);
+ }
+ /*
+ Change state if necessary, and |goto switch| if the current
+ character should be ignored, or |goto reswitch| if the current
+ character changes to another;
+ */
+ /* The following 48-way switch accomplishes the scanning quickly, assuming
+ that a decent C compiler has translated the code. Note that the numeric
+ values for |mid_line|, |skip_blanks|, and |new_line| are spaced
+ apart from each other by |max_char_code+1|, so we can add a character's
+ command code to the state to get a single number that characterizes both.
+ */
+ switch (istate + cur_cmd) {
+ case mid_line + ignore_cmd:
+ case skip_blanks + ignore_cmd:
+ case new_line + ignore_cmd:
+ case skip_blanks + spacer_cmd:
+ case new_line + spacer_cmd: /* Cases where character is ignored */
+ goto SWITCH;
+ break;
+ case mid_line + escape_cmd:
+ case new_line + escape_cmd:
+ case skip_blanks + escape_cmd: /* Scan a control sequence ...; */
+ istate = (unsigned char) scan_control_sequence();
+ if (cur_cmd >= outer_call_cmd)
+ check_outer_validity();
+ break;
+ case mid_line + active_char_cmd:
+ case new_line + active_char_cmd:
+ case skip_blanks + active_char_cmd: /* Process an active-character */
+ cur_cs = active_to_cs(cur_chr, false);
+ cur_cmd = eq_type(cur_cs);
+ cur_chr = equiv(cur_cs);
+ istate = mid_line;
+ if (cur_cmd >= outer_call_cmd)
+ check_outer_validity();
+ break;
+ case mid_line + sup_mark_cmd:
+ case new_line + sup_mark_cmd:
+ case skip_blanks + sup_mark_cmd: /* If this |sup_mark| starts */
+ if (process_sup_mark())
+ goto RESWITCH;
+ else
+ istate = mid_line;
+ break;
+ case mid_line + invalid_char_cmd:
+ case new_line + invalid_char_cmd:
+ case skip_blanks + invalid_char_cmd: /* Decry the invalid character and |goto restart|; */
+ invalid_character_error();
+ return false; /* because state may be |token_list| now */
+ break;
+ case mid_line + spacer_cmd: /* Enter |skip_blanks| state, emit a space; */
+ istate = skip_blanks;
+ cur_chr = ' ';
+ break;
+ case mid_line + car_ret_cmd: /* Finish line, emit a space; */
+ /* When a character of type |spacer| gets through, its character code is
+ changed to $\.{"\ "}=040$. This means that the ASCII codes for tab and space,
+ and for the space inserted at the end of a line, will
+ be treated alike when macro parameters are being matched. We do this
+ since such characters are indistinguishable on most computer terminal displays.
+ */
+ iloc = ilimit + 1;
+ cur_cmd = spacer_cmd;
+ cur_chr = ' ';
+ break;
+ case skip_blanks + car_ret_cmd:
+ case mid_line + comment_cmd:
+ case new_line + comment_cmd:
+ case skip_blanks + comment_cmd: /* Finish line, |goto switch|; */
+ iloc = ilimit + 1;
+ goto SWITCH;
+ break;
+ case new_line + car_ret_cmd: /* Finish line, emit a \.{\\par}; */
+ iloc = ilimit + 1;
+ cur_cs = par_loc;
+ cur_cmd = eq_type(cur_cs);
+ cur_chr = equiv(cur_cs);
+ if (cur_cmd >= outer_call_cmd)
+ check_outer_validity();
+ break;
+ case skip_blanks + left_brace_cmd:
+ case new_line + left_brace_cmd:
+ istate = mid_line; /* fall through */
+ case mid_line + left_brace_cmd:
+ align_state++;
+ break;
+ case skip_blanks + right_brace_cmd:
+ case new_line + right_brace_cmd:
+ istate = mid_line; /* fall through */
+ case mid_line + right_brace_cmd:
+ align_state--;
+ break;
+ case mid_line + math_shift_cmd:
+ case mid_line + tab_mark_cmd:
+ case mid_line + mac_param_cmd:
+ case mid_line + sub_mark_cmd:
+ case mid_line + letter_cmd:
+ case mid_line + other_char_cmd:
+ break;
+#if 0
+ case skip_blanks + math_shift:
+ case skip_blanks + tab_mark:
+ case skip_blanks + mac_param:
+ case skip_blanks + sub_mark:
+ case skip_blanks + letter:
+ case skip_blanks + other_char:
+ case new_line + math_shift:
+ case new_line + tab_mark:
+ case new_line + mac_param:
+ case new_line + sub_mark:
+ case new_line + letter:
+ case new_line + other_char:
+#else
+ default:
+#endif
+ istate = mid_line;
+ break;
+ }
+ } else {
+ if (iname != 21)
+ istate = new_line;
+
+ /*
+ Move to next line of file,
+ or |goto restart| if there is no next line,
+ or |return| if a \.{\\read} line has finished;
+ */
+ do {
+ next_line_retval r = next_line();
+ if (r == next_line_return) {
+ return true;
+ } else if (r == next_line_restart) {
+ return false;
+ }
+ } while (0);
+ check_interrupt();
+ goto SWITCH;
+ }
+ return true;
+}
+
+@ @c
+#define is_hex(a) ((a>='0'&&a<='9')||(a>='a'&&a<='f'))
+
+#define add_nybble(a) do { \
+ if (a<='9') cur_chr=(cur_chr<<4)+a-'0'; \
+ else cur_chr=(cur_chr<<4)+a-'a'+10; \
+ } while (0)
+
+#define hex_to_cur_chr do { \
+ if (c<='9') cur_chr=c-'0'; \
+ else cur_chr=c-'a'+10; \
+ add_nybble(cc); \
+ } while (0)
+
+#define four_hex_to_cur_chr do { \
+ hex_to_cur_chr; \
+ add_nybble(ccc); add_nybble(cccc); \
+ } while (0)
+
+#define five_hex_to_cur_chr do { \
+ four_hex_to_cur_chr; \
+ add_nybble(ccccc); \
+ } while (0)
+
+#define six_hex_to_cur_chr do { \
+ five_hex_to_cur_chr; \
+ add_nybble(cccccc); \
+ } while (0)
+
+
+@ Notice that a code like \.{\^\^8} becomes \.x if not followed by a hex digit.
+
+@c
+static boolean process_sup_mark(void)
+{
+ if (cur_chr == buffer[iloc]) {
+ int c, cc;
+ if (iloc < ilimit) {
+ if ((cur_chr == buffer[iloc + 1]) && (cur_chr == buffer[iloc + 2])
+ && (cur_chr == buffer[iloc + 3])
+ && (cur_chr == buffer[iloc + 4])
+ && ((iloc + 10) <= ilimit)) {
+ int ccc, cccc, ccccc, cccccc; /* constituents of a possible expanded code */
+ c = buffer[iloc + 5];
+ cc = buffer[iloc + 6];
+ ccc = buffer[iloc + 7];
+ cccc = buffer[iloc + 8];
+ ccccc = buffer[iloc + 9];
+ cccccc = buffer[iloc + 10];
+ if ((is_hex(c)) && (is_hex(cc)) && (is_hex(ccc))
+ && (is_hex(cccc))
+ && (is_hex(ccccc)) && (is_hex(cccccc))) {
+ iloc = iloc + 11;
+ six_hex_to_cur_chr;
+ return true;
+ }
+ }
+ if ((cur_chr == buffer[iloc + 1]) && (cur_chr == buffer[iloc + 2])
+ && (cur_chr == buffer[iloc + 3]) && ((iloc + 8) <= ilimit)) {
+ int ccc, cccc, ccccc; /* constituents of a possible expanded code */
+ c = buffer[iloc + 4];
+ cc = buffer[iloc + 5];
+ ccc = buffer[iloc + 6];
+ cccc = buffer[iloc + 7];
+ ccccc = buffer[iloc + 8];
+ if ((is_hex(c)) && (is_hex(cc)) && (is_hex(ccc))
+ && (is_hex(cccc)) && (is_hex(ccccc))) {
+ iloc = iloc + 9;
+ five_hex_to_cur_chr;
+ return true;
+ }
+ }
+ if ((cur_chr == buffer[iloc + 1]) && (cur_chr == buffer[iloc + 2])
+ && ((iloc + 6) <= ilimit)) {
+ int ccc, cccc; /* constituents of a possible expanded code */
+ c = buffer[iloc + 3];
+ cc = buffer[iloc + 4];
+ ccc = buffer[iloc + 5];
+ cccc = buffer[iloc + 6];
+ if ((is_hex(c)) && (is_hex(cc)) && (is_hex(ccc))
+ && (is_hex(cccc))) {
+ iloc = iloc + 7;
+ four_hex_to_cur_chr;
+ return true;
+ }
+ }
+ c = buffer[iloc + 1];
+ if (c < 0200) { /* yes we have an expanded char */
+ iloc = iloc + 2;
+ if (is_hex(c) && iloc <= ilimit) {
+ cc = buffer[iloc];
+ if (is_hex(cc)) {
+ incr(iloc);
+ hex_to_cur_chr;
+ return true;
+ }
+ }
+ cur_chr = (c < 0100 ? c + 0100 : c - 0100);
+ return true;
+ }
+ }
+ }
+ return false;
+}
+
+@ Control sequence names are scanned only when they appear in some line of
+ a file; once they have been scanned the first time, their |eqtb| location
+ serves as a unique identification, so \TeX\ doesn't need to refer to the
+ original name any more except when it prints the equivalent in symbolic form.
+
+ The program that scans a control sequence has been written carefully
+ in order to avoid the blowups that might otherwise occur if a malicious
+ user tried something like `\.{\\catcode\'15=0}'. The algorithm might
+ look at |buffer[ilimit+1]|, but it never looks at |buffer[ilimit+2]|.
+
+ If expanded characters like `\.{\^\^A}' or `\.{\^\^df}'
+ appear in or just following
+ a control sequence name, they are converted to single characters in the
+ buffer and the process is repeated, slowly but surely.
+
+@c
+static boolean check_expanded_code(int *kk); /* below */
+
+static int scan_control_sequence(void)
+{
+ int retval = mid_line;
+ if (iloc > ilimit) {
+ cur_cs = null_cs; /* |state| is irrelevant in this case */
+ } else {
+ register int cat; /* |cat_code(cur_chr)|, usually */
+ while (1) {
+ int k = iloc;
+ do_buffer_to_unichar(cur_chr, k);
+ do_get_cat_code(cat, cur_chr);
+ if (cat != letter_cmd || k > ilimit) {
+ retval = (cat == spacer_cmd ? skip_blanks : mid_line);
+ if (cat == sup_mark_cmd && check_expanded_code(&k)) /* If an expanded...; */
+ continue;
+ } else {
+ retval = skip_blanks;
+ do {
+ do_buffer_to_unichar(cur_chr, k);
+ do_get_cat_code(cat, cur_chr);
+ } while (cat == letter_cmd && k <= ilimit);
+
+ if (cat == sup_mark_cmd && check_expanded_code(&k)) /* If an expanded...; */
+ continue;
+ if (cat != letter_cmd) {
+ decr(k);
+ if (cur_chr > 0xFFFF)
+ decr(k);
+ if (cur_chr > 0x7FF)
+ decr(k);
+ if (cur_chr > 0x7F)
+ decr(k);
+ } /* now |k| points to first nonletter */
+ }
+ cur_cs = id_lookup(iloc, k - iloc);
+ iloc = k;
+ break;
+ }
+ }
+ cur_cmd = eq_type(cur_cs);
+ cur_chr = equiv(cur_cs);
+ return retval;
+}
+
+@ Whenever we reach the following piece of code, we will have
+ |cur_chr=buffer[k-1]| and |k<=ilimit+1| and |cat=get_cat_code(cat_code_table,cur_chr)|. If an
+ expanded code like \.{\^\^A} or \.{\^\^df} appears in |buffer[(k-1)..(k+1)]|
+ or |buffer[(k-1)..(k+2)]|, we
+ will store the corresponding code in |buffer[k-1]| and shift the rest of
+ the buffer left two or three places.
+
+@c
+static boolean check_expanded_code(int *kk)
+{
+ int l;
+ int k = *kk;
+ int d = 1; /* number of excess characters in an expanded code */
+ int c, cc, ccc, cccc, ccccc, cccccc; /* constituents of a possible expanded code */
+ if (buffer[k] == cur_chr && k < ilimit) {
+ if ((cur_chr == buffer[k + 1]) && (cur_chr == buffer[k + 2])
+ && ((k + 6) <= ilimit)) {
+ d = 4;
+ if ((cur_chr == buffer[k + 3]) && ((k + 8) <= ilimit))
+ d = 5;
+ if ((cur_chr == buffer[k + 4]) && ((k + 10) <= ilimit))
+ d = 6;
+ c = buffer[k + d - 1];
+ cc = buffer[k + d];
+ ccc = buffer[k + d + 1];
+ cccc = buffer[k + d + 2];
+ if (d == 6) {
+ ccccc = buffer[k + d + 3];
+ cccccc = buffer[k + d + 4];
+ if (is_hex(c) && is_hex(cc) && is_hex(ccc) && is_hex(cccc)
+ && is_hex(ccccc) && is_hex(cccccc))
+ six_hex_to_cur_chr;
+ } else if (d == 5) {
+ ccccc = buffer[k + d + 3];
+ if (is_hex(c) && is_hex(cc) && is_hex(ccc) && is_hex(cccc)
+ && is_hex(ccccc))
+ five_hex_to_cur_chr;
+ } else {
+ if (is_hex(c) && is_hex(cc) && is_hex(ccc) && is_hex(cccc))
+ four_hex_to_cur_chr;
+ }
+ } else {
+ c = buffer[k + 1];
+ if (c < 0200) {
+ d = 1;
+ if (is_hex(c) && (k + 2) <= ilimit) {
+ cc = buffer[k + 2];
+ if (is_hex(c) && is_hex(cc)) {
+ d = 2;
+ hex_to_cur_chr;
+ }
+ } else if (c < 0100) {
+ cur_chr = c + 0100;
+ } else {
+ cur_chr = c - 0100;
+ }
+ }
+ }
+ if (d > 2)
+ d = 2 * d - 1;
+ else
+ d++;
+ if (cur_chr <= 0x7F) {
+ buffer[k - 1] = (packed_ASCII_code) cur_chr;
+ } else if (cur_chr <= 0x7FF) {
+ buffer[k - 1] = (packed_ASCII_code) (0xC0 + cur_chr / 0x40);
+ k++;
+ d--;
+ buffer[k - 1] = (packed_ASCII_code) (0x80 + cur_chr % 0x40);
+ } else if (cur_chr <= 0xFFFF) {
+ buffer[k - 1] = (packed_ASCII_code) (0xE0 + cur_chr / 0x1000);
+ k++;
+ d--;
+ buffer[k - 1] =
+ (packed_ASCII_code) (0x80 + (cur_chr % 0x1000) / 0x40);
+ k++;
+ d--;
+ buffer[k - 1] =
+ (packed_ASCII_code) (0x80 + (cur_chr % 0x1000) % 0x40);
+ } else {
+ buffer[k - 1] = (packed_ASCII_code) (0xF0 + cur_chr / 0x40000);
+ k++;
+ d--;
+ buffer[k - 1] =
+ (packed_ASCII_code) (0x80 + (cur_chr % 0x40000) / 0x1000);
+ k++;
+ d--;
+ buffer[k - 1] =
+ (packed_ASCII_code) (0x80 +
+ ((cur_chr % 0x40000) % 0x1000) / 0x40);
+ k++;
+ d--;
+ buffer[k - 1] =
+ (packed_ASCII_code) (0x80 +
+ ((cur_chr % 0x40000) % 0x1000) % 0x40);
+ }
+ l = k;
+ ilimit = ilimit - d;
+ while (l <= ilimit) {
+ buffer[l] = buffer[l + d];
+ l++;
+ }
+ *kk = k;
+ return true;
+ }
+ return false;
+}
+
+@ todo: this is a function because it is still used from the converted pascal.
+ once that is gone, it can be a \#define again
+
+@c
+boolean end_line_char_inactive(void)
+{
+ return ((end_line_char < 0) || (end_line_char > 127));
+}
+
+@ All of the easy branches of |get_next| have now been taken care of.
+ There is one more branch.
+
+@c
+static next_line_retval next_line(void)
+{
+ boolean inhibit_eol = false; /* a way to end a pseudo file without trailing space */
+ if (iname > 17) {
+ /* Read next line of file into |buffer|, or |goto restart| if the file has ended */
+ incr(line);
+ first = istart;
+ if (!force_eof) {
+ if (iname <= 20) {
+ if (pseudo_input()) { /* not end of file */
+ firm_up_the_line(); /* this sets |ilimit| */
+ line_catcode_table = DEFAULT_CAT_TABLE;
+ if ((iname == 19) && (pseudo_lines(pseudo_files) == null))
+ inhibit_eol = true;
+ } else if ((every_eof != null) && !eof_seen[iindex]) {
+ ilimit = first - 1;
+ eof_seen[iindex] = true; /* fake one empty line */
+ if (iname != 19)
+ begin_token_list(every_eof, every_eof_text);
+ return next_line_restart;
+ } else {
+ force_eof = true;
+ }
+ } else {
+ if (iname == 21) {
+ if (luacstring_input()) { /* not end of strings */
+ firm_up_the_line();
+ line_catcode_table = (short) luacstring_cattable();
+ line_partial = (signed char) luacstring_partial();
+ if (luacstring_final_line() || line_partial
+ || line_catcode_table == NO_CAT_TABLE)
+ inhibit_eol = true;
+ if (!line_partial)
+ istate = new_line;
+ } else {
+ force_eof = true;
+ }
+ } else {
+ if (lua_input_ln(cur_file, 0, true)) { /* not end of file */
+ firm_up_the_line(); /* this sets |ilimit| */
+ line_catcode_table = DEFAULT_CAT_TABLE;
+ } else if ((every_eof != null) && (!eof_seen[iindex])) {
+ ilimit = first - 1;
+ eof_seen[iindex] = true; /* fake one empty line */
+ begin_token_list(every_eof, every_eof_text);
+ return next_line_restart;
+ } else {
+ force_eof = true;
+ }
+ }
+ }
+ }
+ if (force_eof) {
+ if (tracing_nesting > 0)
+ if ((grp_stack[in_open] != cur_boundary)
+ || (if_stack[in_open] != cond_ptr))
+ if (!((iname == 19) || (iname == 21)))
+ file_warning(); /* give warning for some unfinished groups and/or conditionals */
+ if ((iname > 21) || (iname == 20)) {
+ if (tracefilenames)
+ print_char(')');
+ open_parens--;
+#if 0
+ update_terminal(); /* show user that file has been read */
+#endif
+ }
+ force_eof = false;
+ if (iname == 21 || /* lua input */
+ iname == 19) { /* \.{\\scantextokens} */
+ end_file_reading();
+ } else {
+ end_file_reading();
+ check_outer_validity();
+ }
+ return next_line_restart;
+ }
+ if (inhibit_eol || end_line_char_inactive())
+ ilimit--;
+ else
+ buffer[ilimit] = (packed_ASCII_code) end_line_char;
+ first = ilimit + 1;
+ iloc = istart; /* ready to read */
+ } else {
+ if (!terminal_input) { /* \.{\\read} line has ended */
+ cur_cmd = 0;
+ cur_chr = 0;
+ return next_line_return; /* OUTER */
+ }
+ if (input_ptr > 0) { /* text was inserted during error recovery */
+ end_file_reading();
+ return next_line_restart; /* resume previous level */
+ }
+ if (selector < log_only)
+ open_log_file();
+ if (interaction > nonstop_mode) {
+ if (end_line_char_inactive())
+ ilimit++;
+ if (ilimit == istart) { /* previous line was empty */
+ tprint_nl("(Please type a command or say `\\end')");
+ }
+ print_ln();
+ first = istart;
+ prompt_input("*"); /* input on-line into |buffer| */
+ ilimit = last;
+ if (end_line_char_inactive())
+ ilimit--;
+ else
+ buffer[ilimit] = (packed_ASCII_code) end_line_char;
+ first = ilimit + 1;
+ iloc = istart;
+ } else {
+ fatal_error("*** (job aborted, no legal \\end found)");
+ /* nonstop mode, which is intended for overnight batch processing,
+ never waits for on-line input */
+ }
+ }
+ return next_line_ok;
+}
+
+@ Let's consider now what happens when |get_next| is looking at a token list.
+
+@c
+static boolean get_next_tokenlist(void)
+{
+ register halfword t; /* a token */
+ t = token_info(iloc);
+ iloc = token_link(iloc); /* move to next */
+ if (t >= cs_token_flag) { /* a control sequence token */
+ cur_cs = t - cs_token_flag;
+ cur_cmd = eq_type(cur_cs);
+ if (cur_cmd >= outer_call_cmd) {
+ if (cur_cmd == dont_expand_cmd) { /* Get the next token, suppressing expansion */
+ /* The present point in the program is reached only when the |expand|
+ routine has inserted a special marker into the input. In this special
+ case, |token_info(iloc)| is known to be a control sequence token, and |token_link(iloc)=null|.
+ */
+ cur_cs = token_info(iloc) - cs_token_flag;
+ iloc = null;
+ cur_cmd = eq_type(cur_cs);
+ if (cur_cmd > max_command_cmd) {
+ cur_cmd = relax_cmd;
+ cur_chr = no_expand_flag;
+ return true;
+ }
+ } else {
+ check_outer_validity();
+ }
+ }
+ cur_chr = equiv(cur_cs);
+ } else {
+ cur_cmd = token_cmd(t);
+ cur_chr = token_chr(t);
+ switch (cur_cmd) {
+ case left_brace_cmd:
+ align_state++;
+ break;
+ case right_brace_cmd:
+ align_state--;
+ break;
+ case out_param_cmd: /* Insert macro parameter and |goto restart|; */
+ begin_token_list(param_stack[param_start + cur_chr - 1], parameter);
+ return false;
+ break;
+ }
+ }
+ return true;
+}
+
+@ Now we're ready to take the plunge into |get_next| itself. Parts of
+ this routine are executed more often than any other instructions of \TeX.
+ @^mastication@>@^inner loop@>
+
+@ sets |cur_cmd|, |cur_chr|, |cur_cs| to next token
+
+@c
+void get_next(void)
+{
+ RESTART:
+ cur_cs = 0;
+ if (istate != token_list) {
+ /* Input from external file, |goto restart| if no input found */
+ if (!get_next_file())
+ goto RESTART;
+ } else {
+ if (iloc == null) {
+ end_token_list();
+ goto RESTART; /* list exhausted, resume previous level */
+ } else if (!get_next_tokenlist()) {
+ goto RESTART; /* parameter needs to be expanded */
+ }
+ }
+ /* If an alignment entry has just ended, take appropriate action */
+ if ((cur_cmd == tab_mark_cmd || cur_cmd == car_ret_cmd) && align_state == 0) {
+ insert_vj_template();
+ goto RESTART;
+ }
+}
+
+
+@ Since |get_next| is used so frequently in \TeX, it is convenient
+to define three related procedures that do a little more:
+
+\yskip\hang|get_token| not only sets |cur_cmd| and |cur_chr|, it
+also sets |cur_tok|, a packed halfword version of the current token.
+
+\yskip\hang|get_x_token|, meaning ``get an expanded token,'' is like
+|get_token|, but if the current token turns out to be a user-defined
+control sequence (i.e., a macro call), or a conditional,
+or something like \.{\\topmark} or \.{\\expandafter} or \.{\\csname},
+it is eliminated from the input by beginning the expansion of the macro
+or the evaluation of the conditional.
+
+\yskip\hang|x_token| is like |get_x_token| except that it assumes that
+|get_next| has already been called.
+
+\yskip\noindent
+In fact, these three procedures account for almost every use of |get_next|.
+
+No new control sequences will be defined except during a call of
+|get_token|, or when \.{\\csname} compresses a token list, because
+|no_new_control_sequence| is always |true| at other times.
+
+@c
+void get_token(void)
+{ /* sets |cur_cmd|, |cur_chr|, |cur_tok| */
+ no_new_control_sequence = false;
+ get_token_lua();
+ no_new_control_sequence = true;
+ if (cur_cs == 0)
+ cur_tok = token_val(cur_cmd, cur_chr);
+ else
+ cur_tok = cs_token_flag + cur_cs;
+}
+
+@ @c
+void get_token_lua(void)
+{
+ register int callback_id;
+ callback_id = callback_defined(token_filter_callback);
+ if (callback_id > 0) {
+ while (istate == token_list && iloc == null && iindex != v_template)
+ end_token_list();
+ /* there is some stuff we don't want to see inside the callback */
+ if (!(istate == token_list &&
+ ((nofilter == true) || (iindex == backed_up && iloc != null)))) {
+ do_get_token_lua(callback_id);
+ return;
+ }
+ }
+ get_next();
+}
+
+
+@ changes the string |s| to a token list
+@c
+halfword string_to_toks(char *ss)
+{
+ halfword p; /* tail of the token list */
+ halfword q; /* new node being added to the token list via |store_new_token| */
+ halfword t; /* token being appended */
+ char *s = ss, *se = ss + strlen(s);
+ p = temp_token_head;
+ set_token_link(p, null);
+ while (s < se) {
+ t = (halfword) str2uni((unsigned char *) s);
+ s += utf8_size(t);
+ if (t == ' ')
+ t = space_token;
+ else
+ t = other_token + t;
+ fast_store_new_token(t);
+ }
+ return token_link(temp_token_head);
+}
+
+@ The token lists for macros and for other things like \.{\\mark} and \.{\\output}
+and \.{\\write} are produced by a procedure called |scan_toks|.
+
+Before we get into the details of |scan_toks|, let's consider a much
+simpler task, that of converting the current string into a token list.
+The |str_toks| function does this; it classifies spaces as type |spacer|
+and everything else as type |other_char|.
+
+The token list created by |str_toks| begins at |link(temp_token_head)| and ends
+at the value |p| that is returned. (If |p=temp_token_head|, the list is empty.)
+
+|lua_str_toks| is almost identical, but it also escapes the three
+symbols that |lua| considers special while scanning a literal string
+
+@c
+static halfword lua_str_toks(lstring b)
+{ /* changes the string |str_pool[b..pool_ptr]| to a token list */
+ halfword p; /* tail of the token list */
+ halfword q; /* new node being added to the token list via |store_new_token| */
+ halfword t; /* token being appended */
+ unsigned char *k; /* index into string */
+ p = temp_token_head;
+ set_token_link(p, null);
+ k = (unsigned char *) b.s;
+ while (k < (unsigned char *) b.s + b.l) {
+ t = pool_to_unichar(k);
+ k += utf8_size(t);
+ if (t == ' ') {
+ t = space_token;
+ } else {
+ if ((t == '\\') || (t == '"') || (t == '\'') || (t == 10)
+ || (t == 13))
+ fast_store_new_token(other_token + '\\');
+ if (t == 10)
+ t = 'n';
+ if (t == 13)
+ t = 'r';
+ t = other_token + t;
+ }
+ fast_store_new_token(t);
+ }
+ return p;
+}
+
+
+@ Incidentally, the main reason for wanting |str_toks| is the function |the_toks|,
+which has similar input/output characteristics.
+
+@c
+halfword str_toks(lstring s)
+{ /* changes the string |str_pool[b..pool_ptr]| to a token list */
+ halfword p; /* tail of the token list */
+ halfword q; /* new node being added to the token list via |store_new_token| */
+ halfword t; /* token being appended */
+ unsigned char *k, *l; /* index into string */
+ p = temp_token_head;
+ set_token_link(p, null);
+ k = s.s;
+ l = k + s.l;
+ while (k < l) {
+ t = pool_to_unichar(k);
+ k += utf8_size(t);
+ if (t == ' ')
+ t = space_token;
+ else
+ t = other_token + t;
+ fast_store_new_token(t);
+ }
+ return p;
+}
+
+@ Here's part of the |expand| subroutine that we are now ready to complete:
+@c
+void ins_the_toks(void)
+{
+ (void) the_toks();
+ ins_list(token_link(temp_token_head));
+}
+
+@ This routine, used in the next one, prints the job name, possibly
+modified by the |process_jobname| callback.
+
+@c
+static void print_job_name(void)
+{
+ if (job_name) {
+ char *s, *ss; /* C strings for jobname before and after processing */
+ int callback_id, lua_retval;
+ s = (char*)str_string(job_name);
+ callback_id = callback_defined(process_jobname_callback);
+ if (callback_id > 0) {
+ lua_retval = run_callback(callback_id, "S->S", s, &ss);
+ if ((lua_retval == true) && (ss != NULL))
+ s = ss;
+ }
+ tprint(s);
+ } else {
+ print(job_name);
+ }
+}
+
+@ Here is a routine that print the result of a convert command, using
+ the argument |i|. It returns |false | if it does not know to print
+ the code |c|. The function exists because lua code and tex code can
+ both call it to convert something.
+
+@c
+static boolean print_convert_string(halfword c, int i)
+{
+ int ff; /* for use with |set_ff| */
+ boolean ret = true;
+ switch (c) {
+ case number_code:
+ print_int(i);
+ break;
+ case uchar_code:
+ print(i);
+ break;
+ case roman_numeral_code:
+ print_roman_int(i);
+ break;
+ case etex_code:
+ tprint(eTeX_version_string);
+ break;
+ case pdftex_revision_code:
+ tprint(pdftex_revision);
+ break;
+ case luatex_revision_code:
+ print(get_luatexrevision());
+ break;
+ case luatex_date_code:
+ print_int(get_luatex_date_info());
+ break;
+ case pdftex_banner_code:
+ tprint(pdftex_banner);
+ break;
+ case uniform_deviate_code:
+ print_int(unif_rand(i));
+ break;
+ case normal_deviate_code:
+ print_int(norm_rand());
+ break;
+ case format_name_code:
+ print(format_name);
+ break;
+ case job_name_code:
+ print_job_name();
+ break;
+ case font_name_code:
+ append_string((unsigned char *) font_name(i),
+ (unsigned) strlen(font_name(i)));
+ if (font_size(i) != font_dsize(i)) {
+ tprint(" at ");
+ print_scaled(font_size(i));
+ tprint("pt");
+ }
+ break;
+ case font_id_code:
+ print_int(i);
+ break;
+ case math_style_code:
+ print_math_style();
+ break;
+ case pdf_font_name_code:
+ case pdf_font_objnum_code:
+ set_ff(i);
+ if (c == pdf_font_name_code)
+ print_int(obj_info(static_pdf, pdf_font_num(ff)));
+ else
+ print_int(pdf_font_num(ff));
+ break;
+ case pdf_font_size_code:
+ print_scaled(font_size(i));
+ tprint("pt");
+ break;
+ case pdf_page_ref_code:
+ print_int(pdf_get_obj(static_pdf, obj_type_page, i, false));
+ break;
+ case pdf_xform_name_code:
+ print_int(obj_info(static_pdf, i));
+ break;
+ case eTeX_revision_code:
+ tprint(eTeX_revision);
+ break;
+ default:
+ ret = false;
+ break;
+ }
+ return ret;
+}
+
+@ @c
+int scan_lua_state(void)
+{
+ int sn = 0;
+ if (scan_keyword("name")) {
+ scan_pdf_ext_toks();
+ sn = def_ref;
+ }
+ /* Parse optional lua state integer, or an instance name to be stored in |sn| */
+ /* Get the next non-blank non-relax non-call token */
+ do {
+ get_x_token();
+ } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
+
+ back_input(); /* have to push it back, whatever it is */
+ if (cur_cmd != left_brace_cmd) {
+ scan_register_num();
+ if (get_lua_name(cur_val))
+ sn = (cur_val - 65536);
+ }
+ return sn;
+}
+
+
+@ The procedure |conv_toks| uses |str_toks| to insert the token list
+for |convert| functions into the scanner; `\.{\\outer}' control sequences
+are allowed to follow `\.{\\string}' and `\.{\\meaning}'.
+
+The extra temp string |u| is needed because |pdf_scan_ext_toks| incorporates
+any pending string in its output. In order to save such a pending string,
+we have to create a temporary string that is destroyed immediately after.
+
+@c
+void conv_toks(void)
+{
+ int old_setting; /* holds |selector| setting */
+ halfword p, q;
+ int save_scanner_status; /* |scanner_status| upon entry */
+ halfword save_def_ref; /* |def_ref| upon entry, important if inside `\.{\\message}' */
+ halfword save_warning_index;
+ boolean bool; /* temp boolean */
+ str_number s; /* first temp string */
+ int sn; /* lua chunk name */
+ str_number u = 0; /* third temp string, will become non-nil if a string is already being built */
+ int i = 0; /* first temp integer */
+ int j = 0; /* second temp integer */
+ int c = cur_chr; /* desired type of conversion */
+ str_number str;
+ /* Scan the argument for command |c| */
+ switch (c) {
+ case uchar_code:
+ scan_char_num();
+ break;
+ case number_code:
+ case roman_numeral_code:
+ scan_int();
+ break;
+ case string_code:
+ case meaning_code:
+ save_scanner_status = scanner_status;
+ scanner_status = normal;
+ get_token();
+ scanner_status = save_scanner_status;
+ break;
+ case etex_code:
+ break;
+ case font_name_code:
+ case font_id_code:
+ scan_font_ident();
+ break;
+ case pdftex_revision_code:
+ case luatex_revision_code:
+ case luatex_date_code:
+ case pdftex_banner_code:
+ break;
+ case pdf_font_name_code:
+ case pdf_font_objnum_code:
+ case pdf_font_size_code:
+ scan_font_ident();
+ if (cur_val == null_font)
+ pdf_error("font", "invalid font identifier");
+ if (c != pdf_font_size_code) {
+ pdf_check_vf(cur_val);
+ if (!font_used(cur_val))
+ pdf_init_font(static_pdf, cur_val);
+ }
+ break;
+ case pdf_page_ref_code:
+ scan_int();
+ if (cur_val <= 0)
+ pdf_error("pageref", "invalid page number");
+ break;
+ case left_margin_kern_code:
+ case right_margin_kern_code:
+ scan_int();
+ if ((box(cur_val) == null) || (type(box(cur_val)) != hlist_node))
+ pdf_error("marginkern", "a non-empty hbox expected");
+ break;
+ case pdf_xform_name_code:
+ scan_int();
+ check_obj_type(static_pdf, obj_type_xform, cur_val);
+ break;
+ case pdf_creation_date_code:
+ ins_list(string_to_toks(getcreationdate(static_pdf)));
+ return;
+ break;
+ case format_name_code:
+ case job_name_code:
+ if (job_name == 0)
+ open_log_file();
+ break;
+ case pdf_colorstack_init_code:
+ bool = scan_keyword("page");
+ if (scan_keyword("direct"))
+ cur_val = direct_always;
+ else if (scan_keyword("page"))
+ cur_val = direct_page;
+ else
+ cur_val = set_origin;
+ save_scanner_status = scanner_status;
+ save_warning_index = warning_index;
+ save_def_ref = def_ref;
+ u = save_cur_string();
+ scan_pdf_ext_toks();
+ s = tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ def_ref = save_def_ref;
+ warning_index = save_warning_index;
+ scanner_status = save_scanner_status;
+ cur_val = newcolorstack(s, cur_val, bool);
+ flush_str(s);
+ cur_val_level = int_val_level;
+ if (cur_val < 0) {
+ print_err("Too many color stacks");
+ help2("The number of color stacks is limited to 32768.",
+ "I'll use the default color stack 0 here.");
+ error();
+ cur_val = 0;
+ restore_cur_string(u);
+ }
+ break;
+ case uniform_deviate_code:
+ scan_int();
+ break;
+ case normal_deviate_code:
+ break;
+ case lua_escape_string_code:
+ {
+ lstring escstr;
+ int l = 0;
+ save_scanner_status = scanner_status;
+ save_def_ref = def_ref;
+ save_warning_index = warning_index;
+ scan_pdf_ext_toks();
+ bool = in_lua_escape;
+ in_lua_escape = true;
+ escstr.s = (unsigned char *) tokenlist_to_cstring(def_ref, false, &l);
+ escstr.l = (unsigned) l;
+ in_lua_escape = bool;
+ delete_token_ref(def_ref);
+ def_ref = save_def_ref;
+ warning_index = save_warning_index;
+ scanner_status = save_scanner_status;
+ (void) lua_str_toks(escstr);
+ ins_list(token_link(temp_token_head));
+ free(escstr.s);
+ return;
+ }
+ break;
+ case math_style_code:
+ break;
+ case expanded_code:
+ save_scanner_status = scanner_status;
+ save_warning_index = warning_index;
+ save_def_ref = def_ref;
+ u = save_cur_string();
+ scan_pdf_ext_toks();
+ warning_index = save_warning_index;
+ scanner_status = save_scanner_status;
+ ins_list(token_link(def_ref));
+ def_ref = save_def_ref;
+ restore_cur_string(u);
+ return;
+ break;
+ case lua_code:
+ u = save_cur_string();
+ save_scanner_status = scanner_status;
+ save_def_ref = def_ref;
+ save_warning_index = warning_index;
+ sn = scan_lua_state();
+ scan_pdf_ext_toks();
+ s = def_ref;
+ warning_index = save_warning_index;
+ def_ref = save_def_ref;
+ scanner_status = save_scanner_status;
+ luacstrings = 0;
+ luatokencall(s, sn);
+ delete_token_ref(s);
+ restore_cur_string(u); /* TODO: check this, was different */
+ if (luacstrings > 0)
+ lua_string_start();
+ return;
+ break;
+ case pdf_insert_ht_code:
+ scan_register_num();
+ break;
+ case pdf_ximage_bbox_code:
+ scan_int();
+ check_obj_type(static_pdf, obj_type_ximage, cur_val);
+ i = obj_data_ptr(static_pdf, cur_val);
+ scan_int();
+ j = cur_val;
+ if ((j < 1) || (j > 4))
+ pdf_error("pdfximagebbox", "invalid parameter");
+ break;
+ /* Cases of 'Scan the argument for command |c|' */
+ case eTeX_revision_code:
+ break;
+ default:
+ confusion("convert");
+ break;
+ }
+
+ old_setting = selector;
+ selector = new_string;
+
+ /* Print the result of command |c| */
+ if (!print_convert_string(c, cur_val)) {
+ switch (c) {
+ case string_code:
+ if (cur_cs != 0)
+ sprint_cs(cur_cs);
+ else
+ print(cur_chr);
+ break;
+ case meaning_code:
+ print_meaning();
+ break;
+ case left_margin_kern_code:
+ p = list_ptr(box(cur_val));
+ if ((p != null) && (!is_char_node(p)) &&
+ (type(p) == glue_node) && (subtype(p) == left_skip_code + 1))
+ p = vlink(p);
+ if ((p != null) && (!is_char_node(p)) &&
+ (type(p) == margin_kern_node) && (subtype(p) == left_side))
+ print_scaled(width(p));
+ else
+ print_char('0');
+ tprint("pt");
+ break;
+ case right_margin_kern_code:
+ q = list_ptr(box(cur_val));
+ p = null;
+ if (q != null) {
+ p = prev_rightmost(q, null);
+ if ((p != null) && (!is_char_node(p)) && (type(p) == glue_node)
+ && (subtype(p) == right_skip_code + 1))
+ p = prev_rightmost(q, p);
+ }
+ if ((p != null) && (!is_char_node(p)) &&
+ (type(p) == margin_kern_node) && (subtype(p) == right_side))
+ print_scaled(width(p));
+ else
+ print_char('0');
+ tprint("pt");
+ break;
+ case pdf_colorstack_init_code:
+ print_int(cur_val);
+ break;
+ case pdf_insert_ht_code:
+ i = cur_val;
+ p = page_ins_head;
+ while (i >= subtype(vlink(p)))
+ p = vlink(p);
+ if (subtype(p) == i)
+ print_scaled(height(p));
+ else
+ print_char('0');
+ tprint("pt");
+ break;
+ case pdf_ximage_bbox_code:
+ if (is_pdf_image(i)) {
+ switch (j) {
+ case 1:
+ print_scaled(epdf_orig_x(i));
+ break;
+ case 2:
+ print_scaled(epdf_orig_y(i));
+ break;
+ case 3:
+ print_scaled(epdf_orig_x(i) + epdf_xsize(i));
+ break;
+ case 4:
+ print_scaled(epdf_orig_y(i) + epdf_ysize(i));
+ break;
+ }
+ } else {
+ print_scaled(0);
+ }
+ tprint("pt");
+ break;
+ case pdf_creation_date_code:
+ case lua_escape_string_code:
+ case lua_code:
+ case expanded_code:
+ break;
+ default:
+ confusion("convert");
+ break;
+ }
+ }
+
+ selector = old_setting;
+ str = make_string();
+ (void) str_toks(str_lstring(str));
+ flush_str(str);
+ ins_list(token_link(temp_token_head));
+}
+
+@ This boolean is keeping track of the lua string escape state
+@c
+boolean in_lua_escape;
+
+@ probably not needed anymore
+@c
+boolean is_convert(halfword c)
+{
+ return (c == convert_cmd);
+}
+
+str_number the_convert_string(halfword c, int i)
+{
+ int old_setting; /* saved |selector| setting */
+ str_number ret = 0;
+ old_setting = selector;
+ selector = new_string;
+ if (print_convert_string(c, i)) {
+ ret = make_string();
+ } else if (c == font_identifier_code) {
+ print_font_identifier(i);
+ ret = make_string();
+ }
+ selector = old_setting;
+ return ret;
+}
+
+@ Another way to create a token list is via the \.{\\read} command. The
+sixteen files potentially usable for reading appear in the following
+global variables. The value of |read_open[n]| will be |closed| if
+stream number |n| has not been opened or if it has been fully read;
+|just_open| if an \.{\\openin} but not a \.{\\read} has been done;
+and |normal| if it is open and ready to read the next line.
+
+@c
+FILE *read_file[16]; /* used for \.{\\read} */
+int read_open[17]; /* state of |read_file[n]| */
+
+void initialize_read(void)
+{
+ int k;
+ for (k = 0; k <= 16; k++)
+ read_open[k] = closed;
+}
+
+@ The |read_toks| procedure constructs a token list like that for any
+macro definition, and makes |cur_val| point to it. Parameter |r| points
+to the control sequence that will receive this token list.
+
+@c
+void read_toks(int n, halfword r, halfword j)
+{
+ halfword p; /* tail of the token list */
+ halfword q; /* new node being added to the token list via |store_new_token| */
+ int s; /* saved value of |align_state| */
+ int m; /* stream number */
+ scanner_status = defining;
+ warning_index = r;
+ p = get_avail();
+ def_ref = p;
+ set_token_ref_count(def_ref, 0);
+ p = def_ref; /* the reference count */
+ store_new_token(end_match_token);
+ if ((n < 0) || (n > 15))
+ m = 16;
+ else
+ m = n;
+ s = align_state;
+ align_state = 1000000; /* disable tab marks, etc. */
+ do {
+ /* Input and store tokens from the next line of the file */
+ begin_file_reading();
+ iname = m + 1;
+ if (read_open[m] == closed) {
+ /* Input for \.{\\read} from the terminal */
+ /* Here we input on-line into the |buffer| array, prompting the user explicitly
+ if |n>=0|. The value of |n| is set negative so that additional prompts
+ will not be given in the case of multi-line input. */
+ if (interaction > nonstop_mode) {
+ if (n < 0) {
+ prompt_input("");
+ } else {
+ wake_up_terminal();
+ print_ln();
+ sprint_cs(r);
+ prompt_input(" =");
+ n = -1;
+ }
+ } else {
+ fatal_error
+ ("*** (cannot \\read from terminal in nonstop modes)");
+ }
+
+ } else if (read_open[m] == just_open) {
+ /* Input the first line of |read_file[m]| */
+ /* The first line of a file must be treated specially, since |lua_input_ln|
+ must be told not to start with |get|. */
+ if (lua_input_ln(read_file[m], (m + 1), false)) {
+ read_open[m] = normal;
+ } else {
+ lua_a_close_in(read_file[m], (m + 1));
+ read_open[m] = closed;
+ }
+
+ } else {
+ /* Input the next line of |read_file[m]| */
+ /* An empty line is appended at the end of a |read_file|. */
+ if (!lua_input_ln(read_file[m], (m + 1), true)) {
+ lua_a_close_in(read_file[m], (m + 1));
+ read_open[m] = closed;
+ if (align_state != 1000000) {
+ runaway();
+ print_err("File ended within \\read");
+ help1("This \\read has unbalanced braces.");
+ align_state = 1000000;
+ error();
+ }
+ }
+
+ }
+ ilimit = last;
+ if (end_line_char_inactive())
+ decr(ilimit);
+ else
+ buffer[ilimit] = (packed_ASCII_code) int_par(end_line_char_code);
+ first = ilimit + 1;
+ iloc = istart;
+ istate = new_line;
+ /* Handle \.{\\readline} and |goto done|; */
+ if (j == 1) {
+ while (iloc <= ilimit) { /* current line not yet finished */
+ do_buffer_to_unichar(cur_chr, iloc);
+ if (cur_chr == ' ')
+ cur_tok = space_token;
+ else
+ cur_tok = cur_chr + other_token;
+ store_new_token(cur_tok);
+ }
+ } else {
+ while (1) {
+ get_token();
+ if (cur_tok == 0)
+ break; /* |cur_cmd=cur_chr=0| will occur at the end of the line */
+ if (align_state < 1000000) { /* unmatched `\.\}' aborts the line */
+ do {
+ get_token();
+ } while (cur_tok != 0);
+ align_state = 1000000;
+ break;
+ }
+ store_new_token(cur_tok);
+ }
+ }
+ end_file_reading();
+
+ } while (align_state != 1000000);
+ cur_val = def_ref;
+ scanner_status = normal;
+ align_state = s;
+}
+
+@ @c
+str_number tokens_to_string(halfword p)
+{ /* return a string from tokens list */
+ int old_setting;
+ if (selector == new_string)
+ pdf_error("tokens",
+ "tokens_to_string() called while selector = new_string");
+ old_setting = selector;
+ selector = new_string;
+ show_token_list(token_link(p), null, -1);
+ selector = old_setting;
+ return make_string();
+}
+
+@ @c
+#define make_room(a) \
+ if ((unsigned)i+a+1>alloci) { \
+ ret = xrealloc(ret,(alloci+64)); \
+ alloci = alloci + 64; \
+ }
+
+
+#define append_i_byte(a) ret[i++] = (char)(a)
+
+#define Print_char(a) make_room(1); append_i_byte(a)
+
+#define Print_uchar(s) { \
+ make_room(4); \
+ if (s<=0x7F) { \
+ append_i_byte(s); \
+ } else if (s<=0x7FF) { \
+ append_i_byte(0xC0 + (s / 0x40)); \
+ append_i_byte(0x80 + (s % 0x40)); \
+ } else if (s<=0xFFFF) { \
+ append_i_byte(0xE0 + (s / 0x1000)); \
+ append_i_byte(0x80 + ((s % 0x1000) / 0x40)); \
+ append_i_byte(0x80 + ((s % 0x1000) % 0x40)); \
+ } else if (s>=0x110000) { \
+ append_i_byte(s-0x11000); \
+ } else { \
+ append_i_byte(0xF0 + (s / 0x40000)); \
+ append_i_byte(0x80 + ((s % 0x40000) / 0x1000)); \
+ append_i_byte(0x80 + (((s % 0x40000) % 0x1000) / 0x40)); \
+ append_i_byte(0x80 + (((s % 0x40000) % 0x1000) % 0x40)); \
+ } }
+
+
+#define Print_esc(b) { \
+ const char *v = b; \
+ if (e>0 && e<STRING_OFFSET) { \
+ Print_uchar (e); \
+ } \
+ make_room(strlen(v)); \
+ while (*v) { append_i_byte(*v); v++; } \
+ }
+
+#define is_cat_letter(a) \
+ (get_char_cat_code(pool_to_unichar(str_string((a)))) == 11)
+
+@ the actual token conversion in this function is now functionally
+ equivalent to |show_token_list|, except that it always prints the
+ whole token list.
+ TODO: check whether this causes problems in the lua library.
+
+@c
+char *tokenlist_to_cstring(int pp, int inhibit_par, int *siz)
+{
+ register int p, c, m;
+ int q;
+ int infop;
+ char *s, *sh;
+ int e = 0;
+ char *ret;
+ int match_chr = '#';
+ int n = '0';
+ unsigned alloci = 1024;
+ int i = 0;
+ p = pp;
+ if (p == null) {
+ if (siz != NULL)
+ *siz = 0;
+ return NULL;
+ }
+ ret = xmalloc(alloci);
+ p = token_link(p); /* skip refcount */
+ if (p != null) {
+ e = int_par(escape_char_code);
+ }
+ while (p != null) {
+ if (p < (int) fix_mem_min || p > (int) fix_mem_end) {
+ Print_esc("CLOBBERED.");
+ break;
+ }
+ infop = token_info(p);
+ if (infop >= cs_token_flag) {
+ if (!(inhibit_par && infop == par_token)) {
+ q = infop - cs_token_flag;
+ if (q < hash_base) {
+ if (q == null_cs) {
+ Print_esc("csname");
+ Print_esc("endcsname");
+ } else {
+ Print_esc("IMPOSSIBLE.");
+ }
+ } else if ((q >= undefined_control_sequence)
+ && ((q <= eqtb_size)
+ || (q > eqtb_size + hash_extra))) {
+ Print_esc("IMPOSSIBLE.");
+ } else if ((cs_text(q) < 0) || (cs_text(q) >= str_ptr)) {
+ Print_esc("NONEXISTENT.");
+ } else {
+ str_number txt = cs_text(q);
+ sh = makecstring(txt);
+ s = sh;
+ if (is_active_cs(txt)) {
+ s = s + 3;
+ while (*s) {
+ Print_char(*s);
+ s++;
+ }
+ } else {
+ Print_uchar(e);
+ while (*s) {
+ Print_char(*s);
+ s++;
+ }
+ if ((!single_letter(txt)) || is_cat_letter(txt)) {
+ Print_char(' ');
+ }
+ }
+ free(sh);
+ }
+ }
+ } else {
+ if (infop < 0) {
+ Print_esc("BAD.");
+ } else {
+ m = token_cmd(infop);
+ c = token_chr(infop);
+ switch (m) {
+ case left_brace_cmd:
+ case right_brace_cmd:
+ case math_shift_cmd:
+ case tab_mark_cmd:
+ case sup_mark_cmd:
+ case sub_mark_cmd:
+ case spacer_cmd:
+ case letter_cmd:
+ case other_char_cmd:
+ Print_uchar(c);
+ break;
+ case mac_param_cmd:
+ if (!in_lua_escape)
+ Print_uchar(c);
+ Print_uchar(c);
+ break;
+ case out_param_cmd:
+ Print_uchar(match_chr);
+ if (c <= 9) {
+ Print_char(c + '0');
+ } else {
+ Print_char('!');
+ goto EXIT;
+ }
+ break;
+ case match_cmd:
+ match_chr = c;
+ Print_uchar(c);
+ n++;
+ Print_char(n);
+ if (n > '9')
+ goto EXIT;
+ break;
+ case end_match_cmd:
+ if (c == 0) {
+ Print_char('-');
+ Print_char('>');
+ }
+ break;
+ default:
+ Print_esc("BAD.");
+ break;
+ }
+ }
+ }
+ p = token_link(p);
+ }
+ EXIT:
+ ret[i] = '\0';
+ if (siz != NULL)
+ *siz = i;
+ return ret;
+}
+
+@ @c
+lstring *tokenlist_to_lstring(int pp, int inhibit_par)
+{
+ int siz;
+ lstring *ret = xmalloc(sizeof(lstring));
+ ret->s = (unsigned char *) tokenlist_to_cstring(pp, inhibit_par, &siz);
+ ret->l = (size_t) siz;
+ return ret;
+}
+
+@ @c
+void free_lstring(lstring * ls)
+{
+ if (ls == NULL)
+ return;
+ if (ls->s != NULL)
+ free(ls->s);
+ free(ls);
+}
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 20:35:08 +0000