summaryrefslogtreecommitdiff
path: root/Build/source/texk
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk')
-rw-r--r--Build/source/texk/web2c/ChangeLog4
-rw-r--r--Build/source/texk/web2c/Makefile.am1
-rw-r--r--Build/source/texk/web2c/Makefile.in383
-rw-r--r--Build/source/texk/web2c/luatexdir/ChangeLog6
-rw-r--r--Build/source/texk/web2c/luatexdir/am/luaffi.am43
-rw-r--r--Build/source/texk/web2c/luatexdir/am/luamisc.am2
-rw-r--r--Build/source/texk/web2c/luatexdir/am/luatex.am2
-rw-r--r--Build/source/texk/web2c/luatexdir/font/luafont.w4417
-rw-r--r--Build/source/texk/web2c/luatexdir/image/writejpg.w2
-rw-r--r--Build/source/texk/web2c/luatexdir/lua/lnodelib.c420
-rw-r--r--Build/source/texk/web2c/luatexdir/lua/luainit.w2182
-rw-r--r--Build/source/texk/web2c/luatexdir/lua/luajitstuff.w4
-rw-r--r--Build/source/texk/web2c/luatexdir/lua/luastuff.w1128
-rw-r--r--Build/source/texk/web2c/luatexdir/lua/luatex-api.h4
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/CONTRIBUTING.md30
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/LICENSE58
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/Makefile.orig32
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/PATENTS33
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/README78
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/README.md86
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/call.c275
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/call_arm.dasc610
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/call_arm.h1013
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/call_x64.h1204
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/call_x64win.h1191
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/call_x86.dasc1640
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/call_x86.h1172
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/ctype.c272
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_arm.h455
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_arm.lua952
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_ppc.h408
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_ppc.lua1225
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_proto.h83
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x64.lua12
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x86.h470
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x86.lua1931
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/dynasm/dynasm.lua1096
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/ffi.c3614
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/ffi.c.orig3552
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/ffi.h466
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/ffi.h.orig455
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/generate_call_h.bat4
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/luaffi-scm-1.rockspec34
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/msvc/inttypes.h31
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/msvc/stdbool.h42
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/msvc/stdint.h174
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/msvcbuild.bat76
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/parser.c2618
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/test.c720
-rw-r--r--Build/source/texk/web2c/luatexdir/luaffi/test.lua1003
-rw-r--r--Build/source/texk/web2c/luatexdir/tex/commands.w1757
-rw-r--r--Build/source/texk/web2c/luatexdir/tex/dumpdata.w1052
-rw-r--r--Build/source/texk/web2c/luatexdir/tex/equivalents.h3
-rw-r--r--Build/source/texk/web2c/luatexdir/tex/maincontrol.w7277
-rw-r--r--Build/source/texk/web2c/luatexdir/tex/texmath.w5138
-rw-r--r--Build/source/texk/web2c/luatexdir/tex/texnodes.w7530
56 files changed, 43099 insertions, 15371 deletions
diff --git a/Build/source/texk/web2c/ChangeLog b/Build/source/texk/web2c/ChangeLog
index a8c401afe10..b8c886fca13 100644
--- a/Build/source/texk/web2c/ChangeLog
+++ b/Build/source/texk/web2c/ChangeLog
@@ -1,3 +1,7 @@
+2017-02-09 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * Makefile.am: Sync with the LuaTeX upstream.
+
2017-01-28 Karl Berry <karl@freefriends.org>
* tex.ch (texarray),
diff --git a/Build/source/texk/web2c/Makefile.am b/Build/source/texk/web2c/Makefile.am
index 9a07fcbc600..4e6b2cc5788 100644
--- a/Build/source/texk/web2c/Makefile.am
+++ b/Build/source/texk/web2c/Makefile.am
@@ -227,6 +227,7 @@ include $(srcdir)/luatexdir/am/luamisc.am
include $(srcdir)/luatexdir/am/libunilib.am
include $(srcdir)/luatexdir/am/luafontforge.am
include $(srcdir)/luatexdir/am/libluatex.am
+include $(srcdir)/luatexdir/am/luaffi.am
include $(srcdir)/luatexdir/am/luatex.am
## XeTeX
diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in
index db7555873e6..5dde0bd0512 100644
--- a/Build/source/texk/web2c/Makefile.in
+++ b/Build/source/texk/web2c/Makefile.in
@@ -385,8 +385,9 @@ am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \
configure.lineno config.status.lineno
mkinstalldirs = $(install_sh) -d
CONFIG_HEADER = $(top_builddir)/w2c/c-auto.h ff-config.h
-CONFIG_CLEAN_FILES = web2c-sh tangle-sh ctangleboot-sh silent-sh \
- synctexdir/synctex.pc callexe.c
+CONFIG_CLEAN_FILES = omegafonts/Makefile otps/Makefile \
+ otps/win32/Makefile window/Makefile web2c-sh tangle-sh \
+ ctangleboot-sh silent-sh synctexdir/synctex.pc callexe.c
CONFIG_CLEAN_VPATH_FILES =
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
@@ -475,9 +476,17 @@ libkanji_a_AR = $(AR) $(ARFLAGS)
libkanji_a_LIBADD =
am_libkanji_a_OBJECTS = ptexdir/libkanji_a-kanji.$(OBJEXT)
libkanji_a_OBJECTS = $(am_libkanji_a_OBJECTS)
+libluaffi_a_AR = $(AR) $(ARFLAGS)
+libluaffi_a_LIBADD =
+am__objects_1 = luatexdir/luaffi/libluaffi_a-call.$(OBJEXT) \
+ luatexdir/luaffi/libluaffi_a-ctype.$(OBJEXT) \
+ luatexdir/luaffi/libluaffi_a-ffi.$(OBJEXT) \
+ luatexdir/luaffi/libluaffi_a-parser.$(OBJEXT)
+nodist_libluaffi_a_OBJECTS = $(am__objects_1)
+libluaffi_a_OBJECTS = $(nodist_libluaffi_a_OBJECTS)
libluajitmisc_a_AR = $(AR) $(ARFLAGS)
libluajitmisc_a_LIBADD =
-am__objects_1 = \
+am__objects_2 = \
luatexdir/luafilesystem/src/libluajitmisc_a-lfs.$(OBJEXT) \
luatexdir/luamd5/libluajitmisc_a-md5.$(OBJEXT) \
luatexdir/luamd5/libluajitmisc_a-md5lib.$(OBJEXT) \
@@ -492,11 +501,11 @@ am__objects_1 = \
luatexdir/luazlib/libluajitmisc_a-lgzip.$(OBJEXT) \
luatexdir/luazlib/libluajitmisc_a-lzlib.$(OBJEXT) \
luatexdir/slnunicode/libluajitmisc_a-slnunico.$(OBJEXT)
-nodist_libluajitmisc_a_OBJECTS = $(am__objects_1)
+nodist_libluajitmisc_a_OBJECTS = $(am__objects_2)
libluajitmisc_a_OBJECTS = $(nodist_libluajitmisc_a_OBJECTS)
libluajitsocket_a_AR = $(AR) $(ARFLAGS)
libluajitsocket_a_LIBADD =
-am__objects_2 = \
+am__objects_3 = \
luatexdir/luasocket/src/libluajitsocket_a-auxiliar.$(OBJEXT) \
luatexdir/luasocket/src/libluajitsocket_a-buffer.$(OBJEXT) \
luatexdir/luasocket/src/libluajitsocket_a-except.$(OBJEXT) \
@@ -512,13 +521,13 @@ am__objects_2 = \
luatexdir/luasocket/src/libluajitsocket_a-tcp.$(OBJEXT) \
luatexdir/luasocket/src/libluajitsocket_a-timeout.$(OBJEXT) \
luatexdir/luasocket/src/libluajitsocket_a-udp.$(OBJEXT)
-nodist_libluajitsocket_a_OBJECTS = $(am__objects_2)
+nodist_libluajitsocket_a_OBJECTS = $(am__objects_3)
libluajitsocket_a_OBJECTS = $(nodist_libluajitsocket_a_OBJECTS)
libluajittex_a_AR = $(AR) $(ARFLAGS)
libluajittex_a_LIBADD =
dist_libluajittex_a_OBJECTS = \
luatexdir/lua/libluajittex_a-lstrlibextjit.$(OBJEXT)
-am__objects_3 = luatexdir/luafontloader/src/libluajittex_a-ffdummies.$(OBJEXT) \
+am__objects_4 = luatexdir/luafontloader/src/libluajittex_a-ffdummies.$(OBJEXT) \
luatexdir/luafontloader/src/libluajittex_a-luafflib.$(OBJEXT) \
luatexdir/lua/libluajittex_a-lcallbacklib.$(OBJEXT) \
luatexdir/lua/libluajittex_a-lfontlib.$(OBJEXT) \
@@ -539,7 +548,7 @@ am__objects_3 = luatexdir/luafontloader/src/libluajittex_a-ffdummies.$(OBJEXT) \
luatexdir/lua/libluajittex_a-lnewtokenlib.$(OBJEXT) \
luatexdir/utils/libluajittex_a-avl.$(OBJEXT) \
synctexdir/libluajittex_a-synctex.$(OBJEXT)
-am__objects_4 = libluajittex_a-dvigen.$(OBJEXT) \
+am__objects_5 = libluajittex_a-dvigen.$(OBJEXT) \
libluajittex_a-dofont.$(OBJEXT) \
libluajittex_a-luafont.$(OBJEXT) \
libluajittex_a-mapfile.$(OBJEXT) libluajittex_a-pkin.$(OBJEXT) \
@@ -630,13 +639,13 @@ am__objects_4 = libluajittex_a-dvigen.$(OBJEXT) \
libluajittex_a-utils.$(OBJEXT) \
libluajittex_a-unistring.$(OBJEXT)
nodist_libluajittex_a_OBJECTS = libluajittex_a-luajitstuff.$(OBJEXT) \
- libluajittex_a-texluajitc.$(OBJEXT) $(am__objects_3) \
- $(am__objects_4)
+ libluajittex_a-texluajitc.$(OBJEXT) $(am__objects_4) \
+ $(am__objects_5)
libluajittex_a_OBJECTS = $(dist_libluajittex_a_OBJECTS) \
$(nodist_libluajittex_a_OBJECTS)
libluamisc_a_AR = $(AR) $(ARFLAGS)
libluamisc_a_LIBADD =
-am__objects_5 = \
+am__objects_6 = \
luatexdir/luafilesystem/src/libluamisc_a-lfs.$(OBJEXT) \
luatexdir/luamd5/libluamisc_a-md5.$(OBJEXT) \
luatexdir/luamd5/libluamisc_a-md5lib.$(OBJEXT) \
@@ -651,11 +660,11 @@ am__objects_5 = \
luatexdir/luazlib/libluamisc_a-lgzip.$(OBJEXT) \
luatexdir/luazlib/libluamisc_a-lzlib.$(OBJEXT) \
luatexdir/slnunicode/libluamisc_a-slnunico.$(OBJEXT)
-nodist_libluamisc_a_OBJECTS = $(am__objects_5)
+nodist_libluamisc_a_OBJECTS = $(am__objects_6)
libluamisc_a_OBJECTS = $(nodist_libluamisc_a_OBJECTS)
libluasocket_a_AR = $(AR) $(ARFLAGS)
libluasocket_a_LIBADD =
-am__objects_6 = \
+am__objects_7 = \
luatexdir/luasocket/src/libluasocket_a-auxiliar.$(OBJEXT) \
luatexdir/luasocket/src/libluasocket_a-buffer.$(OBJEXT) \
luatexdir/luasocket/src/libluasocket_a-except.$(OBJEXT) \
@@ -671,13 +680,13 @@ am__objects_6 = \
luatexdir/luasocket/src/libluasocket_a-tcp.$(OBJEXT) \
luatexdir/luasocket/src/libluasocket_a-timeout.$(OBJEXT) \
luatexdir/luasocket/src/libluasocket_a-udp.$(OBJEXT)
-nodist_libluasocket_a_OBJECTS = $(am__objects_6)
+nodist_libluasocket_a_OBJECTS = $(am__objects_7)
libluasocket_a_OBJECTS = $(nodist_libluasocket_a_OBJECTS)
libluatex_a_AR = $(AR) $(ARFLAGS)
libluatex_a_LIBADD =
dist_libluatex_a_OBJECTS = \
luatexdir/lua/libluatex_a-lstrlibext.$(OBJEXT)
-am__objects_7 = \
+am__objects_8 = \
luatexdir/luafontloader/src/libluatex_a-ffdummies.$(OBJEXT) \
luatexdir/luafontloader/src/libluatex_a-luafflib.$(OBJEXT) \
luatexdir/lua/libluatex_a-lcallbacklib.$(OBJEXT) \
@@ -699,7 +708,7 @@ am__objects_7 = \
luatexdir/lua/libluatex_a-lnewtokenlib.$(OBJEXT) \
luatexdir/utils/libluatex_a-avl.$(OBJEXT) \
synctexdir/libluatex_a-synctex.$(OBJEXT)
-am__objects_8 = libluatex_a-dvigen.$(OBJEXT) \
+am__objects_9 = libluatex_a-dvigen.$(OBJEXT) \
libluatex_a-dofont.$(OBJEXT) libluatex_a-luafont.$(OBJEXT) \
libluatex_a-mapfile.$(OBJEXT) libluatex_a-pkin.$(OBJEXT) \
libluatex_a-sfnt.$(OBJEXT) libluatex_a-subfont.$(OBJEXT) \
@@ -759,8 +768,8 @@ am__objects_8 = libluatex_a-dvigen.$(OBJEXT) \
libluatex_a-managed-sa.$(OBJEXT) libluatex_a-utils.$(OBJEXT) \
libluatex_a-unistring.$(OBJEXT)
nodist_libluatex_a_OBJECTS = libluatex_a-luastuff.$(OBJEXT) \
- libluatex_a-texluac.$(OBJEXT) $(am__objects_7) \
- $(am__objects_8)
+ libluatex_a-texluac.$(OBJEXT) $(am__objects_8) \
+ $(am__objects_9)
libluatex_a_OBJECTS = $(dist_libluatex_a_OBJECTS) \
$(nodist_libluatex_a_OBJECTS)
libmd5_a_AR = $(AR) $(ARFLAGS)
@@ -769,16 +778,16 @@ am_libmd5_a_OBJECTS = libmd5/libmd5_a-md5.$(OBJEXT)
libmd5_a_OBJECTS = $(am_libmd5_a_OBJECTS)
libmf_a_AR = $(AR) $(ARFLAGS)
libmf_a_LIBADD =
-am__objects_9 = mfini.$(OBJEXT) mf0.$(OBJEXT)
-nodist_libmf_a_OBJECTS = $(am__objects_9) mf-pool.$(OBJEXT)
+am__objects_10 = mfini.$(OBJEXT) mf0.$(OBJEXT)
+nodist_libmf_a_OBJECTS = $(am__objects_10) mf-pool.$(OBJEXT)
libmf_a_OBJECTS = $(nodist_libmf_a_OBJECTS)
libmflua_a_AR = $(AR) $(ARFLAGS)
libmflua_a_LIBADD =
dist_libmflua_a_OBJECTS = luatexdir/lua/libmflua_a-lkpselib.$(OBJEXT) \
mfluadir/libmflua_a-mfluac.$(OBJEXT)
-am__objects_10 = libmflua_a-mfluaini.$(OBJEXT) \
+am__objects_11 = libmflua_a-mfluaini.$(OBJEXT) \
libmflua_a-mflua0.$(OBJEXT)
-nodist_libmflua_a_OBJECTS = $(am__objects_10) \
+nodist_libmflua_a_OBJECTS = $(am__objects_11) \
libmflua_a-mflua-pool.$(OBJEXT)
libmflua_a_OBJECTS = $(dist_libmflua_a_OBJECTS) \
$(nodist_libmflua_a_OBJECTS)
@@ -787,27 +796,27 @@ libmfluajit_a_LIBADD =
dist_libmfluajit_a_OBJECTS = \
luatexdir/lua/libmfluajit_a-lkpselib.$(OBJEXT) \
mfluadir/libmfluajit_a-mfluac.$(OBJEXT)
-am__objects_11 = libmfluajit_a-mfluajitini.$(OBJEXT) \
+am__objects_12 = libmfluajit_a-mfluajitini.$(OBJEXT) \
libmfluajit_a-mfluajit0.$(OBJEXT)
-nodist_libmfluajit_a_OBJECTS = $(am__objects_11) \
+nodist_libmfluajit_a_OBJECTS = $(am__objects_12) \
libmfluajit_a-mfluajit-pool.$(OBJEXT)
libmfluajit_a_OBJECTS = $(dist_libmfluajit_a_OBJECTS) \
$(nodist_libmfluajit_a_OBJECTS)
libmplib_a_AR = $(AR) $(ARFLAGS)
libmplib_a_LIBADD =
-am__objects_12 = libmplib_a-mp.$(OBJEXT)
-am__objects_13 = libmplib_a-mpmath.$(OBJEXT)
-am__objects_14 = libmplib_a-mpmathbinary.$(OBJEXT)
-am__objects_15 = libmplib_a-mpmathdecimal.$(OBJEXT)
-am__objects_16 = libmplib_a-mpmathdouble.$(OBJEXT)
-am__objects_17 = libmplib_a-mpstrings.$(OBJEXT)
-am__objects_18 = libmplib_a-pngout.$(OBJEXT)
-am__objects_19 = libmplib_a-psout.$(OBJEXT)
-am__objects_20 = libmplib_a-svgout.$(OBJEXT)
+am__objects_13 = libmplib_a-mp.$(OBJEXT)
+am__objects_14 = libmplib_a-mpmath.$(OBJEXT)
+am__objects_15 = libmplib_a-mpmathbinary.$(OBJEXT)
+am__objects_16 = libmplib_a-mpmathdecimal.$(OBJEXT)
+am__objects_17 = libmplib_a-mpmathdouble.$(OBJEXT)
+am__objects_18 = libmplib_a-mpstrings.$(OBJEXT)
+am__objects_19 = libmplib_a-pngout.$(OBJEXT)
+am__objects_20 = libmplib_a-psout.$(OBJEXT)
+am__objects_21 = libmplib_a-svgout.$(OBJEXT)
nodist_libmplib_a_OBJECTS = libmplib_a-tfmin.$(OBJEXT) \
- $(am__objects_12) $(am__objects_13) $(am__objects_14) \
- $(am__objects_15) $(am__objects_16) $(am__objects_17) \
- $(am__objects_18) $(am__objects_19) $(am__objects_20)
+ $(am__objects_13) $(am__objects_14) $(am__objects_15) \
+ $(am__objects_16) $(am__objects_17) $(am__objects_18) \
+ $(am__objects_19) $(am__objects_20) $(am__objects_21)
libmplib_a_OBJECTS = $(nodist_libmplib_a_OBJECTS)
libmputil_a_AR = $(AR) $(ARFLAGS)
libmputil_a_LIBADD =
@@ -829,7 +838,7 @@ am__libpdftex_a_SOURCES_DIST = pdftexdir/avl.c pdftexdir/avl.h \
pdftexdir/writepng.c pdftexdir/writet1.c pdftexdir/writet3.c \
pdftexdir/writettf.c pdftexdir/writettf.h pdftexdir/writezip.c \
pdftexdir/regex/regex.c pdftexdir/regex/regex.h
-@MINGW32_TRUE@am__objects_21 = \
+@MINGW32_TRUE@am__objects_22 = \
@MINGW32_TRUE@ pdftexdir/regex/libpdftex_a-regex.$(OBJEXT)
am_libpdftex_a_OBJECTS = pdftexdir/libpdftex_a-avl.$(OBJEXT) \
pdftexdir/libpdftex_a-avlstuff.$(OBJEXT) \
@@ -850,13 +859,13 @@ am_libpdftex_a_OBJECTS = pdftexdir/libpdftex_a-avl.$(OBJEXT) \
pdftexdir/libpdftex_a-writet1.$(OBJEXT) \
pdftexdir/libpdftex_a-writet3.$(OBJEXT) \
pdftexdir/libpdftex_a-writettf.$(OBJEXT) \
- pdftexdir/libpdftex_a-writezip.$(OBJEXT) $(am__objects_21)
+ pdftexdir/libpdftex_a-writezip.$(OBJEXT) $(am__objects_22)
libpdftex_a_OBJECTS = $(am_libpdftex_a_OBJECTS)
libsynctex_a_AR = $(AR) $(ARFLAGS)
libsynctex_a_LIBADD =
-am__objects_22 = synctexdir/libsynctex_a-synctex_parser.$(OBJEXT) \
+am__objects_23 = synctexdir/libsynctex_a-synctex_parser.$(OBJEXT) \
synctexdir/libsynctex_a-synctex_parser_utils.$(OBJEXT)
-nodist_libsynctex_a_OBJECTS = $(am__objects_22)
+nodist_libsynctex_a_OBJECTS = $(am__objects_23)
libsynctex_a_OBJECTS = $(nodist_libsynctex_a_OBJECTS)
libukanji_a_AR = $(AR) $(ARFLAGS)
libukanji_a_LIBADD =
@@ -897,10 +906,10 @@ am__libxetex_a_SOURCES_DIST = xetexdir/MathTable.h \
xetexdir/XeTeXFontInst_Mac.h xetexdir/XeTeXFontMgr_Mac.mm \
xetexdir/XeTeXFontMgr_Mac.h xetexdir/XeTeX_mac.c \
xetexdir/XeTeXFontMgr_FC.cpp xetexdir/XeTeXFontMgr_FC.h
-@XETEX_MACOSX_TRUE@am__objects_23 = xetexdir/libxetex_a-XeTeXFontInst_Mac.$(OBJEXT) \
+@XETEX_MACOSX_TRUE@am__objects_24 = xetexdir/libxetex_a-XeTeXFontInst_Mac.$(OBJEXT) \
@XETEX_MACOSX_TRUE@ xetexdir/libxetex_a-XeTeXFontMgr_Mac.$(OBJEXT) \
@XETEX_MACOSX_TRUE@ xetexdir/libxetex_a-XeTeX_mac.$(OBJEXT)
-@XETEX_MACOSX_FALSE@am__objects_24 = xetexdir/libxetex_a-XeTeXFontMgr_FC.$(OBJEXT)
+@XETEX_MACOSX_FALSE@am__objects_25 = xetexdir/libxetex_a-XeTeXFontMgr_FC.$(OBJEXT)
am_libxetex_a_OBJECTS = xetexdir/libxetex_a-XeTeXFontInst.$(OBJEXT) \
xetexdir/libxetex_a-XeTeXFontMgr.$(OBJEXT) \
xetexdir/libxetex_a-XeTeXLayoutInterface.$(OBJEXT) \
@@ -914,8 +923,8 @@ am_libxetex_a_OBJECTS = xetexdir/libxetex_a-XeTeXFontInst.$(OBJEXT) \
xetexdir/image/libxetex_a-jpegimage.$(OBJEXT) \
xetexdir/image/libxetex_a-mfileio.$(OBJEXT) \
xetexdir/image/libxetex_a-numbers.$(OBJEXT) \
- xetexdir/image/libxetex_a-pngimage.$(OBJEXT) $(am__objects_23) \
- $(am__objects_24)
+ xetexdir/image/libxetex_a-pngimage.$(OBJEXT) $(am__objects_24) \
+ $(am__objects_25)
libxetex_a_OBJECTS = $(am_libxetex_a_OBJECTS)
LTLIBRARIES = $(lib_LTLIBRARIES)
am__DEPENDENCIES_1 =
@@ -983,8 +992,8 @@ PROGRAMS = $(bin_PROGRAMS) $(noinst_PROGRAMS)
dist_aleph_OBJECTS = alephdir/aleph-aleph.$(OBJEXT) \
alephdir/aleph-alephbis.$(OBJEXT) \
alephdir/aleph-alephextra.$(OBJEXT)
-am__objects_25 = aleph-alephini.$(OBJEXT) aleph-aleph0.$(OBJEXT)
-nodist_aleph_OBJECTS = $(am__objects_25) aleph-aleph-pool.$(OBJEXT)
+am__objects_26 = aleph-alephini.$(OBJEXT) aleph-aleph0.$(OBJEXT)
+nodist_aleph_OBJECTS = $(am__objects_26) aleph-aleph-pool.$(OBJEXT)
aleph_OBJECTS = $(dist_aleph_OBJECTS) $(nodist_aleph_OBJECTS)
am__DEPENDENCIES_2 = $(proglib) $(am__DEPENDENCIES_1)
aleph_DEPENDENCIES = $(am__DEPENDENCIES_2) $(am__DEPENDENCIES_1)
@@ -1043,22 +1052,22 @@ am__dist_eptex_SOURCES_DIST = eptexdir/eptexextra.c \
eptexdir/eptexextra.h eptexdir/eptex_version.h \
synctexdir/synctex.c synctexdir/synctex.h \
synctexdir/synctex-common.h synctexdir/synctex-eptex.h
-@EPTEX_SYNCTEX_TRUE@am__objects_26 = \
+@EPTEX_SYNCTEX_TRUE@am__objects_27 = \
@EPTEX_SYNCTEX_TRUE@ synctexdir/eptex-synctex.$(OBJEXT)
dist_eptex_OBJECTS = eptexdir/eptex-eptexextra.$(OBJEXT) \
- $(am__objects_26)
-am__objects_27 = eptex-eptexini.$(OBJEXT) eptex-eptex0.$(OBJEXT)
-nodist_eptex_OBJECTS = $(am__objects_27) eptex-eptex-pool.$(OBJEXT)
+ $(am__objects_27)
+am__objects_28 = eptex-eptexini.$(OBJEXT) eptex-eptex0.$(OBJEXT)
+nodist_eptex_OBJECTS = $(am__objects_28) eptex-eptex-pool.$(OBJEXT)
eptex_OBJECTS = $(dist_eptex_OBJECTS) $(nodist_eptex_OBJECTS)
@EPTEX_SYNCTEX_TRUE@am__DEPENDENCIES_3 = $(am__DEPENDENCIES_1)
am__dist_etex_SOURCES_DIST = etexdir/etexextra.c etexdir/etexextra.h \
etexdir/etex_version.h synctexdir/synctex.c \
synctexdir/synctex.h synctexdir/synctex-common.h \
synctexdir/synctex-etex.h
-@ETEX_SYNCTEX_TRUE@am__objects_28 = synctexdir/etex-synctex.$(OBJEXT)
-dist_etex_OBJECTS = etexdir/etex-etexextra.$(OBJEXT) $(am__objects_28)
-am__objects_29 = etex-etexini.$(OBJEXT) etex-etex0.$(OBJEXT)
-nodist_etex_OBJECTS = $(am__objects_29) etex-etex-pool.$(OBJEXT)
+@ETEX_SYNCTEX_TRUE@am__objects_29 = synctexdir/etex-synctex.$(OBJEXT)
+dist_etex_OBJECTS = etexdir/etex-etexextra.$(OBJEXT) $(am__objects_29)
+am__objects_30 = etex-etexini.$(OBJEXT) etex-etex0.$(OBJEXT)
+nodist_etex_OBJECTS = $(am__objects_30) etex-etex-pool.$(OBJEXT)
etex_OBJECTS = $(dist_etex_OBJECTS) $(nodist_etex_OBJECTS)
@ETEX_SYNCTEX_TRUE@am__DEPENDENCIES_4 = $(am__DEPENDENCIES_1)
etex_DEPENDENCIES = $(am__DEPENDENCIES_2) $(am__DEPENDENCIES_1) \
@@ -1067,12 +1076,12 @@ am__dist_euptex_SOURCES_DIST = euptexdir/euptexextra.c \
euptexdir/euptexextra.h synctexdir/synctex.c \
synctexdir/synctex.h synctexdir/synctex-common.h \
synctexdir/synctex-euptex.h
-@EUPTEX_SYNCTEX_TRUE@am__objects_30 = \
+@EUPTEX_SYNCTEX_TRUE@am__objects_31 = \
@EUPTEX_SYNCTEX_TRUE@ synctexdir/euptex-synctex.$(OBJEXT)
dist_euptex_OBJECTS = euptexdir/euptex-euptexextra.$(OBJEXT) \
- $(am__objects_30)
-am__objects_31 = euptex-euptexini.$(OBJEXT) euptex-euptex0.$(OBJEXT)
-nodist_euptex_OBJECTS = $(am__objects_31) euptex-euptex-pool.$(OBJEXT)
+ $(am__objects_31)
+am__objects_32 = euptex-euptexini.$(OBJEXT) euptex-euptex0.$(OBJEXT)
+nodist_euptex_OBJECTS = $(am__objects_32) euptex-euptex-pool.$(OBJEXT)
euptex_OBJECTS = $(dist_euptex_OBJECTS) $(nodist_euptex_OBJECTS)
@EUPTEX_SYNCTEX_TRUE@am__DEPENDENCIES_5 = $(am__DEPENDENCIES_1)
am_gftodvi_OBJECTS =
@@ -1091,9 +1100,9 @@ gftype_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1)
nodist_initex_OBJECTS = initex-callexe.$(OBJEXT)
initex_OBJECTS = $(nodist_initex_OBJECTS)
initex_DEPENDENCIES =
-am__objects_32 = luatexdir/luajittex-luatex.$(OBJEXT) \
+am__objects_33 = luatexdir/luajittex-luatex.$(OBJEXT) \
mplibdir/luajittex-lmplib.$(OBJEXT)
-nodist_luajittex_OBJECTS = $(am__objects_32)
+nodist_luajittex_OBJECTS = $(am__objects_33)
luajittex_OBJECTS = $(nodist_luajittex_OBJECTS)
am__DEPENDENCIES_6 = libmplib.a $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1) $(am__DEPENDENCIES_1) \
@@ -1104,9 +1113,9 @@ am__DEPENDENCIES_6 = libmplib.a $(am__DEPENDENCIES_1) \
luajittex_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CXXLD) $(luajittex_CXXFLAGS) \
$(CXXFLAGS) $(luajittex_LDFLAGS) $(LDFLAGS) -o $@
-am__objects_33 = luatexdir/luatex-luatex.$(OBJEXT) \
+am__objects_34 = luatexdir/luatex-luatex.$(OBJEXT) \
mplibdir/luatex-lmplib.$(OBJEXT)
-nodist_luatex_OBJECTS = $(am__objects_33)
+nodist_luatex_OBJECTS = $(am__objects_34)
luatex_OBJECTS = $(nodist_luatex_OBJECTS)
am__DEPENDENCIES_7 = $(am__DEPENDENCIES_1)
luatex_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
@@ -1133,8 +1142,8 @@ mflua_DEPENDENCIES = libmflua.a $(am__DEPENDENCIES_2) $(windowlib) \
mflua_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
$(mflua_LDFLAGS) $(LDFLAGS) -o $@
-am__objects_34 = mfluadir/mflua_nowin-mfluaextra.$(OBJEXT)
-nodist_mflua_nowin_OBJECTS = $(am__objects_34)
+am__objects_35 = mfluadir/mflua_nowin-mfluaextra.$(OBJEXT)
+nodist_mflua_nowin_OBJECTS = $(am__objects_35)
mflua_nowin_OBJECTS = $(nodist_mflua_nowin_OBJECTS)
mflua_nowin_DEPENDENCIES = libmflua.a $(am__DEPENDENCIES_2) \
$(windowlib) $(am__DEPENDENCIES_7)
@@ -1148,8 +1157,8 @@ mfluajit_DEPENDENCIES = libmfluajit.a $(am__DEPENDENCIES_2) \
mfluajit_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
$(mfluajit_LDFLAGS) $(LDFLAGS) -o $@
-am__objects_35 = mfluajitdir/mfluajit_nowin-mfluajitextra.$(OBJEXT)
-nodist_mfluajit_nowin_OBJECTS = $(am__objects_35)
+am__objects_36 = mfluajitdir/mfluajit_nowin-mfluajitextra.$(OBJEXT)
+nodist_mfluajit_nowin_OBJECTS = $(am__objects_36)
mfluajit_nowin_OBJECTS = $(nodist_mfluajit_nowin_OBJECTS)
mfluajit_nowin_DEPENDENCIES = libmfluajit.a $(am__DEPENDENCIES_2) \
$(windowlib) $(am__DEPENDENCIES_1)
@@ -1161,8 +1170,8 @@ nodist_mft_OBJECTS = mft.$(OBJEXT)
mft_OBJECTS = $(nodist_mft_OBJECTS)
mft_LDADD = $(LDADD)
mft_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1)
-am__objects_36 = mpost-mpxout.$(OBJEXT)
-nodist_mpost_OBJECTS = mpost-mpost.$(OBJEXT) $(am__objects_36)
+am__objects_37 = mpost-mpxout.$(OBJEXT)
+nodist_mpost_OBJECTS = mpost-mpost.$(OBJEXT) $(am__objects_37)
mpost_OBJECTS = $(nodist_mpost_OBJECTS)
mpost_DEPENDENCIES = libmplib.a $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1) $(am__DEPENDENCIES_1) \
@@ -1194,12 +1203,12 @@ am__dist_pdftex_SOURCES_DIST = pdftexdir/pdftexextra.c \
pdftexdir/etex_version.h synctexdir/synctex.c \
synctexdir/synctex.h synctexdir/synctex-common.h \
synctexdir/synctex-pdftex.h
-@PDFTEX_SYNCTEX_TRUE@am__objects_37 = \
+@PDFTEX_SYNCTEX_TRUE@am__objects_38 = \
@PDFTEX_SYNCTEX_TRUE@ synctexdir/pdftex-synctex.$(OBJEXT)
dist_pdftex_OBJECTS = pdftexdir/pdftex-pdftexextra.$(OBJEXT) \
- $(am__objects_37)
-am__objects_38 = pdftex-pdftexini.$(OBJEXT) pdftex-pdftex0.$(OBJEXT)
-nodist_pdftex_OBJECTS = $(am__objects_38) pdftex-pdftex-pool.$(OBJEXT)
+ $(am__objects_38)
+am__objects_39 = pdftex-pdftexini.$(OBJEXT) pdftex-pdftex0.$(OBJEXT)
+nodist_pdftex_OBJECTS = $(am__objects_39) pdftex-pdftex-pool.$(OBJEXT)
pdftex_OBJECTS = $(dist_pdftex_OBJECTS) $(nodist_pdftex_OBJECTS)
am__DEPENDENCIES_10 = $(am__DEPENDENCIES_1) $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1) libmd5.a
@@ -1226,20 +1235,20 @@ nodist_pltotf_OBJECTS = pltotf.$(OBJEXT)
pltotf_OBJECTS = $(nodist_pltotf_OBJECTS)
pltotf_LDADD = $(LDADD)
pltotf_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1)
-am__objects_39 = pmpost-pmp.$(OBJEXT)
-am__objects_40 = pmpost-pmpmath.$(OBJEXT)
-am__objects_41 = pmpost-pmpmathbinary.$(OBJEXT)
-am__objects_42 = pmpost-pmpmathdecimal.$(OBJEXT)
-am__objects_43 = pmpost-pmpmathdouble.$(OBJEXT)
-am__objects_44 = pmpost-pmpstrings.$(OBJEXT)
-am__objects_45 = pmpost-pmpxout.$(OBJEXT)
-am__objects_46 = pmpost-ppngout.$(OBJEXT)
-am__objects_47 = pmpost-ppsout.$(OBJEXT)
-am__objects_48 = pmpost-psvgout.$(OBJEXT)
-nodist_pmpost_OBJECTS = $(am__objects_39) $(am__objects_40) \
- $(am__objects_41) $(am__objects_42) $(am__objects_43) \
- pmpost-pmpost.$(OBJEXT) $(am__objects_44) $(am__objects_45) \
- $(am__objects_46) $(am__objects_47) $(am__objects_48) \
+am__objects_40 = pmpost-pmp.$(OBJEXT)
+am__objects_41 = pmpost-pmpmath.$(OBJEXT)
+am__objects_42 = pmpost-pmpmathbinary.$(OBJEXT)
+am__objects_43 = pmpost-pmpmathdecimal.$(OBJEXT)
+am__objects_44 = pmpost-pmpmathdouble.$(OBJEXT)
+am__objects_45 = pmpost-pmpstrings.$(OBJEXT)
+am__objects_46 = pmpost-pmpxout.$(OBJEXT)
+am__objects_47 = pmpost-ppngout.$(OBJEXT)
+am__objects_48 = pmpost-ppsout.$(OBJEXT)
+am__objects_49 = pmpost-psvgout.$(OBJEXT)
+nodist_pmpost_OBJECTS = $(am__objects_40) $(am__objects_41) \
+ $(am__objects_42) $(am__objects_43) $(am__objects_44) \
+ pmpost-pmpost.$(OBJEXT) $(am__objects_45) $(am__objects_46) \
+ $(am__objects_47) $(am__objects_48) $(am__objects_49) \
pmpost-ptfmin.$(OBJEXT)
pmpost_OBJECTS = $(nodist_pmpost_OBJECTS)
pmpost_DEPENDENCIES = $(am__DEPENDENCIES_1) $(am__DEPENDENCIES_1) \
@@ -1257,10 +1266,10 @@ am__dist_ptex_SOURCES_DIST = ptexdir/ptexextra.c ptexdir/ptexextra.h \
ptexdir/ptex_version.h synctexdir/synctex.c \
synctexdir/synctex.h synctexdir/synctex-common.h \
synctexdir/synctex-ptex.h
-@PTEX_SYNCTEX_TRUE@am__objects_49 = synctexdir/ptex-synctex.$(OBJEXT)
-dist_ptex_OBJECTS = ptexdir/ptex-ptexextra.$(OBJEXT) $(am__objects_49)
-am__objects_50 = ptex-ptexini.$(OBJEXT) ptex-ptex0.$(OBJEXT)
-nodist_ptex_OBJECTS = $(am__objects_50) ptex-ptex-pool.$(OBJEXT)
+@PTEX_SYNCTEX_TRUE@am__objects_50 = synctexdir/ptex-synctex.$(OBJEXT)
+dist_ptex_OBJECTS = ptexdir/ptex-ptexextra.$(OBJEXT) $(am__objects_50)
+am__objects_51 = ptex-ptexini.$(OBJEXT) ptex-ptex0.$(OBJEXT)
+nodist_ptex_OBJECTS = $(am__objects_51) ptex-ptex-pool.$(OBJEXT)
ptex_OBJECTS = $(dist_ptex_OBJECTS) $(nodist_ptex_OBJECTS)
@PTEX_SYNCTEX_TRUE@am__DEPENDENCIES_11 = $(am__DEPENDENCIES_1)
am_ptftopl_OBJECTS =
@@ -1281,10 +1290,10 @@ tangleboot_LDADD = $(LDADD)
am__dist_tex_SOURCES_DIST = texextra.c synctexdir/synctex.c \
synctexdir/synctex.h synctexdir/synctex-common.h \
synctexdir/synctex-tex.h
-@TEX_SYNCTEX_TRUE@am__objects_51 = synctexdir/tex-synctex.$(OBJEXT)
-dist_tex_OBJECTS = tex-texextra.$(OBJEXT) $(am__objects_51)
-am__objects_52 = tex-texini.$(OBJEXT) tex-tex0.$(OBJEXT)
-nodist_tex_OBJECTS = $(am__objects_52) tex-tex-pool.$(OBJEXT)
+@TEX_SYNCTEX_TRUE@am__objects_52 = synctexdir/tex-synctex.$(OBJEXT)
+dist_tex_OBJECTS = tex-texextra.$(OBJEXT) $(am__objects_52)
+am__objects_53 = tex-texini.$(OBJEXT) tex-tex0.$(OBJEXT)
+nodist_tex_OBJECTS = $(am__objects_53) tex-tex-pool.$(OBJEXT)
tex_OBJECTS = $(dist_tex_OBJECTS) $(nodist_tex_OBJECTS)
@TEX_SYNCTEX_TRUE@am__DEPENDENCIES_13 = $(am__DEPENDENCIES_1)
tex_DEPENDENCIES = $(am__DEPENDENCIES_2) $(am__DEPENDENCIES_1) \
@@ -1309,21 +1318,21 @@ am_updvitype_OBJECTS =
nodist_updvitype_OBJECTS = updvitype-updvitype.$(OBJEXT)
updvitype_OBJECTS = $(am_updvitype_OBJECTS) \
$(nodist_updvitype_OBJECTS)
-am__objects_53 = upmpost-pmp.$(OBJEXT)
-am__objects_54 = upmpost-pmpmath.$(OBJEXT)
-am__objects_55 = upmpost-pmpmathbinary.$(OBJEXT)
-am__objects_56 = upmpost-pmpmathdecimal.$(OBJEXT)
-am__objects_57 = upmpost-pmpmathdouble.$(OBJEXT)
-am__objects_58 = upmpost-pmpstrings.$(OBJEXT)
-am__objects_59 = upmpost-pmpxout.$(OBJEXT)
-am__objects_60 = upmpost-ppngout.$(OBJEXT)
-am__objects_61 = upmpost-ppsout.$(OBJEXT)
-am__objects_62 = upmpost-psvgout.$(OBJEXT)
-am__objects_63 = $(am__objects_53) $(am__objects_54) $(am__objects_55) \
- $(am__objects_56) $(am__objects_57) upmpost-pmpost.$(OBJEXT) \
- $(am__objects_58) $(am__objects_59) $(am__objects_60) \
- $(am__objects_61) $(am__objects_62) upmpost-ptfmin.$(OBJEXT)
-nodist_upmpost_OBJECTS = $(am__objects_63)
+am__objects_54 = upmpost-pmp.$(OBJEXT)
+am__objects_55 = upmpost-pmpmath.$(OBJEXT)
+am__objects_56 = upmpost-pmpmathbinary.$(OBJEXT)
+am__objects_57 = upmpost-pmpmathdecimal.$(OBJEXT)
+am__objects_58 = upmpost-pmpmathdouble.$(OBJEXT)
+am__objects_59 = upmpost-pmpstrings.$(OBJEXT)
+am__objects_60 = upmpost-pmpxout.$(OBJEXT)
+am__objects_61 = upmpost-ppngout.$(OBJEXT)
+am__objects_62 = upmpost-ppsout.$(OBJEXT)
+am__objects_63 = upmpost-psvgout.$(OBJEXT)
+am__objects_64 = $(am__objects_54) $(am__objects_55) $(am__objects_56) \
+ $(am__objects_57) $(am__objects_58) upmpost-pmpost.$(OBJEXT) \
+ $(am__objects_59) $(am__objects_60) $(am__objects_61) \
+ $(am__objects_62) $(am__objects_63) upmpost-ptfmin.$(OBJEXT)
+nodist_upmpost_OBJECTS = $(am__objects_64)
upmpost_OBJECTS = $(nodist_upmpost_OBJECTS)
am__DEPENDENCIES_15 = $(am__DEPENDENCIES_1) $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1) $(am__DEPENDENCIES_1) \
@@ -1337,12 +1346,12 @@ am__dist_uptex_SOURCES_DIST = uptexdir/uptexextra.c \
uptexdir/uptexextra.h uptexdir/uptex_version.h \
synctexdir/synctex.c synctexdir/synctex.h \
synctexdir/synctex-common.h synctexdir/synctex-uptex.h
-@UPTEX_SYNCTEX_TRUE@am__objects_64 = \
+@UPTEX_SYNCTEX_TRUE@am__objects_65 = \
@UPTEX_SYNCTEX_TRUE@ synctexdir/uptex-synctex.$(OBJEXT)
dist_uptex_OBJECTS = uptexdir/uptex-uptexextra.$(OBJEXT) \
- $(am__objects_64)
-am__objects_65 = uptex-uptexini.$(OBJEXT) uptex-uptex0.$(OBJEXT)
-nodist_uptex_OBJECTS = $(am__objects_65) uptex-uptex-pool.$(OBJEXT)
+ $(am__objects_65)
+am__objects_66 = uptex-uptexini.$(OBJEXT) uptex-uptex0.$(OBJEXT)
+nodist_uptex_OBJECTS = $(am__objects_66) uptex-uptex-pool.$(OBJEXT)
uptex_OBJECTS = $(dist_uptex_OBJECTS) $(nodist_uptex_OBJECTS)
@UPTEX_SYNCTEX_TRUE@am__DEPENDENCIES_16 = $(am__DEPENDENCIES_1)
am_uptftopl_OBJECTS =
@@ -1381,12 +1390,12 @@ am__dist_xetex_SOURCES_DIST = xetexdir/xetexextra.c \
xetexdir/xetex_version.h synctexdir/synctex.c \
synctexdir/synctex.h synctexdir/synctex-common.h \
synctexdir/synctex-xetex.h
-@XETEX_SYNCTEX_TRUE@am__objects_66 = \
+@XETEX_SYNCTEX_TRUE@am__objects_67 = \
@XETEX_SYNCTEX_TRUE@ synctexdir/xetex-synctex.$(OBJEXT)
dist_xetex_OBJECTS = xetexdir/xetex-xetexextra.$(OBJEXT) \
- $(am__objects_66)
-am__objects_67 = xetex-xetexini.$(OBJEXT) xetex-xetex0.$(OBJEXT)
-nodist_xetex_OBJECTS = $(am__objects_67) xetex-xetex-pool.$(OBJEXT)
+ $(am__objects_67)
+am__objects_68 = xetex-xetexini.$(OBJEXT) xetex-xetex0.$(OBJEXT)
+nodist_xetex_OBJECTS = $(am__objects_68) xetex-xetex-pool.$(OBJEXT)
xetex_OBJECTS = $(dist_xetex_OBJECTS) $(nodist_xetex_OBJECTS)
@XETEX_MACOSX_FALSE@am__DEPENDENCIES_17 = $(am__DEPENDENCIES_1)
am__DEPENDENCIES_18 = $(libxetex) $(am__DEPENDENCIES_1) \
@@ -1469,6 +1478,7 @@ am__v_OBJCXXLD_ = $(am__v_OBJCXXLD_@AM_DEFAULT_V@)
am__v_OBJCXXLD_0 = @echo " OBJCXXLD" $@;
am__v_OBJCXXLD_1 =
SOURCES = $(libff_a_SOURCES) $(libkanji_a_SOURCES) \
+ $(nodist_libluaffi_a_SOURCES) \
$(nodist_libluajitmisc_a_SOURCES) \
$(nodist_libluajitsocket_a_SOURCES) \
$(dist_libluajittex_a_SOURCES) \
@@ -1793,6 +1803,7 @@ am__DIST_COMMON = $(dist_man_MANS) $(srcdir)/../../am/bin_links.am \
$(srcdir)/euptexdir/am/euptex.am $(srcdir)/libmd5/am/md5.am \
$(srcdir)/luatexdir/am/libluatex.am \
$(srcdir)/luatexdir/am/libunilib.am \
+ $(srcdir)/luatexdir/am/luaffi.am \
$(srcdir)/luatexdir/am/luafontforge.am \
$(srcdir)/luatexdir/am/luamisc.am \
$(srcdir)/luatexdir/am/luasocket.am \
@@ -1821,7 +1832,11 @@ am__DIST_COMMON = $(dist_man_MANS) $(srcdir)/../../am/bin_links.am \
$(top_srcdir)/../../build-aux/test-driver \
$(top_srcdir)/../texlive/w32_wrapper/callexe.c \
$(top_srcdir)/luatexdir/luafontloader/ff-config.in \
- $(top_srcdir)/synctexdir/synctex.pc.in ../../build-aux/compile \
+ $(top_srcdir)/omegafonts/Makefile.in \
+ $(top_srcdir)/otps/Makefile.in \
+ $(top_srcdir)/otps/win32/Makefile.in \
+ $(top_srcdir)/synctexdir/synctex.pc.in \
+ $(top_srcdir)/window/Makefile.in ../../build-aux/compile \
../../build-aux/config.guess ../../build-aux/config.sub \
../../build-aux/depcomp ../../build-aux/install-sh \
../../build-aux/ltmain.sh ../../build-aux/missing \
@@ -2100,8 +2115,8 @@ proglib = lib/lib.a
EXTRA_LIBRARIES = libmf.a libmflua.a libmfluajit.a libmputil.a \
libmplib.a libkanji.a libukanji.a libpdftex.a libluasocket.a \
libluajitsocket.a libluamisc.a libluajitmisc.a libunilib.a \
- libff.a libluatex.a libluajittex.a libxetex.a libsynctex.a \
- libmd5.a
+ libff.a libluatex.a libluajittex.a libluaffi.a libxetex.a \
+ libsynctex.a libmd5.a
EXTRA_LTLIBRARIES = libsynctex.la
lib_LIBRARIES = $(am__append_109)
lib_LTLIBRARIES = $(am__append_108)
@@ -3166,7 +3181,7 @@ libluasocket_sources = \
luatexdir/luasocket/src/udp.h \
luatexdir/luasocket/src/usocket.h
-libluamisc_a_DEPENDENCIES = $(ZZIPLIB_DEPEND) libluasocket.a
+libluamisc_a_DEPENDENCIES = $(ZZIPLIB_DEPEND) libluasocket.a libluaffi.a
libluajitmisc_a_DEPENDENCIES = $(ZZIPLIB_DEPEND) libluajitsocket.a
libluamisc_a_CPPFLAGS = $(ZLIB_INCLUDES) $(ZZIPLIB_INCLUDES) $(LUA_INCLUDES)
libluajitmisc_a_CPPFLAGS = $(ZLIB_INCLUDES) $(ZZIPLIB_INCLUDES) \
@@ -3501,6 +3516,22 @@ luatex_pdf_ctangle = $(ctangle_silent)CWEBINPUTS=$(srcdir)/luatexdir/pdf $(ctang
################################################################################
luatex_tex_ctangle = $(ctangle_silent)CWEBINPUTS=$(srcdir)/luatexdir/tex $(ctangle)
luatex_utils_ctangle = $(ctangle_silent)CWEBINPUTS=$(srcdir)/luatexdir/utils $(ctangle)
+libluaffi_a_CPPFLAGS = \
+ -I$(top_srcdir)/luatexdir/luaffi -I$(top_srcdir)/luatexdir/luaffi/dynasm $(LUA_INCLUDES)
+
+libluaffi_a_CFLAGS = # $(WARNING_CFLAGS)
+nodist_libluaffi_a_SOURCES = $(libluaffi_sources)
+libluaffi_sources = \
+ luatexdir/luaffi/call_arm.h \
+ luatexdir/luaffi/call.c \
+ luatexdir/luaffi/call_x64.h \
+ luatexdir/luaffi/call_x64win.h \
+ luatexdir/luaffi/call_x86.h \
+ luatexdir/luaffi/ctype.c \
+ luatexdir/luaffi/ffi.c \
+ luatexdir/luaffi/ffi.h \
+ luatexdir/luaffi/parser.c
+
# Force Automake to use CXXLD for linking
nodist_EXTRA_luatex_SOURCES = dummy.cxx
@@ -3520,7 +3551,7 @@ luatex_postldadd = libmplib.a $(MPFR_LIBS) $(GMP_LIBS) $(CAIRO_LIBS) \
$(PIXMAN_LIBS) $(ZZIPLIB_LIBS) $(LIBPNG_LIBS) $(ZLIB_LIBS) \
$(POPPLER_LIBS) $(LDADD) libmputil.a libunilib.a libmd5.a \
$(lua_socketlibs)
-luatex_LDADD = libluatex.a libff.a libluamisc.a libluasocket.a $(LUA_LIBS) $(luatex_postldadd)
+luatex_LDADD = libluatex.a libff.a libluamisc.a libluasocket.a libluaffi.a $(LUA_LIBS) $(luatex_postldadd)
luajittex_LDADD = libluajittex.a libff.a libluajitmisc.a libluajitsocket.a $(LUAJIT_LIBS) $(luatex_postldadd)
luatex_depend = $(proglib) $(KPATHSEA_DEPEND) $(LIBPNG_DEPEND) libmputil.a libmd5.a
luatex_DEPENDENCIES = $(luatex_depend) libluatex.a
@@ -3823,7 +3854,7 @@ all: ff-config.h
.SUFFIXES: .c .cc .cin .cpp .cxx .h .hin .lo .log .mm .o .obj .p .pin .pl .pl$(EXEEXT) .test .test$(EXEEXT) .trs
am--refresh: Makefile
@:
-$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(srcdir)/../../am/dist_hook.am $(srcdir)/am/bootstrap.am $(srcdir)/am/web.am $(srcdir)/am/cweb.am $(srcdir)/am/texmf.am $(srcdir)/mfluadir/am/mflua.am $(srcdir)/mfluajitdir/am/mfluajit.am $(srcdir)/mplibdir/am/mplib.am $(srcdir)/pmpostdir/am/pmpost.am $(srcdir)/mplibdir/am/libmputil.am $(srcdir)/mplibdir/am/libmplib.am $(srcdir)/etexdir/am/etex.am $(srcdir)/ptexdir/am/ptex.am $(srcdir)/eptexdir/am/eptex.am $(srcdir)/uptexdir/am/uptex.am $(srcdir)/euptexdir/am/euptex.am $(srcdir)/pdftexdir/am/libpdftex.am $(srcdir)/pdftexdir/am/pdftex.am $(srcdir)/pdftexdir/am/ttf2afm.am $(srcdir)/pdftexdir/am/pdftosrc.am $(srcdir)/luatexdir/am/luasocket.am $(srcdir)/luatexdir/am/luamisc.am $(srcdir)/luatexdir/am/libunilib.am $(srcdir)/luatexdir/am/luafontforge.am $(srcdir)/luatexdir/am/libluatex.am $(srcdir)/luatexdir/am/luatex.am $(srcdir)/xetexdir/am/xetex.am $(srcdir)/omegaware/am/omegaware.am $(srcdir)/alephdir/am/aleph.am $(srcdir)/synctexdir/am/synctex.am $(srcdir)/libmd5/am/md5.am $(srcdir)/../../am/bin_links.am $(am__configure_deps)
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(srcdir)/../../am/dist_hook.am $(srcdir)/am/bootstrap.am $(srcdir)/am/web.am $(srcdir)/am/cweb.am $(srcdir)/am/texmf.am $(srcdir)/mfluadir/am/mflua.am $(srcdir)/mfluajitdir/am/mfluajit.am $(srcdir)/mplibdir/am/mplib.am $(srcdir)/pmpostdir/am/pmpost.am $(srcdir)/mplibdir/am/libmputil.am $(srcdir)/mplibdir/am/libmplib.am $(srcdir)/etexdir/am/etex.am $(srcdir)/ptexdir/am/ptex.am $(srcdir)/eptexdir/am/eptex.am $(srcdir)/uptexdir/am/uptex.am $(srcdir)/euptexdir/am/euptex.am $(srcdir)/pdftexdir/am/libpdftex.am $(srcdir)/pdftexdir/am/pdftex.am $(srcdir)/pdftexdir/am/ttf2afm.am $(srcdir)/pdftexdir/am/pdftosrc.am $(srcdir)/luatexdir/am/luasocket.am $(srcdir)/luatexdir/am/luamisc.am $(srcdir)/luatexdir/am/libunilib.am $(srcdir)/luatexdir/am/luafontforge.am $(srcdir)/luatexdir/am/libluatex.am $(srcdir)/luatexdir/am/luaffi.am $(srcdir)/luatexdir/am/luatex.am $(srcdir)/xetexdir/am/xetex.am $(srcdir)/omegaware/am/omegaware.am $(srcdir)/alephdir/am/aleph.am $(srcdir)/synctexdir/am/synctex.am $(srcdir)/libmd5/am/md5.am $(srcdir)/../../am/bin_links.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
@@ -3845,7 +3876,7 @@ Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
echo ' cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe);; \
esac;
-$(srcdir)/../../am/dist_hook.am $(srcdir)/am/bootstrap.am $(srcdir)/am/web.am $(srcdir)/am/cweb.am $(srcdir)/am/texmf.am $(srcdir)/mfluadir/am/mflua.am $(srcdir)/mfluajitdir/am/mfluajit.am $(srcdir)/mplibdir/am/mplib.am $(srcdir)/pmpostdir/am/pmpost.am $(srcdir)/mplibdir/am/libmputil.am $(srcdir)/mplibdir/am/libmplib.am $(srcdir)/etexdir/am/etex.am $(srcdir)/ptexdir/am/ptex.am $(srcdir)/eptexdir/am/eptex.am $(srcdir)/uptexdir/am/uptex.am $(srcdir)/euptexdir/am/euptex.am $(srcdir)/pdftexdir/am/libpdftex.am $(srcdir)/pdftexdir/am/pdftex.am $(srcdir)/pdftexdir/am/ttf2afm.am $(srcdir)/pdftexdir/am/pdftosrc.am $(srcdir)/luatexdir/am/luasocket.am $(srcdir)/luatexdir/am/luamisc.am $(srcdir)/luatexdir/am/libunilib.am $(srcdir)/luatexdir/am/luafontforge.am $(srcdir)/luatexdir/am/libluatex.am $(srcdir)/luatexdir/am/luatex.am $(srcdir)/xetexdir/am/xetex.am $(srcdir)/omegaware/am/omegaware.am $(srcdir)/alephdir/am/aleph.am $(srcdir)/synctexdir/am/synctex.am $(srcdir)/libmd5/am/md5.am $(srcdir)/../../am/bin_links.am $(am__empty):
+$(srcdir)/../../am/dist_hook.am $(srcdir)/am/bootstrap.am $(srcdir)/am/web.am $(srcdir)/am/cweb.am $(srcdir)/am/texmf.am $(srcdir)/mfluadir/am/mflua.am $(srcdir)/mfluajitdir/am/mfluajit.am $(srcdir)/mplibdir/am/mplib.am $(srcdir)/pmpostdir/am/pmpost.am $(srcdir)/mplibdir/am/libmputil.am $(srcdir)/mplibdir/am/libmplib.am $(srcdir)/etexdir/am/etex.am $(srcdir)/ptexdir/am/ptex.am $(srcdir)/eptexdir/am/eptex.am $(srcdir)/uptexdir/am/uptex.am $(srcdir)/euptexdir/am/euptex.am $(srcdir)/pdftexdir/am/libpdftex.am $(srcdir)/pdftexdir/am/pdftex.am $(srcdir)/pdftexdir/am/ttf2afm.am $(srcdir)/pdftexdir/am/pdftosrc.am $(srcdir)/luatexdir/am/luasocket.am $(srcdir)/luatexdir/am/luamisc.am $(srcdir)/luatexdir/am/libunilib.am $(srcdir)/luatexdir/am/luafontforge.am $(srcdir)/luatexdir/am/libluatex.am $(srcdir)/luatexdir/am/luaffi.am $(srcdir)/luatexdir/am/luatex.am $(srcdir)/xetexdir/am/xetex.am $(srcdir)/omegaware/am/omegaware.am $(srcdir)/alephdir/am/aleph.am $(srcdir)/synctexdir/am/synctex.am $(srcdir)/libmd5/am/md5.am $(srcdir)/../../am/bin_links.am $(am__empty):
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
$(SHELL) ./config.status --recheck
@@ -3878,6 +3909,14 @@ stamp-h2: $(top_srcdir)/luatexdir/luafontloader/ff-config.in $(top_builddir)/con
distclean-hdr:
-rm -f w2c/c-auto.h w2c/stamp-h1 ff-config.h stamp-h2
+omegafonts/Makefile: $(top_builddir)/config.status $(top_srcdir)/omegafonts/Makefile.in
+ cd $(top_builddir) && $(SHELL) ./config.status $@
+otps/Makefile: $(top_builddir)/config.status $(top_srcdir)/otps/Makefile.in
+ cd $(top_builddir) && $(SHELL) ./config.status $@
+otps/win32/Makefile: $(top_builddir)/config.status $(top_srcdir)/otps/win32/Makefile.in
+ cd $(top_builddir) && $(SHELL) ./config.status $@
+window/Makefile: $(top_builddir)/config.status $(top_srcdir)/window/Makefile.in
+ cd $(top_builddir) && $(SHELL) ./config.status $@
web2c-sh: $(top_builddir)/config.status $(srcdir)/web2c-sh.in
cd $(top_builddir) && $(SHELL) ./config.status $@
tangle-sh: $(top_builddir)/config.status $(srcdir)/tangle-sh.in
@@ -4075,6 +4114,29 @@ libkanji.a: $(libkanji_a_OBJECTS) $(libkanji_a_DEPENDENCIES) $(EXTRA_libkanji_a_
$(AM_V_at)-rm -f libkanji.a
$(AM_V_AR)$(libkanji_a_AR) libkanji.a $(libkanji_a_OBJECTS) $(libkanji_a_LIBADD)
$(AM_V_at)$(RANLIB) libkanji.a
+luatexdir/luaffi/$(am__dirstamp):
+ @$(MKDIR_P) luatexdir/luaffi
+ @: > luatexdir/luaffi/$(am__dirstamp)
+luatexdir/luaffi/$(DEPDIR)/$(am__dirstamp):
+ @$(MKDIR_P) luatexdir/luaffi/$(DEPDIR)
+ @: > luatexdir/luaffi/$(DEPDIR)/$(am__dirstamp)
+luatexdir/luaffi/libluaffi_a-call.$(OBJEXT): \
+ luatexdir/luaffi/$(am__dirstamp) \
+ luatexdir/luaffi/$(DEPDIR)/$(am__dirstamp)
+luatexdir/luaffi/libluaffi_a-ctype.$(OBJEXT): \
+ luatexdir/luaffi/$(am__dirstamp) \
+ luatexdir/luaffi/$(DEPDIR)/$(am__dirstamp)
+luatexdir/luaffi/libluaffi_a-ffi.$(OBJEXT): \
+ luatexdir/luaffi/$(am__dirstamp) \
+ luatexdir/luaffi/$(DEPDIR)/$(am__dirstamp)
+luatexdir/luaffi/libluaffi_a-parser.$(OBJEXT): \
+ luatexdir/luaffi/$(am__dirstamp) \
+ luatexdir/luaffi/$(DEPDIR)/$(am__dirstamp)
+
+libluaffi.a: $(libluaffi_a_OBJECTS) $(libluaffi_a_DEPENDENCIES) $(EXTRA_libluaffi_a_DEPENDENCIES)
+ $(AM_V_at)-rm -f libluaffi.a
+ $(AM_V_AR)$(libluaffi_a_AR) libluaffi.a $(libluaffi_a_OBJECTS) $(libluaffi_a_LIBADD)
+ $(AM_V_at)$(RANLIB) libluaffi.a
luatexdir/luafilesystem/src/$(am__dirstamp):
@$(MKDIR_P) luatexdir/luafilesystem/src
@: > luatexdir/luafilesystem/src/$(am__dirstamp)
@@ -5240,6 +5302,7 @@ mostlyclean-compile:
-rm -f libmd5/*.$(OBJEXT)
-rm -f luatexdir/*.$(OBJEXT)
-rm -f luatexdir/lua/*.$(OBJEXT)
+ -rm -f luatexdir/luaffi/*.$(OBJEXT)
-rm -f luatexdir/luafilesystem/src/*.$(OBJEXT)
-rm -f luatexdir/luafontloader/fontforge/fontforge/*.$(OBJEXT)
-rm -f luatexdir/luafontloader/fontforge/gutils/*.$(OBJEXT)
@@ -5633,6 +5696,10 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@luatexdir/lua/$(DEPDIR)/libluatex_a-ltexlib.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@luatexdir/lua/$(DEPDIR)/libmflua_a-lkpselib.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@luatexdir/lua/$(DEPDIR)/libmfluajit_a-lkpselib.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@luatexdir/luaffi/$(DEPDIR)/libluaffi_a-call.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ctype.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ffi.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@luatexdir/luaffi/$(DEPDIR)/libluaffi_a-parser.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@luatexdir/luafilesystem/src/$(DEPDIR)/libluajitmisc_a-lfs.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@luatexdir/luafilesystem/src/$(DEPDIR)/libluamisc_a-lfs.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@luatexdir/luafontloader/fontforge/fontforge/$(DEPDIR)/libff_a-autohint.Po@am__quote@
@@ -6455,6 +6522,62 @@ ptexdir/libkanji_a-kanji.obj: ptexdir/kanji.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libkanji_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ptexdir/libkanji_a-kanji.obj `if test -f 'ptexdir/kanji.c'; then $(CYGPATH_W) 'ptexdir/kanji.c'; else $(CYGPATH_W) '$(srcdir)/ptexdir/kanji.c'; fi`
+luatexdir/luaffi/libluaffi_a-call.o: luatexdir/luaffi/call.c
+@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -MT luatexdir/luaffi/libluaffi_a-call.o -MD -MP -MF luatexdir/luaffi/$(DEPDIR)/libluaffi_a-call.Tpo -c -o luatexdir/luaffi/libluaffi_a-call.o `test -f 'luatexdir/luaffi/call.c' || echo '$(srcdir)/'`luatexdir/luaffi/call.c
+@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) luatexdir/luaffi/$(DEPDIR)/libluaffi_a-call.Tpo luatexdir/luaffi/$(DEPDIR)/libluaffi_a-call.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='luatexdir/luaffi/call.c' object='luatexdir/luaffi/libluaffi_a-call.o' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -c -o luatexdir/luaffi/libluaffi_a-call.o `test -f 'luatexdir/luaffi/call.c' || echo '$(srcdir)/'`luatexdir/luaffi/call.c
+
+luatexdir/luaffi/libluaffi_a-call.obj: luatexdir/luaffi/call.c
+@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -MT luatexdir/luaffi/libluaffi_a-call.obj -MD -MP -MF luatexdir/luaffi/$(DEPDIR)/libluaffi_a-call.Tpo -c -o luatexdir/luaffi/libluaffi_a-call.obj `if test -f 'luatexdir/luaffi/call.c'; then $(CYGPATH_W) 'luatexdir/luaffi/call.c'; else $(CYGPATH_W) '$(srcdir)/luatexdir/luaffi/call.c'; fi`
+@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) luatexdir/luaffi/$(DEPDIR)/libluaffi_a-call.Tpo luatexdir/luaffi/$(DEPDIR)/libluaffi_a-call.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='luatexdir/luaffi/call.c' object='luatexdir/luaffi/libluaffi_a-call.obj' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -c -o luatexdir/luaffi/libluaffi_a-call.obj `if test -f 'luatexdir/luaffi/call.c'; then $(CYGPATH_W) 'luatexdir/luaffi/call.c'; else $(CYGPATH_W) '$(srcdir)/luatexdir/luaffi/call.c'; fi`
+
+luatexdir/luaffi/libluaffi_a-ctype.o: luatexdir/luaffi/ctype.c
+@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -MT luatexdir/luaffi/libluaffi_a-ctype.o -MD -MP -MF luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ctype.Tpo -c -o luatexdir/luaffi/libluaffi_a-ctype.o `test -f 'luatexdir/luaffi/ctype.c' || echo '$(srcdir)/'`luatexdir/luaffi/ctype.c
+@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ctype.Tpo luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ctype.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='luatexdir/luaffi/ctype.c' object='luatexdir/luaffi/libluaffi_a-ctype.o' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -c -o luatexdir/luaffi/libluaffi_a-ctype.o `test -f 'luatexdir/luaffi/ctype.c' || echo '$(srcdir)/'`luatexdir/luaffi/ctype.c
+
+luatexdir/luaffi/libluaffi_a-ctype.obj: luatexdir/luaffi/ctype.c
+@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -MT luatexdir/luaffi/libluaffi_a-ctype.obj -MD -MP -MF luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ctype.Tpo -c -o luatexdir/luaffi/libluaffi_a-ctype.obj `if test -f 'luatexdir/luaffi/ctype.c'; then $(CYGPATH_W) 'luatexdir/luaffi/ctype.c'; else $(CYGPATH_W) '$(srcdir)/luatexdir/luaffi/ctype.c'; fi`
+@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ctype.Tpo luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ctype.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='luatexdir/luaffi/ctype.c' object='luatexdir/luaffi/libluaffi_a-ctype.obj' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -c -o luatexdir/luaffi/libluaffi_a-ctype.obj `if test -f 'luatexdir/luaffi/ctype.c'; then $(CYGPATH_W) 'luatexdir/luaffi/ctype.c'; else $(CYGPATH_W) '$(srcdir)/luatexdir/luaffi/ctype.c'; fi`
+
+luatexdir/luaffi/libluaffi_a-ffi.o: luatexdir/luaffi/ffi.c
+@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -MT luatexdir/luaffi/libluaffi_a-ffi.o -MD -MP -MF luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ffi.Tpo -c -o luatexdir/luaffi/libluaffi_a-ffi.o `test -f 'luatexdir/luaffi/ffi.c' || echo '$(srcdir)/'`luatexdir/luaffi/ffi.c
+@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ffi.Tpo luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ffi.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='luatexdir/luaffi/ffi.c' object='luatexdir/luaffi/libluaffi_a-ffi.o' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -c -o luatexdir/luaffi/libluaffi_a-ffi.o `test -f 'luatexdir/luaffi/ffi.c' || echo '$(srcdir)/'`luatexdir/luaffi/ffi.c
+
+luatexdir/luaffi/libluaffi_a-ffi.obj: luatexdir/luaffi/ffi.c
+@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -MT luatexdir/luaffi/libluaffi_a-ffi.obj -MD -MP -MF luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ffi.Tpo -c -o luatexdir/luaffi/libluaffi_a-ffi.obj `if test -f 'luatexdir/luaffi/ffi.c'; then $(CYGPATH_W) 'luatexdir/luaffi/ffi.c'; else $(CYGPATH_W) '$(srcdir)/luatexdir/luaffi/ffi.c'; fi`
+@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ffi.Tpo luatexdir/luaffi/$(DEPDIR)/libluaffi_a-ffi.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='luatexdir/luaffi/ffi.c' object='luatexdir/luaffi/libluaffi_a-ffi.obj' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -c -o luatexdir/luaffi/libluaffi_a-ffi.obj `if test -f 'luatexdir/luaffi/ffi.c'; then $(CYGPATH_W) 'luatexdir/luaffi/ffi.c'; else $(CYGPATH_W) '$(srcdir)/luatexdir/luaffi/ffi.c'; fi`
+
+luatexdir/luaffi/libluaffi_a-parser.o: luatexdir/luaffi/parser.c
+@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -MT luatexdir/luaffi/libluaffi_a-parser.o -MD -MP -MF luatexdir/luaffi/$(DEPDIR)/libluaffi_a-parser.Tpo -c -o luatexdir/luaffi/libluaffi_a-parser.o `test -f 'luatexdir/luaffi/parser.c' || echo '$(srcdir)/'`luatexdir/luaffi/parser.c
+@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) luatexdir/luaffi/$(DEPDIR)/libluaffi_a-parser.Tpo luatexdir/luaffi/$(DEPDIR)/libluaffi_a-parser.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='luatexdir/luaffi/parser.c' object='luatexdir/luaffi/libluaffi_a-parser.o' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -c -o luatexdir/luaffi/libluaffi_a-parser.o `test -f 'luatexdir/luaffi/parser.c' || echo '$(srcdir)/'`luatexdir/luaffi/parser.c
+
+luatexdir/luaffi/libluaffi_a-parser.obj: luatexdir/luaffi/parser.c
+@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -MT luatexdir/luaffi/libluaffi_a-parser.obj -MD -MP -MF luatexdir/luaffi/$(DEPDIR)/libluaffi_a-parser.Tpo -c -o luatexdir/luaffi/libluaffi_a-parser.obj `if test -f 'luatexdir/luaffi/parser.c'; then $(CYGPATH_W) 'luatexdir/luaffi/parser.c'; else $(CYGPATH_W) '$(srcdir)/luatexdir/luaffi/parser.c'; fi`
+@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) luatexdir/luaffi/$(DEPDIR)/libluaffi_a-parser.Tpo luatexdir/luaffi/$(DEPDIR)/libluaffi_a-parser.Po
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='luatexdir/luaffi/parser.c' object='luatexdir/luaffi/libluaffi_a-parser.obj' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluaffi_a_CPPFLAGS) $(CPPFLAGS) $(libluaffi_a_CFLAGS) $(CFLAGS) -c -o luatexdir/luaffi/libluaffi_a-parser.obj `if test -f 'luatexdir/luaffi/parser.c'; then $(CYGPATH_W) 'luatexdir/luaffi/parser.c'; else $(CYGPATH_W) '$(srcdir)/luatexdir/luaffi/parser.c'; fi`
+
luatexdir/luafilesystem/src/libluajitmisc_a-lfs.o: luatexdir/luafilesystem/src/lfs.c
@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libluajitmisc_a_CPPFLAGS) $(CPPFLAGS) $(libluajitmisc_a_CFLAGS) $(CFLAGS) -MT luatexdir/luafilesystem/src/libluajitmisc_a-lfs.o -MD -MP -MF luatexdir/luafilesystem/src/$(DEPDIR)/libluajitmisc_a-lfs.Tpo -c -o luatexdir/luafilesystem/src/libluajitmisc_a-lfs.o `test -f 'luatexdir/luafilesystem/src/lfs.c' || echo '$(srcdir)/'`luatexdir/luafilesystem/src/lfs.c
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) luatexdir/luafilesystem/src/$(DEPDIR)/libluajitmisc_a-lfs.Tpo luatexdir/luafilesystem/src/$(DEPDIR)/libluajitmisc_a-lfs.Po
@@ -13960,6 +14083,8 @@ distclean-generic:
-rm -f luatexdir/$(am__dirstamp)
-rm -f luatexdir/lua/$(DEPDIR)/$(am__dirstamp)
-rm -f luatexdir/lua/$(am__dirstamp)
+ -rm -f luatexdir/luaffi/$(DEPDIR)/$(am__dirstamp)
+ -rm -f luatexdir/luaffi/$(am__dirstamp)
-rm -f luatexdir/luafilesystem/src/$(DEPDIR)/$(am__dirstamp)
-rm -f luatexdir/luafilesystem/src/$(am__dirstamp)
-rm -f luatexdir/luafontloader/fontforge/fontforge/$(DEPDIR)/$(am__dirstamp)
@@ -14019,7 +14144,7 @@ clean-am: clean-binPROGRAMS clean-generic clean-libLIBRARIES \
distclean: distclean-recursive
-rm -f $(am__CONFIG_DISTCLEAN_FILES)
- -rm -rf ./$(DEPDIR) alephdir/$(DEPDIR) eptexdir/$(DEPDIR) etexdir/$(DEPDIR) euptexdir/$(DEPDIR) libmd5/$(DEPDIR) luatexdir/$(DEPDIR) luatexdir/lua/$(DEPDIR) luatexdir/luafilesystem/src/$(DEPDIR) luatexdir/luafontloader/fontforge/fontforge/$(DEPDIR) luatexdir/luafontloader/fontforge/gutils/$(DEPDIR) luatexdir/luafontloader/src/$(DEPDIR) luatexdir/luamd5/$(DEPDIR) luatexdir/luapeg/$(DEPDIR) luatexdir/luaprofiler/$(DEPDIR) luatexdir/luasocket/src/$(DEPDIR) luatexdir/luazip/src/$(DEPDIR) luatexdir/luazlib/$(DEPDIR) luatexdir/slnunicode/$(DEPDIR) luatexdir/unilib/$(DEPDIR) luatexdir/utils/$(DEPDIR) mfluadir/$(DEPDIR) mfluajitdir/$(DEPDIR) mplibdir/$(DEPDIR) pdftexdir/$(DEPDIR) pdftexdir/regex/$(DEPDIR) ptexdir/$(DEPDIR) synctexdir/$(DEPDIR) uptexdir/$(DEPDIR) xetexdir/$(DEPDIR) xetexdir/image/$(DEPDIR)
+ -rm -rf ./$(DEPDIR) alephdir/$(DEPDIR) eptexdir/$(DEPDIR) etexdir/$(DEPDIR) euptexdir/$(DEPDIR) libmd5/$(DEPDIR) luatexdir/$(DEPDIR) luatexdir/lua/$(DEPDIR) luatexdir/luaffi/$(DEPDIR) luatexdir/luafilesystem/src/$(DEPDIR) luatexdir/luafontloader/fontforge/fontforge/$(DEPDIR) luatexdir/luafontloader/fontforge/gutils/$(DEPDIR) luatexdir/luafontloader/src/$(DEPDIR) luatexdir/luamd5/$(DEPDIR) luatexdir/luapeg/$(DEPDIR) luatexdir/luaprofiler/$(DEPDIR) luatexdir/luasocket/src/$(DEPDIR) luatexdir/luazip/src/$(DEPDIR) luatexdir/luazlib/$(DEPDIR) luatexdir/slnunicode/$(DEPDIR) luatexdir/unilib/$(DEPDIR) luatexdir/utils/$(DEPDIR) mfluadir/$(DEPDIR) mfluajitdir/$(DEPDIR) mplibdir/$(DEPDIR) pdftexdir/$(DEPDIR) pdftexdir/regex/$(DEPDIR) ptexdir/$(DEPDIR) synctexdir/$(DEPDIR) uptexdir/$(DEPDIR) xetexdir/$(DEPDIR) xetexdir/image/$(DEPDIR)
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-hdr distclean-libtool distclean-tags
@@ -14070,7 +14195,7 @@ installcheck-am:
maintainer-clean: maintainer-clean-recursive
-rm -f $(am__CONFIG_DISTCLEAN_FILES)
-rm -rf $(top_srcdir)/autom4te.cache
- -rm -rf ./$(DEPDIR) alephdir/$(DEPDIR) eptexdir/$(DEPDIR) etexdir/$(DEPDIR) euptexdir/$(DEPDIR) libmd5/$(DEPDIR) luatexdir/$(DEPDIR) luatexdir/lua/$(DEPDIR) luatexdir/luafilesystem/src/$(DEPDIR) luatexdir/luafontloader/fontforge/fontforge/$(DEPDIR) luatexdir/luafontloader/fontforge/gutils/$(DEPDIR) luatexdir/luafontloader/src/$(DEPDIR) luatexdir/luamd5/$(DEPDIR) luatexdir/luapeg/$(DEPDIR) luatexdir/luaprofiler/$(DEPDIR) luatexdir/luasocket/src/$(DEPDIR) luatexdir/luazip/src/$(DEPDIR) luatexdir/luazlib/$(DEPDIR) luatexdir/slnunicode/$(DEPDIR) luatexdir/unilib/$(DEPDIR) luatexdir/utils/$(DEPDIR) mfluadir/$(DEPDIR) mfluajitdir/$(DEPDIR) mplibdir/$(DEPDIR) pdftexdir/$(DEPDIR) pdftexdir/regex/$(DEPDIR) ptexdir/$(DEPDIR) synctexdir/$(DEPDIR) uptexdir/$(DEPDIR) xetexdir/$(DEPDIR) xetexdir/image/$(DEPDIR)
+ -rm -rf ./$(DEPDIR) alephdir/$(DEPDIR) eptexdir/$(DEPDIR) etexdir/$(DEPDIR) euptexdir/$(DEPDIR) libmd5/$(DEPDIR) luatexdir/$(DEPDIR) luatexdir/lua/$(DEPDIR) luatexdir/luaffi/$(DEPDIR) luatexdir/luafilesystem/src/$(DEPDIR) luatexdir/luafontloader/fontforge/fontforge/$(DEPDIR) luatexdir/luafontloader/fontforge/gutils/$(DEPDIR) luatexdir/luafontloader/src/$(DEPDIR) luatexdir/luamd5/$(DEPDIR) luatexdir/luapeg/$(DEPDIR) luatexdir/luaprofiler/$(DEPDIR) luatexdir/luasocket/src/$(DEPDIR) luatexdir/luazip/src/$(DEPDIR) luatexdir/luazlib/$(DEPDIR) luatexdir/slnunicode/$(DEPDIR) luatexdir/unilib/$(DEPDIR) luatexdir/utils/$(DEPDIR) mfluadir/$(DEPDIR) mfluajitdir/$(DEPDIR) mplibdir/$(DEPDIR) pdftexdir/$(DEPDIR) pdftexdir/regex/$(DEPDIR) ptexdir/$(DEPDIR) synctexdir/$(DEPDIR) uptexdir/$(DEPDIR) xetexdir/$(DEPDIR) xetexdir/image/$(DEPDIR)
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
@@ -15147,6 +15272,12 @@ utils.c: ctangle$(EXEEXT) luatexdir/utils/utils.w
unistring.c: ctangle$(EXEEXT) luatexdir/utils/unistring.w
$(luatex_utils_ctangle) unistring.w
+#libluaffi_a_DEPENDENCIES = $(ZLIB_DEPEND)
+
+$(libluaffi_a_OBJECTS): $(LUA_DEPEND)
+
+#EXTRA_DIST
+
$(luatex_OBJECTS): libluatex.a
$(luajittex_OBJECTS): libluajittex.a
diff --git a/Build/source/texk/web2c/luatexdir/ChangeLog b/Build/source/texk/web2c/luatexdir/ChangeLog
index a3f9c26e2af..441fab87fe4 100644
--- a/Build/source/texk/web2c/luatexdir/ChangeLog
+++ b/Build/source/texk/web2c/luatexdir/ChangeLog
@@ -1,3 +1,9 @@
+2017-02-07 Luigi Scarso <luigi.scarso@gmail.com>
+
+ * luaffi/: First attempt to implement the ffi module in lua
+ compatible with the ffi module of luajit.
+
+
2015-11-01 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
* luatex.c: Improve a little (w32 only).
diff --git a/Build/source/texk/web2c/luatexdir/am/luaffi.am b/Build/source/texk/web2c/luatexdir/am/luaffi.am
new file mode 100644
index 00000000000..3e64258cacf
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/am/luaffi.am
@@ -0,0 +1,43 @@
+## texk/web2c/luatexdir/am/luaffi.am: Makefile fragment for luaffi
+##
+## Copyright (C) 2017 Luigi Scarso <tex-live@tug.org>
+## You may freely use, modify and/or distribute this file.
+
+## luaffi
+## Only for luatex, luajittex has its own module
+
+##
+## Preliminary version
+## UNSTABLE AND UNTESTED !!!!
+##
+
+
+EXTRA_LIBRARIES += libluaffi.a
+
+#libluaffi_a_DEPENDENCIES = $(ZLIB_DEPEND)
+
+$(libluaffi_a_OBJECTS): $(LUA_DEPEND)
+
+libluaffi_a_CPPFLAGS = \
+ -I$(top_srcdir)/luatexdir/luaffi -I$(top_srcdir)/luatexdir/luaffi/dynasm $(LUA_INCLUDES)
+
+libluaffi_a_CFLAGS = # $(WARNING_CFLAGS)
+
+nodist_libluaffi_a_SOURCES = $(libluaffi_sources)
+
+
+
+libluaffi_sources = \
+ luatexdir/luaffi/call_arm.h \
+ luatexdir/luaffi/call.c \
+ luatexdir/luaffi/call_x64.h \
+ luatexdir/luaffi/call_x64win.h \
+ luatexdir/luaffi/call_x86.h \
+ luatexdir/luaffi/ctype.c \
+ luatexdir/luaffi/ffi.c \
+ luatexdir/luaffi/ffi.h \
+ luatexdir/luaffi/parser.c
+
+## Not used
+##
+#EXTRA_DIST
diff --git a/Build/source/texk/web2c/luatexdir/am/luamisc.am b/Build/source/texk/web2c/luatexdir/am/luamisc.am
index 35fd29f9af8..07bf9bc8acc 100644
--- a/Build/source/texk/web2c/luatexdir/am/luamisc.am
+++ b/Build/source/texk/web2c/luatexdir/am/luamisc.am
@@ -8,7 +8,7 @@
## and slnunicode)
EXTRA_LIBRARIES += libluamisc.a libluajitmisc.a
-libluamisc_a_DEPENDENCIES = $(ZZIPLIB_DEPEND) libluasocket.a
+libluamisc_a_DEPENDENCIES = $(ZZIPLIB_DEPEND) libluasocket.a libluaffi.a
libluajitmisc_a_DEPENDENCIES = $(ZZIPLIB_DEPEND) libluajitsocket.a
$(libluamisc_a_OBJECTS): $(libluamisc_a_DEPENDENCIES)
diff --git a/Build/source/texk/web2c/luatexdir/am/luatex.am b/Build/source/texk/web2c/luatexdir/am/luatex.am
index 891a11030d5..d67ae11f3f8 100644
--- a/Build/source/texk/web2c/luatexdir/am/luatex.am
+++ b/Build/source/texk/web2c/luatexdir/am/luatex.am
@@ -52,7 +52,7 @@ luatex_postldadd = libmplib.a $(MPFR_LIBS) $(GMP_LIBS) $(CAIRO_LIBS) $(PIXMAN_LI
luatex_postldadd += $(ZZIPLIB_LIBS) $(LIBPNG_LIBS) $(ZLIB_LIBS) $(POPPLER_LIBS)
luatex_postldadd += $(LDADD) libmputil.a libunilib.a libmd5.a $(lua_socketlibs)
-luatex_LDADD = libluatex.a libff.a libluamisc.a libluasocket.a $(LUA_LIBS) $(luatex_postldadd)
+luatex_LDADD = libluatex.a libff.a libluamisc.a libluasocket.a libluaffi.a $(LUA_LIBS) $(luatex_postldadd)
luajittex_LDADD = libluajittex.a libff.a libluajitmisc.a libluajitsocket.a $(LUAJIT_LIBS) $(luatex_postldadd)
luatex_depend = $(proglib) $(KPATHSEA_DEPEND) $(LIBPNG_DEPEND) libmputil.a libmd5.a
diff --git a/Build/source/texk/web2c/luatexdir/font/luafont.w b/Build/source/texk/web2c/luatexdir/font/luafont.w
index a998c308ef0..6ea9a4d5eea 100644
--- a/Build/source/texk/web2c/luatexdir/font/luafont.w
+++ b/Build/source/texk/web2c/luatexdir/font/luafont.w
@@ -1,2195 +1,2222 @@
-% luafont.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
-#include "ptexlib.h"
-#include "lua/luatex-api.h"
-
-#define noVERBOSE
-
-/* todo: also keys */
-
-const char *font_type_strings[] = {
- "unknown", "virtual", "real", NULL
-};
-
-const char *font_writingmode_strings[] = {
- "unknown", "horizontal", "vertical", NULL
-};
-
-const char *font_identity_strings[] = {
- "unknown", "horizontal", "vertical", NULL
-};
-
-const char *font_format_strings[] = {
- "unknown", "type1", "type3", "truetype", "opentype", NULL
-};
-
-const char *font_embedding_strings[] = {
- "unknown", "no", "subset", "full", NULL
-};
-
-const char *ligature_type_strings[] = {
- "=:", "=:|", "|=:", "|=:|", "", "=:|>", "|=:>", "|=:|>", "", "", "", "|=:|>>", NULL
-};
-
-const char *MATH_param_names[] = {
- "nil",
- "ScriptPercentScaleDown",
- "ScriptScriptPercentScaleDown",
- "DelimitedSubFormulaMinHeight",
- "DisplayOperatorMinHeight",
- "MathLeading",
- "AxisHeight",
- "AccentBaseHeight",
- "FlattenedAccentBaseHeight",
- "SubscriptShiftDown",
- "SubscriptTopMax",
- "SubscriptBaselineDropMin",
- "SuperscriptShiftUp",
- "SuperscriptShiftUpCramped",
- "SuperscriptBottomMin",
- "SuperscriptBaselineDropMax",
- "SubSuperscriptGapMin",
- "SuperscriptBottomMaxWithSubscript",
- "SpaceAfterScript",
- "UpperLimitGapMin",
- "UpperLimitBaselineRiseMin",
- "LowerLimitGapMin",
- "LowerLimitBaselineDropMin",
- "StackTopShiftUp",
- "StackTopDisplayStyleShiftUp",
- "StackBottomShiftDown",
- "StackBottomDisplayStyleShiftDown",
- "StackGapMin",
- "StackDisplayStyleGapMin",
- "StretchStackTopShiftUp",
- "StretchStackBottomShiftDown",
- "StretchStackGapAboveMin",
- "StretchStackGapBelowMin",
- "FractionNumeratorShiftUp",
- "FractionNumeratorDisplayStyleShiftUp",
- "FractionDenominatorShiftDown",
- "FractionDenominatorDisplayStyleShiftDown",
- "FractionNumeratorGapMin",
- "FractionNumeratorDisplayStyleGapMin",
- "FractionRuleThickness",
- "FractionDenominatorGapMin",
- "FractionDenominatorDisplayStyleGapMin",
- "SkewedFractionHorizontalGap",
- "SkewedFractionVerticalGap",
- "OverbarVerticalGap",
- "OverbarRuleThickness",
- "OverbarExtraAscender",
- "UnderbarVerticalGap",
- "UnderbarRuleThickness",
- "UnderbarExtraDescender",
- "RadicalVerticalGap",
- "RadicalDisplayStyleVerticalGap",
- "RadicalRuleThickness",
- "RadicalExtraAscender",
- "RadicalKernBeforeDegree",
- "RadicalKernAfterDegree",
- "RadicalDegreeBottomRaisePercent",
- "MinConnectorOverlap",
- "SubscriptShiftDownWithSuperscript",
- "FractionDelimiterSize",
- "FractionDelimiterDisplayStyleSize",
- "NoLimitSubFactor",
- "NoLimitSupFactor",
- NULL,
-};
-
-/* here for now, may be useful elsewhere */
-
-int ff_checkoption (lua_State *L, int narg, const char *def, const char *const lst[]);
-
-int ff_checkoption (lua_State *L, int narg, const char *def, const char *const lst[]) {
- const char *name = (def) ? luaL_optstring(L, narg, def) : luaL_checkstring(L, narg);
- int i;
- for (i=0; lst[i]; i++)
- if (strcmp(lst[i], name) == 0)
- return i;
- return -1;
-}
-
-#define dump_intfield(L,n,c) \
- lua_push_string_by_name(L,n); \
- lua_pushinteger(L, c); \
- lua_rawset(L, -3); \
-
-#define dump_stringfield(L,n,c) \
- lua_push_string_by_name(L,n); \
- lua_pushstring(L, c); \
- lua_rawset(L, -3);
-
-#define dump_booleanfield(L,n,c) \
- lua_push_string_by_name(L,n); \
- lua_pushboolean(L, c); \
- lua_rawset(L, -3);
-
-static void dump_math_kerns(lua_State * L, charinfo * co, int l, int id)
-{
- int i;
- for (i = 0; i < l; i++) {
- lua_newtable(L);
- if (id==top_left_kern) {
- dump_intfield(L, height, co->top_left_math_kern_array[(2*i)]);
- dump_intfield(L, kern, co->top_left_math_kern_array[(2*i)+1]);
- } else if (id==top_right_kern) {
- dump_intfield(L, height, co->top_right_math_kern_array[(2*i)]);
- dump_intfield(L, kern, co->top_right_math_kern_array[(2*i)+1]);
- } else if (id==bottom_right_kern) {
- dump_intfield(L, height, co->bottom_right_math_kern_array[(2*i)]);
- dump_intfield(L, kern, co->bottom_right_math_kern_array[(2*i)+1]);
- } else if (id==bottom_left_kern) {
- dump_intfield(L, height, co->bottom_left_math_kern_array[(2*i)]);
- dump_intfield(L, kern, co->bottom_left_math_kern_array[(2*i)+1]);
- }
- lua_rawseti(L, -2, (i + 1));
- }
-}
-
-static void font_char_to_lua(lua_State * L, internal_font_number f, charinfo * co)
-{
- liginfo *l;
- kerninfo *ki;
-
- lua_createtable(L, 0, 10);
-
- dump_intfield(L,width,get_charinfo_width(co));
- dump_intfield(L,height,get_charinfo_height(co));
- dump_intfield(L,depth,get_charinfo_depth(co));
-
- if (get_charinfo_italic(co) != 0) {
- dump_intfield(L,italic,get_charinfo_italic(co));
- }
- if (get_charinfo_vert_italic(co) != 0) {
- dump_intfield(L,vert_italic,get_charinfo_vert_italic(co));
- }
- if (get_charinfo_top_accent(co) !=0 && get_charinfo_top_accent(co) != INT_MIN) {
- dump_intfield(L,top_accent,get_charinfo_top_accent(co));
- }
- if (get_charinfo_bot_accent(co) != 0 && get_charinfo_bot_accent(co) != INT_MIN) {
- dump_intfield(L,bot_accent,get_charinfo_bot_accent(co));
- }
- if (get_charinfo_ef(co) != 1000) {
- dump_intfield(L,expansion_factor,get_charinfo_ef(co));
- }
- if (get_charinfo_lp(co) != 0) {
- dump_intfield(L,left_protruding,get_charinfo_lp(co));
- }
- if (get_charinfo_rp(co) != 0) {
- dump_intfield(L,right_protruding,get_charinfo_rp(co));
- }
- if (font_encodingbytes(f) == 2) {
- dump_intfield(L,index,get_charinfo_index(co));
- }
- if (get_charinfo_name(co) != NULL) {
- dump_stringfield(L,name,get_charinfo_name(co));
- }
- if (get_charinfo_tounicode(co) != NULL) {
- dump_stringfield(L,tounicode,get_charinfo_tounicode(co));
- }
- if (get_charinfo_tag(co) == list_tag) {
- dump_intfield(L,next,get_charinfo_remainder(co));
- }
- if (get_charinfo_used(co)) {
- dump_booleanfield(L,used,(get_charinfo_used(co) ? true : false));
- }
- if (get_charinfo_tag(co) == ext_tag) {
- extinfo *h;
- h = get_charinfo_hor_variants(co);
- if (h != NULL) {
- int i = 1;
- lua_push_string_by_name(L,horiz_variants);
- lua_newtable(L);
- while (h != NULL) {
- lua_createtable(L, 0, 5);
- dump_intfield(L, glyph, h->glyph);
- dump_intfield(L, extender, h->extender);
- dump_intfield(L, start, h->start_overlap);
- dump_intfield(L, end, h->end_overlap);
- dump_intfield(L, advance, h->advance);
- lua_rawseti(L, -2, i);
- i++;
- h = h->next;
- }
- lua_rawset(L, -3);
- }
- h = get_charinfo_vert_variants(co);
- if (h != NULL) {
- int i = 1;
- lua_push_string_by_name(L,vert_variants);
- lua_newtable(L);
- while (h != NULL) {
- lua_createtable(L, 0, 5);
- dump_intfield(L, glyph, h->glyph);
- dump_intfield(L, extender, h->extender);
- dump_intfield(L, start, h->start_overlap);
- dump_intfield(L, end, h->end_overlap);
- dump_intfield(L, advance, h->advance);
- lua_rawseti(L, -2, i);
- i++;
- h = h->next;
- }
- lua_rawset(L, -3);
- }
- }
- ki = get_charinfo_kerns(co);
- if (ki != NULL) {
- int i;
- lua_push_string_by_name(L,kerns);
- lua_createtable(L, 10, 1);
- for (i = 0; !kern_end(ki[i]); i++) {
- if (kern_disabled(ki[i])) {
- /* skip like in lookup */
- } else {
- lua_rawgeti(L, -1, kern_char(ki[i]));
- if (lua_type(L,-1) == LUA_TNIL) {
- lua_pop(L,1);
- if (kern_char(ki[i]) == right_boundarychar) {
- lua_push_string_by_name(L,right_boundary);
- } else {
- lua_pushinteger(L, kern_char(ki[i]));
- }
- lua_pushinteger(L, kern_kern(ki[i]));
- lua_rawset(L, -3);
- } else {
- /* first one wins */
- lua_pop(L,1);
- }
- }
- }
- lua_rawset(L, -3);
- }
- l = get_charinfo_ligatures(co);
- if (l != NULL) {
- int i;
- lua_push_string_by_name(L,ligatures);
- lua_createtable(L, 10, 1);
- for (i = 0; !lig_end(l[i]); i++) {
- if (lig_char(l[i]) == right_boundarychar) {
- lua_push_string_by_name(L,right_boundary);
- } else {
- lua_pushinteger(L, lig_char(l[i]));
- }
- lua_createtable(L, 0, 2);
- lua_push_string_by_name(L,type);
- lua_pushinteger(L, lig_type(l[i]));
- lua_rawset(L, -3);
- lua_push_string_by_name(L,char);
- lua_pushinteger(L, lig_replacement(l[i]));
- lua_rawset(L, -3);
- lua_rawset(L, -3);
- }
- lua_rawset(L, -3);
- }
-
- lua_push_string_by_name(L,mathkern);
- lua_newtable(L);
- {
- int i, j;
- i = get_charinfo_math_kerns(co, top_right_kern);
- j = 0;
- if (i > 0) {
- j++;
- lua_push_string_by_name(L,top_right);
- lua_newtable(L);
- dump_math_kerns(L, co, i, top_right_kern);
- lua_rawset(L, -3);
- }
- i = get_charinfo_math_kerns(co, top_left_kern);
- if (i > 0) {
- j++;
- lua_push_string_by_name(L,top_left);
- lua_newtable(L);
- dump_math_kerns(L, co, i, top_left_kern);
- lua_rawset(L, -3);
- }
- i = get_charinfo_math_kerns(co, bottom_right_kern);
- if (i > 0) {
- j++;
- lua_push_string_by_name(L,bottom_right);
- lua_newtable(L);
- dump_math_kerns(L, co, i, bottom_right_kern);
- lua_rawset(L, -3);
- }
- i = get_charinfo_math_kerns(co, bottom_left_kern);
- if (i > 0) {
- j++;
- lua_push_string_by_name(L,bottom_left);
- lua_newtable(L);
- dump_math_kerns(L, co, i, bottom_left_kern);
- lua_rawset(L, -3);
- }
- if (j > 0)
- lua_rawset(L, -3);
- else
- lua_pop(L, 2);
- }
-}
-
-static void write_lua_parameters(lua_State * L, int f)
-{
- int k;
- lua_push_string_by_name(L,parameters);
- lua_newtable(L);
- for (k = 1; k <= font_params(f); k++) {
- switch (k) {
- case slant_code:
- dump_intfield(L,slant,font_param(f, k));
- break;
- case space_code:
- dump_intfield(L,space,font_param(f, k));
- break;
- case space_stretch_code:
- dump_intfield(L,space_stretch,font_param(f, k));
- break;
- case space_shrink_code:
- dump_intfield(L,space_shrink,font_param(f, k));
- break;
- case x_height_code:
- dump_intfield(L,x_height,font_param(f, k));
- break;
- case quad_code:
- dump_intfield(L,quad,font_param(f, k));
- break;
- case extra_space_code:
- dump_intfield(L,extra_space,font_param(f, k));
- break;
- default:
- lua_pushinteger(L, font_param(f, k));
- lua_rawseti(L, -2, k);
- }
- }
- lua_rawset(L, -3);
-}
-
-@ @c
-static void write_lua_math_parameters(lua_State * L, int f)
-{
- int k;
- lua_push_string_by_name(L,MathConstants);
- lua_newtable(L);
- for (k = 1; k <= font_math_params(f); k++) {
- lua_pushinteger(L, font_math_param(f, k));
- if (k <= MATH_param_max) {
- lua_setfield(L, -2, MATH_param_names[k]);
- } else {
- lua_rawseti(L, -2, k);
- }
- }
- lua_rawset(L, -3);
-}
-
-int font_to_lua(lua_State * L, int f)
-{
- int k;
- charinfo *co;
- if (font_cache_id(f) > 0) {
- /* fetch the table from the registry if it was
- saved there by |font_from_lua()| */
- lua_rawgeti(L, LUA_REGISTRYINDEX, font_cache_id(f));
- /* fontdimens can be changed from tex code */
- write_lua_parameters(L, f);
- return 1;
- }
-
- lua_newtable(L);
- lua_push_string_by_name(L,name);
- lua_pushstring(L, font_name(f));
- lua_rawset(L, -3);
- if (font_area(f) != NULL) {
- dump_stringfield(L,area,font_area(f));
- }
- if (font_filename(f) != NULL) {
- dump_stringfield(L,filename,font_filename(f));
- }
- if (font_fullname(f) != NULL) {
- dump_stringfield(L,fullname,font_fullname(f));
- }
- if (font_psname(f) != NULL) {
- dump_stringfield(L,psname,font_psname(f));
- }
- if (font_encodingname(f) != NULL) {
- dump_stringfield(L,encodingname,font_encodingname(f));
- }
-
- dump_booleanfield(L,used,(font_used(f) ? true : false));
- dump_stringfield(L,type,font_type_strings[font_type(f)]);
- dump_stringfield(L,format,font_format_strings[font_format(f)]);
- dump_stringfield(L,writingmode,font_writingmode_strings[font_writingmode(f)]);
- dump_stringfield(L,identity,font_identity_strings[font_identity(f)]);
- dump_stringfield(L,embedding,font_embedding_strings[font_embedding(f)]);
-
- dump_intfield(L,units_per_em,font_units_per_em(f));
- dump_intfield(L,size,font_size(f));
- dump_intfield(L,designsize,font_dsize(f));
- dump_intfield(L,checksum,font_checksum(f));
- dump_intfield(L,slant,font_slant(f));
- dump_intfield(L,extend,font_extend(f));
- dump_intfield(L,direction,font_natural_dir(f));
- dump_intfield(L,encodingbytes,font_encodingbytes(f));
- dump_booleanfield(L,oldmath,font_oldmath(f));
- dump_intfield(L,tounicode,font_tounicode(f));
-
- /* the next one is read only */
- if (font_max_shrink(f) != 0) {
- dump_intfield(L,shrink,font_max_shrink(f));
- }
- if (font_max_stretch(f) != 0) {
- dump_intfield(L,stretch,font_max_stretch(f));
- }
- if (font_step(f) != 0) {
- dump_intfield(L,step,font_step(f));
- }
- if (font_auto_expand(f) != 0) {
- dump_booleanfield(L,auto_expand,font_auto_expand(f));
- }
- if (pdf_font_attr(f) != 0) {
- char *s = makecstring(pdf_font_attr(f));
- dump_stringfield(L,attributes,s);
- free(s);
- }
-
- /* params */
- write_lua_parameters(L, f);
- write_lua_math_parameters(L, f);
-
- /* chars */
- lua_push_string_by_name(L,characters);
- lua_createtable(L, font_tables[f]->charinfo_size, 0); /* all characters */
- if (has_left_boundary(f)) {
- co = get_charinfo(f, left_boundarychar);
- lua_push_string_by_name(L,left_boundary);
- font_char_to_lua(L, f, co);
- lua_rawset(L, -3);
- }
- if (has_right_boundary(f)) {
- co = get_charinfo(f, right_boundarychar);
- lua_push_string_by_name(L,right_boundary);
- font_char_to_lua(L, f, co);
- lua_rawset(L, -3);
- }
- for (k = font_bc(f); k <= font_ec(f); k++) {
- if (quick_char_exists(f, k)) {
- lua_pushinteger(L, k);
- co = get_charinfo(f, k);
- font_char_to_lua(L, f, co);
- lua_rawset(L, -3);
- }
- }
- lua_rawset(L, -3);
-
- if (font_cache_id(f) == 0) { /* renew */
- int r;
- lua_pushvalue(L, -1);
- r = luaL_ref(L, LUA_REGISTRYINDEX); /* pops the table */
- set_font_cache_id(f, r);
- }
- return 1;
-}
-
-#define count_hash_items(L,name,n) \
- n = 0; \
- lua_key_rawgeti(name); \
- if (lua_type(L, -1) == LUA_TTABLE) { \
- lua_pushnil(L); \
- while (lua_next(L, -2) != 0) { \
- n++; \
- lua_pop(L, 1); \
- } \
- } \
- if (n) { \
- /* keep table on stack */ \
- } else{ \
- lua_pop(L, 1); \
- }
-
-@ @c
-#define streq(a,b) (strcmp(a,b)==0)
-
-#define append_packet(k) { *(cp++) = (eight_bits) (k); }
-
-#define do_store_four(l) { \
- append_packet((l & 0xFF000000) >> 24); \
- append_packet((l & 0x00FF0000) >> 16); \
- append_packet((l & 0x0000FF00) >> 8); \
- append_packet((l & 0x000000FF)); \
-}
-
-@ @c
-static void append_float(eight_bits ** cpp, float a)
-{
- unsigned int i;
- eight_bits *cp = *cpp;
- union U {
- float a;
- eight_bits b[sizeof(float)];
- } u;
- u.a = a;
- for (i = 0; i < sizeof(float); i++)
- append_packet(u.b[i]);
- *cpp = cp;
-}
-
-static int n_enum_field(lua_State * L, int name_index, int dflt, const char **values)
-{
- int k, t;
- const char *s;
- int i = dflt;
- lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
- lua_rawget(L, -2);
- t = lua_type(L,-1);
- if (t == LUA_TNUMBER) {
- i = (int) lua_tointeger(L, -1);
- } else if (t == LUA_TSTRING) {
- s = lua_tostring(L, -1);
- k = 0;
- while (values[k] != NULL) {
- if (strcmp(values[k], s) == 0) {
- i = k;
- break;
- }
- k++;
- }
- }
- lua_pop(L, 1);
- return i;
-}
-
-static int n_boolean_field(lua_State * L, int name_index, int dflt)
-{
- int i = dflt;
- lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
- lua_rawget(L, -2);
- if (lua_isboolean(L, -1)) {
- i = lua_toboolean(L, -1);
- }
- lua_pop(L, 1);
- return i;
-}
-
-static char *n_string_field_copy(lua_State * L, int name_index, const char *dflt)
-{
- char *i;
- lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
- lua_rawget(L, -2);
- if (lua_type(L,-1) == LUA_TSTRING) {
- i = xstrdup(lua_tostring(L, -1));
- } else if (dflt == NULL) {
- i = NULL;
- } else {
- i = xstrdup(dflt);
- }
- lua_pop(L, 1);
- return i;
-}
-
-static const char *n_string_field(lua_State * L, int name_index)
-{
- lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
- lua_rawget(L, -2);
- return lua_tostring(L,-1);
-}
-
-static int n_some_field(lua_State * L, int name_index)
-{
- lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
- lua_rawget(L, -2);
- return lua_type(L,-1);
-}
-
-/*static void init_font_string_pointers(lua_State * L){}*/
-
-static int count_char_packet_bytes(lua_State * L)
-{
- register int i;
- register int l = 0;
- int ff = 0;
- for (i = 1; i <= (int) lua_rawlen(L, -1); i++) {
- lua_rawgeti(L, -1, i);
- if (lua_istable(L, -1)) {
- lua_rawgeti(L, -1, 1);
- if (lua_type(L,-1) == LUA_TSTRING) {
- const char *s = lua_tostring(L, -1);
- if (lua_key_eq(s, font)) {
- l += 5;
- ff = 1;
- } else if (lua_key_eq(s, char)) {
- if (ff == 0) {
- l += 5;
- }
- l += 5;
- ff = 1;
- } else if (lua_key_eq(s, slot)) {
- l += 10;
- ff = 1;
- } else if (lua_key_eq(s, comment) || lua_key_eq(s, nop)) {
- ;
- } else if (lua_key_eq(s, push) || lua_key_eq(s, pop)) {
- l++;
- } else if (lua_key_eq(s, rule)) {
- l += 9;
- } else if (lua_key_eq(s, right) || lua_key_eq(s, node)
- || lua_key_eq(s, down) || lua_key_eq(s, image)) {
- l += 5;
- } else if (lua_key_eq(s, scale)) {
- l += sizeof(float) + 1;
- } else if (lua_key_eq(s, special) || lua_key_eq(s, lua)) {
- size_t len;
- lua_rawgeti(L, -2, 2);
- if (lua_type(L,-1) == LUA_TSTRING) {
- (void) lua_tolstring(L, -1, &len);
- lua_pop(L, 1);
- if (len > 0) {
- l = (int) (l + 5 + (int) len);
- }
- } else {
- lua_pop(L, 1);
- normal_error("vf command","invalid packet special");
- /* fprintf(stdout, "invalid packet special!\n"); */
- }
- } else {
- normal_error("vf command","unknown packet command");
- /* fprintf(stdout, "unknown packet command %s!\n", s); */
- }
- } else {
- normal_error("vf command","no packet command");
- /* fprintf(stdout, "no packet command!\n"); */
- }
- lua_pop(L, 1); /* command name */
- }
- lua_pop(L, 1); /* item */
- }
- return l;
-}
-
-static scaled sp_to_dvi(halfword sp, halfword atsize)
-{
- double result, mult;
- mult = (double) (atsize / 65536.0);
- result = (double) (sp * 16.0);
- return floor(result / mult);
-}
-
-@ @c
-static void read_char_packets(lua_State * L, int *l_fonts, charinfo * co, internal_font_number f, int atsize)
-{
- int i, n, m;
- size_t l;
- int cmd;
- const char *s;
- eight_bits *cpackets, *cp;
- int ff = 0;
- int max_f = 0;
- int pc = count_char_packet_bytes(L);
- if (pc <= 0)
- return;
- while (l_fonts[(max_f + 1)] != 0)
- max_f++;
- cp = cpackets = xmalloc((unsigned) (pc + 1));
- for (i = 1; i <= (int) lua_rawlen(L, -1); i++) {
- lua_rawgeti(L, -1, i);
- if (lua_istable(L, -1)) {
- /* fetch the command code */
- lua_rawgeti(L, -1, 1);
- if (lua_type(L,-1) == LUA_TSTRING) {
- s = lua_tostring(L, -1);
- cmd = 0;
- if (lua_key_eq(s, font)) {
- cmd = packet_font_code;
- } else if (lua_key_eq(s, char)) {
- cmd = packet_char_code;
- if (ff == 0) {
- append_packet(packet_font_code);
- ff = l_fonts[1];
- do_store_four(ff);
- }
- } else if (lua_key_eq(s, slot)) {
- cmd = packet_nop_code;
- lua_rawgeti(L, -2, 2);
- n = (int) luaL_checkinteger(L, -1);
- if (n ==0) {
- ff = f;
- } else {
- ff = (n > max_f ? l_fonts[1] : l_fonts[n]);
- }
- lua_rawgeti(L, -3, 3);
- n = (int) luaL_checkinteger(L, -1);
- lua_pop(L, 2);
- append_packet(packet_font_code);
- do_store_four(ff);
- append_packet(packet_char_code);
- do_store_four(n);
- } else if (lua_key_eq(s, comment) || lua_key_eq(s, nop)) {
- cmd = packet_nop_code;
- } else if (lua_key_eq(s, node)) {
- cmd = packet_node_code;
- } else if (lua_key_eq(s, push)) {
- cmd = packet_push_code;
- } else if (lua_key_eq(s, pop)) {
- cmd = packet_pop_code;
- } else if (lua_key_eq(s, rule)) {
- cmd = packet_rule_code;
- } else if (lua_key_eq(s, right)) {
- cmd = packet_right_code;
- } else if (lua_key_eq(s, down)) {
- cmd = packet_down_code;
- } else if (lua_key_eq(s, special)) {
- cmd = packet_special_code;
- } else if (lua_key_eq(s, image)) {
- cmd = packet_image_code;
- } else if (lua_key_eq(s, scale)) {
- cmd = packet_scale_code;
- } else if (lua_key_eq(s, lua)) {
- cmd = packet_lua_code;
- }
- switch (cmd) {
- case packet_push_code:
- case packet_pop_code:
- append_packet(cmd);
- break;
- case packet_font_code:
- append_packet(cmd);
- lua_rawgeti(L, -2, 2);
- n = (int) luaL_checkinteger(L, -1);
- if (n == 0) {
- ff = n;
- } else {
- ff = (n > max_f ? l_fonts[1] : l_fonts[n]);
- }
- do_store_four(ff);
- lua_pop(L, 1);
- break;
- case packet_node_code:
- append_packet(cmd);
- lua_rawgeti(L, -2, 2);
- n = copy_node_list(nodelist_from_lua(L));
- do_store_four(n);
- lua_pop(L, 1);
- break;
- case packet_char_code:
- append_packet(cmd);
- lua_rawgeti(L, -2, 2);
- n = (int) luaL_checkinteger(L, -1);
- do_store_four(n);
- lua_pop(L, 1);
- break;
- case packet_right_code:
- case packet_down_code:
- append_packet(cmd);
- lua_rawgeti(L, -2, 2);
- n = (int) luaL_checkinteger(L, -1);
- do_store_four(sp_to_dvi(n, atsize));
- lua_pop(L, 1);
- break;
- case packet_rule_code:
- append_packet(cmd);
- lua_rawgeti(L, -2, 2);
- n = (int) luaL_checkinteger(L, -1);
- do_store_four(sp_to_dvi(n, atsize));
- lua_rawgeti(L, -3, 3);
- n = (int) luaL_checkinteger(L, -1);
- do_store_four(sp_to_dvi(n, atsize));
- lua_pop(L, 2);
- break;
- case packet_special_code:
- case packet_lua_code:
- append_packet(cmd);
- lua_rawgeti(L, -2, 2);
- s = luaL_checklstring(L, -1, &l);
- if (l > 0) {
- do_store_four(l);
- m = (int) l;
- while (m > 0) {
- n = *s++;
- m--;
- append_packet(n);
- }
- }
- lua_pop(L, 1);
- break;
- case packet_image_code:
- append_packet(cmd);
- lua_rawgeti(L, -2, 2); /* img/imgtable? ... */
- if (lua_istable(L, -1)) { /* imgtable ... */
- lua_getglobal(L, "img"); /* imglib imgtable ... */
- lua_pushstring(L, "new"); /* `new' imglib imgtable ... */
- lua_gettable(L, -2); /* f imglib imgtable ... */
- lua_insert(L, -3); /* imglib imgtable f ... */
- lua_pop(L, 1); /* imgtable f ... */
- lua_call(L, 1, 1);
- } /* img ... */
- luaL_checkudata(L, -1, TYPE_IMG); /* img ... --- just typecheck */
- n = luaL_ref(L, LUA_REGISTRYINDEX); /* ... */
- do_store_four(n);
- break;
- case packet_nop_code:
- break;
- case packet_scale_code:
- append_packet(cmd);
- lua_rawgeti(L, -2, 2);
- append_float(&cp, (float) luaL_checknumber(L, -1));
- lua_pop(L, 1);
- break;
- default:
- normal_error("vf command","invalid packet code");
- /* fprintf(stdout, "Unknown char packet code %s\n", s); */
- }
- }
- lua_pop(L, 1); /* command code */
- } else {
- normal_error("vf command","commands has to be a tbale");
- /* fprintf(stdout, "Found a `commands' item that is not a table\n"); */
- }
- lua_pop(L, 1); /* command table */
- }
- append_packet(packet_end_code);
- set_charinfo_packets(co, cpackets);
- return;
-}
-
-@ @c
-static void read_lua_cidinfo(lua_State * L, int f)
-{
- int i;
- char *s;
- /*lua_getfield(L, -1, "cidinfo");*/
- lua_key_rawgeti(cidinfo);
- if (lua_istable(L, -1)) {
- i = lua_numeric_field_by_index(L,lua_key_index(version), 0);
- set_font_cidversion(f, i);
- i = lua_numeric_field_by_index(L,lua_key_index(supplement), 0);
- set_font_cidsupplement(f, i);
- s = n_string_field_copy(L, lua_key_index(registry), "Adobe"); /* Adobe-Identity-0 */
- set_font_cidregistry(f, s);
- s = n_string_field_copy(L, lua_key_index(ordering), "Identity");
- set_font_cidordering(f, s);
- }
- lua_pop(L, 1);
-}
-
-
-@ @c
-static void read_lua_parameters(lua_State * L, int f)
-{
- int i, n, t;
- const char *s;
- /*lua_getfield(L, -1, "parameters");*/
- lua_key_rawgeti(parameters);
- if (lua_istable(L, -1)) {
- /* the number of parameters is the max(IntegerKeys(L)),7) */
- n = 7;
- lua_pushnil(L); /* first key */
- while (lua_next(L, -2) != 0) {
- if (lua_type(L, -2) == LUA_TNUMBER) {
- i = (int) lua_tointeger(L, -2);
- if (i > n)
- n = i;
- }
- lua_pop(L, 1); /* pop value */
- }
- if (n > 7)
- set_font_params(f, n);
- /* sometimes it is handy to have all integer keys */
- for (i = 1; i <= 7; i++) {
- lua_rawgeti(L, -1, i);
- if (lua_type(L, -1) == LUA_TNUMBER) {
- n = lua_roundnumber(L, -1); /* round ? */
- set_font_param(f, i, n);
- }
- lua_pop(L, 1);
- }
- lua_pushnil(L); /* first key */
- while (lua_next(L, -2) != 0) {
- t = lua_type(L,-2);
- if (t == LUA_TNUMBER) {
- i = (int) lua_tointeger(L, -2);
- if (i >= 8) {
- if (lua_type(L,-1) == LUA_TNUMBER) {
- n = lua_roundnumber(L, -1);
- } else {
- n = 0;
- }
- set_font_param(f, i, n);
- }
- } else if (t == LUA_TSTRING) {
- s = lua_tostring(L, -2);
- if (lua_type(L,-1) == LUA_TNUMBER) {
- n = lua_roundnumber(L, -1);
- } else {
- n = 0;
- }
- if (lua_key_eq(s, slant)) {
- set_font_param(f, slant_code, n);
- } else if (lua_key_eq(s, space)) {
- set_font_param(f, space_code, n);
- } else if (lua_key_eq(s, space_stretch)) {
- set_font_param(f, space_stretch_code, n);
- } else if (lua_key_eq(s, space_shrink)) {
- set_font_param(f, space_shrink_code, n);
- } else if (lua_key_eq(s, x_height)) {
- set_font_param(f, x_height_code, n);
- } else if (lua_key_eq(s, quad)) {
- set_font_param(f, quad_code, n);
- } else if (lua_key_eq(s, extra_space)) {
- set_font_param(f, extra_space_code, n);
- }
- }
- lua_pop(L, 1);
- }
- }
- lua_pop(L, 1);
-
-}
-
-@ @c
-static void read_lua_math_parameters(lua_State * L, int f)
-{
- int i = 0, n = 0, t;
- /*lua_getfield(L, -1, "MathConstants");*/
- lua_key_rawgeti(MathConstants);
- if (lua_istable(L, -1)) {
- lua_pushnil(L);
- while (lua_next(L, -2) != 0) {
- t = lua_type(L,-2);
- if (t == LUA_TNUMBER) {
- i = (int) lua_tointeger(L, -2);
- } else if (t == LUA_TSTRING) {
- i = ff_checkoption(L, -2, NULL, MATH_param_names);
- }
- n = (int) lua_roundnumber(L, -1);
- if (i > 0) {
- set_font_math_param(f, i, n);
- }
- lua_pop(L, 1); /* pop value */
- }
- set_font_oldmath(f,false);
- } else {
- set_font_oldmath(f,true);
- }
- lua_pop(L, 1);
-}
-
-@ @c
-#define MIN_INF -0x7FFFFFFF
-
-static void store_math_kerns(lua_State * L, int index, charinfo * co, int id)
-{
- int l, k;
- scaled ht, krn;
- lua_key_direct_rawgeti(index);
- if (lua_istable(L, -1) && ((k = (int) lua_rawlen(L, -1)) > 0)) {
- for (l = 0; l < k; l++) {
- lua_rawgeti(L, -1, (l + 1));
- if (lua_istable(L, -1)) {
- ht = (scaled) lua_numeric_field_by_index(L, lua_key_index(height), MIN_INF);
- krn = (scaled) lua_numeric_field_by_index(L, lua_key_index(kern), MIN_INF);
- if (krn > MIN_INF && ht > MIN_INF)
- add_charinfo_math_kern(co, id, ht, krn);
- }
- lua_pop(L, 1);
- }
- }
- lua_pop(L, 1);
-}
-
-@ @c
-static void font_char_from_lua(lua_State * L, internal_font_number f, int i, int *l_fonts, boolean has_math)
-{
- int k, r, t, lt, u, n;
- charinfo *co;
- kerninfo *ckerns;
- liginfo *cligs;
- scaled j;
- const char *s;
- int nl = 0; /* number of ligature table items */
- int nk = 0; /* number of kern table items */
- int ctr = 0;
- int atsize = font_size(f);
- if (lua_istable(L, -1)) {
- co = get_charinfo(f, i);
- set_charinfo_tag(co, 0);
- j = lua_numeric_field_by_index(L, lua_key_index(width), 0);
- set_charinfo_width(co, j);
- j = lua_numeric_field_by_index(L, lua_key_index(height), 0);
- set_charinfo_height(co, j);
- j = lua_numeric_field_by_index(L, lua_key_index(depth), 0);
- set_charinfo_depth(co, j);
- j = lua_numeric_field_by_index(L, lua_key_index(italic), 0);
- set_charinfo_italic(co, j);
- j = lua_numeric_field_by_index(L, lua_key_index(vert_italic), 0);
- set_charinfo_vert_italic(co, j);
- j = lua_numeric_field_by_index(L, lua_key_index(index), 0);
- set_charinfo_index(co, j);
- j = lua_numeric_field_by_index(L, lua_key_index(expansion_factor), 1000);
- set_charinfo_ef(co, j);
- j = lua_numeric_field_by_index(L, lua_key_index(left_protruding), 0);
- set_charinfo_lp(co, j);
- j = lua_numeric_field_by_index(L, lua_key_index(right_protruding), 0);
- set_charinfo_rp(co, j);
- k = n_boolean_field(L, lua_key_index(used), 0);
- set_charinfo_used(co, k);
- s = n_string_field(L, lua_key_index(name));
- if (s != NULL)
- set_charinfo_name(co, xstrdup(s));
- else
- set_charinfo_name(co, NULL);
- /* n_string_field leaves a value on stack*/
- lua_pop(L,1);
- u = n_some_field(L,lua_key_index(tounicode));
- if (u == LUA_TNUMBER) {
- u = lua_tointeger(L,-1);
- if (u < 0) {
- set_charinfo_tounicode(co, NULL);
- } else if (u < 0xD7FF || (u > 0xDFFF && u <= 0xFFFF)) {
- char *s = malloc(5);
- sprintf(s,"%04X",(unsigned int) u);
- set_charinfo_tounicode(co,s);
- } else {
- char *s = malloc(9);
- u = u - 0x10000;
- sprintf(s,"%04X%04X",(unsigned int) (floor(u/1024)+0xD800),(unsigned int) (u%1024+0xDC00));
- set_charinfo_tounicode(co,s);
- }
- } else if (u == LUA_TTABLE) {
- n = lua_rawlen(L,-1);
- u = 0;
- for (k = 1; k <= n; k++) {
- lua_rawgeti(L, -1, k);
- if (lua_type(L,-1) == LUA_TNUMBER) {
- u = lua_tointeger(L,-1);
- } else {
- lua_pop(L, 1);
- break;
- }
- if (u < 0) {
- u = -1;
- lua_pop(L, 1);
- break;
- } else if (u < 0xD7FF || (u > 0xDFFF && u <= 0xFFFF)) {
- u = u + 4;
- } else {
- u = u + 8;
- }
- lua_pop(L, 1);
- }
- if (u>0) {
- char *s = malloc(u+1);
- char *t = s ;
- for (k = 1; k <= n; k++) {
- lua_rawgeti(L, -1, k);
- u = lua_tointeger(L,-1);
- if (u < 0xD7FF || (u > 0xDFFF && u <= 0xFFFF)) {
- sprintf(t,"%04X",(unsigned int) u);
- t += 4;
- } else {
- u = u - 0x10000;
- sprintf(t,"%04X%04X",(unsigned int) (floor(u/1024)+0xD800),(unsigned int) (u%1024+0xDC00));
- t += 8;
- }
- lua_pop(L, 1);
- }
- set_charinfo_tounicode(co,s);
- } else {
- set_charinfo_tounicode(co, NULL);
- }
- } else if (u == LUA_TSTRING) {
- s = lua_tostring(L,-1);
- set_charinfo_tounicode(co, xstrdup(s));
- } else {
- set_charinfo_tounicode(co, NULL);
- }
- /* ... leaves a value on stack*/
- lua_pop(L,1);
-
- if (has_math) {
- j = lua_numeric_field_by_index(L, lua_key_index(top_accent), INT_MIN);
- set_charinfo_top_accent(co, j);
- j = lua_numeric_field_by_index(L, lua_key_index(bot_accent), INT_MIN);
- set_charinfo_bot_accent(co, j);
- k = lua_numeric_field_by_index(L, lua_key_index(next), -1);
- if (k >= 0) {
- set_charinfo_tag(co, list_tag);
- set_charinfo_remainder(co, k);
- }
-
- lua_key_rawgeti(extensible);
- if (lua_istable(L, -1)) {
- int top, bot, mid, rep;
- top = lua_numeric_field_by_index(L, lua_key_index(top), 0);
- bot = lua_numeric_field_by_index(L, lua_key_index(bot), 0);
- mid = lua_numeric_field_by_index(L, lua_key_index(mid), 0);
- rep = lua_numeric_field_by_index(L, lua_key_index(rep), 0);
- if (top != 0 || bot != 0 || mid != 0 || rep != 0) {
- set_charinfo_tag(co, ext_tag);
- set_charinfo_extensible(co, top, bot, mid, rep);
- } else {
- formatted_warning("font", "lua-loaded font %s char U+%X has an invalid extensible field",
- font_name(f), (int) i);
- }
- }
- lua_pop(L, 1);
-
- lua_key_rawgeti(horiz_variants);
- if (lua_istable(L, -1)) {
- int glyph, startconnect, endconnect, advance, extender;
- extinfo *h;
- set_charinfo_tag(co, ext_tag);
- set_charinfo_hor_variants(co, NULL);
- for (k = 1;; k++) {
- lua_rawgeti(L, -1, k);
- if (lua_istable(L, -1)) {
- glyph = lua_numeric_field_by_index(L, lua_key_index(glyph), 0);
- extender = lua_numeric_field_by_index(L, lua_key_index(extender), 0);
- startconnect = lua_numeric_field_by_index(L, lua_key_index(start), 0);
- endconnect = lua_numeric_field_by_index(L, lua_key_index(end), 0);
- advance = lua_numeric_field_by_index(L, lua_key_index(advance), 0);
- h = new_variant(glyph, startconnect, endconnect, advance, extender);
- add_charinfo_hor_variant(co, h);
- lua_pop(L, 1);
- } else {
- lua_pop(L, 1);
- break;
- }
- }
- }
- lua_pop(L, 1);
-
- lua_key_rawgeti(vert_variants);
- if (lua_istable(L, -1)) {
- int glyph, startconnect, endconnect, advance, extender;
- extinfo *h;
- set_charinfo_tag(co, ext_tag);
- set_charinfo_vert_variants(co, NULL);
- for (k = 1;; k++) {
- lua_rawgeti(L, -1, k);
- if (lua_istable(L, -1)) {
- glyph = lua_numeric_field_by_index(L, lua_key_index(glyph), 0);
- extender = lua_numeric_field_by_index(L, lua_key_index(extender), 0);
- startconnect = lua_numeric_field_by_index(L, lua_key_index(start), 0);
- endconnect = lua_numeric_field_by_index(L, lua_key_index(end), 0);
- advance = lua_numeric_field_by_index(L, lua_key_index(advance), 0);
- h = new_variant(glyph, startconnect, endconnect, advance, extender);
- add_charinfo_vert_variant(co, h);
- lua_pop(L, 1);
- } else {
- lua_pop(L, 1);
- break;
- }
- }
- }
- lua_pop(L, 1);
-
- /*
- Here is a complete example:
-
- |mathkern = {|
- | bottom_left = { { height = 420, kern = 80 }, { height = 520, kern = 4 } },|
- | bottom_right = { { height = 0, kern = 48 } },|
- | top_left = { { height = 620, kern = 0 }, { height = 720, kern = -80 } },|
- | top_right = { { height = 676, kern = 115 }, { height = 776, kern = 45 } },|
- |}|
-
- */
-
- lua_key_rawgeti(mathkern);
- if (lua_istable(L, -1)) {
- store_math_kerns(L,lua_key_index(top_left), co, top_left_kern);
- store_math_kerns(L,lua_key_index(top_right), co, top_right_kern);
- store_math_kerns(L,lua_key_index(bottom_right), co, bottom_right_kern);
- store_math_kerns(L,lua_key_index(bottom_left), co, bottom_left_kern);
- }
- lua_pop(L, 1);
- }
- /* end of |has_math| */
- count_hash_items(L, kerns, nk);
- if (nk > 0) {
- /* kerns table still on stack */
- ckerns = xcalloc((unsigned) (nk + 1), sizeof(kerninfo));
- ctr = 0;
- lua_pushnil(L); /* traverse hash */
- while (lua_next(L, -2) != 0) {
- k = non_boundarychar;
- lt = lua_type(L,-2);
- if (lt == LUA_TNUMBER) {
- k = (int) lua_tointeger(L, -2); /* adjacent char */
- if (k < 0)
- k = non_boundarychar;
- } else if (lt == LUA_TSTRING) {
- s = lua_tostring(L, -2);
- if (lua_key_eq(s, right_boundary)) {
- k = right_boundarychar;
- if (!has_right_boundary(f))
- set_right_boundary(f, get_charinfo(f, right_boundarychar));
- }
- }
- j = lua_roundnumber(L, -1); /* movement */
- if (k != non_boundarychar) {
- set_kern_item(ckerns[ctr], k, j);
- ctr++;
- } else {
- formatted_warning("font", "lua-loaded font %s char U+%X has an invalid kern field",
- font_name(f), (int) i);
- }
- lua_pop(L, 1);
- }
- /* guard against empty tables */
- if (ctr > 0) {
- set_kern_item(ckerns[ctr], end_kern, 0);
- set_charinfo_kerns(co, ckerns);
- } else {
- formatted_warning("font", "lua-loaded font %s char U+%X has an invalid kerns field",
- font_name(f), (int) i);
- }
- lua_pop(L, 1);
- }
-
- /* packet commands */
- lua_key_rawgeti(commands);
- if (lua_istable(L, -1)) {
- lua_pushnil(L); /* first key */
- if (lua_next(L, -2) != 0) {
- lua_pop(L, 2);
- read_char_packets(L, (int *) l_fonts, co, f, atsize);
- }
- }
- lua_pop(L, 1);
-
- /* ligatures */
- count_hash_items(L, ligatures, nl);
- if (nl > 0) {
- /* ligatures table still on stack */
- cligs = xcalloc((unsigned) (nl + 1), sizeof(liginfo));
- ctr = 0;
- lua_pushnil(L); /* traverse hash */
- while (lua_next(L, -2) != 0) {
- k = non_boundarychar;
- lt = lua_type(L,-2);
- if (lt == LUA_TNUMBER) {
- k = (int) lua_tointeger(L, -2); /* adjacent char */
- if (k < 0) {
- k = non_boundarychar;
- }
- } else if (lt == LUA_TSTRING) {
- s = lua_tostring(L, -2);
- if (lua_key_eq(s, right_boundary)) {
- k = right_boundarychar;
- if (!has_right_boundary(f))
- set_right_boundary(f, get_charinfo(f, right_boundarychar));
- }
- }
- r = -1;
- if (lua_istable(L, -1)) {
- r = lua_numeric_field_by_index(L, lua_key_index(char), -1); /* ligature */
- }
- if (r != -1 && k != non_boundarychar) {
- t = n_enum_field(L, lua_key_index(type), 0, ligature_type_strings);
- set_ligature_item(cligs[ctr], (char) ((t * 2) + 1), k, r);
- ctr++;
- } else {
- formatted_warning("font", "lua-loaded font %s char U+%X has an invalid ligature field",
- font_name(f), (int) i);
- }
- lua_pop(L, 1); /* iterator value */
- }
- /* guard against empty tables */
- if (ctr > 0) {
- set_ligature_item(cligs[ctr], 0, end_ligature, 0);
- set_charinfo_ligatures(co, cligs);
- } else {
- formatted_warning("font", "lua-loaded font %s char U+%X has an invalid ligatures field",
- font_name(f), (int) i);
- }
- lua_pop(L, 1); /* ligatures table */
- }
- }
-}
-
-@ The caller has to fix the state of the lua stack when there is an error!
-
-@c
-int font_from_lua(lua_State * L, int f)
-{
- int i, n, r, t, lt;
- int s_top; /* lua stack top */
- int bc; /* first char index */
- int ec; /* last char index */
- char *s;
- const char *ss;
- int *l_fonts = NULL;
- int save_ref ;
- boolean no_math = false;
-
- /* will we save a cache of the luat table? */
-
- save_ref = 1; /* we start with ss = "yes" */
- ss = NULL;
- ss = n_string_field(L, lua_key_index(cache));
- if (lua_key_eq(ss, no))
- save_ref = -1;
- else if (lua_key_eq(ss, renew))
- save_ref = 0;
- /* n_string_field leaves a value on stack*/
- lua_pop(L,1);
-
- /* the table is at stack index -1 */
-
- s = n_string_field_copy(L,lua_key_index(area), "");
- set_font_area(f, s);
- s = n_string_field_copy(L, lua_key_index(filename), NULL);
- set_font_filename(f, s);
- s = n_string_field_copy(L, lua_key_index(encodingname), NULL);
- set_font_encodingname(f, s);
-
- s = n_string_field_copy(L, lua_key_index(name), NULL);
- set_font_name(f, s);
- s = n_string_field_copy(L, lua_key_index(fullname), font_name(f));
- set_font_fullname(f, s);
-
- if (s == NULL) {
- formatted_error("font","lua-loaded font '%d' has no name!", f);
- return false;
- }
- s = n_string_field_copy(L, lua_key_index(psname), NULL);
- set_font_psname(f, s);
-
- i = lua_numeric_field_by_index(L,lua_key_index(units_per_em), 0);
- set_font_units_per_em(f, i);
- i = lua_numeric_field_by_index(L,lua_key_index(designsize), 655360);
- set_font_dsize(f, i);
- i = lua_numeric_field_by_index(L,lua_key_index(size), font_dsize(f));
- set_font_size(f, i);
- set_font_checksum(f, (unsigned)(lua_unsigned_numeric_field_by_index(L,lua_key_index(checksum), 0))) ;
- i = lua_numeric_field_by_index(L,lua_key_index(direction), 0);
- set_font_natural_dir(f, i);
- i = lua_numeric_field_by_index(L,lua_key_index(encodingbytes), 0);
- set_font_encodingbytes(f, (char) i);
- i = n_boolean_field(L,lua_key_index(oldmath), 0);
- set_font_oldmath(f, i);
- i = lua_numeric_field_by_index(L,lua_key_index(tounicode), 0);
- set_font_tounicode(f, (char) i);
-
- i = lua_numeric_field_by_index(L,lua_key_index(extend), 1000);
- if (i < FONT_EXTEND_MIN)
- i = FONT_EXTEND_MIN;
- if (i > FONT_EXTEND_MAX)
- i = FONT_EXTEND_MAX;
- set_font_extend(f, i);
- i = lua_numeric_field_by_index(L,lua_key_index(slant), 0);
- if (i < FONT_SLANT_MIN)
- i = FONT_SLANT_MIN;
- if (i > FONT_SLANT_MAX)
- i = FONT_SLANT_MAX;
- set_font_slant(f, i);
-
- i = lua_numeric_field_by_index(L,lua_key_index(hyphenchar), default_hyphen_char_par);
- set_hyphen_char(f, i);
- i = lua_numeric_field_by_index(L,lua_key_index(skewchar), default_skew_char_par);
- set_skew_char(f, i);
- i = n_boolean_field(L, lua_key_index(used), 0);
- set_font_used(f, (char) i);
-
- s = n_string_field_copy(L, lua_key_index(attributes), NULL);
- if (s != NULL && strlen(s) > 0) {
- i = maketexstring(s);
- set_pdf_font_attr(f, i);
- }
- free(s);
-
- i = n_enum_field(L, lua_key_index(type), unknown_font_type, font_type_strings);
- set_font_type(f, i);
- i = n_enum_field(L, lua_key_index(format), unknown_format, font_format_strings);
- set_font_format(f, i);
- i = n_enum_field(L, lua_key_index(writingmode), unknown_writingmode, font_writingmode_strings);
- set_font_writingmode(f, i);
- i = n_enum_field(L, lua_key_index(identity), unknown_identity, font_identity_strings);
- set_font_identity(f, i);
- i = n_enum_field(L, lua_key_index(embedding), unknown_embedding, font_embedding_strings);
- set_font_embedding(f, i);
- if (font_encodingbytes(f) == 0 && (font_format(f) == opentype_format || font_format(f) == truetype_format)) {
- set_font_encodingbytes(f, 2);
- }
-
- /* now fetch the base fonts, if needed */
- count_hash_items(L, fonts, n);
- if (n > 0) {
- /* font table still on stack */
- l_fonts = xmalloc((unsigned) ((unsigned) (n + 2) * sizeof(int)));
- memset(l_fonts, 0, (size_t) ((unsigned) (n + 2) * sizeof(int)));
- for (i = 1; i <= n; i++) {
- lua_rawgeti(L, -1, i);
- if (lua_istable(L, -1)) {
- lua_key_rawgeti(id);
- if (lua_isnumber(L, -1)) {
- l_fonts[i] = (int) lua_tointeger(L, -1);
- if (l_fonts[i] == 0) {
- l_fonts[i] = (int) f;
- }
- lua_pop(L, 2); /* pop id and entry */
- continue;
- }
- lua_pop(L, 1); /* pop id */
- };
- ss = NULL;
- if (lua_istable(L, -1)) {
- ss = n_string_field(L, lua_key_index(name));
- /* string is anchored */
- lua_pop(L,1);
- }
- if (ss != NULL) {
- t = lua_numeric_field_by_index(L, lua_key_index(size), -1000);
- /* TODO: the stack is messed up, otherwise this explicit resizing would not be needed */
- s_top = lua_gettop(L);
- if (strcmp(font_name(f), ss) == 0)
- l_fonts[i] = f;
- else
- l_fonts[i] = find_font_id(ss, t);
- lua_settop(L, s_top);
- } else {
- formatted_error("font","invalid local font in lua-loaded font '%s'", font_name(f));
- }
- lua_pop(L, 1); /* pop list entry */
- }
- lua_pop(L, 1); /* pop font table */
- } else if (font_type(f) == virtual_font_type) {
- formatted_error("font","invalid local fonts in lua-loaded font '%s'", font_name(f));
- } else {
- l_fonts = xmalloc(3 * sizeof(int));
- l_fonts[0] = 0;
- l_fonts[1] = f;
- l_fonts[2] = 0;
- }
-
- /* parameters */
- no_math = n_boolean_field(L, lua_key_index(nomath), 0);
- read_lua_parameters(L, f);
- if (!no_math) {
- read_lua_math_parameters(L, f);
- if (n_boolean_field(L, lua_key_index(oldmath), 0)) {
- set_font_oldmath(f,true);
- }
-
- } else {
- set_font_oldmath(f,true);
- }
- read_lua_cidinfo(L, f);
-
- /* characters */
- lua_key_rawgeti(characters);
- if (lua_istable(L, -1)) {
- /* find the array size values */
- int num = 0; /* number of charinfo's to add */
- ec = 0;
- bc = -1;
- lua_pushnil(L); /* first key */
- while (lua_next(L, -2) != 0) {
- if (lua_isnumber(L, -2)) {
- i = (int) lua_tointeger(L, -2);
- if (i >= 0) {
- if (lua_istable(L, -1)) {
- num++;
- if (i > ec)
- ec = i;
- if (bc < 0)
- bc = i;
- if (bc >= 0 && i < bc)
- bc = i;
- }
- }
- }
- lua_pop(L, 1);
- }
- if (bc != -1) {
- font_malloc_charinfo(f, num);
- set_font_bc(f, bc);
- set_font_ec(f, ec);
- lua_pushnil(L); /* first key */
- while (lua_next(L, -2) != 0) {
- lt = lua_type(L,-2);
- if (lt == LUA_TNUMBER) {
- i = (int) lua_tointeger(L, -2);
- if (i >= 0) {
- font_char_from_lua(L, f, i, l_fonts, !no_math);
- }
- } else if (lt == LUA_TSTRING) {
- const char *ss1 = lua_tostring(L, -2);
- if (lua_key_eq(ss1, left_boundary)) {
- font_char_from_lua(L, f, left_boundarychar, l_fonts,
- !no_math);
- } else if (lua_key_eq(ss1, right_boundary)) {
- font_char_from_lua(L, f, right_boundarychar, l_fonts,
- !no_math);
- }
- }
- lua_pop(L, 1);
- }
- lua_pop(L, 1);
-
- /*
- Handle font expansion last: the |copy_font| routine is called eventually,
- and that needs to know |bc| and |ec|.
- */
-
- if (font_type(f) != virtual_font_type) {
- int fstep = lua_numeric_field_by_index(L, lua_key_index(step), 0);
- if (fstep < 0)
- fstep = 0;
- if (fstep > 100)
- fstep = 100;
- if (fstep != 0) {
- int fshrink = lua_numeric_field_by_index(L, lua_key_index(shrink), 0);
- int fstretch =lua_numeric_field_by_index(L, lua_key_index(stretch), 0);
- int fexpand = n_boolean_field(L, lua_key_index(auto_expand), 0);
- if (fshrink < 0)
- fshrink = 0;
- if (fshrink > 500)
- fshrink = 500;
- fshrink -= (fshrink % fstep);
- if (fshrink < 0)
- fshrink = 0;
- if (fstretch < 0)
- fstretch = 0;
- if (fstretch > 1000)
- fstretch = 1000;
- fstretch -= (fstretch % fstep);
- if (fstretch < 0)
- fstretch = 0;
- set_expand_params(f, fexpand, fstretch, fshrink, fstep);
- }
- }
-
- } else {
- /* jikes, no characters */
- formatted_warning("font","lua-loaded font '%d' with name '%s' has no characters", f, font_name(f));
- }
-
- if (save_ref > 0) {
- r = luaL_ref(L, LUA_REGISTRYINDEX); /* pops the table */
- set_font_cache_id(f, r);
- } else {
- lua_pop(L, 1);
- set_font_cache_id(f, save_ref);
- }
- } else {
- /* jikes, no characters */
- formatted_warning("font","lua-loaded font '%d' with name '%s' has no character table", f, font_name(f));
- }
- if (l_fonts != NULL)
- free(l_fonts);
- return true;
-}
-
-@* Ligaturing.
-
-@c
-static void nesting_append(halfword nest1, halfword newn)
-{
- halfword tail = tlink(nest1);
- if (tail == null) {
- couple_nodes(nest1, newn);
- } else {
- couple_nodes(tail, newn);
- }
- tlink(nest1) = newn;
-}
-
-static void nesting_prepend(halfword nest1, halfword newn)
-{
- halfword head = vlink(nest1);
- couple_nodes(nest1, newn);
- if (head == null) {
- tlink(nest1) = newn;
- } else {
- couple_nodes(newn, head);
- }
-}
-
-static void nesting_prepend_list(halfword nest1, halfword newn)
-{
- halfword head = vlink(nest1);
- couple_nodes(nest1, newn);
- if (head == null) {
- tlink(nest1) = tail_of_list(newn);
- } else {
- halfword tail = tail_of_list(newn);
- couple_nodes(tail, head);
- }
-}
-
-static int test_ligature(liginfo * lig, halfword left, halfword right)
-{
- if (type(left) != glyph_node)
- return 0;
- if (font(left) != font(right))
- return 0;
- if (is_ghost(left) || is_ghost(right))
- return 0;
- *lig = get_ligature(font(left), character(left), character(right));
- if (is_valid_ligature(*lig)) {
- return 1;
- }
- return 0;
-}
-
-static int try_ligature(halfword * frst, halfword fwd)
-{
- halfword cur = *frst;
- liginfo lig;
- if (test_ligature(&lig, cur, fwd)) {
- int move_after = (lig_type(lig) & 0x0C) >> 2;
- int keep_right = ((lig_type(lig) & 0x01) != 0);
- int keep_left = ((lig_type(lig) & 0x02) != 0);
- halfword newgl = raw_glyph_node();
- font(newgl) = font(cur);
- character(newgl) = lig_replacement(lig);
- set_is_ligature(newgl);
- /*
- below might not be correct in contrived border case.
- but we use it only for debugging, so ...
- */
- if (character(cur) < 0) {
- set_is_leftboundary(newgl);
- }
- if (character(fwd) < 0) {
- set_is_rightboundary(newgl);
- }
- if (character(cur) < 0) {
- if (character(fwd) < 0) {
- build_attribute_list(newgl);
- } else {
- add_node_attr_ref(node_attr(fwd));
- node_attr(newgl) = node_attr(fwd);
- }
- } else {
- add_node_attr_ref(node_attr(cur));
- node_attr(newgl) = node_attr(cur);
- }
-
- /*
- TODO/FIXME if this ligature is consists of another ligature
- we should add it's |lig_ptr| to the new glyphs |lig_ptr| (and
- cleanup the no longer needed node) LOW PRIORITY
- */
- /* left side */
- if (keep_left) {
- halfword new_first = copy_node(cur);
- lig_ptr(newgl) = new_first;
- couple_nodes(cur, newgl);
- if (move_after) {
- move_after--;
- cur = newgl;
- }
- } else {
- halfword prev = alink(cur);
- uncouple_node(cur);
- lig_ptr(newgl) = cur;
- couple_nodes(prev, newgl);
- cur = newgl; /* as cur has disappeared */
- }
- /* right side */
- if (keep_right) {
- halfword new_second = copy_node(fwd);
- /* correct, because we {\it know\/} |lig_ptr| points to {\it one\/} node */
- couple_nodes(lig_ptr(newgl), new_second);
- couple_nodes(newgl, fwd);
- if (move_after) {
- move_after--;
- cur = fwd;
- }
- } else {
- halfword next = vlink(fwd);
- uncouple_node(fwd);
- /* correct, because we {\it know\/} |lig_ptr| points to {\it one\/} node */
- couple_nodes(lig_ptr(newgl), fwd);
- if (next != null) {
- couple_nodes(newgl, next);
- }
- }
- /* check and return */
- *frst = cur;
- return 1;
- }
- return 0;
-}
-
-@ there shouldn't be any ligatures here - we only add them at the end of
- |xxx_break| in a \.{DISC-1 - DISC-2} situation and we stop processing \.{DISC-1}
- (we continue with \.{DISC-1}'s |post_| and |no_break|.
-
-@c
-static halfword handle_lig_nest(halfword root, halfword cur)
-{
- if (cur == null)
- return root;
- while (vlink(cur) != null) {
- halfword fwd = vlink(cur);
- if (type(cur) == glyph_node && type(fwd) == glyph_node &&
- font(cur) == font(fwd) && try_ligature(&cur, fwd)) {
- continue;
- }
- cur = vlink(cur);
- }
- tlink(root) = cur;
- return root;
-}
-
-static halfword handle_lig_word(halfword cur)
-{
- halfword right = null;
- if (type(cur) == boundary_node) {
- halfword prev = alink(cur);
- halfword fwd = vlink(cur);
- /* no need to uncouple |cur|, it is freed */
- flush_node(cur);
- if (fwd == null) {
- vlink(prev) = fwd;
- return prev;
- }
- couple_nodes(prev, fwd);
- if (type(fwd) != glyph_node)
- return prev;
- cur = fwd;
- } else if (has_left_boundary(font(cur))) {
- halfword prev = alink(cur);
- halfword p = new_glyph(font(cur), left_boundarychar);
- couple_nodes(prev, p);
- couple_nodes(p, cur);
- cur = p;
- }
- if (has_right_boundary(font(cur))) {
- right = new_glyph(font(cur), right_boundarychar);
- }
- while (1) {
- /* A glyph followed by ... */
- if (type(cur) == glyph_node) {
- halfword fwd = vlink(cur);
- if (fwd == null) { /* last character of paragraph */
- if (right == null)
- break;
- /* \.{--\\par} prohibits use of |couple_nodes| here */
- try_couple_nodes(cur, right);
- right = null;
- continue;
- }
- if (type(fwd) == glyph_node) { /* |GLYPH - GLYPH| */
- if (font(cur) != font(fwd))
- break;
- if (try_ligature(&cur, fwd))
- continue;
- } else if (type(fwd) == disc_node) { /* |GLYPH - DISC| */
-
- /* if \.{a{bx}{}{y}} and \.{a+b=>B} convert to \.{{Bx}{}{ay}} */
- halfword pre = vlink_pre_break(fwd);
- halfword nob = vlink_no_break(fwd);
- halfword next, tail;
- liginfo lig;
- /* Check on: a{b?}{?}{?} and a+b=>B : {B?}{?}{a?} */
- /* Check on: a{?}{?}{b?} and a+b=>B : {a?}{?}{B?} */
- if ((pre != null && type(pre) == glyph_node
- && test_ligature(&lig, cur, pre))
- || (nob != null && type(nob) == glyph_node
- && test_ligature(&lig, cur, nob))) {
- /* move cur from before disc, to skipped part */
- halfword prev = alink(cur);
- uncouple_node(cur);
- couple_nodes(prev, fwd);
- nesting_prepend(no_break(fwd), cur);
- /* now ligature the |pre_break| */
- nesting_prepend(pre_break(fwd), copy_node(cur));
- /* As we have removed cur, we need to start again ... */
- cur = prev;
- }
- /* Check on: a{?}{?}{}b and a+b=>B : {a?}{?b}{B} */
- next = vlink(fwd);
- if (nob == null && next != null && type(next) == glyph_node
- && test_ligature(&lig, cur, next)) {
- /* move |cur| from before |disc| to |no_break| part */
- halfword prev = alink(cur);
- uncouple_node(cur);
- couple_nodes(prev, fwd);
- couple_nodes(no_break(fwd), cur); /* we {\it know\/} it's empty */
- /* now copy cur the |pre_break| */
- nesting_prepend(pre_break(fwd), copy_node(cur));
- /* move next from after disc to |no_break| part */
- tail = vlink(next);
- uncouple_node(next);
- try_couple_nodes(fwd, tail);
- couple_nodes(cur, next); /* we {\it know\/} this works */
- tlink(no_break(fwd)) = next; /* and make sure the list is correct */
- /* now copy next to the |post_break| */
- nesting_append(post_break(fwd), copy_node(next));
- /* As we have removed cur, we need to start again ... */
- cur = prev;
- }
- /* we are finished with the |pre_break| */
- handle_lig_nest(pre_break(fwd), vlink_pre_break(fwd));
- } else if (type(fwd) == boundary_node) {
- halfword next = vlink(fwd);
- try_couple_nodes(cur, next);
- flush_node(fwd);
- if (right != null) {
- flush_node(right); /* Shame, didn't need it */
- /* no need to reset |right|, we're going to leave the loop anyway */
- }
- break;
- } else {
- /* fwd is something unknown */
- if (right == null)
- break;
- couple_nodes(cur, right);
- couple_nodes(right, fwd);
- right = null;
- continue;
- }
- /* A discretionary followed by ... */
- } else if (type(cur) == disc_node) {
- /* If \.{{?}{x}{?}} or \.{{?}{?}{y}} then ... */
- if (vlink_no_break(cur) != null || vlink_post_break(cur) != null) {
- halfword prev = 0;
- halfword fwd;
- liginfo lig;
- if (subtype(cur) == select_disc) {
- prev = alink(cur);
- if (vlink_post_break(cur) != null)
- handle_lig_nest(post_break(prev), vlink_post_break(prev));
- if (vlink_no_break(cur) != null)
- handle_lig_nest(no_break(prev), vlink_no_break(prev));
- }
- if (vlink_post_break(cur) != null)
- handle_lig_nest(post_break(cur), vlink_post_break(cur));
- if (vlink_no_break(cur) != null)
- handle_lig_nest(no_break(cur), vlink_no_break(cur));
- while ((fwd = vlink(cur)) != null) {
- halfword nob, pst, next;
- if (type(fwd) != glyph_node)
- break;
- if (subtype(cur) != select_disc) {
- nob = tlink_no_break(cur);
- pst = tlink_post_break(cur);
- if ((nob == null || !test_ligature(&lig, nob, fwd)) &&
- (pst == null || !test_ligature(&lig, pst, fwd)))
- break;
- nesting_append(no_break(cur), copy_node(fwd));
- handle_lig_nest(no_break(cur), nob);
- } else {
- int dobreak = 0;
- nob = tlink_no_break(prev);
- pst = tlink_post_break(prev);
- if ((nob == null || !test_ligature(&lig, nob, fwd)) &&
- (pst == null || !test_ligature(&lig, pst, fwd)))
- dobreak = 1;
- if (!dobreak) {
- nesting_append(no_break(prev), copy_node(fwd));
- handle_lig_nest(no_break(prev), nob);
- nesting_append(post_break(prev), copy_node(fwd));
- handle_lig_nest(post_break(prev), pst);
- }
- dobreak = 0;
- nob = tlink_no_break(cur);
- pst = tlink_post_break(cur);
- if ((nob == null || !test_ligature(&lig, nob, fwd)) &&
- (pst == null || !test_ligature(&lig, pst, fwd)))
- dobreak = 1;
- if (!dobreak) {
- nesting_append(no_break(cur), copy_node(fwd));
- handle_lig_nest(no_break(cur), nob);
- }
- if (dobreak)
- break;
- }
- next = vlink(fwd);
- uncouple_node(fwd);
- try_couple_nodes(cur, next);
- nesting_append(post_break(cur), fwd);
- handle_lig_nest(post_break(cur), pst);
- }
- if (fwd != null && type(fwd) == disc_node) {
- halfword next = vlink(fwd);
- if (vlink_no_break(fwd) == null
- && vlink_post_break(fwd) == null
- && next != null
- && type(next) == glyph_node
- && ((tlink_post_break(cur) != null && test_ligature(&lig, tlink_post_break(cur), next)) ||
- (tlink_no_break (cur) != null && test_ligature(&lig, tlink_no_break (cur), next)))) {
- /* Building an |init_disc| followed by a |select_disc|
- \.{{a-}{b}{AB} {-}{}{}} 'c'
- */
- /* is it tail necessary ? */
- halfword last1 = vlink(next), tail ;
- uncouple_node(next);
- try_couple_nodes(fwd, last1);
- /* \.{{a-}{b}{AB} {-}{c}{}} */
- nesting_append(post_break(fwd), copy_node(next));
- /* \.{{a-}{b}{AB} {-}{c}{-}} */
- if (vlink_no_break(cur) != null) {
- nesting_prepend(no_break(fwd), copy_node(vlink_pre_break(fwd)));
- }
- /* \.{{a-}{b}{AB} {b-}{c}{-}} */
- if (vlink_post_break(cur) != null)
- nesting_prepend_list(pre_break(fwd), copy_node_list(vlink_post_break(cur)));
- /* \.{{a-}{b}{AB} {b-}{c}{AB-}} */
- if (vlink_no_break(cur) != null) {
- nesting_prepend_list(no_break(fwd), copy_node_list(vlink_no_break(cur)));
- }
- /* \.{{a-}{b}{ABC} {b-}{c}{AB-}} */
- tail = tlink_no_break(cur);
- nesting_append(no_break(cur), copy_node(next));
- handle_lig_nest(no_break(cur), tail);
- /* \.{{a-}{BC}{ABC} {b-}{c}{AB-}} */
- tail = tlink_post_break(cur);
- nesting_append(post_break(cur), next);
- handle_lig_nest(post_break(cur), tail);
- /* and set the subtypes */
- subtype(cur) = init_disc;
- subtype(fwd) = select_disc;
- }
- }
- }
-
- } else {
- /* NO GLYPH NOR DISC */
- return cur;
- }
- /* step-to-next-node */
- /* \.{--\\par} allows |vlink(cur)| to be null */
- cur = vlink(cur);
- }
-
- return cur;
-}
-
-@ Return value is the new tail, head should be a dummy
-
-@c
-halfword handle_ligaturing(halfword head, halfword tail)
-{
- halfword save_tail1; /* trick to allow explicit |node==null| tests */
- halfword cur, prev;
-
- if (vlink(head) == null)
- return tail;
- save_tail1 = vlink(tail);
- vlink(tail) = null;
-
- /* |if (fix_node_lists)| */
- fix_node_list(head);
-
- prev = head;
- cur = vlink(prev);
-
- while (cur != null) {
- if (type(cur) == glyph_node || (type(cur) == boundary_node)) {
- cur = handle_lig_word(cur);
- }
- prev = cur;
- cur = vlink(cur);
- }
- if (prev == null)
- prev = tail;
-
- if (valid_node(save_tail1)) {
- try_couple_nodes(prev, save_tail1);
- }
- return prev;
-}
-
-
-@* Kerning.
-
-@c
-static void add_kern_before(halfword left, halfword right)
-{
- if ((!is_rightghost(right)) &&
- font(left) == font(right) && has_kern(font(left), character(left))) {
- int k = raw_get_kern(font(left), character(left), character(right));
- if (k != 0) {
- halfword kern = new_kern(k);
- halfword prev = alink(right);
- couple_nodes(prev, kern);
- couple_nodes(kern, right);
- /* update the attribute list (inherit from left) */
- delete_attribute_ref(node_attr(kern));
- add_node_attr_ref(node_attr(left));
- node_attr(kern) = node_attr(left);
- }
- }
-}
-
-static void add_kern_after(halfword left, halfword right, halfword aft)
-{
- if ((!is_rightghost(right)) &&
- font(left) == font(right) && has_kern(font(left), character(left))) {
- int k = raw_get_kern(font(left), character(left), character(right));
- if (k != 0) {
- halfword kern = new_kern(k);
- halfword next = vlink(aft);
- couple_nodes(aft, kern);
- try_couple_nodes(kern, next);
- /* update the attribute list (inherit from left == aft) */
- delete_attribute_ref(node_attr(kern));
- add_node_attr_ref(node_attr(aft));
- node_attr(kern) = node_attr(aft);
- }
- }
-}
-
-static void do_handle_kerning(halfword root, halfword init_left, halfword init_right)
-{
- halfword cur = vlink(root);
- halfword left = null;
- if (cur == null) {
- if (init_left != null && init_right != null) {
- add_kern_after(init_left, init_right, root);
- tlink(root) = vlink(root);
- }
- return;
- }
- if (type(cur) == glyph_node) {
- set_is_glyph(cur);
- if (init_left != null)
- add_kern_before(init_left, cur);
- left = cur;
- }
- while ((cur = vlink(cur)) != null) {
- if (type(cur) == glyph_node) {
- set_is_glyph(cur);
- if (left != null) {
- add_kern_before(left, cur);
- if (character(left) < 0 || is_ghost(left)) {
- halfword prev = alink(left);
- couple_nodes(prev, cur);
- flush_node(left);
- }
- }
- left = cur;
- } else {
- if (type(cur) == disc_node) {
- halfword right = type(vlink(cur)) == glyph_node ? vlink(cur) : null;
- do_handle_kerning(pre_break(cur), left, null);
- do_handle_kerning(post_break(cur), null, right);
- if (vlink_post_break(cur) != null)
- tlink_post_break(cur) = tail_of_list(vlink_post_break(cur));
- do_handle_kerning(no_break(cur), left, right);
- if (vlink_no_break(cur) != null)
- tlink_no_break(cur) = tail_of_list(vlink_no_break(cur)); /* needed? */
- }
- if (left != null) {
- if (character(left) < 0 || is_ghost(left)) {
- halfword prev = alink(left);
- couple_nodes(prev, cur);
- flush_node(left);
- }
- left = null;
- }
- }
- }
- if (left != null) {
- if (init_right != null)
- add_kern_after(left, init_right, left);
- if (character(left) < 0 || is_ghost(left)) {
- halfword prev = alink(left);
- halfword next = vlink(left);
- if (next != null) {
- couple_nodes(prev, next);
- tlink(root) = next;
- } else if (prev != root) {
- vlink(prev) = null;
- tlink(root) = prev;
- } else {
- vlink(root) = null;
- tlink(root) = null;
- }
- flush_node(left);
- }
- }
-}
-
-halfword handle_kerning(halfword head, halfword tail)
-{
- halfword save_link;
- save_link = vlink(tail);
- vlink(tail) = null;
- tlink(head) = tail;
- do_handle_kerning(head, null, null);
- tail = tlink(head);
- if (valid_node(save_link)) {
- try_couple_nodes(tail, save_link);
- }
- return tail;
-}
-
-@* ligaturing and kerning : lua-interface.
-
-@c
-static halfword run_lua_ligkern_callback(halfword head, halfword tail, int callback_id)
-{
- int i;
- int top = lua_gettop(Luas);
- if (!get_callback(Luas, callback_id)) {
- lua_pop(Luas, 2);
- return tail;
- }
- nodelist_to_lua(Luas, head);
- nodelist_to_lua(Luas, tail);
- if ((i=lua_pcall(Luas, 2, 0, 0)) != 0) {
- luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
- return tail;
- }
- fix_node_list(head);
- lua_settop(Luas, top);
- return tail;
-}
-
-halfword new_ligkern(halfword head, halfword tail)
-{
- int callback_id = 0;
- if (vlink(head) == null)
- return tail;
- callback_id = callback_defined(ligaturing_callback);
- if (callback_id > 0) {
- tail = run_lua_ligkern_callback(head, tail, callback_id);
- if (tail == null)
- tail = tail_of_list(head);
- } else if (callback_id == 0) {
- tail = handle_ligaturing(head, tail);
- }
- callback_id = callback_defined(kerning_callback);
- if (callback_id > 0) {
- tail = run_lua_ligkern_callback(head, tail, callback_id);
- if (tail == null) {
- tail = tail_of_list(head);
- }
- } else if (callback_id == 0) {
- halfword nest1 = new_node(nesting_node, 1);
- halfword cur = vlink(head);
- halfword aft = vlink(tail);
- couple_nodes(nest1, cur);
- tlink(nest1) = tail;
- vlink(tail) = null;
- do_handle_kerning(nest1, null, null);
- couple_nodes(head, vlink(nest1));
- tail = tlink(nest1);
- try_couple_nodes(tail, aft);
- flush_node(nest1);
- }
- return tail;
-}
+% luafont.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
+#include "ptexlib.h"
+#include "lua/luatex-api.h"
+
+#define noVERBOSE
+
+/* todo: also keys */
+
+const char *font_type_strings[] = {
+ "unknown", "virtual", "real", NULL
+};
+
+const char *font_writingmode_strings[] = {
+ "unknown", "horizontal", "vertical", NULL
+};
+
+const char *font_identity_strings[] = {
+ "unknown", "horizontal", "vertical", NULL
+};
+
+const char *font_format_strings[] = {
+ "unknown", "type1", "type3", "truetype", "opentype", NULL
+};
+
+const char *font_embedding_strings[] = {
+ "unknown", "no", "subset", "full", NULL
+};
+
+const char *ligature_type_strings[] = {
+ "=:", "=:|", "|=:", "|=:|", "", "=:|>", "|=:>", "|=:|>", "", "", "", "|=:|>>", NULL
+};
+
+const char *MATH_param_names[] = {
+ "nil",
+ "ScriptPercentScaleDown",
+ "ScriptScriptPercentScaleDown",
+ "DelimitedSubFormulaMinHeight",
+ "DisplayOperatorMinHeight",
+ "MathLeading",
+ "AxisHeight",
+ "AccentBaseHeight",
+ "FlattenedAccentBaseHeight",
+ "SubscriptShiftDown",
+ "SubscriptTopMax",
+ "SubscriptBaselineDropMin",
+ "SuperscriptShiftUp",
+ "SuperscriptShiftUpCramped",
+ "SuperscriptBottomMin",
+ "SuperscriptBaselineDropMax",
+ "SubSuperscriptGapMin",
+ "SuperscriptBottomMaxWithSubscript",
+ "SpaceAfterScript",
+ "UpperLimitGapMin",
+ "UpperLimitBaselineRiseMin",
+ "LowerLimitGapMin",
+ "LowerLimitBaselineDropMin",
+ "StackTopShiftUp",
+ "StackTopDisplayStyleShiftUp",
+ "StackBottomShiftDown",
+ "StackBottomDisplayStyleShiftDown",
+ "StackGapMin",
+ "StackDisplayStyleGapMin",
+ "StretchStackTopShiftUp",
+ "StretchStackBottomShiftDown",
+ "StretchStackGapAboveMin",
+ "StretchStackGapBelowMin",
+ "FractionNumeratorShiftUp",
+ "FractionNumeratorDisplayStyleShiftUp",
+ "FractionDenominatorShiftDown",
+ "FractionDenominatorDisplayStyleShiftDown",
+ "FractionNumeratorGapMin",
+ "FractionNumeratorDisplayStyleGapMin",
+ "FractionRuleThickness",
+ "FractionDenominatorGapMin",
+ "FractionDenominatorDisplayStyleGapMin",
+ "SkewedFractionHorizontalGap",
+ "SkewedFractionVerticalGap",
+ "OverbarVerticalGap",
+ "OverbarRuleThickness",
+ "OverbarExtraAscender",
+ "UnderbarVerticalGap",
+ "UnderbarRuleThickness",
+ "UnderbarExtraDescender",
+ "RadicalVerticalGap",
+ "RadicalDisplayStyleVerticalGap",
+ "RadicalRuleThickness",
+ "RadicalExtraAscender",
+ "RadicalKernBeforeDegree",
+ "RadicalKernAfterDegree",
+ "RadicalDegreeBottomRaisePercent",
+ "MinConnectorOverlap",
+ "SubscriptShiftDownWithSuperscript",
+ "FractionDelimiterSize",
+ "FractionDelimiterDisplayStyleSize",
+ "NoLimitSubFactor",
+ "NoLimitSupFactor",
+ NULL,
+};
+
+/* here for now, may be useful elsewhere */
+
+int ff_checkoption (lua_State *L, int narg, const char *def, const char *const lst[]);
+
+int ff_checkoption (lua_State *L, int narg, const char *def, const char *const lst[]) {
+ const char *name = (def) ? luaL_optstring(L, narg, def) : luaL_checkstring(L, narg);
+ int i;
+ for (i=0; lst[i]; i++)
+ if (strcmp(lst[i], name) == 0)
+ return i;
+ return -1;
+}
+
+#define dump_intfield(L,n,c) \
+ lua_push_string_by_name(L,n); \
+ lua_pushinteger(L, c); \
+ lua_rawset(L, -3); \
+
+#define dump_stringfield(L,n,c) \
+ lua_push_string_by_name(L,n); \
+ lua_pushstring(L, c); \
+ lua_rawset(L, -3);
+
+#define dump_booleanfield(L,n,c) \
+ lua_push_string_by_name(L,n); \
+ lua_pushboolean(L, c); \
+ lua_rawset(L, -3);
+
+static void dump_math_kerns(lua_State * L, charinfo * co, int l, int id)
+{
+ int i;
+ for (i = 0; i < l; i++) {
+ lua_newtable(L);
+ if (id==top_left_kern) {
+ dump_intfield(L, height, co->top_left_math_kern_array[(2*i)]);
+ dump_intfield(L, kern, co->top_left_math_kern_array[(2*i)+1]);
+ } else if (id==top_right_kern) {
+ dump_intfield(L, height, co->top_right_math_kern_array[(2*i)]);
+ dump_intfield(L, kern, co->top_right_math_kern_array[(2*i)+1]);
+ } else if (id==bottom_right_kern) {
+ dump_intfield(L, height, co->bottom_right_math_kern_array[(2*i)]);
+ dump_intfield(L, kern, co->bottom_right_math_kern_array[(2*i)+1]);
+ } else if (id==bottom_left_kern) {
+ dump_intfield(L, height, co->bottom_left_math_kern_array[(2*i)]);
+ dump_intfield(L, kern, co->bottom_left_math_kern_array[(2*i)+1]);
+ }
+ lua_rawseti(L, -2, (i + 1));
+ }
+}
+
+static void font_char_to_lua(lua_State * L, internal_font_number f, charinfo * co)
+{
+ liginfo *l;
+ kerninfo *ki;
+
+ lua_createtable(L, 0, 10);
+
+ dump_intfield(L,width,get_charinfo_width(co));
+ dump_intfield(L,height,get_charinfo_height(co));
+ dump_intfield(L,depth,get_charinfo_depth(co));
+
+ if (get_charinfo_italic(co) != 0) {
+ dump_intfield(L,italic,get_charinfo_italic(co));
+ }
+ if (get_charinfo_vert_italic(co) != 0) {
+ dump_intfield(L,vert_italic,get_charinfo_vert_italic(co));
+ }
+ if (get_charinfo_top_accent(co) !=0 && get_charinfo_top_accent(co) != INT_MIN) {
+ dump_intfield(L,top_accent,get_charinfo_top_accent(co));
+ }
+ if (get_charinfo_bot_accent(co) != 0 && get_charinfo_bot_accent(co) != INT_MIN) {
+ dump_intfield(L,bot_accent,get_charinfo_bot_accent(co));
+ }
+ if (get_charinfo_ef(co) != 1000) {
+ dump_intfield(L,expansion_factor,get_charinfo_ef(co));
+ }
+ if (get_charinfo_lp(co) != 0) {
+ dump_intfield(L,left_protruding,get_charinfo_lp(co));
+ }
+ if (get_charinfo_rp(co) != 0) {
+ dump_intfield(L,right_protruding,get_charinfo_rp(co));
+ }
+ if (font_encodingbytes(f) == 2) {
+ dump_intfield(L,index,get_charinfo_index(co));
+ }
+ if (get_charinfo_name(co) != NULL) {
+ dump_stringfield(L,name,get_charinfo_name(co));
+ }
+ if (get_charinfo_tounicode(co) != NULL) {
+ dump_stringfield(L,tounicode,get_charinfo_tounicode(co));
+ }
+ if (get_charinfo_tag(co) == list_tag) {
+ dump_intfield(L,next,get_charinfo_remainder(co));
+ }
+ if (get_charinfo_used(co)) {
+ dump_booleanfield(L,used,(get_charinfo_used(co) ? true : false));
+ }
+ if (get_charinfo_tag(co) == ext_tag) {
+ extinfo *h;
+ h = get_charinfo_hor_variants(co);
+ if (h != NULL) {
+ int i = 1;
+ lua_push_string_by_name(L,horiz_variants);
+ lua_newtable(L);
+ while (h != NULL) {
+ lua_createtable(L, 0, 5);
+ dump_intfield(L, glyph, h->glyph);
+ dump_intfield(L, extender, h->extender);
+ dump_intfield(L, start, h->start_overlap);
+ dump_intfield(L, end, h->end_overlap);
+ dump_intfield(L, advance, h->advance);
+ lua_rawseti(L, -2, i);
+ i++;
+ h = h->next;
+ }
+ lua_rawset(L, -3);
+ }
+ h = get_charinfo_vert_variants(co);
+ if (h != NULL) {
+ int i = 1;
+ lua_push_string_by_name(L,vert_variants);
+ lua_newtable(L);
+ while (h != NULL) {
+ lua_createtable(L, 0, 5);
+ dump_intfield(L, glyph, h->glyph);
+ dump_intfield(L, extender, h->extender);
+ dump_intfield(L, start, h->start_overlap);
+ dump_intfield(L, end, h->end_overlap);
+ dump_intfield(L, advance, h->advance);
+ lua_rawseti(L, -2, i);
+ i++;
+ h = h->next;
+ }
+ lua_rawset(L, -3);
+ }
+ }
+ ki = get_charinfo_kerns(co);
+ if (ki != NULL) {
+ int i;
+ lua_push_string_by_name(L,kerns);
+ lua_createtable(L, 10, 1);
+ for (i = 0; !kern_end(ki[i]); i++) {
+ if (kern_disabled(ki[i])) {
+ /* skip like in lookup */
+ } else {
+ lua_rawgeti(L, -1, kern_char(ki[i]));
+ if (lua_type(L,-1) == LUA_TNIL) {
+ lua_pop(L,1);
+ if (kern_char(ki[i]) == right_boundarychar) {
+ lua_push_string_by_name(L,right_boundary);
+ } else {
+ lua_pushinteger(L, kern_char(ki[i]));
+ }
+ lua_pushinteger(L, kern_kern(ki[i]));
+ lua_rawset(L, -3);
+ } else {
+ /* first one wins */
+ lua_pop(L,1);
+ }
+ }
+ }
+ lua_rawset(L, -3);
+ }
+ l = get_charinfo_ligatures(co);
+ if (l != NULL) {
+ int i;
+ lua_push_string_by_name(L,ligatures);
+ lua_createtable(L, 10, 1);
+ for (i = 0; !lig_end(l[i]); i++) {
+ if (lig_char(l[i]) == right_boundarychar) {
+ lua_push_string_by_name(L,right_boundary);
+ } else {
+ lua_pushinteger(L, lig_char(l[i]));
+ }
+ lua_createtable(L, 0, 2);
+ lua_push_string_by_name(L,type);
+ lua_pushinteger(L, lig_type(l[i]));
+ lua_rawset(L, -3);
+ lua_push_string_by_name(L,char);
+ lua_pushinteger(L, lig_replacement(l[i]));
+ lua_rawset(L, -3);
+ lua_rawset(L, -3);
+ }
+ lua_rawset(L, -3);
+ }
+
+ lua_push_string_by_name(L,mathkern);
+ lua_newtable(L);
+ {
+ int i, j;
+ i = get_charinfo_math_kerns(co, top_right_kern);
+ j = 0;
+ if (i > 0) {
+ j++;
+ lua_push_string_by_name(L,top_right);
+ lua_newtable(L);
+ dump_math_kerns(L, co, i, top_right_kern);
+ lua_rawset(L, -3);
+ }
+ i = get_charinfo_math_kerns(co, top_left_kern);
+ if (i > 0) {
+ j++;
+ lua_push_string_by_name(L,top_left);
+ lua_newtable(L);
+ dump_math_kerns(L, co, i, top_left_kern);
+ lua_rawset(L, -3);
+ }
+ i = get_charinfo_math_kerns(co, bottom_right_kern);
+ if (i > 0) {
+ j++;
+ lua_push_string_by_name(L,bottom_right);
+ lua_newtable(L);
+ dump_math_kerns(L, co, i, bottom_right_kern);
+ lua_rawset(L, -3);
+ }
+ i = get_charinfo_math_kerns(co, bottom_left_kern);
+ if (i > 0) {
+ j++;
+ lua_push_string_by_name(L,bottom_left);
+ lua_newtable(L);
+ dump_math_kerns(L, co, i, bottom_left_kern);
+ lua_rawset(L, -3);
+ }
+ if (j > 0)
+ lua_rawset(L, -3);
+ else
+ lua_pop(L, 2);
+ }
+}
+
+static void write_lua_parameters(lua_State * L, int f)
+{
+ int k;
+ lua_push_string_by_name(L,parameters);
+ lua_newtable(L);
+ for (k = 1; k <= font_params(f); k++) {
+ switch (k) {
+ case slant_code:
+ dump_intfield(L,slant,font_param(f, k));
+ break;
+ case space_code:
+ dump_intfield(L,space,font_param(f, k));
+ break;
+ case space_stretch_code:
+ dump_intfield(L,space_stretch,font_param(f, k));
+ break;
+ case space_shrink_code:
+ dump_intfield(L,space_shrink,font_param(f, k));
+ break;
+ case x_height_code:
+ dump_intfield(L,x_height,font_param(f, k));
+ break;
+ case quad_code:
+ dump_intfield(L,quad,font_param(f, k));
+ break;
+ case extra_space_code:
+ dump_intfield(L,extra_space,font_param(f, k));
+ break;
+ default:
+ lua_pushinteger(L, font_param(f, k));
+ lua_rawseti(L, -2, k);
+ }
+ }
+ lua_rawset(L, -3);
+}
+
+@ @c
+static void write_lua_math_parameters(lua_State * L, int f)
+{
+ int k;
+ lua_push_string_by_name(L,MathConstants);
+ lua_newtable(L);
+ for (k = 1; k <= font_math_params(f); k++) {
+ lua_pushinteger(L, font_math_param(f, k));
+ if (k <= MATH_param_max) {
+ lua_setfield(L, -2, MATH_param_names[k]);
+ } else {
+ lua_rawseti(L, -2, k);
+ }
+ }
+ lua_rawset(L, -3);
+}
+
+int font_to_lua(lua_State * L, int f)
+{
+ int k;
+ charinfo *co;
+ if (font_cache_id(f) > 0) {
+ /* fetch the table from the registry if it was
+ saved there by |font_from_lua()| */
+ lua_rawgeti(L, LUA_REGISTRYINDEX, font_cache_id(f));
+ /* fontdimens can be changed from tex code */
+ write_lua_parameters(L, f);
+ return 1;
+ }
+
+ lua_newtable(L);
+ lua_push_string_by_name(L,name);
+ lua_pushstring(L, font_name(f));
+ lua_rawset(L, -3);
+ if (font_area(f) != NULL) {
+ dump_stringfield(L,area,font_area(f));
+ }
+ if (font_filename(f) != NULL) {
+ dump_stringfield(L,filename,font_filename(f));
+ }
+ if (font_fullname(f) != NULL) {
+ dump_stringfield(L,fullname,font_fullname(f));
+ }
+ if (font_psname(f) != NULL) {
+ dump_stringfield(L,psname,font_psname(f));
+ }
+ if (font_encodingname(f) != NULL) {
+ dump_stringfield(L,encodingname,font_encodingname(f));
+ }
+
+ dump_booleanfield(L,used,(font_used(f) ? true : false));
+ dump_stringfield(L,type,font_type_strings[font_type(f)]);
+ dump_stringfield(L,format,font_format_strings[font_format(f)]);
+ dump_stringfield(L,writingmode,font_writingmode_strings[font_writingmode(f)]);
+ dump_stringfield(L,identity,font_identity_strings[font_identity(f)]);
+ dump_stringfield(L,embedding,font_embedding_strings[font_embedding(f)]);
+
+ dump_intfield(L,units_per_em,font_units_per_em(f));
+ dump_intfield(L,size,font_size(f));
+ dump_intfield(L,designsize,font_dsize(f));
+ dump_intfield(L,checksum,font_checksum(f));
+ dump_intfield(L,slant,font_slant(f));
+ dump_intfield(L,extend,font_extend(f));
+ dump_intfield(L,direction,font_natural_dir(f));
+ dump_intfield(L,encodingbytes,font_encodingbytes(f));
+ dump_booleanfield(L,oldmath,font_oldmath(f));
+ dump_intfield(L,tounicode,font_tounicode(f));
+
+ /* the next one is read only */
+ if (font_max_shrink(f) != 0) {
+ dump_intfield(L,shrink,font_max_shrink(f));
+ }
+ if (font_max_stretch(f) != 0) {
+ dump_intfield(L,stretch,font_max_stretch(f));
+ }
+ if (font_step(f) != 0) {
+ dump_intfield(L,step,font_step(f));
+ }
+ if (font_auto_expand(f) != 0) {
+ dump_booleanfield(L,auto_expand,font_auto_expand(f));
+ }
+ if (pdf_font_attr(f) != 0) {
+ char *s = makecstring(pdf_font_attr(f));
+ dump_stringfield(L,attributes,s);
+ free(s);
+ }
+
+ /* params */
+ write_lua_parameters(L, f);
+ write_lua_math_parameters(L, f);
+
+ /* chars */
+ lua_push_string_by_name(L,characters);
+ lua_createtable(L, font_tables[f]->charinfo_size, 0); /* all characters */
+ if (has_left_boundary(f)) {
+ co = get_charinfo(f, left_boundarychar);
+ lua_push_string_by_name(L,left_boundary);
+ font_char_to_lua(L, f, co);
+ lua_rawset(L, -3);
+ }
+ if (has_right_boundary(f)) {
+ co = get_charinfo(f, right_boundarychar);
+ lua_push_string_by_name(L,right_boundary);
+ font_char_to_lua(L, f, co);
+ lua_rawset(L, -3);
+ }
+ for (k = font_bc(f); k <= font_ec(f); k++) {
+ if (quick_char_exists(f, k)) {
+ lua_pushinteger(L, k);
+ co = get_charinfo(f, k);
+ font_char_to_lua(L, f, co);
+ lua_rawset(L, -3);
+ }
+ }
+ lua_rawset(L, -3);
+
+ if (font_cache_id(f) == 0) { /* renew */
+ int r;
+ lua_pushvalue(L, -1);
+ r = luaL_ref(L, LUA_REGISTRYINDEX); /* pops the table */
+ set_font_cache_id(f, r);
+ }
+ return 1;
+}
+
+#define count_hash_items(L,name,n) \
+ n = 0; \
+ lua_key_rawgeti(name); \
+ if (lua_type(L, -1) == LUA_TTABLE) { \
+ lua_pushnil(L); \
+ while (lua_next(L, -2) != 0) { \
+ n++; \
+ lua_pop(L, 1); \
+ } \
+ } \
+ if (n) { \
+ /* keep table on stack */ \
+ } else{ \
+ lua_pop(L, 1); \
+ }
+
+@ @c
+#define streq(a,b) (strcmp(a,b)==0)
+
+#define append_packet(k) { *(cp++) = (eight_bits) (k); }
+
+#define do_store_four(l) { \
+ append_packet((l & 0xFF000000) >> 24); \
+ append_packet((l & 0x00FF0000) >> 16); \
+ append_packet((l & 0x0000FF00) >> 8); \
+ append_packet((l & 0x000000FF)); \
+}
+
+@ @c
+static void append_float(eight_bits ** cpp, float a)
+{
+ unsigned int i;
+ eight_bits *cp = *cpp;
+ union U {
+ float a;
+ eight_bits b[sizeof(float)];
+ } u;
+ u.a = a;
+ for (i = 0; i < sizeof(float); i++)
+ append_packet(u.b[i]);
+ *cpp = cp;
+}
+
+static int n_enum_field(lua_State * L, int name_index, int dflt, const char **values)
+{
+ int k, t;
+ const char *s;
+ int i = dflt;
+ lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
+ lua_rawget(L, -2);
+ t = lua_type(L,-1);
+ if (t == LUA_TNUMBER) {
+ i = (int) lua_tointeger(L, -1);
+ } else if (t == LUA_TSTRING) {
+ s = lua_tostring(L, -1);
+ k = 0;
+ while (values[k] != NULL) {
+ if (strcmp(values[k], s) == 0) {
+ i = k;
+ break;
+ }
+ k++;
+ }
+ }
+ lua_pop(L, 1);
+ return i;
+}
+
+static int n_boolean_field(lua_State * L, int name_index, int dflt)
+{
+ int i = dflt;
+ lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
+ lua_rawget(L, -2);
+ if (lua_isboolean(L, -1)) {
+ i = lua_toboolean(L, -1);
+ }
+ lua_pop(L, 1);
+ return i;
+}
+
+static char *n_string_field_copy(lua_State * L, int name_index, const char *dflt)
+{
+ char *i;
+ lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
+ lua_rawget(L, -2);
+ if (lua_type(L,-1) == LUA_TSTRING) {
+ i = xstrdup(lua_tostring(L, -1));
+ } else if (dflt == NULL) {
+ i = NULL;
+ } else {
+ i = xstrdup(dflt);
+ }
+ lua_pop(L, 1);
+ return i;
+}
+
+static const char *n_string_field(lua_State * L, int name_index)
+{
+ lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
+ lua_rawget(L, -2);
+ return lua_tostring(L,-1);
+}
+
+static int n_some_field(lua_State * L, int name_index)
+{
+ lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
+ lua_rawget(L, -2);
+ return lua_type(L,-1);
+}
+
+/*static void init_font_string_pointers(lua_State * L){}*/
+
+static int count_char_packet_bytes(lua_State * L)
+{
+ register int i;
+ register int l = 0;
+ int ff = 0;
+ for (i = 1; i <= (int) lua_rawlen(L, -1); i++) {
+ lua_rawgeti(L, -1, i);
+ if (lua_istable(L, -1)) {
+ lua_rawgeti(L, -1, 1);
+ if (lua_type(L,-1) == LUA_TSTRING) {
+ const char *s = lua_tostring(L, -1);
+ if (lua_key_eq(s, font)) {
+ l += 5;
+ ff = 1;
+ } else if (lua_key_eq(s, char)) {
+ if (ff == 0) {
+ l += 5;
+ }
+ l += 5;
+ ff = 1;
+ } else if (lua_key_eq(s, slot)) {
+ l += 10;
+ ff = 1;
+ } else if (lua_key_eq(s, comment) || lua_key_eq(s, nop)) {
+ ;
+ } else if (lua_key_eq(s, push) || lua_key_eq(s, pop)) {
+ l++;
+ } else if (lua_key_eq(s, rule)) {
+ l += 9;
+ } else if (lua_key_eq(s, right) || lua_key_eq(s, node)
+ || lua_key_eq(s, down) || lua_key_eq(s, image)) {
+ l += 5;
+ } else if (lua_key_eq(s, scale)) {
+ l += sizeof(float) + 1;
+ } else if (lua_key_eq(s, special) || lua_key_eq(s, lua)) {
+ size_t len;
+ lua_rawgeti(L, -2, 2);
+ if (lua_type(L,-1) == LUA_TSTRING) {
+ (void) lua_tolstring(L, -1, &len);
+ lua_pop(L, 1);
+ if (len > 0) {
+ l = (int) (l + 5 + (int) len);
+ }
+ } else {
+ lua_pop(L, 1);
+ normal_error("vf command","invalid packet special");
+ /* fprintf(stdout, "invalid packet special!\n"); */
+ }
+ } else {
+ normal_error("vf command","unknown packet command");
+ /* fprintf(stdout, "unknown packet command %s!\n", s); */
+ }
+ } else {
+ normal_error("vf command","no packet command");
+ /* fprintf(stdout, "no packet command!\n"); */
+ }
+ lua_pop(L, 1); /* command name */
+ }
+ lua_pop(L, 1); /* item */
+ }
+ return l;
+}
+
+static scaled sp_to_dvi(halfword sp, halfword atsize)
+{
+ double result, mult;
+ mult = (double) (atsize / 65536.0);
+ result = (double) (sp * 16.0);
+ return floor(result / mult);
+}
+
+@ @c
+static void read_char_packets(lua_State * L, int *l_fonts, charinfo * co, internal_font_number f, int atsize)
+{
+ int i, n, m;
+ size_t l;
+ int cmd;
+ const char *s;
+ eight_bits *cpackets, *cp;
+ int ff = 0;
+ int max_f = 0;
+ int pc = count_char_packet_bytes(L);
+ if (pc <= 0)
+ return;
+ while (l_fonts[(max_f + 1)] != 0)
+ max_f++;
+ cp = cpackets = xmalloc((unsigned) (pc + 1));
+ for (i = 1; i <= (int) lua_rawlen(L, -1); i++) {
+ lua_rawgeti(L, -1, i);
+ if (lua_istable(L, -1)) {
+ /* fetch the command code */
+ lua_rawgeti(L, -1, 1);
+ if (lua_type(L,-1) == LUA_TSTRING) {
+ s = lua_tostring(L, -1);
+ cmd = 0;
+ if (lua_key_eq(s, font)) {
+ cmd = packet_font_code;
+ } else if (lua_key_eq(s, char)) {
+ cmd = packet_char_code;
+ if (ff == 0) {
+ append_packet(packet_font_code);
+ ff = l_fonts[1];
+ do_store_four(ff);
+ }
+ } else if (lua_key_eq(s, slot)) {
+ cmd = packet_nop_code;
+ lua_rawgeti(L, -2, 2);
+ n = (int) luaL_checkinteger(L, -1);
+ if (n ==0) {
+ ff = f;
+ } else {
+ ff = (n > max_f ? l_fonts[1] : l_fonts[n]);
+ }
+ lua_rawgeti(L, -3, 3);
+ n = (int) luaL_checkinteger(L, -1);
+ lua_pop(L, 2);
+ append_packet(packet_font_code);
+ do_store_four(ff);
+ append_packet(packet_char_code);
+ do_store_four(n);
+ } else if (lua_key_eq(s, comment) || lua_key_eq(s, nop)) {
+ cmd = packet_nop_code;
+ } else if (lua_key_eq(s, node)) {
+ cmd = packet_node_code;
+ } else if (lua_key_eq(s, push)) {
+ cmd = packet_push_code;
+ } else if (lua_key_eq(s, pop)) {
+ cmd = packet_pop_code;
+ } else if (lua_key_eq(s, rule)) {
+ cmd = packet_rule_code;
+ } else if (lua_key_eq(s, right)) {
+ cmd = packet_right_code;
+ } else if (lua_key_eq(s, down)) {
+ cmd = packet_down_code;
+ } else if (lua_key_eq(s, special)) {
+ cmd = packet_special_code;
+ } else if (lua_key_eq(s, image)) {
+ cmd = packet_image_code;
+ } else if (lua_key_eq(s, scale)) {
+ cmd = packet_scale_code;
+ } else if (lua_key_eq(s, lua)) {
+ cmd = packet_lua_code;
+ }
+ switch (cmd) {
+ case packet_push_code:
+ case packet_pop_code:
+ append_packet(cmd);
+ break;
+ case packet_font_code:
+ append_packet(cmd);
+ lua_rawgeti(L, -2, 2);
+ n = (int) luaL_checkinteger(L, -1);
+ if (n == 0) {
+ ff = n;
+ } else {
+ ff = (n > max_f ? l_fonts[1] : l_fonts[n]);
+ }
+ do_store_four(ff);
+ lua_pop(L, 1);
+ break;
+ case packet_node_code:
+ append_packet(cmd);
+ lua_rawgeti(L, -2, 2);
+ n = copy_node_list(nodelist_from_lua(L));
+ do_store_four(n);
+ lua_pop(L, 1);
+ break;
+ case packet_char_code:
+ append_packet(cmd);
+ lua_rawgeti(L, -2, 2);
+ n = (int) luaL_checkinteger(L, -1);
+ do_store_four(n);
+ lua_pop(L, 1);
+ break;
+ case packet_right_code:
+ case packet_down_code:
+ append_packet(cmd);
+ lua_rawgeti(L, -2, 2);
+ n = (int) luaL_checkinteger(L, -1);
+ do_store_four(sp_to_dvi(n, atsize));
+ lua_pop(L, 1);
+ break;
+ case packet_rule_code:
+ append_packet(cmd);
+ lua_rawgeti(L, -2, 2);
+ n = (int) luaL_checkinteger(L, -1);
+ do_store_four(sp_to_dvi(n, atsize));
+ lua_rawgeti(L, -3, 3);
+ n = (int) luaL_checkinteger(L, -1);
+ do_store_four(sp_to_dvi(n, atsize));
+ lua_pop(L, 2);
+ break;
+ case packet_special_code:
+ case packet_lua_code:
+ append_packet(cmd);
+ lua_rawgeti(L, -2, 2);
+ s = luaL_checklstring(L, -1, &l);
+ if (l > 0) {
+ do_store_four(l);
+ m = (int) l;
+ while (m > 0) {
+ n = *s++;
+ m--;
+ append_packet(n);
+ }
+ }
+ lua_pop(L, 1);
+ break;
+ case packet_image_code:
+ append_packet(cmd);
+ lua_rawgeti(L, -2, 2); /* img/imgtable? ... */
+ if (lua_istable(L, -1)) { /* imgtable ... */
+ lua_getglobal(L, "img"); /* imglib imgtable ... */
+ lua_pushstring(L, "new"); /* `new' imglib imgtable ... */
+ lua_gettable(L, -2); /* f imglib imgtable ... */
+ lua_insert(L, -3); /* imglib imgtable f ... */
+ lua_pop(L, 1); /* imgtable f ... */
+ lua_call(L, 1, 1);
+ } /* img ... */
+ luaL_checkudata(L, -1, TYPE_IMG); /* img ... --- just typecheck */
+ n = luaL_ref(L, LUA_REGISTRYINDEX); /* ... */
+ do_store_four(n);
+ break;
+ case packet_nop_code:
+ break;
+ case packet_scale_code:
+ append_packet(cmd);
+ lua_rawgeti(L, -2, 2);
+ append_float(&cp, (float) luaL_checknumber(L, -1));
+ lua_pop(L, 1);
+ break;
+ default:
+ normal_error("vf command","invalid packet code");
+ /* fprintf(stdout, "Unknown char packet code %s\n", s); */
+ }
+ }
+ lua_pop(L, 1); /* command code */
+ } else {
+ normal_error("vf command","commands has to be a tbale");
+ /* fprintf(stdout, "Found a `commands' item that is not a table\n"); */
+ }
+ lua_pop(L, 1); /* command table */
+ }
+ append_packet(packet_end_code);
+ set_charinfo_packets(co, cpackets);
+ return;
+}
+
+@ @c
+static void read_lua_cidinfo(lua_State * L, int f)
+{
+ int i;
+ char *s;
+ /*lua_getfield(L, -1, "cidinfo");*/
+ lua_key_rawgeti(cidinfo);
+ if (lua_istable(L, -1)) {
+ i = lua_numeric_field_by_index(L,lua_key_index(version), 0);
+ set_font_cidversion(f, i);
+ i = lua_numeric_field_by_index(L,lua_key_index(supplement), 0);
+ set_font_cidsupplement(f, i);
+ s = n_string_field_copy(L, lua_key_index(registry), "Adobe"); /* Adobe-Identity-0 */
+ set_font_cidregistry(f, s);
+ s = n_string_field_copy(L, lua_key_index(ordering), "Identity");
+ set_font_cidordering(f, s);
+ }
+ lua_pop(L, 1);
+}
+
+
+@ @c
+static void read_lua_parameters(lua_State * L, int f)
+{
+ int i, n, t;
+ const char *s;
+ /*lua_getfield(L, -1, "parameters");*/
+ lua_key_rawgeti(parameters);
+ if (lua_istable(L, -1)) {
+ /* the number of parameters is the max(IntegerKeys(L)),7) */
+ n = 7;
+ lua_pushnil(L); /* first key */
+ while (lua_next(L, -2) != 0) {
+ if (lua_type(L, -2) == LUA_TNUMBER) {
+ i = (int) lua_tointeger(L, -2);
+ if (i > n)
+ n = i;
+ }
+ lua_pop(L, 1); /* pop value */
+ }
+ if (n > 7)
+ set_font_params(f, n);
+ /* sometimes it is handy to have all integer keys */
+ for (i = 1; i <= 7; i++) {
+ lua_rawgeti(L, -1, i);
+ if (lua_type(L, -1) == LUA_TNUMBER) {
+ n = lua_roundnumber(L, -1); /* round ? */
+ set_font_param(f, i, n);
+ }
+ lua_pop(L, 1);
+ }
+ lua_pushnil(L); /* first key */
+ while (lua_next(L, -2) != 0) {
+ t = lua_type(L,-2);
+ if (t == LUA_TNUMBER) {
+ i = (int) lua_tointeger(L, -2);
+ if (i >= 8) {
+ if (lua_type(L,-1) == LUA_TNUMBER) {
+ n = lua_roundnumber(L, -1);
+ } else {
+ n = 0;
+ }
+ set_font_param(f, i, n);
+ }
+ } else if (t == LUA_TSTRING) {
+ s = lua_tostring(L, -2);
+ if (lua_type(L,-1) == LUA_TNUMBER) {
+ n = lua_roundnumber(L, -1);
+ } else {
+ n = 0;
+ }
+ if (lua_key_eq(s, slant)) {
+ set_font_param(f, slant_code, n);
+ } else if (lua_key_eq(s, space)) {
+ set_font_param(f, space_code, n);
+ } else if (lua_key_eq(s, space_stretch)) {
+ set_font_param(f, space_stretch_code, n);
+ } else if (lua_key_eq(s, space_shrink)) {
+ set_font_param(f, space_shrink_code, n);
+ } else if (lua_key_eq(s, x_height)) {
+ set_font_param(f, x_height_code, n);
+ } else if (lua_key_eq(s, quad)) {
+ set_font_param(f, quad_code, n);
+ } else if (lua_key_eq(s, extra_space)) {
+ set_font_param(f, extra_space_code, n);
+ }
+ }
+ lua_pop(L, 1);
+ }
+ }
+ lua_pop(L, 1);
+
+}
+
+@ @c
+static void read_lua_math_parameters(lua_State * L, int f)
+{
+ int i = 0, n = 0, t;
+ /*lua_getfield(L, -1, "MathConstants");*/
+ lua_key_rawgeti(MathConstants);
+ if (lua_istable(L, -1)) {
+ lua_pushnil(L);
+ while (lua_next(L, -2) != 0) {
+ t = lua_type(L,-2);
+ if (t == LUA_TNUMBER) {
+ i = (int) lua_tointeger(L, -2);
+ } else if (t == LUA_TSTRING) {
+ i = ff_checkoption(L, -2, NULL, MATH_param_names);
+ }
+ n = (int) lua_roundnumber(L, -1);
+ if (i > 0) {
+ set_font_math_param(f, i, n);
+ }
+ lua_pop(L, 1); /* pop value */
+ }
+ set_font_oldmath(f,false);
+ } else {
+ set_font_oldmath(f,true);
+ }
+ lua_pop(L, 1);
+}
+
+@ @c
+#define MIN_INF -0x7FFFFFFF
+
+static void store_math_kerns(lua_State * L, int index, charinfo * co, int id)
+{
+ int l, k;
+ scaled ht, krn;
+ lua_key_direct_rawgeti(index);
+ if (lua_istable(L, -1) && ((k = (int) lua_rawlen(L, -1)) > 0)) {
+ for (l = 0; l < k; l++) {
+ lua_rawgeti(L, -1, (l + 1));
+ if (lua_istable(L, -1)) {
+ ht = (scaled) lua_numeric_field_by_index(L, lua_key_index(height), MIN_INF);
+ krn = (scaled) lua_numeric_field_by_index(L, lua_key_index(kern), MIN_INF);
+ if (krn > MIN_INF && ht > MIN_INF)
+ add_charinfo_math_kern(co, id, ht, krn);
+ }
+ lua_pop(L, 1);
+ }
+ }
+ lua_pop(L, 1);
+}
+
+@ @c
+static void font_char_from_lua(lua_State * L, internal_font_number f, int i, int *l_fonts, boolean has_math)
+{
+ int k, r, t, lt, u, n;
+ charinfo *co;
+ kerninfo *ckerns;
+ liginfo *cligs;
+ scaled j;
+ const char *s;
+ int nl = 0; /* number of ligature table items */
+ int nk = 0; /* number of kern table items */
+ int ctr = 0;
+ int atsize = font_size(f);
+ if (lua_istable(L, -1)) {
+ co = get_charinfo(f, i);
+ set_charinfo_tag(co, 0);
+ j = lua_numeric_field_by_index(L, lua_key_index(width), 0);
+ set_charinfo_width(co, j);
+ j = lua_numeric_field_by_index(L, lua_key_index(height), 0);
+ set_charinfo_height(co, j);
+ j = lua_numeric_field_by_index(L, lua_key_index(depth), 0);
+ set_charinfo_depth(co, j);
+ j = lua_numeric_field_by_index(L, lua_key_index(italic), 0);
+ set_charinfo_italic(co, j);
+ j = lua_numeric_field_by_index(L, lua_key_index(vert_italic), 0);
+ set_charinfo_vert_italic(co, j);
+ j = lua_numeric_field_by_index(L, lua_key_index(index), 0);
+ set_charinfo_index(co, j);
+ j = lua_numeric_field_by_index(L, lua_key_index(expansion_factor), 1000);
+ set_charinfo_ef(co, j);
+ j = lua_numeric_field_by_index(L, lua_key_index(left_protruding), 0);
+ set_charinfo_lp(co, j);
+ j = lua_numeric_field_by_index(L, lua_key_index(right_protruding), 0);
+ set_charinfo_rp(co, j);
+ k = n_boolean_field(L, lua_key_index(used), 0);
+ set_charinfo_used(co, k);
+ s = n_string_field(L, lua_key_index(name));
+ if (s != NULL)
+ set_charinfo_name(co, xstrdup(s));
+ else
+ set_charinfo_name(co, NULL);
+ /* n_string_field leaves a value on stack*/
+ lua_pop(L,1);
+ u = n_some_field(L,lua_key_index(tounicode));
+ if (u == LUA_TNUMBER) {
+ u = lua_tointeger(L,-1);
+ if (u < 0) {
+ set_charinfo_tounicode(co, NULL);
+ } else if (u < 0xD7FF || (u > 0xDFFF && u <= 0xFFFF)) {
+ char *s = malloc(5);
+ sprintf(s,"%04X",(unsigned int) u);
+ set_charinfo_tounicode(co,s);
+ } else {
+ char *s = malloc(9);
+ u = u - 0x10000;
+ sprintf(s,"%04X%04X",(unsigned int) (floor(u/1024)+0xD800),(unsigned int) (u%1024+0xDC00));
+ set_charinfo_tounicode(co,s);
+ }
+ } else if (u == LUA_TTABLE) {
+ n = lua_rawlen(L,-1);
+ u = 0;
+ for (k = 1; k <= n; k++) {
+ lua_rawgeti(L, -1, k);
+ if (lua_type(L,-1) == LUA_TNUMBER) {
+ u = lua_tointeger(L,-1);
+ } else {
+ lua_pop(L, 1);
+ break;
+ }
+ if (u < 0) {
+ u = -1;
+ lua_pop(L, 1);
+ break;
+ } else if (u < 0xD7FF || (u > 0xDFFF && u <= 0xFFFF)) {
+ u = u + 4;
+ } else {
+ u = u + 8;
+ }
+ lua_pop(L, 1);
+ }
+ if (u>0) {
+ char *s = malloc(u+1);
+ char *t = s ;
+ for (k = 1; k <= n; k++) {
+ lua_rawgeti(L, -1, k);
+ u = lua_tointeger(L,-1);
+ if (u < 0xD7FF || (u > 0xDFFF && u <= 0xFFFF)) {
+ sprintf(t,"%04X",(unsigned int) u);
+ t += 4;
+ } else {
+ u = u - 0x10000;
+ sprintf(t,"%04X%04X",(unsigned int) (floor(u/1024)+0xD800),(unsigned int) (u%1024+0xDC00));
+ t += 8;
+ }
+ lua_pop(L, 1);
+ }
+ set_charinfo_tounicode(co,s);
+ } else {
+ set_charinfo_tounicode(co, NULL);
+ }
+ } else if (u == LUA_TSTRING) {
+ s = lua_tostring(L,-1);
+ set_charinfo_tounicode(co, xstrdup(s));
+ } else {
+ set_charinfo_tounicode(co, NULL);
+ }
+ /* ... leaves a value on stack*/
+ lua_pop(L,1);
+
+ if (has_math) {
+ j = lua_numeric_field_by_index(L, lua_key_index(top_accent), INT_MIN);
+ set_charinfo_top_accent(co, j);
+ j = lua_numeric_field_by_index(L, lua_key_index(bot_accent), INT_MIN);
+ set_charinfo_bot_accent(co, j);
+ k = lua_numeric_field_by_index(L, lua_key_index(next), -1);
+ if (k >= 0) {
+ set_charinfo_tag(co, list_tag);
+ set_charinfo_remainder(co, k);
+ }
+
+ lua_key_rawgeti(extensible);
+ if (lua_istable(L, -1)) {
+ int top, bot, mid, rep;
+ top = lua_numeric_field_by_index(L, lua_key_index(top), 0);
+ bot = lua_numeric_field_by_index(L, lua_key_index(bot), 0);
+ mid = lua_numeric_field_by_index(L, lua_key_index(mid), 0);
+ rep = lua_numeric_field_by_index(L, lua_key_index(rep), 0);
+ if (top != 0 || bot != 0 || mid != 0 || rep != 0) {
+ set_charinfo_tag(co, ext_tag);
+ set_charinfo_extensible(co, top, bot, mid, rep);
+ } else {
+ formatted_warning("font", "lua-loaded font %s char U+%X has an invalid extensible field",
+ font_name(f), (int) i);
+ }
+ }
+ lua_pop(L, 1);
+
+ lua_key_rawgeti(horiz_variants);
+ if (lua_istable(L, -1)) {
+ int glyph, startconnect, endconnect, advance, extender;
+ extinfo *h;
+ set_charinfo_tag(co, ext_tag);
+ set_charinfo_hor_variants(co, NULL);
+ for (k = 1;; k++) {
+ lua_rawgeti(L, -1, k);
+ if (lua_istable(L, -1)) {
+ glyph = lua_numeric_field_by_index(L, lua_key_index(glyph), 0);
+ extender = lua_numeric_field_by_index(L, lua_key_index(extender), 0);
+ startconnect = lua_numeric_field_by_index(L, lua_key_index(start), 0);
+ endconnect = lua_numeric_field_by_index(L, lua_key_index(end), 0);
+ advance = lua_numeric_field_by_index(L, lua_key_index(advance), 0);
+ h = new_variant(glyph, startconnect, endconnect, advance, extender);
+ add_charinfo_hor_variant(co, h);
+ lua_pop(L, 1);
+ } else {
+ lua_pop(L, 1);
+ break;
+ }
+ }
+ }
+ lua_pop(L, 1);
+
+ lua_key_rawgeti(vert_variants);
+ if (lua_istable(L, -1)) {
+ int glyph, startconnect, endconnect, advance, extender;
+ extinfo *h;
+ set_charinfo_tag(co, ext_tag);
+ set_charinfo_vert_variants(co, NULL);
+ for (k = 1;; k++) {
+ lua_rawgeti(L, -1, k);
+ if (lua_istable(L, -1)) {
+ glyph = lua_numeric_field_by_index(L, lua_key_index(glyph), 0);
+ extender = lua_numeric_field_by_index(L, lua_key_index(extender), 0);
+ startconnect = lua_numeric_field_by_index(L, lua_key_index(start), 0);
+ endconnect = lua_numeric_field_by_index(L, lua_key_index(end), 0);
+ advance = lua_numeric_field_by_index(L, lua_key_index(advance), 0);
+ h = new_variant(glyph, startconnect, endconnect, advance, extender);
+ add_charinfo_vert_variant(co, h);
+ lua_pop(L, 1);
+ } else {
+ lua_pop(L, 1);
+ break;
+ }
+ }
+ }
+ lua_pop(L, 1);
+
+ /*
+ Here is a complete example:
+
+ |mathkern = {|
+ | bottom_left = { { height = 420, kern = 80 }, { height = 520, kern = 4 } },|
+ | bottom_right = { { height = 0, kern = 48 } },|
+ | top_left = { { height = 620, kern = 0 }, { height = 720, kern = -80 } },|
+ | top_right = { { height = 676, kern = 115 }, { height = 776, kern = 45 } },|
+ |}|
+
+ */
+
+ lua_key_rawgeti(mathkern);
+ if (lua_istable(L, -1)) {
+ store_math_kerns(L,lua_key_index(top_left), co, top_left_kern);
+ store_math_kerns(L,lua_key_index(top_right), co, top_right_kern);
+ store_math_kerns(L,lua_key_index(bottom_right), co, bottom_right_kern);
+ store_math_kerns(L,lua_key_index(bottom_left), co, bottom_left_kern);
+ }
+ lua_pop(L, 1);
+ }
+ /* end of |has_math| */
+ count_hash_items(L, kerns, nk);
+ if (nk > 0) {
+ /* kerns table still on stack */
+ ckerns = xcalloc((unsigned) (nk + 1), sizeof(kerninfo));
+ ctr = 0;
+ lua_pushnil(L); /* traverse hash */
+ while (lua_next(L, -2) != 0) {
+ k = non_boundarychar;
+ lt = lua_type(L,-2);
+ if (lt == LUA_TNUMBER) {
+ k = (int) lua_tointeger(L, -2); /* adjacent char */
+ if (k < 0)
+ k = non_boundarychar;
+ } else if (lt == LUA_TSTRING) {
+ s = lua_tostring(L, -2);
+ if (lua_key_eq(s, right_boundary)) {
+ k = right_boundarychar;
+ if (!has_right_boundary(f))
+ set_right_boundary(f, get_charinfo(f, right_boundarychar));
+ }
+ }
+ j = lua_roundnumber(L, -1); /* movement */
+ if (k != non_boundarychar) {
+ set_kern_item(ckerns[ctr], k, j);
+ ctr++;
+ } else {
+ formatted_warning("font", "lua-loaded font %s char U+%X has an invalid kern field",
+ font_name(f), (int) i);
+ }
+ lua_pop(L, 1);
+ }
+ /* guard against empty tables */
+ if (ctr > 0) {
+ set_kern_item(ckerns[ctr], end_kern, 0);
+ set_charinfo_kerns(co, ckerns);
+ } else {
+ formatted_warning("font", "lua-loaded font %s char U+%X has an invalid kerns field",
+ font_name(f), (int) i);
+ }
+ lua_pop(L, 1);
+ }
+
+ /* packet commands */
+ lua_key_rawgeti(commands);
+ if (lua_istable(L, -1)) {
+ lua_pushnil(L); /* first key */
+ if (lua_next(L, -2) != 0) {
+ lua_pop(L, 2);
+ read_char_packets(L, (int *) l_fonts, co, f, atsize);
+ }
+ }
+ lua_pop(L, 1);
+
+ /* ligatures */
+ count_hash_items(L, ligatures, nl);
+ if (nl > 0) {
+ /* ligatures table still on stack */
+ cligs = xcalloc((unsigned) (nl + 1), sizeof(liginfo));
+ ctr = 0;
+ lua_pushnil(L); /* traverse hash */
+ while (lua_next(L, -2) != 0) {
+ k = non_boundarychar;
+ lt = lua_type(L,-2);
+ if (lt == LUA_TNUMBER) {
+ k = (int) lua_tointeger(L, -2); /* adjacent char */
+ if (k < 0) {
+ k = non_boundarychar;
+ }
+ } else if (lt == LUA_TSTRING) {
+ s = lua_tostring(L, -2);
+ if (lua_key_eq(s, right_boundary)) {
+ k = right_boundarychar;
+ if (!has_right_boundary(f))
+ set_right_boundary(f, get_charinfo(f, right_boundarychar));
+ }
+ }
+ r = -1;
+ if (lua_istable(L, -1)) {
+ r = lua_numeric_field_by_index(L, lua_key_index(char), -1); /* ligature */
+ }
+ if (r != -1 && k != non_boundarychar) {
+ t = n_enum_field(L, lua_key_index(type), 0, ligature_type_strings);
+ set_ligature_item(cligs[ctr], (char) ((t * 2) + 1), k, r);
+ ctr++;
+ } else {
+ formatted_warning("font", "lua-loaded font %s char U+%X has an invalid ligature field",
+ font_name(f), (int) i);
+ }
+ lua_pop(L, 1); /* iterator value */
+ }
+ /* guard against empty tables */
+ if (ctr > 0) {
+ set_ligature_item(cligs[ctr], 0, end_ligature, 0);
+ set_charinfo_ligatures(co, cligs);
+ } else {
+ formatted_warning("font", "lua-loaded font %s char U+%X has an invalid ligatures field",
+ font_name(f), (int) i);
+ }
+ lua_pop(L, 1); /* ligatures table */
+ }
+ }
+}
+
+@ The caller has to fix the state of the lua stack when there is an error!
+
+@c
+int font_from_lua(lua_State * L, int f)
+{
+ int i, n, r, t, lt;
+ int s_top; /* lua stack top */
+ int bc; /* first char index */
+ int ec; /* last char index */
+ char *s;
+ const char *ss;
+ int *l_fonts = NULL;
+ int save_ref ;
+ boolean no_math = false;
+
+ /* will we save a cache of the luat table? */
+
+ save_ref = 1; /* we start with ss = "yes" */
+ ss = NULL;
+ ss = n_string_field(L, lua_key_index(cache));
+ if (lua_key_eq(ss, no))
+ save_ref = -1;
+ else if (lua_key_eq(ss, renew))
+ save_ref = 0;
+ /* n_string_field leaves a value on stack*/
+ lua_pop(L,1);
+
+ /* the table is at stack index -1 */
+
+ s = n_string_field_copy(L,lua_key_index(area), "");
+ set_font_area(f, s);
+ s = n_string_field_copy(L, lua_key_index(filename), NULL);
+ set_font_filename(f, s);
+ s = n_string_field_copy(L, lua_key_index(encodingname), NULL);
+ set_font_encodingname(f, s);
+
+ s = n_string_field_copy(L, lua_key_index(name), NULL);
+ set_font_name(f, s);
+ s = n_string_field_copy(L, lua_key_index(fullname), font_name(f));
+ set_font_fullname(f, s);
+
+ if (s == NULL) {
+ formatted_error("font","lua-loaded font '%d' has no name!", f);
+ return false;
+ }
+ s = n_string_field_copy(L, lua_key_index(psname), NULL);
+ set_font_psname(f, s);
+
+ i = lua_numeric_field_by_index(L,lua_key_index(units_per_em), 0);
+ set_font_units_per_em(f, i);
+ i = lua_numeric_field_by_index(L,lua_key_index(designsize), 655360);
+ set_font_dsize(f, i);
+ i = lua_numeric_field_by_index(L,lua_key_index(size), font_dsize(f));
+ set_font_size(f, i);
+ set_font_checksum(f, (unsigned)(lua_unsigned_numeric_field_by_index(L,lua_key_index(checksum), 0))) ;
+ i = lua_numeric_field_by_index(L,lua_key_index(direction), 0);
+ set_font_natural_dir(f, i);
+ i = lua_numeric_field_by_index(L,lua_key_index(encodingbytes), 0);
+ set_font_encodingbytes(f, (char) i);
+ i = n_boolean_field(L,lua_key_index(oldmath), 0);
+ set_font_oldmath(f, i);
+ i = lua_numeric_field_by_index(L,lua_key_index(tounicode), 0);
+ set_font_tounicode(f, (char) i);
+
+ i = lua_numeric_field_by_index(L,lua_key_index(extend), 1000);
+ if (i < FONT_EXTEND_MIN)
+ i = FONT_EXTEND_MIN;
+ if (i > FONT_EXTEND_MAX)
+ i = FONT_EXTEND_MAX;
+ set_font_extend(f, i);
+ i = lua_numeric_field_by_index(L,lua_key_index(slant), 0);
+ if (i < FONT_SLANT_MIN)
+ i = FONT_SLANT_MIN;
+ if (i > FONT_SLANT_MAX)
+ i = FONT_SLANT_MAX;
+ set_font_slant(f, i);
+
+ i = lua_numeric_field_by_index(L,lua_key_index(hyphenchar), default_hyphen_char_par);
+ set_hyphen_char(f, i);
+ i = lua_numeric_field_by_index(L,lua_key_index(skewchar), default_skew_char_par);
+ set_skew_char(f, i);
+ i = n_boolean_field(L, lua_key_index(used), 0);
+ set_font_used(f, (char) i);
+
+ s = n_string_field_copy(L, lua_key_index(attributes), NULL);
+ if (s != NULL && strlen(s) > 0) {
+ i = maketexstring(s);
+ set_pdf_font_attr(f, i);
+ }
+ free(s);
+
+ i = n_enum_field(L, lua_key_index(type), unknown_font_type, font_type_strings);
+ set_font_type(f, i);
+ i = n_enum_field(L, lua_key_index(format), unknown_format, font_format_strings);
+ set_font_format(f, i);
+ i = n_enum_field(L, lua_key_index(writingmode), unknown_writingmode, font_writingmode_strings);
+ set_font_writingmode(f, i);
+ i = n_enum_field(L, lua_key_index(identity), unknown_identity, font_identity_strings);
+ set_font_identity(f, i);
+ i = n_enum_field(L, lua_key_index(embedding), unknown_embedding, font_embedding_strings);
+ set_font_embedding(f, i);
+ if (font_encodingbytes(f) == 0 && (font_format(f) == opentype_format || font_format(f) == truetype_format)) {
+ set_font_encodingbytes(f, 2);
+ }
+
+ /* now fetch the base fonts, if needed */
+ count_hash_items(L, fonts, n);
+ if (n > 0) {
+ /* font table still on stack */
+ l_fonts = xmalloc((unsigned) ((unsigned) (n + 2) * sizeof(int)));
+ memset(l_fonts, 0, (size_t) ((unsigned) (n + 2) * sizeof(int)));
+ for (i = 1; i <= n; i++) {
+ lua_rawgeti(L, -1, i);
+ if (lua_istable(L, -1)) {
+ lua_key_rawgeti(id);
+ if (lua_isnumber(L, -1)) {
+ l_fonts[i] = (int) lua_tointeger(L, -1);
+ if (l_fonts[i] == 0) {
+ l_fonts[i] = (int) f;
+ }
+ lua_pop(L, 2); /* pop id and entry */
+ continue;
+ }
+ lua_pop(L, 1); /* pop id */
+ };
+ ss = NULL;
+ if (lua_istable(L, -1)) {
+ ss = n_string_field(L, lua_key_index(name));
+ /* string is anchored */
+ lua_pop(L,1);
+ }
+ if (ss != NULL) {
+ t = lua_numeric_field_by_index(L, lua_key_index(size), -1000);
+ /* TODO: the stack is messed up, otherwise this explicit resizing would not be needed */
+ s_top = lua_gettop(L);
+ if (strcmp(font_name(f), ss) == 0)
+ l_fonts[i] = f;
+ else
+ l_fonts[i] = find_font_id(ss, t);
+ lua_settop(L, s_top);
+ } else {
+ formatted_error("font","invalid local font in lua-loaded font '%s'", font_name(f));
+ }
+ lua_pop(L, 1); /* pop list entry */
+ }
+ lua_pop(L, 1); /* pop font table */
+ } else if (font_type(f) == virtual_font_type) {
+ formatted_error("font","invalid local fonts in lua-loaded font '%s'", font_name(f));
+ } else {
+ l_fonts = xmalloc(3 * sizeof(int));
+ l_fonts[0] = 0;
+ l_fonts[1] = f;
+ l_fonts[2] = 0;
+ }
+
+ /* parameters */
+ no_math = n_boolean_field(L, lua_key_index(nomath), 0);
+ read_lua_parameters(L, f);
+ if (!no_math) {
+ read_lua_math_parameters(L, f);
+ if (n_boolean_field(L, lua_key_index(oldmath), 0)) {
+ set_font_oldmath(f,true);
+ }
+
+ } else {
+ set_font_oldmath(f,true);
+ }
+ read_lua_cidinfo(L, f);
+
+ /* characters */
+ lua_key_rawgeti(characters);
+ if (lua_istable(L, -1)) {
+ /* find the array size values */
+ int num = 0; /* number of charinfo's to add */
+ ec = 0;
+ bc = -1;
+ lua_pushnil(L); /* first key */
+ while (lua_next(L, -2) != 0) {
+ if (lua_isnumber(L, -2)) {
+ i = (int) lua_tointeger(L, -2);
+ if (i >= 0) {
+ if (lua_istable(L, -1)) {
+ num++;
+ if (i > ec)
+ ec = i;
+ if (bc < 0)
+ bc = i;
+ if (bc >= 0 && i < bc)
+ bc = i;
+ }
+ }
+ }
+ lua_pop(L, 1);
+ }
+ if (bc != -1) {
+ font_malloc_charinfo(f, num);
+ set_font_bc(f, bc);
+ set_font_ec(f, ec);
+ lua_pushnil(L); /* first key */
+ while (lua_next(L, -2) != 0) {
+ lt = lua_type(L,-2);
+ if (lt == LUA_TNUMBER) {
+ i = (int) lua_tointeger(L, -2);
+ if (i >= 0) {
+ font_char_from_lua(L, f, i, l_fonts, !no_math);
+ }
+ } else if (lt == LUA_TSTRING) {
+ const char *ss1 = lua_tostring(L, -2);
+ if (lua_key_eq(ss1, left_boundary)) {
+ font_char_from_lua(L, f, left_boundarychar, l_fonts,
+ !no_math);
+ } else if (lua_key_eq(ss1, right_boundary)) {
+ font_char_from_lua(L, f, right_boundarychar, l_fonts,
+ !no_math);
+ }
+ }
+ lua_pop(L, 1);
+ }
+ lua_pop(L, 1);
+
+ /*
+ Handle font expansion last: the |copy_font| routine is called eventually,
+ and that needs to know |bc| and |ec|.
+ */
+
+ if (font_type(f) != virtual_font_type) {
+ int fstep = lua_numeric_field_by_index(L, lua_key_index(step), 0);
+ if (fstep < 0)
+ fstep = 0;
+ if (fstep > 100)
+ fstep = 100;
+ if (fstep != 0) {
+ int fshrink = lua_numeric_field_by_index(L, lua_key_index(shrink), 0);
+ int fstretch =lua_numeric_field_by_index(L, lua_key_index(stretch), 0);
+ int fexpand = n_boolean_field(L, lua_key_index(auto_expand), 0);
+ if (fshrink < 0)
+ fshrink = 0;
+ if (fshrink > 500)
+ fshrink = 500;
+ fshrink -= (fshrink % fstep);
+ if (fshrink < 0)
+ fshrink = 0;
+ if (fstretch < 0)
+ fstretch = 0;
+ if (fstretch > 1000)
+ fstretch = 1000;
+ fstretch -= (fstretch % fstep);
+ if (fstretch < 0)
+ fstretch = 0;
+ set_expand_params(f, fexpand, fstretch, fshrink, fstep);
+ }
+ }
+
+ } else {
+ /* jikes, no characters */
+ formatted_warning("font","lua-loaded font '%d' with name '%s' has no characters", f, font_name(f));
+ }
+
+ if (save_ref > 0) {
+ r = luaL_ref(L, LUA_REGISTRYINDEX); /* pops the table */
+ set_font_cache_id(f, r);
+ } else {
+ lua_pop(L, 1);
+ set_font_cache_id(f, save_ref);
+ }
+ } else {
+ /* jikes, no characters */
+ formatted_warning("font","lua-loaded font '%d' with name '%s' has no character table", f, font_name(f));
+ }
+ if (l_fonts != NULL)
+ free(l_fonts);
+ return true;
+}
+
+@* Ligaturing.
+
+@c
+static void nesting_append(halfword nest1, halfword newn)
+{
+ halfword tail = tlink(nest1);
+ if (tail == null) {
+ couple_nodes(nest1, newn);
+ } else {
+ couple_nodes(tail, newn);
+ }
+ tlink(nest1) = newn;
+}
+
+static void nesting_prepend(halfword nest1, halfword newn)
+{
+ halfword head = vlink(nest1);
+ couple_nodes(nest1, newn);
+ if (head == null) {
+ tlink(nest1) = newn;
+ } else {
+ couple_nodes(newn, head);
+ }
+}
+
+static void nesting_prepend_list(halfword nest1, halfword newn)
+{
+ halfword head = vlink(nest1);
+ couple_nodes(nest1, newn);
+ if (head == null) {
+ tlink(nest1) = tail_of_list(newn);
+ } else {
+ halfword tail = tail_of_list(newn);
+ couple_nodes(tail, head);
+ }
+}
+
+static int test_ligature(liginfo * lig, halfword left, halfword right)
+{
+ if (type(left) != glyph_node)
+ return 0;
+ if (font(left) != font(right))
+ return 0;
+ if (is_ghost(left) || is_ghost(right))
+ return 0;
+ *lig = get_ligature(font(left), character(left), character(right));
+ if (is_valid_ligature(*lig)) {
+ return 1;
+ }
+ return 0;
+}
+
+static int try_ligature(halfword * frst, halfword fwd)
+{
+ halfword cur = *frst;
+ liginfo lig;
+ if (test_ligature(&lig, cur, fwd)) {
+ int move_after = (lig_type(lig) & 0x0C) >> 2;
+ int keep_right = ((lig_type(lig) & 0x01) != 0);
+ int keep_left = ((lig_type(lig) & 0x02) != 0);
+ halfword newgl = raw_glyph_node();
+ font(newgl) = font(cur);
+ character(newgl) = lig_replacement(lig);
+ set_is_ligature(newgl);
+ /*
+ below might not be correct in contrived border case.
+ but we use it only for debugging, so ...
+ */
+ if (character(cur) < 0) {
+ set_is_leftboundary(newgl);
+ }
+ if (character(fwd) < 0) {
+ set_is_rightboundary(newgl);
+ }
+ if (character(cur) < 0) {
+ if (character(fwd) < 0) {
+ build_attribute_list(newgl);
+ } else {
+ add_node_attr_ref(node_attr(fwd));
+ node_attr(newgl) = node_attr(fwd);
+ }
+ } else {
+ add_node_attr_ref(node_attr(cur));
+ node_attr(newgl) = node_attr(cur);
+ }
+
+ /*
+ TODO/FIXME if this ligature is consists of another ligature
+ we should add it's |lig_ptr| to the new glyphs |lig_ptr| (and
+ cleanup the no longer needed node) LOW PRIORITY
+ */
+ /* left side */
+ if (keep_left) {
+ halfword new_first = copy_node(cur);
+ lig_ptr(newgl) = new_first;
+ couple_nodes(cur, newgl);
+ if (move_after) {
+ move_after--;
+ cur = newgl;
+ }
+ } else {
+ halfword prev = alink(cur);
+ uncouple_node(cur);
+ lig_ptr(newgl) = cur;
+ couple_nodes(prev, newgl);
+ cur = newgl; /* as cur has disappeared */
+ }
+ /* right side */
+ if (keep_right) {
+ halfword new_second = copy_node(fwd);
+ /* correct, because we {\it know\/} |lig_ptr| points to {\it one\/} node */
+ couple_nodes(lig_ptr(newgl), new_second);
+ couple_nodes(newgl, fwd);
+ if (move_after) {
+ move_after--;
+ cur = fwd;
+ }
+ } else {
+ halfword next = vlink(fwd);
+ uncouple_node(fwd);
+ /* correct, because we {\it know\/} |lig_ptr| points to {\it one\/} node */
+ couple_nodes(lig_ptr(newgl), fwd);
+ if (next != null) {
+ couple_nodes(newgl, next);
+ }
+ }
+ /* check and return */
+ *frst = cur;
+ return 1;
+ }
+ return 0;
+}
+
+@ there shouldn't be any ligatures here - we only add them at the end of
+ |xxx_break| in a \.{DISC-1 - DISC-2} situation and we stop processing \.{DISC-1}
+ (we continue with \.{DISC-1}'s |post_| and |no_break|.
+
+@c
+static halfword handle_lig_nest(halfword root, halfword cur)
+{
+ if (cur == null)
+ return root;
+ while (vlink(cur) != null) {
+ halfword fwd = vlink(cur);
+ if (type(cur) == glyph_node && type(fwd) == glyph_node &&
+ font(cur) == font(fwd) && try_ligature(&cur, fwd)) {
+ continue;
+ }
+ cur = vlink(cur);
+ }
+ tlink(root) = cur;
+ return root;
+}
+
+static halfword handle_lig_word(halfword cur)
+{
+ halfword right = null;
+ if (type(cur) == boundary_node) {
+ halfword prev = alink(cur);
+ halfword fwd = vlink(cur);
+ /* no need to uncouple |cur|, it is freed */
+ flush_node(cur);
+ if (fwd == null) {
+ vlink(prev) = fwd;
+ return prev;
+ }
+ couple_nodes(prev, fwd);
+ if (type(fwd) != glyph_node)
+ return prev;
+ cur = fwd;
+ } else if (has_left_boundary(font(cur))) {
+ halfword prev = alink(cur);
+ halfword p = new_glyph(font(cur), left_boundarychar);
+ couple_nodes(prev, p);
+ couple_nodes(p, cur);
+ cur = p;
+ }
+ if (has_right_boundary(font(cur))) {
+ right = new_glyph(font(cur), right_boundarychar);
+ }
+ while (1) {
+ /* A glyph followed by ... */
+ if (type(cur) == glyph_node) {
+ halfword fwd = vlink(cur);
+ if (fwd == null) { /* last character of paragraph */
+ if (right == null)
+ break;
+ /* \.{--\\par} prohibits use of |couple_nodes| here */
+ try_couple_nodes(cur, right);
+ right = null;
+ continue;
+ }
+ if (type(fwd) == glyph_node) { /* |GLYPH - GLYPH| */
+ if (font(cur) != font(fwd))
+ break;
+ if (try_ligature(&cur, fwd))
+ continue;
+ } else if (type(fwd) == disc_node) { /* |GLYPH - DISC| */
+
+ /* if \.{a{bx}{}{y}} and \.{a+b=>B} convert to \.{{Bx}{}{ay}} */
+ halfword pre = vlink_pre_break(fwd);
+ halfword nob = vlink_no_break(fwd);
+ halfword next, tail;
+ liginfo lig;
+ /* Check on: a{b?}{?}{?} and a+b=>B : {B?}{?}{a?} */
+ /* Check on: a{?}{?}{b?} and a+b=>B : {a?}{?}{B?} */
+ if ((pre != null && type(pre) == glyph_node
+ && test_ligature(&lig, cur, pre))
+ || (nob != null && type(nob) == glyph_node
+ && test_ligature(&lig, cur, nob))) {
+ /* move cur from before disc, to skipped part */
+ halfword prev = alink(cur);
+ uncouple_node(cur);
+ couple_nodes(prev, fwd);
+ nesting_prepend(no_break(fwd), cur);
+ /* now ligature the |pre_break| */
+ nesting_prepend(pre_break(fwd), copy_node(cur));
+ /* As we have removed cur, we need to start again ... */
+ cur = prev;
+ }
+ /* Check on: a{?}{?}{}b and a+b=>B : {a?}{?b}{B} */
+ next = vlink(fwd);
+ if (nob == null && next != null && type(next) == glyph_node
+ && test_ligature(&lig, cur, next)) {
+ /* move |cur| from before |disc| to |no_break| part */
+ halfword prev = alink(cur);
+ uncouple_node(cur);
+ couple_nodes(prev, fwd);
+ couple_nodes(no_break(fwd), cur); /* we {\it know\/} it's empty */
+ /* now copy cur the |pre_break| */
+ nesting_prepend(pre_break(fwd), copy_node(cur));
+ /* move next from after disc to |no_break| part */
+ tail = vlink(next);
+ uncouple_node(next);
+ try_couple_nodes(fwd, tail);
+ couple_nodes(cur, next); /* we {\it know\/} this works */
+ tlink(no_break(fwd)) = next; /* and make sure the list is correct */
+ /* now copy next to the |post_break| */
+ nesting_append(post_break(fwd), copy_node(next));
+ /* As we have removed cur, we need to start again ... */
+ cur = prev;
+ }
+ /* we are finished with the |pre_break| */
+ handle_lig_nest(pre_break(fwd), vlink_pre_break(fwd));
+ } else if (type(fwd) == boundary_node) {
+ halfword next = vlink(fwd);
+ try_couple_nodes(cur, next);
+ flush_node(fwd);
+ if (right != null) {
+ flush_node(right); /* Shame, didn't need it */
+ /* no need to reset |right|, we're going to leave the loop anyway */
+ }
+ break;
+ } else {
+ /* fwd is something unknown */
+ if (right == null)
+ break;
+ couple_nodes(cur, right);
+ couple_nodes(right, fwd);
+ right = null;
+ continue;
+ }
+ /* A discretionary followed by ... */
+ } else if (type(cur) == disc_node) {
+ /* If \.{{?}{x}{?}} or \.{{?}{?}{y}} then ... */
+ if (vlink_no_break(cur) != null || vlink_post_break(cur) != null) {
+ halfword prev = 0;
+ halfword fwd;
+ liginfo lig;
+ if (subtype(cur) == select_disc) {
+ prev = alink(cur);
+ if (vlink_post_break(cur) != null)
+ handle_lig_nest(post_break(prev), vlink_post_break(prev));
+ if (vlink_no_break(cur) != null)
+ handle_lig_nest(no_break(prev), vlink_no_break(prev));
+ }
+ if (vlink_post_break(cur) != null)
+ handle_lig_nest(post_break(cur), vlink_post_break(cur));
+ if (vlink_no_break(cur) != null)
+ handle_lig_nest(no_break(cur), vlink_no_break(cur));
+ while ((fwd = vlink(cur)) != null) {
+ halfword nob, pst, next;
+ if (type(fwd) != glyph_node)
+ break;
+ if (subtype(cur) != select_disc) {
+ nob = tlink_no_break(cur);
+ pst = tlink_post_break(cur);
+ if ((nob == null || !test_ligature(&lig, nob, fwd)) &&
+ (pst == null || !test_ligature(&lig, pst, fwd)))
+ break;
+ nesting_append(no_break(cur), copy_node(fwd));
+ handle_lig_nest(no_break(cur), nob);
+ } else {
+ int dobreak = 0;
+ nob = tlink_no_break(prev);
+ pst = tlink_post_break(prev);
+ if ((nob == null || !test_ligature(&lig, nob, fwd)) &&
+ (pst == null || !test_ligature(&lig, pst, fwd)))
+ dobreak = 1;
+ if (!dobreak) {
+ nesting_append(no_break(prev), copy_node(fwd));
+ handle_lig_nest(no_break(prev), nob);
+ nesting_append(post_break(prev), copy_node(fwd));
+ handle_lig_nest(post_break(prev), pst);
+ }
+ dobreak = 0;
+ nob = tlink_no_break(cur);
+ pst = tlink_post_break(cur);
+ if ((nob == null || !test_ligature(&lig, nob, fwd)) &&
+ (pst == null || !test_ligature(&lig, pst, fwd)))
+ dobreak = 1;
+ if (!dobreak) {
+ nesting_append(no_break(cur), copy_node(fwd));
+ handle_lig_nest(no_break(cur), nob);
+ }
+ if (dobreak)
+ break;
+ }
+ next = vlink(fwd);
+ uncouple_node(fwd);
+ try_couple_nodes(cur, next);
+ nesting_append(post_break(cur), fwd);
+ handle_lig_nest(post_break(cur), pst);
+ }
+ if (fwd != null && type(fwd) == disc_node) {
+ halfword next = vlink(fwd);
+ if (vlink_no_break(fwd) == null
+ && vlink_post_break(fwd) == null
+ && next != null
+ && type(next) == glyph_node
+ && ((tlink_post_break(cur) != null && test_ligature(&lig, tlink_post_break(cur), next)) ||
+ (tlink_no_break (cur) != null && test_ligature(&lig, tlink_no_break (cur), next)))) {
+ /* Building an |init_disc| followed by a |select_disc|
+ \.{{a-}{b}{AB} {-}{}{}} 'c'
+ */
+ /* is it tail necessary ? */
+ halfword last1 = vlink(next), tail ;
+ uncouple_node(next);
+ try_couple_nodes(fwd, last1);
+ /* \.{{a-}{b}{AB} {-}{c}{}} */
+ nesting_append(post_break(fwd), copy_node(next));
+ /* \.{{a-}{b}{AB} {-}{c}{-}} */
+ if (vlink_no_break(cur) != null) {
+ nesting_prepend(no_break(fwd), copy_node(vlink_pre_break(fwd)));
+ }
+ /* \.{{a-}{b}{AB} {b-}{c}{-}} */
+ if (vlink_post_break(cur) != null)
+ nesting_prepend_list(pre_break(fwd), copy_node_list(vlink_post_break(cur)));
+ /* \.{{a-}{b}{AB} {b-}{c}{AB-}} */
+ if (vlink_no_break(cur) != null) {
+ nesting_prepend_list(no_break(fwd), copy_node_list(vlink_no_break(cur)));
+ }
+ /* \.{{a-}{b}{ABC} {b-}{c}{AB-}} */
+ tail = tlink_no_break(cur);
+ nesting_append(no_break(cur), copy_node(next));
+ handle_lig_nest(no_break(cur), tail);
+ /* \.{{a-}{BC}{ABC} {b-}{c}{AB-}} */
+ tail = tlink_post_break(cur);
+ nesting_append(post_break(cur), next);
+ handle_lig_nest(post_break(cur), tail);
+ /* and set the subtypes */
+ subtype(cur) = init_disc;
+ subtype(fwd) = select_disc;
+ }
+ }
+ }
+
+ } else {
+ /* NO GLYPH NOR DISC */
+ return cur;
+ }
+ /* step-to-next-node */
+ /* \.{--\\par} allows |vlink(cur)| to be null */
+ cur = vlink(cur);
+ }
+
+ return cur;
+}
+
+@ Return value is the new tail, head should be a dummy
+
+@c
+halfword handle_ligaturing(halfword head, halfword tail)
+{
+ halfword save_tail1 = null; /* trick to allow explicit |node==null| tests */
+ halfword cur, prev;
+
+ if (vlink(head) == null)
+ return tail;
+ if (tail != null) {
+ save_tail1 = vlink(tail);
+ vlink(tail) = null;
+ }
+
+ /* |if (fix_node_lists)| */
+ fix_node_list(head);
+
+ prev = head;
+ cur = vlink(prev);
+
+ while (cur != null) {
+ if (type(cur) == glyph_node || (type(cur) == boundary_node)) {
+ cur = handle_lig_word(cur);
+ }
+ prev = cur;
+ cur = vlink(cur);
+ }
+ if (prev == null) {
+ /* hh: looks bad to me */
+ prev = tail;
+ }
+
+ if (tail != null) {
+ try_couple_nodes(prev, save_tail1);
+ }
+ return prev;
+}
+
+
+@* Kerning.
+
+@c
+static void add_kern_before(halfword left, halfword right)
+{
+ if ((!is_rightghost(right)) &&
+ font(left) == font(right) && has_kern(font(left), character(left))) {
+ int k = raw_get_kern(font(left), character(left), character(right));
+ if (k != 0) {
+ halfword kern = new_kern(k);
+ halfword prev = alink(right);
+ couple_nodes(prev, kern);
+ couple_nodes(kern, right);
+ /* update the attribute list (inherit from left) */
+ delete_attribute_ref(node_attr(kern));
+ add_node_attr_ref(node_attr(left));
+ node_attr(kern) = node_attr(left);
+ }
+ }
+}
+
+static void add_kern_after(halfword left, halfword right, halfword aft)
+{
+ if ((!is_rightghost(right)) &&
+ font(left) == font(right) && has_kern(font(left), character(left))) {
+ int k = raw_get_kern(font(left), character(left), character(right));
+ if (k != 0) {
+ halfword kern = new_kern(k);
+ halfword next = vlink(aft);
+ couple_nodes(aft, kern);
+ try_couple_nodes(kern, next);
+ /* update the attribute list (inherit from left == aft) */
+ delete_attribute_ref(node_attr(kern));
+ add_node_attr_ref(node_attr(aft));
+ node_attr(kern) = node_attr(aft);
+ }
+ }
+}
+
+static void do_handle_kerning(halfword root, halfword init_left, halfword init_right)
+{
+ halfword cur = vlink(root);
+ halfword left = null;
+ if (cur == null) {
+ if (init_left != null && init_right != null) {
+ add_kern_after(init_left, init_right, root);
+ tlink(root) = vlink(root);
+ }
+ return;
+ }
+ if (type(cur) == glyph_node) {
+ set_is_glyph(cur);
+ if (init_left != null)
+ add_kern_before(init_left, cur);
+ left = cur;
+ }
+ while ((cur = vlink(cur)) != null) {
+ if (type(cur) == glyph_node) {
+ set_is_glyph(cur);
+ if (left != null) {
+ add_kern_before(left, cur);
+ if (character(left) < 0 || is_ghost(left)) {
+ halfword prev = alink(left);
+ couple_nodes(prev, cur);
+ flush_node(left);
+ }
+ }
+ left = cur;
+ } else {
+ if (type(cur) == disc_node) {
+ halfword right = type(vlink(cur)) == glyph_node ? vlink(cur) : null;
+ do_handle_kerning(pre_break(cur), left, null);
+ if (vlink_pre_break(cur) != null)
+ tlink_pre_break(cur) = tail_of_list(vlink_pre_break(cur));
+ do_handle_kerning(post_break(cur), null, right);
+ if (vlink_post_break(cur) != null)
+ tlink_post_break(cur) = tail_of_list(vlink_post_break(cur));
+ do_handle_kerning(no_break(cur), left, right);
+ if (vlink_no_break(cur) != null)
+ tlink_no_break(cur) = tail_of_list(vlink_no_break(cur)); /* needed? */
+ }
+ if (left != null) {
+ if (character(left) < 0 || is_ghost(left)) {
+ halfword prev = alink(left);
+ couple_nodes(prev, cur);
+ flush_node(left);
+ }
+ left = null;
+ }
+ }
+ }
+ if (left != null) {
+ if (init_right != null)
+ add_kern_after(left, init_right, left);
+ if (character(left) < 0 || is_ghost(left)) {
+ halfword prev = alink(left);
+ halfword next = vlink(left);
+ if (next != null) {
+ couple_nodes(prev, next);
+ tlink(root) = next;
+ } else if (prev != root) {
+ vlink(prev) = null;
+ tlink(root) = prev;
+ } else {
+ vlink(root) = null;
+ tlink(root) = null;
+ }
+ flush_node(left);
+ }
+ }
+}
+
+/*
+halfword handle_kerning(halfword head, halfword tail)
+{
+ halfword save_link;
+ save_link = vlink(tail);
+ vlink(tail) = null;
+ tlink(head) = tail;
+ do_handle_kerning(head, null, null);
+ tail = tlink(head);
+ if (valid_node(save_link)) {
+ try_couple_nodes(tail, save_link);
+ }
+ return tail;
+}
+*/
+
+halfword handle_kerning(halfword head, halfword tail)
+{
+ halfword save_link = null;
+ if (tail == null) {
+ tlink(head) = null;
+ do_handle_kerning(head, null, null);
+ } else {
+ save_link = vlink(tail);
+ vlink(tail) = null;
+ tlink(head) = tail;
+ do_handle_kerning(head, null, null);
+ tail = tlink(head);
+ if (valid_node(save_link)) {
+ try_couple_nodes(tail, save_link);
+ }
+ }
+ return tail;
+}
+
+@* ligaturing and kerning : lua-interface.
+
+@c
+static halfword run_lua_ligkern_callback(halfword head, halfword tail, int callback_id)
+{
+ int i;
+ int top = lua_gettop(Luas);
+ if (!get_callback(Luas, callback_id)) {
+ lua_pop(Luas, 2);
+ return tail;
+ }
+ nodelist_to_lua(Luas, head);
+ nodelist_to_lua(Luas, tail);
+ if ((i=lua_pcall(Luas, 2, 0, 0)) != 0) {
+ luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
+ return tail;
+ }
+ fix_node_list(head);
+ lua_settop(Luas, top);
+ return tail;
+}
+
+halfword new_ligkern(halfword head, halfword tail)
+{
+ int callback_id = 0;
+ if (vlink(head) == null)
+ return tail;
+ callback_id = callback_defined(ligaturing_callback);
+ if (callback_id > 0) {
+ tail = run_lua_ligkern_callback(head, tail, callback_id);
+ if (tail == null)
+ tail = tail_of_list(head);
+ } else if (callback_id == 0) {
+ tail = handle_ligaturing(head, tail);
+ }
+ callback_id = callback_defined(kerning_callback);
+ if (callback_id > 0) {
+ tail = run_lua_ligkern_callback(head, tail, callback_id);
+ if (tail == null) {
+ tail = tail_of_list(head);
+ }
+ } else if (callback_id == 0) {
+ halfword nest1 = new_node(nesting_node, 1);
+ halfword cur = vlink(head);
+ halfword aft = vlink(tail);
+ couple_nodes(nest1, cur);
+ tlink(nest1) = tail;
+ vlink(tail) = null;
+ do_handle_kerning(nest1, null, null);
+ couple_nodes(head, vlink(nest1));
+ tail = tlink(nest1);
+ try_couple_nodes(tail, aft);
+ flush_node(nest1);
+ }
+ return tail;
+}
diff --git a/Build/source/texk/web2c/luatexdir/image/writejpg.w b/Build/source/texk/web2c/luatexdir/image/writejpg.w
index 31b79a8b3c1..7d463b77374 100644
--- a/Build/source/texk/web2c/luatexdir/image/writejpg.w
+++ b/Build/source/texk/web2c/luatexdir/image/writejpg.w
@@ -281,7 +281,7 @@ static void read_APP1_Exif (FILE *fp, unsigned short length, int *xx, int *yy, i
}
if (found_res) {
if (tempx>0 && tempy>0) {
- if (tempx!=(*xx) || tempy!=(*yy) && (*xx!=0 && (*yy!=0) ) ) {
+ if ((tempx!=(*xx) || tempy!=(*yy)) && (*xx!=0 && (*yy!=0) ) ) {
formatted_warning("readjpg","Exif resolution %ddpi x %ddpi differs from the input resolution %ddpi x %ddpi",tempx,tempy,*xx,*yy);
}
if (tempx==1 || tempy==1) {
diff --git a/Build/source/texk/web2c/luatexdir/lua/lnodelib.c b/Build/source/texk/web2c/luatexdir/lua/lnodelib.c
index 103e5f32479..8a96f328f8b 100644
--- a/Build/source/texk/web2c/luatexdir/lua/lnodelib.c
+++ b/Build/source/texk/web2c/luatexdir/lua/lnodelib.c
@@ -569,6 +569,107 @@ static int lua_nodelib_direct_getcharacter(lua_State * L)
return 1;
}
+static int lua_nodelib_direct_getcomponents(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if (n == null) {
+ lua_pushnil(L);
+ } else if (type(n) == glyph_node) {
+ lua_pushinteger(L, lig_ptr(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int lua_nodelib_direct_getlang(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if (n == null) {
+ lua_pushnil(L);
+ } else if (type(n) == glyph_node) {
+ lua_pushinteger(L, char_lang(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int lua_nodelib_direct_getattributelist(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if ((n) && nodetype_has_attributes(type(n))) {
+ lua_pushinteger(L, node_attr(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int lua_nodelib_direct_getpenalty(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if (n == null) {
+ lua_pushnil(L);
+ } else if (type(n) == penalty_node) {
+ lua_pushinteger(L, penalty(n));
+ } else if (type(n) == disc_node) {
+ lua_pushinteger(L, disc_penalty(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int lua_nodelib_direct_getkern(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if (n == null) {
+ lua_pushnil(L);
+ } else if (type(n) == kern_node || type(n) == margin_kern_node) {
+ lua_pushinteger(L, width(n));
+ } else if (type(n) == math_node) {
+ lua_pushinteger(L, surround(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int lua_nodelib_direct_getdir(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if (n == null) {
+ lua_pushnil(L);
+ } else if (type(n) == dir_node) {
+ lua_push_dir_text(L, dir_dir(n));
+ } else if (type(n) == hlist_node || type(n) == vlist_node) {
+ lua_push_dir_par(L, box_dir(n));
+ } else if (type(n) == rule_node) {
+ lua_push_dir_par(L, rule_dir(n));
+ } else if (type(n) == local_par_node) {
+ lua_push_dir_par(L, local_par_dir(n));
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
+static int lua_nodelib_direct_getoffsets(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if (n == null) {
+ lua_pushnil(L);
+ } else if (type(n) == glyph_node) {
+ lua_pushinteger(L, x_displace(n));
+ lua_pushinteger(L, y_displace(n));
+ return 2;
+ } else {
+ lua_pushnil(L);
+ }
+ return 1;
+}
+
/* node.getdisc */
static int lua_nodelib_direct_getdiscretionary(lua_State * L)
@@ -696,22 +797,25 @@ static int lua_nodelib_direct_setwhd(lua_State * L)
if ((t == hlist_node) || (t == vlist_node) || (t == rule_node) || (t == unset_node)) {
int t = lua_gettop(L) ;
if (t > 1) {
- width(n) = (halfword) lua_roundnumber(L, 2);
+ if ((lua_type(L, 2) == LUA_TNUMBER)) {
+ width(n) = (halfword) lua_roundnumber(L, 2);
+ } else {
+ /* leave as is */
+ }
if (t > 2) {
- height(n) = (halfword) lua_roundnumber(L, 3);
- if (t > 3) {
- depth(n) = (halfword) lua_roundnumber(L, 4);
+ if ((lua_type(L, 3) == LUA_TNUMBER)) {
+ height(n) = (halfword) lua_roundnumber(L, 3);
} else {
- depth(n) = 0;
+ /* leave as is */
+ }
+ if (t > 3) {
+ if ((lua_type(L, 4) == LUA_TNUMBER)) {
+ depth(n) = (halfword) lua_roundnumber(L, 4);
+ } else {
+ /* leave as is */
+ }
}
- } else {
- height(n) = 0;
- depth(n) = 0;
}
- } else {
- width(n) = 0;
- height(n) = 0;
- depth(n) = 0;
}
}
}
@@ -728,6 +832,8 @@ static int lua_nodelib_getlist(lua_State * L)
lua_pushnil(L);
} else if ((type(*n) == hlist_node) || (type(*n) == vlist_node)) {
fast_metatable_or_nil_alink(list_ptr(*n));
+ } else if ((type(*n) == sub_box_node) || (type(*n) == sub_mlist_node)) {
+ fast_metatable_or_nil_alink(math_list(*n));
} else {
lua_pushnil(L);
}
@@ -739,13 +845,21 @@ static int lua_nodelib_getlist(lua_State * L)
static int lua_nodelib_setlist(lua_State * L)
{
halfword *n = lua_touserdata(L, 1);
- if ((n != null) && ((type(n) == hlist_node) || (type(n) == vlist_node))) {
- if (lua_type(L,2) == LUA_TNIL) {
- list_ptr(n) = null;
+ if (n != null) {
+ if ((type(*n) == hlist_node) || (type(*n) == vlist_node)) {
+ if (lua_type(L,2) == LUA_TNIL) {
+ list_ptr(n) = null;
+ } else {
+ halfword *l = lua_touserdata(L, 2);
+ list_ptr(n) = l;
+ }
} else {
- halfword *l = lua_touserdata(L, 2);
- list_ptr(n) = l;
- }
+ if (lua_type(L,2) == LUA_TNIL) {
+ math_list(n) = null;
+ } else {
+ halfword *l = lua_touserdata(L, 2);
+ math_list(n) = l;
+ }
}
return 0;
}
@@ -759,10 +873,17 @@ static int lua_nodelib_direct_getlist(lua_State * L)
halfword n = lua_tointeger(L, 1);
if (n == null) {
lua_pushnil(L);
- } else if ((type(n) == hlist_node) || (type(n) == vlist_node)) {
- nodelib_pushdirect_or_nil_alink(list_ptr(n));
} else {
- lua_pushnil(L);
+ halfword t = type(n) ;
+ if ((t == hlist_node) || (t == vlist_node)) {
+ nodelib_pushdirect_or_nil_alink(list_ptr(n));
+ } else if ((t == sub_box_node) || (t == sub_mlist_node)) {
+ nodelib_pushdirect_or_nil_alink(math_list(n));
+ } else if (t == adjust_node) {
+ nodelib_pushdirect_or_nil_alink(adjust_ptr(n));
+ } else {
+ lua_pushnil(L);
+ }
}
return 1;
}
@@ -770,11 +891,26 @@ static int lua_nodelib_direct_getlist(lua_State * L)
static int lua_nodelib_direct_setlist(lua_State * L)
{
halfword n = lua_tointeger(L, 1);
- if ((n != null) && ((type(n) == hlist_node) || (type(n) == vlist_node))) {
- if (lua_type(L,2) == LUA_TNUMBER) {
- list_ptr(n) = (halfword) lua_tointeger(L, 2);
- } else {
- list_ptr(n) = null;
+ if (n != null) {
+ halfword t = type(n) ;
+ if ((t == hlist_node) || (t == vlist_node)) {
+ if (lua_type(L,2) == LUA_TNUMBER) {
+ list_ptr(n) = (halfword) lua_tointeger(L, 2);
+ } else {
+ list_ptr(n) = null;
+ }
+ } else if ((t == sub_box_node) || (t == sub_mlist_node)) {
+ if (lua_type(L,2) == LUA_TNUMBER) {
+ math_list(n) = (halfword) lua_tointeger(L, 2);
+ } else {
+ math_list(n) = null;
+ }
+ } else if (t == adjust_node) {
+ if (lua_type(L,2) == LUA_TNUMBER) {
+ adjust_ptr(n) = (halfword) lua_tointeger(L, 2);
+ } else {
+ adjust_ptr(n) = null;
+ }
}
}
return 0;
@@ -874,6 +1010,14 @@ static int lua_nodelib_direct_getnext(lua_State * L)
halfword p = lua_tointeger(L, 1);
if (p == null) {
lua_pushnil(L);
+ } else if ((lua_type(L, 2) == LUA_TNUMBER)) {
+ /* experiment */
+ int n = lua_tointeger(L,2);
+ while (p != null && n > 0) {
+ p = vlink(p);
+ n -= 1;
+ }
+ nodelib_pushdirect_or_nil(p);
} else {
nodelib_pushdirect_or_nil(vlink(p));
}
@@ -889,6 +1033,7 @@ static int lua_nodelib_getprev(lua_State * L)
if ( (p == NULL) || (! lua_getmetatable(L,1)) ) {
lua_pushnil(L);
} else {
+ /* experiment */
lua_get_metatablelua(luatex_node);
if (!lua_rawequal(L, -1, -2)) {
lua_pushnil(L);
@@ -947,6 +1092,13 @@ static int lua_nodelib_direct_getprev(lua_State * L)
halfword p = lua_tointeger(L, 1);
if (p == null) {
lua_pushnil(L);
+ } else if ((lua_type(L, 2) == LUA_TNUMBER)) {
+ int n = lua_tointeger(L,2);
+ while (p != null && n > 0) {
+ p = alink(p);
+ n -= 1;
+ }
+ nodelib_pushdirect_or_nil(p);
} else {
nodelib_pushdirect_or_nil(alink(p));
}
@@ -1351,7 +1503,7 @@ static int lua_nodelib_direct_insert_before(lua_State * L)
set_t_to_prev(head, current);
couple_nodes(t, n);
}
- couple_nodes(n, current);
+ couple_nodes(n, current); /* nice but incompatible: couple_nodes(tail_of_list(n),current) */
if (head == current) {
lua_pushinteger(L, n);
} else {
@@ -1427,7 +1579,7 @@ static int lua_nodelib_direct_insert_after(lua_State * L)
while (vlink(current) != null)
current = vlink(current);
}
- try_couple_nodes(n, vlink(current));
+ try_couple_nodes(n, vlink(current)); /* nice but incompatible: try_couple_nodes(tail_of_list(n), vlink(current)); */
couple_nodes(current, n);
lua_pop(L, 2);
lua_pushinteger(L, n);
@@ -4678,7 +4830,11 @@ static int font_tex_direct_kerning(lua_State * L)
}
alink(vlink(tmp_head)) = p ;
lua_pushinteger(L, vlink(tmp_head));
- lua_pushinteger(L, t);
+ if (t == null) {
+ lua_pushnil(L);
+ } else {
+ lua_pushinteger(L, t);
+ }
lua_pushboolean(L, 1);
flush_node(tmp_head);
return 3;
@@ -6092,6 +6248,143 @@ static int lua_nodelib_direct_setcharacter(lua_State * L)
return 0;
}
+static int lua_nodelib_direct_setfont(lua_State * L) /* family_font is not yet in manual, what does arg 2 do */
+{
+ halfword n = lua_tointeger(L, 1);
+ if (n != null) {
+ halfword t = type(n);
+ /* mandate font */
+ if (t == glyph_node) {
+ font(n) = (halfword) lua_tointeger(L,2);
+ /* optional char */
+ if ((lua_type(L, 3) == LUA_TNUMBER)) {
+ character(n) = (halfword) lua_tointeger(L, 3);
+ }
+ }
+ }
+ return 0;
+}
+
+
+static int lua_nodelib_direct_setcomponents(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if ((n) && (lua_type(L, 2) == LUA_TNUMBER)) {
+ if (type(n) == glyph_node) {
+ lig_ptr(n) = (halfword) lua_tointeger(L, 2);
+ }
+ }
+ return 0;
+}
+
+static int lua_nodelib_direct_setattributelist(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if ((n) && nodetype_has_attributes(type(n))) {
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ halfword a =lua_tointeger(L, 2);
+ if (type(a) == attribute_list_node) {
+ reassign_attribute(n,a);
+ } else if (nodetype_has_attributes(type(a))) {
+ reassign_attribute(n,node_attr(a));
+ } else {
+ reassign_attribute(n,null);
+ }
+ } else {
+ reassign_attribute(n,null);
+ }
+ return 0;
+ }
+ return 0;
+}
+
+static int lua_nodelib_direct_setlang(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if ((n) && (lua_type(L, 2) == LUA_TNUMBER)) {
+ if (type(n) == glyph_node) {
+ set_char_lang(n,lua_tointeger(L, 2));
+ }
+ }
+ return 0;
+}
+
+static int lua_nodelib_direct_setpenalty(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if (n == null) {
+ if (type(n) == penalty_node) {
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ penalty(n) = (halfword) lua_tointeger(L, 2);
+ } else {
+ penalty(n) = 0;
+ }
+ } else if (type(n) == disc_node) {
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ disc_penalty(n) = (halfword) lua_tointeger(L, 2);
+ } else {
+ penalty(n) = 0;
+ }
+ }
+ }
+ return 0;
+}
+
+static int lua_nodelib_direct_setkern(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if (n != null) {
+ if (type(n) == kern_node || type(n) == margin_kern_node) {
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ width(n) = (halfword) lua_tointeger(L, 2);
+ } else {
+ width(n) = 0;
+ }
+ if (lua_type(L, 3) == LUA_TNUMBER) {
+ subtype(n) = (halfword) lua_tointeger(L, 3);
+ }
+ } else if (type(n) == math_node) {
+ if (lua_type(L, 2) == LUA_TNUMBER) {
+ surround(n) = (halfword) lua_tointeger(L, 2);
+ } else {
+ surround(n) = 0;
+ }
+ }
+ }
+ return 0;
+}
+
+static int lua_nodelib_direct_setdir(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if (n != null) {
+ if (type(n) == dir_node) {
+ dir_dir(n) = nodelib_getdir(L, 2, 0);
+ } else if (type(n) == hlist_node || type(n) == vlist_node) {
+ box_dir(n) = nodelib_getdir(L, 2, 1);
+ } else if (type(n) == rule_node) {
+ rule_dir(n) = nodelib_getdir(L, 2, 1);
+ } else if (type(n) == local_par_node) {
+ local_par_dir(n) = nodelib_getdir(L, 3, 1);
+ }
+ }
+ return 0;
+}
+
+static int lua_nodelib_direct_setoffsets(lua_State * L)
+{
+ halfword n = lua_tointeger(L, 1);
+ if ((n) && (type(n) == glyph_node)) {
+ if ((lua_type(L, 2) == LUA_TNUMBER)) {
+ x_displace(n) = (halfword) lua_tointeger(L, 2);
+ }
+ if ((lua_type(L, 3) == LUA_TNUMBER)) {
+ y_displace(n) = (halfword) lua_tointeger(L, 3);
+ }
+ }
+ return 0;
+}
+
static int lua_nodelib_direct_setnext(lua_State * L)
{
halfword n = lua_tointeger(L, 1);
@@ -6136,6 +6429,7 @@ static int lua_nodelib_direct_setboth(lua_State * L)
return 0;
}
+/*
static int lua_nodelib_direct_setlink(lua_State * L)
{
if (lua_type(L, 1) == LUA_TNUMBER) {
@@ -6153,6 +6447,59 @@ static int lua_nodelib_direct_setlink(lua_State * L)
}
return 0;
}
+*/
+
+/*
+ a b b nil c d : prev-a-b-c-next
+ nil a b b nil c d nil : nil-a-b-c-nil
+*/
+
+static int lua_nodelib_direct_setlink(lua_State * L)
+{
+ int n = lua_gettop(L);
+ int i;
+ halfword h = null; /* head node */
+ halfword t = null; /* tail node */
+ halfword c = null; /* current node */
+ for (i=1;i<=n;i++) {
+ /*
+ we don't go for the tail of the current node because we can inject
+ between existing nodes and the nodes themselves can have old values
+ for prev and next, so ... only single nodes are looked at!
+ */
+ if (lua_type(L, i) == LUA_TNUMBER) {
+ c = lua_tointeger(L, i);
+ if (c != t) {
+ if (t != null) {
+ vlink(t) = c;
+ alink(c) = t;
+ } else if (i > 1) {
+ /* we assume that the first node is a kind of head */
+ alink(c) = null;
+ }
+ t = c;
+ if (h == null) {
+ h = t;
+ }
+ } else {
+ /* we ignore duplicate nodes which can be tails or the previous */
+ }
+ } else if (t == null) {
+ /* we just ignore nil nodes and have no tail yet */
+ } else {
+ /* safeguard: a nil in the list can be meant as end so we nil the next of tail */
+ vlink(t) = null;
+ }
+ }
+ if (h == null) {
+ /* no head */
+ lua_pushnil(L);
+ } else {
+ /* first valid head */
+ lua_pushinteger(L,h);
+ }
+ return 1;
+}
static int lua_nodelib_direct_is_char(lua_State * L)
{
@@ -7158,6 +7505,12 @@ static const struct luaL_Reg direct_nodelib_f[] = {
{"free", lua_nodelib_direct_free},
{"getbox", lua_nodelib_direct_getbox},
{"getchar", lua_nodelib_direct_getcharacter},
+ {"getcomponents", lua_nodelib_direct_getcomponents},
+ {"getlang", lua_nodelib_direct_getlang},
+ {"getkern", lua_nodelib_direct_getkern},
+ {"getpenalty", lua_nodelib_direct_getpenalty},
+ {"getdir", lua_nodelib_direct_getdir},
+ {"getoffsets", lua_nodelib_direct_getoffsets},
{"getdisc", lua_nodelib_direct_getdiscretionary},
{"getwhd", lua_nodelib_direct_getwhd},
{"getfield", lua_nodelib_direct_getfield},
@@ -7169,6 +7522,7 @@ static const struct luaL_Reg direct_nodelib_f[] = {
{"getlist", lua_nodelib_direct_getlist},
{"getleader", lua_nodelib_direct_getleader},
{"getsubtype", lua_nodelib_direct_getsubtype},
+ {"getattributelist", lua_nodelib_direct_getattributelist},
{"has_glyph", lua_nodelib_direct_has_glyph},
{"has_attribute", lua_nodelib_direct_has_attribute},
{"get_attribute", lua_nodelib_direct_get_attribute},
@@ -7197,6 +7551,13 @@ static const struct luaL_Reg direct_nodelib_f[] = {
{"setbox", lua_nodelib_direct_setbox},
{"setfield", lua_nodelib_direct_setfield},
{"setchar", lua_nodelib_direct_setcharacter},
+ {"setfont", lua_nodelib_direct_setfont},
+ {"setcomponents", lua_nodelib_direct_setcomponents},
+ {"setlang", lua_nodelib_direct_setlang},
+ {"setkern", lua_nodelib_direct_setkern},
+ {"setpenalty", lua_nodelib_direct_setpenalty},
+ {"setdir", lua_nodelib_direct_setdir},
+ {"setoffsets", lua_nodelib_direct_setoffsets},
{"setdisc", lua_nodelib_direct_setdiscretionary},
{"setwhd", lua_nodelib_direct_setwhd},
{"setnext", lua_nodelib_direct_setnext},
@@ -7206,6 +7567,7 @@ static const struct luaL_Reg direct_nodelib_f[] = {
{"setlist", lua_nodelib_direct_setlist},
{"setleader", lua_nodelib_direct_setleader},
{"setsubtype", lua_nodelib_direct_setsubtype},
+ {"setattributelist", lua_nodelib_direct_setattributelist},
{"slide", lua_nodelib_direct_slide},
/* {"subtype", lua_nodelib_subtype}, */ /* no node argument */
{"tail", lua_nodelib_direct_tail},
diff --git a/Build/source/texk/web2c/luatexdir/lua/luainit.w b/Build/source/texk/web2c/luatexdir/lua/luainit.w
index ca755642038..4e7f9bf505d 100644
--- a/Build/source/texk/web2c/luatexdir/lua/luainit.w
+++ b/Build/source/texk/web2c/luatexdir/lua/luainit.w
@@ -1,1091 +1,1091 @@
-% luainit.w
-%
-% Copyright 2006-2016 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
-
-#include "ptexlib.h"
-
-#include <kpathsea/c-stat.h>
-
-#include "lua/luatex-api.h"
-
-/* internalized strings: see luatex-api.h */
-set_make_keys;
-
-@
-This file is getting a bit messy, but it is not simple to fix unilaterally.
-
-Better to wait until Karl has some time (after texlive 2008) so we can
-synchronize with kpathsea. One problem, for instance, is that I would
-like to resolve the full executable path. |kpse_set_program_name()| does
-that, indirectly (by setting SELFAUTOLOC in the environment), but it
-does much more, making it hard to use for our purpose.
-
-In fact, it sets three C variables:
-
- |kpse_invocation_name| |kpse_invocation_short_name| |kpse->program_name|
-
-and five environment variables:
-
- SELFAUTOLOC SELFAUTODIR SELFAUTOPARENT SELFAUTOGRANDPARENT progname
-
-@c
-const_string LUATEX_IHELP[] = {
- "Usage: " my_name " --lua=FILE [OPTION]... [TEXNAME[.tex]] [COMMANDS]",
- " or: " my_name " --lua=FILE [OPTION]... \\FIRST-LINE",
- " or: " my_name " --lua=FILE [OPTION]... &FMT ARGS",
- " Run " MyName " on TEXNAME, usually creating TEXNAME.pdf.",
- " Any remaining COMMANDS are processed as luatex input, after TEXNAME is read.",
- "",
- " Alternatively, if the first non-option argument begins with a backslash,",
- " " my_name " interprets all non-option arguments as an input line.",
- "",
- " Alternatively, if the first non-option argument begins with a &, the",
- " next word is taken as the FMT to read, overriding all else. Any",
- " remaining arguments are processed as above.",
- "",
- " If no arguments or options are specified, prompt for input.",
- "",
- " The following regular options are understood: ",
- "",
- " --credits display credits and exit",
- " --debug-format enable format debugging",
- " --draftmode switch on draft mode (generates no output PDF)",
- " --[no-]file-line-error disable/enable file:line:error style messages",
- " --[no-]file-line-error-style aliases of --[no-]file-line-error",
- " --fmt=FORMAT load the format file FORMAT",
- " --halt-on-error stop processing at the first error",
- " --help display help and exit",
- " --ini be ini" my_name ", for dumping formats",
- " --interaction=STRING set interaction mode (STRING=batchmode/nonstopmode/scrollmode/errorstopmode)",
- " --jobname=STRING set the job name to STRING",
- " --kpathsea-debug=NUMBER set path searching debugging flags according to the bits of NUMBER",
- " --lua=FILE load and execute a lua initialization script",
- " --[no-]mktex=FMT disable/enable mktexFMT generation (FMT=tex/tfm)",
- " --nosocket disable the lua socket library",
- " --output-comment=STRING use STRING for DVI file comment instead of date (no effect for PDF)",
- " --output-directory=DIR use existing DIR as the directory to write files in",
- " --output-format=FORMAT use FORMAT for job output; FORMAT is 'dvi' or 'pdf'",
- " --progname=STRING set the program name to STRING",
- " --recorder enable filename recorder",
- " --safer disable easily exploitable lua commands",
- " --[no-]shell-escape disable/enable system commands",
- " --shell-restricted restrict system commands to a list of commands given in texmf.cnf",
- " --synctex=NUMBER enable synctex",
- " --utc init time to UTC",
- " --version display version and exit",
- "",
- "Alternate behaviour models can be obtained by special switches",
- "",
- " --luaonly run a lua file, then exit",
- " --luaconly byte-compile a lua file, then exit",
- " --luahashchars the bits used by current Lua interpreter for strings hashing",
-#ifdef LuajitTeX
- " --jiton turns the JIT compiler on (default off)",
- " --jithash=STRING choose the hash function for the lua strings (lua51|luajit20: default lua51)",
-#endif
- "",
- "See the reference manual for more information about the startup process.",
- NULL
-};
-
-/*
- " --8bit ignored, input is assumed to be in UTF-8 encoding",
- " --default-translate-file=FILE ignored, input is assumed to be in UTF-8 encoding",
- " --etex ignored, the etex extensions are always active",
- " --disable-write18 disable \\write18{SHELL COMMAND}",
- " --enable-write18 enable \\write18{SHELL COMMAND}",
- " --[no-]parse-first-line ignored",
- " --translate-file=FILE ignored, input is assumed to be in UTF-8 encoding",
-*/
-
-@ The return value will be the directory of the executable, e.g.: \.{c:/TeX/bin}
-@c
-static char *ex_selfdir(char *argv0)
-{
-#if defined(WIN32)
-#if defined(__MINGW32__)
- char path[PATH_MAX], *fp;
-
- /* SearchPath() always gives back an absolute directory */
- if (SearchPath(NULL, argv0, ".exe", PATH_MAX, path, NULL) == 0)
- FATAL1("Can't determine where the executable %s is.\n", argv0);
- /* slashify the dirname */
- for (fp = path; fp && *fp; fp++)
- if (IS_DIR_SEP(*fp))
- *fp = DIR_SEP;
-#else /* __MINGW32__ */
-#define PATH_MAX 512
- char short_path[PATH_MAX], path[PATH_MAX], *fp;
-
- /* SearchPath() always gives back an absolute directory */
- if (SearchPath(NULL, argv0, ".exe", PATH_MAX, short_path, &fp) == 0)
- FATAL1("Can't determine where the executable %s is.\n", argv0);
- if (getlongpath(path, short_path, sizeof(path)) == 0) {
- FATAL1("This path points to an invalid file : %s\n", short_path);
- }
-#endif /* __MINGW32__ */
- return xdirname(path);
-#else /* WIN32 */
- return kpse_selfdir(argv0);
-#endif
-}
-
-@ @c
-static void prepare_cmdline(lua_State * L, char **av, int ac, int zero_offset)
-{
- int i;
- char *s;
- luaL_checkstack(L, ac + 3, "too many arguments to script");
- lua_createtable(L, 0, 0);
- for (i = 0; i < ac; i++) {
- lua_pushstring(L, av[i]);
- lua_rawseti(L, -2, (i - zero_offset));
- }
- lua_setglobal(L, "arg");
- lua_getglobal(L, "os");
- s = ex_selfdir(argv[0]);
- lua_pushstring(L, s);
- xfree(s);
- lua_setfield(L, -2, "selfdir");
- return;
-}
-
-
-@ @c
-int kpse_init = -1;
-
-@ @c
-string input_name = NULL;
-
-static string user_progname = NULL;
-
-char *startup_filename = NULL;
-int lua_only = 0;
-int lua_offset = 0;
-unsigned char show_luahashchars = 0;
-
-#ifdef LuajitTeX
-int luajiton = 0;
-char *jithash_hashname = NULL;
-#endif
-
-int safer_option = 0;
-int nosocket_option = 0;
-int utc_option = 0;
-
-@ Reading the options.
-
-@ Test whether getopt found an option ``A''.
-Assumes the option index is in the variable |option_index|, and the
-option table in a variable |long_options|.
-
-@c
-#define ARGUMENT_IS(a) STREQ (long_options[option_index].name, a)
-
-/*
- SunOS cc can't initialize automatic structs, so make this static.
-*/
-
-/*
- Nota Bene: we still intercept some options that other engines handle
- so that existing scripted usage will not fail.
-*/
-
-static struct option long_options[] = {
- {"fmt", 1, 0, 0},
- {"lua", 1, 0, 0},
- {"luaonly", 0, 0, 0},
- {"luahashchars", 0, 0, 0},
-#ifdef LuajitTeX
- {"jiton", 0, 0, 0},
- {"jithash", 1, 0, 0},
-#endif
- {"safer", 0, &safer_option, 1},
- {"utc", 0, &utc_option, 1},
- {"nosocket", 0, &nosocket_option, 1},
- {"help", 0, 0, 0},
- {"ini", 0, &ini_version, 1},
- {"interaction", 1, 0, 0},
- {"halt-on-error", 0, &haltonerrorp, 1},
- {"kpathsea-debug", 1, 0, 0},
- {"progname", 1, 0, 0},
- {"version", 0, 0, 0},
- {"credits", 0, 0, 0},
- {"recorder", 0, 0, 0},
- {"etex", 0, 0, 0},
- {"output-comment", 1, 0, 0},
- {"output-directory", 1, 0, 0},
- {"draftmode", 0, 0, 0},
- {"output-format", 1, 0, 0},
- {"shell-escape", 0, &shellenabledp, 1},
- {"no-shell-escape", 0, &shellenabledp, -1},
- {"enable-write18", 0, &shellenabledp, 1},
- {"disable-write18", 0, &shellenabledp, -1},
- {"shell-restricted", 0, 0, 0},
- {"debug-format", 0, &debug_format_file, 1},
- {"file-line-error-style", 0, &filelineerrorstylep, 1},
- {"no-file-line-error-style", 0, &filelineerrorstylep, -1},
-
- /* Shorter option names for the above. */
-
- {"file-line-error", 0, &filelineerrorstylep, 1},
- {"no-file-line-error", 0, &filelineerrorstylep, -1},
- {"jobname", 1, 0, 0},
- {"parse-first-line", 0, &parsefirstlinep, 1},
- {"no-parse-first-line", 0, &parsefirstlinep, -1},
- {"translate-file", 1, 0, 0},
- {"default-translate-file", 1, 0, 0},
- {"8bit", 0, 0, 0},
- {"mktex", 1, 0, 0},
- {"no-mktex", 1, 0, 0},
-
- /* Synchronization: just like "interaction" above */
-
- {"synctex", 1, 0, 0},
- {0, 0, 0, 0}
-};
-
-@ @c
-int lua_numeric_field_by_index(lua_State * L, int name_index, int dflt)
-{
- register int i = dflt;
- lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
- lua_rawget(L, -2);
- if (lua_type(L, -1) == LUA_TNUMBER) {
- i = lua_roundnumber(L, -1);
- }
- lua_pop(L, 1);
- return i;
-}
-
-@ @c
-unsigned int lua_unsigned_numeric_field_by_index(lua_State * L, int name_index, int dflt)
-{
- register unsigned int i = dflt;
- lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
- lua_rawget(L, -2);
- if (lua_type(L, -1) == LUA_TNUMBER) {
- i = lua_uroundnumber(L, -1);
- }
- lua_pop(L, 1);
- return i;
-}
-
-@ @c
-static int recorderoption = 0;
-
-static void parse_options(int ac, char **av)
-{
-#ifdef WIN32
-/* save argc and argv */
- int sargc = argc;
- char **sargv = argv;
-#endif
- int g; /* `getopt' return code. */
- int option_index;
- char *firstfile = NULL;
- opterr = 0; /* dont whine */
-#ifdef LuajitTeX
- if ((strstr(argv[0], "luajittexlua") != NULL) ||
- (strstr(argv[0], "texluajit") != NULL)) {
-#else
- if ((strstr(argv[0], "luatexlua") != NULL) ||
- (strstr(argv[0], "texlua") != NULL)) {
-#endif
- lua_only = 1;
- luainit = 1;
- }
- for (;;) {
- g = getopt_long_only(ac, av, "+", long_options, &option_index);
-
- if (g == -1) /* End of arguments, exit the loop. */
- break;
- if (g == '?') { /* Unknown option. */
- if (!luainit)
- fprintf(stderr,"%s: unrecognized option '%s'\n", argv[0], argv[optind-1]);
- continue;
- }
-
- assert(g == 0); /* We have no short option names. */
-
- if (ARGUMENT_IS("luaonly")) {
- lua_only = 1;
- lua_offset = optind;
- luainit = 1;
- } else if (ARGUMENT_IS("lua")) {
- startup_filename = optarg;
- lua_offset = (optind - 1);
- luainit = 1;
-#ifdef LuajitTeX
- } else if (ARGUMENT_IS("jiton")) {
- luajiton = 1;
- } else if (ARGUMENT_IS("jithash")) {
- size_t len = strlen(optarg);
- if (len<16) {
- jithash_hashname = optarg;
- } else {
- WARNING2("hash name truncated to 15 characters from %d. (%s)", (int) len, optarg);
- jithash_hashname = (string) xmalloc(16);
- strncpy(jithash_hashname, optarg, 15);
- jithash_hashname[15] = 0;
- }
-#endif
- } else if (ARGUMENT_IS("luahashchars")) {
- show_luahashchars = 1;
- } else if (ARGUMENT_IS("kpathsea-debug")) {
- kpathsea_debug |= atoi(optarg);
- } else if (ARGUMENT_IS("progname")) {
- user_progname = optarg;
- } else if (ARGUMENT_IS("jobname")) {
- c_job_name = optarg;
- } else if (ARGUMENT_IS("fmt")) {
- dump_name = optarg;
- } else if (ARGUMENT_IS("output-directory")) {
- output_directory = optarg;
- } else if (ARGUMENT_IS("output-comment")) {
- size_t len = strlen(optarg);
- if (len < 256) {
- output_comment = optarg;
- } else {
- WARNING2("Comment truncated to 255 characters from %d. (%s)", (int) len, optarg);
- output_comment = (string) xmalloc(256);
- strncpy(output_comment, optarg, 255);
- output_comment[255] = 0;
- }
- } else if (ARGUMENT_IS("shell-restricted")) {
- shellenabledp = 1;
- restrictedshell = 1;
- } else if (ARGUMENT_IS("output-format")) {
- output_mode_option = 1;
- if (strcmp(optarg, "dvi") == 0) {
- output_mode_value = 0;
- } else if (strcmp(optarg, "pdf") == 0) {
- output_mode_value = 1;
- } else {
- WARNING1("Ignoring unknown value `%s' for --output-format",optarg);
- output_mode_option = 0;
- }
- } else if (ARGUMENT_IS("draftmode")) {
- draft_mode_option = 1;
- draft_mode_value = 1;
- } else if (ARGUMENT_IS("mktex")) {
- kpse_maketex_option(optarg, true);
- } else if (ARGUMENT_IS("no-mktex")) {
- kpse_maketex_option(optarg, false);
- } else if (ARGUMENT_IS("interaction")) {
- /* These numbers match CPP defines */
- if (STREQ(optarg, "batchmode")) {
- interactionoption = 0;
- } else if (STREQ(optarg, "nonstopmode")) {
- interactionoption = 1;
- } else if (STREQ(optarg, "scrollmode")) {
- interactionoption = 2;
- } else if (STREQ(optarg, "errorstopmode")) {
- interactionoption = 3;
- } else {
- WARNING1("Ignoring unknown argument `%s' to --interaction", optarg);
- }
- } else if (ARGUMENT_IS("synctex")) {
- /* Synchronize TeXnology: catching the command line option as a long */
- synctexoption = (int) strtol(optarg, NULL, 0);
- } else if (ARGUMENT_IS("recorder")) {
- recorderoption = 1 ;
- } else if (ARGUMENT_IS("help")) {
- usagehelp(LUATEX_IHELP, BUG_ADDRESS);
- } else if (ARGUMENT_IS("version")) {
- print_version_banner();
- /* *INDENT-OFF* */
- puts("\n\nExecute '" my_name " --credits' for credits and version details.\n\n"
- "There is NO warranty. Redistribution of this software is covered by\n"
- "the terms of the GNU General Public License, version 2 or (at your option)\n"
- "any later version. For more information about these matters, see the file\n"
- "named COPYING and the LuaTeX source.\n\n"
- "LuaTeX is Copyright 2016 Taco Hoekwater and the LuaTeX Team.\n");
- /* *INDENT-ON* */
- uexit(0);
- } else if (ARGUMENT_IS("credits")) {
- char *versions;
- initversionstring(&versions);
- print_version_banner();
- /* *INDENT-OFF* */
- puts("\n\nThe LuaTeX team is Hans Hagen, Hartmut Henkel, Taco Hoekwater, Luigi Scarso.\n\n"
- MyName " merges and builds upon (parts of) the code from these projects:\n\n"
- "tex : Donald Knuth\n"
- "etex : Peter Breitenlohner, Phil Taylor and friends\n"
- "omega : John Plaice and Yannis Haralambous\n"
- "aleph : Giuseppe Bilotta\n"
- "pdftex : Han The Thanh and friends\n"
- "kpathsea : Karl Berry, Olaf Weber and others\n"
- "lua : Roberto Ierusalimschy, Waldemar Celes and Luiz Henrique de Figueiredo\n"
- "metapost : John Hobby, Taco Hoekwater and friends\n"
- "poppler : Derek Noonburg, Kristian H\\ogsberg (partial)\n"
- "fontforge : George Williams (partial)\n"
- "luajit : Mike Pall (used in LuajitTeX)\n");
- /* *INDENT-ON* */
- puts(versions);
- uexit(0);
- }
- }
- /* attempt to find |input_name| / |dump_name| */
- if (lua_only) {
- if (argv[optind]) {
- startup_filename = xstrdup(argv[optind]);
- lua_offset = optind;
- }
- } else if (argv[optind] && argv[optind][0] == '&') {
- dump_name = xstrdup(argv[optind] + 1);
- } else if (argv[optind] && argv[optind][0] != '\\') {
- if (argv[optind][0] == '*') {
- input_name = xstrdup(argv[optind] + 1);
- } else {
- firstfile = xstrdup(argv[optind]);
- if ((strstr(firstfile, ".lua") ==
- firstfile + strlen(firstfile) - 4)
- || (strstr(firstfile, ".luc") ==
- firstfile + strlen(firstfile) - 4)
- || (strstr(firstfile, ".LUA") ==
- firstfile + strlen(firstfile) - 4)
- || (strstr(firstfile, ".LUC") ==
- firstfile + strlen(firstfile) - 4)) {
- if (startup_filename == NULL) {
- startup_filename = firstfile;
- lua_offset = optind;
- lua_only = 1;
- luainit = 1;
- }
- } else {
- input_name = firstfile;
- }
- }
-#ifdef WIN32
- } else if (sargc > 1 && sargv[sargc-1] && sargv[sargc-1][0] != '-' &&
- sargv[sargc-1][0] != '\\') {
- if (sargv[sargc-1][0] == '&')
- dump_name = xstrdup(sargv[sargc-1] + 1);
- else {
- if (sargv[sargc-1][0] == '*')
- input_name = xstrdup(sargv[sargc-1] + 1);
- else
- input_name = xstrdup(sargv[sargc-1]);
- sargv[sargc-1] = normalize_quotes(input_name, "argument");
- }
- if (safer_option) /* --safer implies --nosocket */
- nosocket_option = 1;
- return;
-#endif
- }
- if (safer_option) /* --safer implies --nosocket */
- nosocket_option = 1;
- /* Finalize the input filename. */
- if (input_name != NULL) {
- argv[optind] = normalize_quotes(input_name, "argument");
- }
-}
-
-@ test for readability
-@c
-#define is_readable(a) (stat(a,&finfo)==0) && S_ISREG(finfo.st_mode) && \
- (f=fopen(a,"r")) != NULL && !fclose(f)
-
-@ @c
-static char *find_filename(char *name, const char *envkey)
-{
- struct stat finfo;
- char *dirname = NULL;
- char *filename = NULL;
- FILE *f;
- if (is_readable(name)) {
- return name;
- } else {
- dirname = getenv(envkey);
- if ((dirname != NULL) && strlen(dirname)) {
- dirname = xstrdup(getenv(envkey));
- if (*(dirname + strlen(dirname) - 1) == '/') {
- *(dirname + strlen(dirname) - 1) = 0;
- }
- filename = xmalloc((unsigned) (strlen(dirname) + strlen(name) + 2));
- filename = concat3(dirname, "/", name);
- xfree(dirname);
- if (is_readable(filename)) {
- return filename;
- }
- xfree(filename);
- }
- }
- return NULL;
-}
-
-@ @c
-
-static void init_kpse(void)
-{
- if (!user_progname) {
- user_progname = dump_name;
- } else if (!dump_name) {
- dump_name = user_progname;
- }
- if (!user_progname) {
- if (ini_version) {
- if (input_name) {
- char *p = input_name + strlen(input_name) - 1;
- while (p >= input_name) {
- if (IS_DIR_SEP (*p)) {
- p++;
- input_name = p;
- break;
- }
- p--;
- }
- user_progname = remove_suffix (input_name);
- }
- if (!user_progname) {
- user_progname = kpse_program_basename(argv[0]);
- }
- } else {
- if (!dump_name) {
- dump_name = kpse_program_basename(argv[0]);
- }
- user_progname = dump_name;
- }
- }
- kpse_set_program_enabled(kpse_fmt_format, MAKE_TEX_FMT_BY_DEFAULT,
- kpse_src_compile);
-
- kpse_set_program_name(argv[0], user_progname);
- init_shell_escape(); /* set up 'restrictedshell' */
- init_start_time();
- program_name_set = 1 ;
- if (recorderoption) {
- recorder_enabled = 1;
- }
-}
-
-@ @c
-static void fix_dumpname(void)
-{
- int dist;
- if (dump_name) {
- /* adjust array for Pascal and provide extension, if needed */
- dist = (int) (strlen(dump_name) - strlen(DUMP_EXT));
- if (strstr(dump_name, DUMP_EXT) == dump_name + dist)
- TEX_format_default = dump_name;
- else
- TEX_format_default = concat(dump_name, DUMP_EXT);
- } else {
- /* For |dump_name| to be NULL is a bug. */
- if (!ini_version) {
- fprintf(stdout, "no format given, quitting\n");
- exit(1);
- }
- }
-}
-
-@ lua require patch
-
-@ Auxiliary function for kpse search
-
-@c
-static const char *luatex_kpse_find_aux(lua_State *L, const char *name,
- kpse_file_format_type format, const char *errname)
-{
- const char *filename;
- const char *altname;
- altname = luaL_gsub(L, name, ".", "/"); /* Lua convention */
- filename = kpse_find_file(altname, format, false);
- if (filename == NULL) {
- filename = kpse_find_file(name, format, false);
- }
- if (filename == NULL) {
- lua_pushfstring(L, "\n\t[kpse %s searcher] file not found: " LUA_QS, errname, name);
- }
- return filename;
-}
-
-@ The lua search function.
-
-When kpathsea is not initialized, then it runs the
-normal lua function that is saved in the registry, otherwise
-it uses kpathsea.
-
-two registry ref variables are needed: one for the actual lua
-function, the other for its environment .
-
-@c
-static int lua_loader_function = 0;
-
-static int luatex_kpse_lua_find(lua_State * L)
-{
- const char *filename;
- const char *name;
- name = luaL_checkstring(L, 1);
- if (program_name_set == 0) {
- lua_rawgeti(L, LUA_REGISTRYINDEX, lua_loader_function);
- lua_pushvalue(L, -2);
- lua_call(L, 1, 1);
- return 1;
- }
- filename = luatex_kpse_find_aux(L, name, kpse_lua_format, "lua");
- if (filename == NULL)
- return 1; /* library not found in this path */
- if (luaL_loadfile(L, filename) != 0) {
- luaL_error(L, "error loading module %s from file %s:\n\t%s",
- lua_tostring(L, 1), filename, lua_tostring(L, -1));
- }
- return 1; /* library loaded successfully */
-}
-
-@ @c
-static int clua_loader_function = 0;
-extern int searcher_C_luatex (lua_State *L, const char *name, const char *filename);
-
-static int luatex_kpse_clua_find(lua_State * L)
-{
- const char *filename;
- const char *name;
- if (safer_option) {
- lua_pushliteral(L, "\n\t[C searcher disabled in safer mode]");
- return 1; /* library not found in this path */
- }
- name = luaL_checkstring(L, 1);
- if (program_name_set == 0) {
- lua_rawgeti(L, LUA_REGISTRYINDEX, clua_loader_function);
- lua_pushvalue(L, -2);
- lua_call(L, 1, 1);
- return 1;
- } else {
- const char *path_saved;
- char *prefix, *postfix, *p, *total;
- char *extensionless;
- char *temp_name;
- int j;
- filename = luatex_kpse_find_aux(L, name, kpse_clua_format, "C");
- if (filename == NULL)
- return 1; /* library not found in this path */
- extensionless = strdup(filename);
- if (!extensionless)
- return 1; /* allocation failure */
- /* Fix Issue 850: replace '.' with LUA_DIRSEP */
- temp_name = strdup(name);
- for(j=0; ; j++){
- if ((unsigned char)temp_name[j]=='\0') {
- break;
- }
- if ((unsigned char)temp_name[j]=='.'){
- temp_name[j]=LUA_DIRSEP[0];
- }
- }
- p = strstr(extensionless, temp_name);
- if (!p) return 1; /* this would be exceedingly weird */
- *p = '\0';
- prefix = strdup(extensionless);
- if (!prefix) return 1; /* allocation failure */
- postfix = strdup(p+strlen(name));
- if (!postfix) return 1; /* allocation failure */
- total = malloc(strlen(prefix)+strlen(postfix)+2);
- if (!total) return 1; /* allocation failure */
- snprintf(total,strlen(prefix)+strlen(postfix)+2, "%s?%s", prefix, postfix);
- /* save package.path */
- lua_getglobal(L,"package");
- lua_getfield(L,-1,"cpath");
- path_saved = lua_tostring(L,-1);
- lua_pop(L,1);
- /* set package.path = "?" */
- lua_pushstring(L,total);
- lua_setfield(L,-2,"cpath");
- lua_pop(L,1); /* pop "package" */
- /* run function */
- lua_rawgeti(L, LUA_REGISTRYINDEX, clua_loader_function);
- lua_pushstring(L, name);
- lua_call(L, 1, 1);
- /* restore package.path */
- lua_getglobal(L,"package");
- lua_pushstring(L,path_saved);
- lua_setfield(L,-2,"cpath");
- lua_pop(L,1); /* pop "package" */
- free(extensionless);
- free(total);
- free(temp_name);
- return 1;
- }
-}
-
-@ Setting up the new search functions.
-
-This replaces package.searchers[2] and package.searchers[3] with the
-functions defined above.
-
-@c
-static void setup_lua_path(lua_State * L)
-{
- lua_getglobal(L, "package");
-#ifdef LuajitTeX
- lua_getfield(L, -1, "loaders");
-#else
- lua_getfield(L, -1, "searchers");
-#endif
- lua_rawgeti(L, -1, 2); /* package.searchers[2] */
- lua_loader_function = luaL_ref(L, LUA_REGISTRYINDEX);
- lua_pushcfunction(L, luatex_kpse_lua_find);
- lua_rawseti(L, -2, 2); /* replace the normal lua loader */
-
- lua_rawgeti(L, -1, 3); /* package.searchers[3] */
- clua_loader_function = luaL_ref(L, LUA_REGISTRYINDEX);
- lua_pushcfunction(L, luatex_kpse_clua_find);
- lua_rawseti(L, -2, 3); /* replace the normal lua lib loader */
-
- lua_pop(L, 2); /* pop the array and table */
-}
-
-@ helper variables for the safe keeping of table ids
-
-@c
-int tex_table_id;
-int pdf_table_id;
-int token_table_id;
-int node_table_id;
-
-@ @c
-int l_pack_type_index [PACK_TYPE_SIZE] ;
-int l_group_code_index [GROUP_CODE_SIZE];
-int l_local_par_index [LOCAL_PAR_SIZE];
-int l_math_style_name_index [MATH_STYLE_NAME_SIZE];
-int l_dir_par_index [DIR_PAR_SIZE];
-int l_dir_text_index [DIR_TEXT_SIZE];
-
-int img_parms [img_parms_max];
-int img_pageboxes [img_pageboxes_max];
-
-int lua_show_valid_list(lua_State *L, const char **list, int max)
-{
- int i;
- lua_newtable(L);
- for (i = 0; i < max; i++) {
- lua_pushinteger(L,i+1);
- lua_pushstring(L, list[i]);
- lua_settable(L, -3);
- }
- return 1;
-}
-
-int lua_show_valid_keys(lua_State *L, int *list, int max)
-{
- int i;
- lua_newtable(L);
- for (i = 0; i < max; i++) {
- lua_pushinteger(L,i+1);
- lua_rawgeti(L, LUA_REGISTRYINDEX, list[i]);
- lua_settable(L, -3);
- }
- return 1;
-}
-
-#if defined(WIN32) || defined(__MINGW32__) || defined(__CYGWIN__)
-char **suffixlist;
-
-# define EXE_SUFFIXES ".com;.exe;.bat;.cmd;.vbs;.vbe;.js;.jse;.wsf;.wsh;.ws;.tcl;.py;.pyw"
-
-@ @c
-static void mk_suffixlist(void)
-{
- char **p;
- char *q, *r, *v;
- int n;
-
-# if defined(__CYGWIN__)
- v = xstrdup(EXE_SUFFIXES);
-# else
- v = (char *) getenv("PATHEXT");
- if (v) /* strlwr() exists also in MingW */
- v = (char *) strlwr(xstrdup(v));
- else
- v = xstrdup(EXE_SUFFIXES);
-# endif
-
- q = v;
- n = 0;
-
- while ((r = strchr(q, ';')) != NULL) {
- n++;
- r++;
- q = r;
- }
- if (*q)
- n++;
- suffixlist = (char **) xmalloc((n + 2) * sizeof(char *));
- p = suffixlist;
- *p = xstrdup(".dll");
- p++;
- q = v;
- while ((r = strchr(q, ';')) != NULL) {
- *r = '\0';
- *p = xstrdup(q);
- p++;
- r++;
- q = r;
- }
- if (*q) {
- *p = xstrdup(q);
- p++;
- }
- *p = NULL;
- free(v);
-}
-#endif
-
-@ @c
-void lua_initialize(int ac, char **av)
-{
- char *given_file = NULL;
- char *banner;
- /*int kpse_init;*/
- size_t len;
- int starttime;
- int utc;
- static char LC_CTYPE_C[] = "LC_CTYPE=C";
- static char LC_COLLATE_C[] = "LC_COLLATE=C";
- static char LC_NUMERIC_C[] = "LC_NUMERIC=C";
- static char engine_luatex[] = "engine=" my_name;
- /* Save to pass along to topenin. */
- const char *fmt = "This is " MyName ", Version %s" WEB2CVERSION;
- argc = ac;
- argv = av;
- len = strlen(fmt) + strlen(luatex_version_string) ;
- banner = xmalloc(len);
- sprintf(banner, fmt, luatex_version_string);
- luatex_banner = banner;
- kpse_invocation_name = kpse_program_basename(argv[0]);
-
- /* be 'luac' */
- if (argc >1) {
-#ifdef LuajitTeX
- if (FILESTRCASEEQ(kpse_invocation_name, "texluajitc"))
- exit(luac_main(ac, av));
- if (STREQ(argv[1], "--luaconly") || STREQ(argv[1], "--luac")) {
- char *argv1 = xmalloc (strlen ("luajittex") + 1);
- av[1] = argv1;
- strcpy (av[1], "luajittex");
- exit(luac_main(--ac, ++av));
- }
-#else
- if (FILESTRCASEEQ(kpse_invocation_name, "texluac"))
- exit(luac_main(ac, av));
- if (STREQ(argv[1], "--luaconly") || STREQ(argv[1], "--luac")) {
- strcpy(av[1], "luatex");
- exit(luac_main(--ac, ++av));
- }
-#endif
- }
-#if defined(WIN32) || defined(__MINGW32__) || defined(__CYGWIN__)
- mk_suffixlist();
-#endif
-
- /* Must be initialized before options are parsed. */
- interactionoption = 4;
- dump_name = NULL;
-
- /* 0 means "disable Synchronize TeXnology".
- synctexoption is a *.web variable.
- We initialize it to a weird value to catch the -synctex command line flag
- At runtime, if synctexoption is not |INT_MAX|, then it contains the command line option provided,
- otherwise no such option was given by the user. */
-#define SYNCTEX_NO_OPTION INT_MAX
- synctexoption = SYNCTEX_NO_OPTION;
-
- /* parse commandline */
- parse_options(ac, av);
- if (lua_only)
- shellenabledp = true;
-
- /* make sure that the locale is 'sane' (for lua) */
-
- putenv(LC_CTYPE_C);
- putenv(LC_COLLATE_C);
- putenv(LC_NUMERIC_C);
-
- /* this is sometimes needed */
- putenv(engine_luatex);
-
- luainterpreter();
-
- /* init internalized strings */
- set_init_keys;
-
- lua_pushstring(Luas,"lua.functions");
- lua_newtable(Luas);
- lua_settable(Luas,LUA_REGISTRYINDEX);
-
- /* here start the key definitions */
- set_l_pack_type_index;
- set_l_group_code_index;
- set_l_local_par_index;
- set_l_math_style_name_index;
- set_l_dir_par_index;
- set_l_dir_text_index;
-
- set_l_img_keys_index;
- set_l_img_pageboxes_index;
-
- prepare_cmdline(Luas, argv, argc, lua_offset); /* collect arguments */
- setup_lua_path(Luas);
-
- if (startup_filename != NULL) {
- given_file = xstrdup(startup_filename);
- if (lua_only) {
- xfree(startup_filename);
- }
- startup_filename = find_filename(given_file, "LUATEXDIR");
- }
- /* now run the file */
- if (startup_filename != NULL) {
- char *v1;
- /* hide the 'tex' and 'pdf' table */
- tex_table_id = hide_lua_table(Luas, "tex");
- token_table_id = hide_lua_table(Luas, "token");
- node_table_id = hide_lua_table(Luas, "node");
- pdf_table_id = hide_lua_table(Luas, "pdf");
-
- if (luaL_loadfile(Luas, startup_filename)) {
- fprintf(stdout, "%s\n", lua_tostring(Luas, -1));
- exit(1);
- }
- /* */
- init_tex_table(Luas);
- if (lua_pcall(Luas, 0, 0, 0)) {
- fprintf(stdout, "%s\n", lua_tostring(Luas, -1));
- lua_traceback(Luas);
- exit(1);
- }
- /* no filename? quit now! */
- if (!input_name) {
- get_lua_string("texconfig", "jobname", &input_name);
- }
- if (!dump_name) {
- get_lua_string("texconfig", "formatname", &dump_name);
- }
- if (lua_only) {
- if (given_file)
- free(given_file);
- /* this is not strictly needed but it pleases valgrind */
- lua_close(Luas);
- exit(0);
- }
- /* unhide the 'tex' and 'pdf' table */
- unhide_lua_table(Luas, "tex", tex_table_id);
- unhide_lua_table(Luas, "pdf", pdf_table_id);
- unhide_lua_table(Luas, "token", token_table_id);
- unhide_lua_table(Luas, "node", node_table_id);
-
- /* |kpse_init| */
- kpse_init = -1;
- get_lua_boolean("texconfig", "kpse_init", &kpse_init);
-
- if (kpse_init != 0) {
- luainit = 0; /* re-enable loading of texmf.cnf values, see luatex.ch */
- init_kpse();
- }
- /* |prohibit_file_trace| (boolean) */
- tracefilenames = 1;
- get_lua_boolean("texconfig", "trace_file_names", &tracefilenames);
-
- /* |file_line_error| */
- filelineerrorstylep = false;
- get_lua_boolean("texconfig", "file_line_error", &filelineerrorstylep);
-
- /* |halt_on_error| */
- haltonerrorp = false;
- get_lua_boolean("texconfig", "halt_on_error", &haltonerrorp);
-
- /* |restrictedshell| */
- v1 = NULL;
- get_lua_string("texconfig", "shell_escape", &v1);
- if (v1) {
- if (*v1 == 't' || *v1 == 'y' || *v1 == '1') {
- shellenabledp = 1;
- } else if (*v1 == 'p') {
- shellenabledp = 1;
- restrictedshell = 1;
- }
- free(v1);
- }
- /* If shell escapes are restricted, get allowed cmds from cnf. */
- if (shellenabledp && restrictedshell == 1) {
- v1 = NULL;
- get_lua_string("texconfig", "shell_escape_commands", &v1);
- if (v1) {
- mk_shellcmdlist(v1);
- free(v1);
- }
- }
-
- starttime = -1 ;
- get_lua_number("texconfig", "start_time", &starttime);
- if (starttime < 0) {
- /*
- We provide this one for compatibility reasons and therefore also in
- uppercase.
- */
- get_lua_number("texconfig", "SOURCE_DATE_EPOCH", &starttime);
- }
- if (starttime >= 0) {
- set_start_time(starttime);
- }
-
- utc = -1 ;
- get_lua_boolean("texconfig", "use_utc_time", &utc);
- if (utc >= 0 && utc <= 1) {
- utc_option = utc;
- }
-
- fix_dumpname();
- } else {
- if (luainit) {
- if (given_file) {
- fprintf(stdout, "%s file %s not found\n", (lua_only ? "Script" : "Configuration"), given_file);
- free(given_file);
- } else {
- fprintf(stdout, "No %s file given\n", (lua_only ? "script" : "configuration"));
- }
- exit(1);
- } else {
- /* init */
- init_kpse();
- fix_dumpname();
- }
- }
-}
-
-@ @c
-void check_texconfig_init(void)
-{
- if (Luas != NULL) {
- lua_getglobal(Luas, "texconfig");
- if (lua_istable(Luas, -1)) {
- lua_getfield(Luas, -1, "init");
- if (lua_isfunction(Luas, -1)) {
- int i = lua_pcall(Luas, 0, 0, 0);
- if (i != 0) {
- /* Can't be more precise here, called before TeX initialization */
- fprintf(stderr, "This went wrong: %s\n", lua_tostring(Luas, -1));
- error();
- }
- }
- }
- }
-}
+% luainit.w
+%
+% Copyright 2006-2017 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
+
+#include "ptexlib.h"
+
+#include <kpathsea/c-stat.h>
+
+#include "lua/luatex-api.h"
+
+/* internalized strings: see luatex-api.h */
+set_make_keys;
+
+@
+This file is getting a bit messy, but it is not simple to fix unilaterally.
+
+Better to wait until Karl has some time (after texlive 2008) so we can
+synchronize with kpathsea. One problem, for instance, is that I would
+like to resolve the full executable path. |kpse_set_program_name()| does
+that, indirectly (by setting SELFAUTOLOC in the environment), but it
+does much more, making it hard to use for our purpose.
+
+In fact, it sets three C variables:
+
+ |kpse_invocation_name| |kpse_invocation_short_name| |kpse->program_name|
+
+and five environment variables:
+
+ SELFAUTOLOC SELFAUTODIR SELFAUTOPARENT SELFAUTOGRANDPARENT progname
+
+@c
+const_string LUATEX_IHELP[] = {
+ "Usage: " my_name " --lua=FILE [OPTION]... [TEXNAME[.tex]] [COMMANDS]",
+ " or: " my_name " --lua=FILE [OPTION]... \\FIRST-LINE",
+ " or: " my_name " --lua=FILE [OPTION]... &FMT ARGS",
+ " Run " MyName " on TEXNAME, usually creating TEXNAME.pdf.",
+ " Any remaining COMMANDS are processed as luatex input, after TEXNAME is read.",
+ "",
+ " Alternatively, if the first non-option argument begins with a backslash,",
+ " " my_name " interprets all non-option arguments as an input line.",
+ "",
+ " Alternatively, if the first non-option argument begins with a &, the",
+ " next word is taken as the FMT to read, overriding all else. Any",
+ " remaining arguments are processed as above.",
+ "",
+ " If no arguments or options are specified, prompt for input.",
+ "",
+ " The following regular options are understood: ",
+ "",
+ " --credits display credits and exit",
+ " --debug-format enable format debugging",
+ " --draftmode switch on draft mode (generates no output PDF)",
+ " --[no-]file-line-error disable/enable file:line:error style messages",
+ " --[no-]file-line-error-style aliases of --[no-]file-line-error",
+ " --fmt=FORMAT load the format file FORMAT",
+ " --halt-on-error stop processing at the first error",
+ " --help display help and exit",
+ " --ini be ini" my_name ", for dumping formats",
+ " --interaction=STRING set interaction mode (STRING=batchmode/nonstopmode/scrollmode/errorstopmode)",
+ " --jobname=STRING set the job name to STRING",
+ " --kpathsea-debug=NUMBER set path searching debugging flags according to the bits of NUMBER",
+ " --lua=FILE load and execute a lua initialization script",
+ " --[no-]mktex=FMT disable/enable mktexFMT generation (FMT=tex/tfm)",
+ " --nosocket disable the lua socket library",
+ " --output-comment=STRING use STRING for DVI file comment instead of date (no effect for PDF)",
+ " --output-directory=DIR use existing DIR as the directory to write files in",
+ " --output-format=FORMAT use FORMAT for job output; FORMAT is 'dvi' or 'pdf'",
+ " --progname=STRING set the program name to STRING",
+ " --recorder enable filename recorder",
+ " --safer disable easily exploitable lua commands",
+ " --[no-]shell-escape disable/enable system commands",
+ " --shell-restricted restrict system commands to a list of commands given in texmf.cnf",
+ " --synctex=NUMBER enable synctex",
+ " --utc init time to UTC",
+ " --version display version and exit",
+ "",
+ "Alternate behaviour models can be obtained by special switches",
+ "",
+ " --luaonly run a lua file, then exit",
+ " --luaconly byte-compile a lua file, then exit",
+ " --luahashchars the bits used by current Lua interpreter for strings hashing",
+#ifdef LuajitTeX
+ " --jiton turns the JIT compiler on (default off)",
+ " --jithash=STRING choose the hash function for the lua strings (lua51|luajit20: default lua51)",
+#endif
+ "",
+ "See the reference manual for more information about the startup process.",
+ NULL
+};
+
+/*
+ " --8bit ignored, input is assumed to be in UTF-8 encoding",
+ " --default-translate-file=FILE ignored, input is assumed to be in UTF-8 encoding",
+ " --etex ignored, the etex extensions are always active",
+ " --disable-write18 disable \\write18{SHELL COMMAND}",
+ " --enable-write18 enable \\write18{SHELL COMMAND}",
+ " --[no-]parse-first-line ignored",
+ " --translate-file=FILE ignored, input is assumed to be in UTF-8 encoding",
+*/
+
+@ The return value will be the directory of the executable, e.g.: \.{c:/TeX/bin}
+@c
+static char *ex_selfdir(char *argv0)
+{
+#if defined(WIN32)
+#if defined(__MINGW32__)
+ char path[PATH_MAX], *fp;
+
+ /* SearchPath() always gives back an absolute directory */
+ if (SearchPath(NULL, argv0, ".exe", PATH_MAX, path, NULL) == 0)
+ FATAL1("Can't determine where the executable %s is.\n", argv0);
+ /* slashify the dirname */
+ for (fp = path; fp && *fp; fp++)
+ if (IS_DIR_SEP(*fp))
+ *fp = DIR_SEP;
+#else /* __MINGW32__ */
+#define PATH_MAX 512
+ char short_path[PATH_MAX], path[PATH_MAX], *fp;
+
+ /* SearchPath() always gives back an absolute directory */
+ if (SearchPath(NULL, argv0, ".exe", PATH_MAX, short_path, &fp) == 0)
+ FATAL1("Can't determine where the executable %s is.\n", argv0);
+ if (getlongpath(path, short_path, sizeof(path)) == 0) {
+ FATAL1("This path points to an invalid file : %s\n", short_path);
+ }
+#endif /* __MINGW32__ */
+ return xdirname(path);
+#else /* WIN32 */
+ return kpse_selfdir(argv0);
+#endif
+}
+
+@ @c
+static void prepare_cmdline(lua_State * L, char **av, int ac, int zero_offset)
+{
+ int i;
+ char *s;
+ luaL_checkstack(L, ac + 3, "too many arguments to script");
+ lua_createtable(L, 0, 0);
+ for (i = 0; i < ac; i++) {
+ lua_pushstring(L, av[i]);
+ lua_rawseti(L, -2, (i - zero_offset));
+ }
+ lua_setglobal(L, "arg");
+ lua_getglobal(L, "os");
+ s = ex_selfdir(argv[0]);
+ lua_pushstring(L, s);
+ xfree(s);
+ lua_setfield(L, -2, "selfdir");
+ return;
+}
+
+
+@ @c
+int kpse_init = -1;
+
+@ @c
+string input_name = NULL;
+
+static string user_progname = NULL;
+
+char *startup_filename = NULL;
+int lua_only = 0;
+int lua_offset = 0;
+unsigned char show_luahashchars = 0;
+
+#ifdef LuajitTeX
+int luajiton = 0;
+char *jithash_hashname = NULL;
+#endif
+
+int safer_option = 0;
+int nosocket_option = 0;
+int utc_option = 0;
+
+@ Reading the options.
+
+@ Test whether getopt found an option ``A''.
+Assumes the option index is in the variable |option_index|, and the
+option table in a variable |long_options|.
+
+@c
+#define ARGUMENT_IS(a) STREQ (long_options[option_index].name, a)
+
+/*
+ SunOS cc can't initialize automatic structs, so make this static.
+*/
+
+/*
+ Nota Bene: we still intercept some options that other engines handle
+ so that existing scripted usage will not fail.
+*/
+
+static struct option long_options[] = {
+ {"fmt", 1, 0, 0},
+ {"lua", 1, 0, 0},
+ {"luaonly", 0, 0, 0},
+ {"luahashchars", 0, 0, 0},
+#ifdef LuajitTeX
+ {"jiton", 0, 0, 0},
+ {"jithash", 1, 0, 0},
+#endif
+ {"safer", 0, &safer_option, 1},
+ {"utc", 0, &utc_option, 1},
+ {"nosocket", 0, &nosocket_option, 1},
+ {"help", 0, 0, 0},
+ {"ini", 0, &ini_version, 1},
+ {"interaction", 1, 0, 0},
+ {"halt-on-error", 0, &haltonerrorp, 1},
+ {"kpathsea-debug", 1, 0, 0},
+ {"progname", 1, 0, 0},
+ {"version", 0, 0, 0},
+ {"credits", 0, 0, 0},
+ {"recorder", 0, 0, 0},
+ {"etex", 0, 0, 0},
+ {"output-comment", 1, 0, 0},
+ {"output-directory", 1, 0, 0},
+ {"draftmode", 0, 0, 0},
+ {"output-format", 1, 0, 0},
+ {"shell-escape", 0, &shellenabledp, 1},
+ {"no-shell-escape", 0, &shellenabledp, -1},
+ {"enable-write18", 0, &shellenabledp, 1},
+ {"disable-write18", 0, &shellenabledp, -1},
+ {"shell-restricted", 0, 0, 0},
+ {"debug-format", 0, &debug_format_file, 1},
+ {"file-line-error-style", 0, &filelineerrorstylep, 1},
+ {"no-file-line-error-style", 0, &filelineerrorstylep, -1},
+
+ /* Shorter option names for the above. */
+
+ {"file-line-error", 0, &filelineerrorstylep, 1},
+ {"no-file-line-error", 0, &filelineerrorstylep, -1},
+ {"jobname", 1, 0, 0},
+ {"parse-first-line", 0, &parsefirstlinep, 1},
+ {"no-parse-first-line", 0, &parsefirstlinep, -1},
+ {"translate-file", 1, 0, 0},
+ {"default-translate-file", 1, 0, 0},
+ {"8bit", 0, 0, 0},
+ {"mktex", 1, 0, 0},
+ {"no-mktex", 1, 0, 0},
+
+ /* Synchronization: just like "interaction" above */
+
+ {"synctex", 1, 0, 0},
+ {0, 0, 0, 0}
+};
+
+@ @c
+int lua_numeric_field_by_index(lua_State * L, int name_index, int dflt)
+{
+ register int i = dflt;
+ lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
+ lua_rawget(L, -2);
+ if (lua_type(L, -1) == LUA_TNUMBER) {
+ i = lua_roundnumber(L, -1);
+ }
+ lua_pop(L, 1);
+ return i;
+}
+
+@ @c
+unsigned int lua_unsigned_numeric_field_by_index(lua_State * L, int name_index, int dflt)
+{
+ register unsigned int i = dflt;
+ lua_rawgeti(L, LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
+ lua_rawget(L, -2);
+ if (lua_type(L, -1) == LUA_TNUMBER) {
+ i = lua_uroundnumber(L, -1);
+ }
+ lua_pop(L, 1);
+ return i;
+}
+
+@ @c
+static int recorderoption = 0;
+
+static void parse_options(int ac, char **av)
+{
+#ifdef WIN32
+/* save argc and argv */
+ int sargc = argc;
+ char **sargv = argv;
+#endif
+ int g; /* `getopt' return code. */
+ int option_index;
+ char *firstfile = NULL;
+ opterr = 0; /* dont whine */
+#ifdef LuajitTeX
+ if ((strstr(argv[0], "luajittexlua") != NULL) ||
+ (strstr(argv[0], "texluajit") != NULL)) {
+#else
+ if ((strstr(argv[0], "luatexlua") != NULL) ||
+ (strstr(argv[0], "texlua") != NULL)) {
+#endif
+ lua_only = 1;
+ luainit = 1;
+ }
+ for (;;) {
+ g = getopt_long_only(ac, av, "+", long_options, &option_index);
+
+ if (g == -1) /* End of arguments, exit the loop. */
+ break;
+ if (g == '?') { /* Unknown option. */
+ if (!luainit)
+ fprintf(stderr,"%s: unrecognized option '%s'\n", argv[0], argv[optind-1]);
+ continue;
+ }
+
+ assert(g == 0); /* We have no short option names. */
+
+ if (ARGUMENT_IS("luaonly")) {
+ lua_only = 1;
+ lua_offset = optind;
+ luainit = 1;
+ } else if (ARGUMENT_IS("lua")) {
+ startup_filename = optarg;
+ lua_offset = (optind - 1);
+ luainit = 1;
+#ifdef LuajitTeX
+ } else if (ARGUMENT_IS("jiton")) {
+ luajiton = 1;
+ } else if (ARGUMENT_IS("jithash")) {
+ size_t len = strlen(optarg);
+ if (len<16) {
+ jithash_hashname = optarg;
+ } else {
+ WARNING2("hash name truncated to 15 characters from %d. (%s)", (int) len, optarg);
+ jithash_hashname = (string) xmalloc(16);
+ strncpy(jithash_hashname, optarg, 15);
+ jithash_hashname[15] = 0;
+ }
+#endif
+ } else if (ARGUMENT_IS("luahashchars")) {
+ show_luahashchars = 1;
+ } else if (ARGUMENT_IS("kpathsea-debug")) {
+ kpathsea_debug |= atoi(optarg);
+ } else if (ARGUMENT_IS("progname")) {
+ user_progname = optarg;
+ } else if (ARGUMENT_IS("jobname")) {
+ c_job_name = optarg;
+ } else if (ARGUMENT_IS("fmt")) {
+ dump_name = optarg;
+ } else if (ARGUMENT_IS("output-directory")) {
+ output_directory = optarg;
+ } else if (ARGUMENT_IS("output-comment")) {
+ size_t len = strlen(optarg);
+ if (len < 256) {
+ output_comment = optarg;
+ } else {
+ WARNING2("Comment truncated to 255 characters from %d. (%s)", (int) len, optarg);
+ output_comment = (string) xmalloc(256);
+ strncpy(output_comment, optarg, 255);
+ output_comment[255] = 0;
+ }
+ } else if (ARGUMENT_IS("shell-restricted")) {
+ shellenabledp = 1;
+ restrictedshell = 1;
+ } else if (ARGUMENT_IS("output-format")) {
+ output_mode_option = 1;
+ if (strcmp(optarg, "dvi") == 0) {
+ output_mode_value = 0;
+ } else if (strcmp(optarg, "pdf") == 0) {
+ output_mode_value = 1;
+ } else {
+ WARNING1("Ignoring unknown value `%s' for --output-format",optarg);
+ output_mode_option = 0;
+ }
+ } else if (ARGUMENT_IS("draftmode")) {
+ draft_mode_option = 1;
+ draft_mode_value = 1;
+ } else if (ARGUMENT_IS("mktex")) {
+ kpse_maketex_option(optarg, true);
+ } else if (ARGUMENT_IS("no-mktex")) {
+ kpse_maketex_option(optarg, false);
+ } else if (ARGUMENT_IS("interaction")) {
+ /* These numbers match CPP defines */
+ if (STREQ(optarg, "batchmode")) {
+ interactionoption = 0;
+ } else if (STREQ(optarg, "nonstopmode")) {
+ interactionoption = 1;
+ } else if (STREQ(optarg, "scrollmode")) {
+ interactionoption = 2;
+ } else if (STREQ(optarg, "errorstopmode")) {
+ interactionoption = 3;
+ } else {
+ WARNING1("Ignoring unknown argument `%s' to --interaction", optarg);
+ }
+ } else if (ARGUMENT_IS("synctex")) {
+ /* Synchronize TeXnology: catching the command line option as a long */
+ synctexoption = (int) strtol(optarg, NULL, 0);
+ } else if (ARGUMENT_IS("recorder")) {
+ recorderoption = 1 ;
+ } else if (ARGUMENT_IS("help")) {
+ usagehelp(LUATEX_IHELP, BUG_ADDRESS);
+ } else if (ARGUMENT_IS("version")) {
+ print_version_banner();
+ /* *INDENT-OFF* */
+ puts("\n\nExecute '" my_name " --credits' for credits and version details.\n\n"
+ "There is NO warranty. Redistribution of this software is covered by\n"
+ "the terms of the GNU General Public License, version 2 or (at your option)\n"
+ "any later version. For more information about these matters, see the file\n"
+ "named COPYING and the LuaTeX source.\n\n"
+ "LuaTeX is Copyright 2017 Taco Hoekwater and the LuaTeX Team.\n");
+ /* *INDENT-ON* */
+ uexit(0);
+ } else if (ARGUMENT_IS("credits")) {
+ char *versions;
+ initversionstring(&versions);
+ print_version_banner();
+ /* *INDENT-OFF* */
+ puts("\n\nThe LuaTeX team is Hans Hagen, Hartmut Henkel, Taco Hoekwater, Luigi Scarso.\n\n"
+ MyName " merges and builds upon (parts of) the code from these projects:\n\n"
+ "tex : Donald Knuth\n"
+ "etex : Peter Breitenlohner, Phil Taylor and friends\n"
+ "omega : John Plaice and Yannis Haralambous\n"
+ "aleph : Giuseppe Bilotta\n"
+ "pdftex : Han The Thanh and friends\n"
+ "kpathsea : Karl Berry, Olaf Weber and others\n"
+ "lua : Roberto Ierusalimschy, Waldemar Celes and Luiz Henrique de Figueiredo\n"
+ "metapost : John Hobby, Taco Hoekwater and friends\n"
+ "poppler : Derek Noonburg, Kristian H\\ogsberg (partial)\n"
+ "fontforge : George Williams (partial)\n"
+ "luajit : Mike Pall (used in LuajitTeX)\n");
+ /* *INDENT-ON* */
+ puts(versions);
+ uexit(0);
+ }
+ }
+ /* attempt to find |input_name| / |dump_name| */
+ if (lua_only) {
+ if (argv[optind]) {
+ startup_filename = xstrdup(argv[optind]);
+ lua_offset = optind;
+ }
+ } else if (argv[optind] && argv[optind][0] == '&') {
+ dump_name = xstrdup(argv[optind] + 1);
+ } else if (argv[optind] && argv[optind][0] != '\\') {
+ if (argv[optind][0] == '*') {
+ input_name = xstrdup(argv[optind] + 1);
+ } else {
+ firstfile = xstrdup(argv[optind]);
+ if ((strstr(firstfile, ".lua") ==
+ firstfile + strlen(firstfile) - 4)
+ || (strstr(firstfile, ".luc") ==
+ firstfile + strlen(firstfile) - 4)
+ || (strstr(firstfile, ".LUA") ==
+ firstfile + strlen(firstfile) - 4)
+ || (strstr(firstfile, ".LUC") ==
+ firstfile + strlen(firstfile) - 4)) {
+ if (startup_filename == NULL) {
+ startup_filename = firstfile;
+ lua_offset = optind;
+ lua_only = 1;
+ luainit = 1;
+ }
+ } else {
+ input_name = firstfile;
+ }
+ }
+#ifdef WIN32
+ } else if (sargc > 1 && sargv[sargc-1] && sargv[sargc-1][0] != '-' &&
+ sargv[sargc-1][0] != '\\') {
+ if (sargv[sargc-1][0] == '&')
+ dump_name = xstrdup(sargv[sargc-1] + 1);
+ else {
+ if (sargv[sargc-1][0] == '*')
+ input_name = xstrdup(sargv[sargc-1] + 1);
+ else
+ input_name = xstrdup(sargv[sargc-1]);
+ sargv[sargc-1] = normalize_quotes(input_name, "argument");
+ }
+ if (safer_option) /* --safer implies --nosocket */
+ nosocket_option = 1;
+ return;
+#endif
+ }
+ if (safer_option) /* --safer implies --nosocket */
+ nosocket_option = 1;
+ /* Finalize the input filename. */
+ if (input_name != NULL) {
+ argv[optind] = normalize_quotes(input_name, "argument");
+ }
+}
+
+@ test for readability
+@c
+#define is_readable(a) (stat(a,&finfo)==0) && S_ISREG(finfo.st_mode) && \
+ (f=fopen(a,"r")) != NULL && !fclose(f)
+
+@ @c
+static char *find_filename(char *name, const char *envkey)
+{
+ struct stat finfo;
+ char *dirname = NULL;
+ char *filename = NULL;
+ FILE *f;
+ if (is_readable(name)) {
+ return name;
+ } else {
+ dirname = getenv(envkey);
+ if ((dirname != NULL) && strlen(dirname)) {
+ dirname = xstrdup(getenv(envkey));
+ if (*(dirname + strlen(dirname) - 1) == '/') {
+ *(dirname + strlen(dirname) - 1) = 0;
+ }
+ filename = xmalloc((unsigned) (strlen(dirname) + strlen(name) + 2));
+ filename = concat3(dirname, "/", name);
+ xfree(dirname);
+ if (is_readable(filename)) {
+ return filename;
+ }
+ xfree(filename);
+ }
+ }
+ return NULL;
+}
+
+@ @c
+
+static void init_kpse(void)
+{
+ if (!user_progname) {
+ user_progname = dump_name;
+ } else if (!dump_name) {
+ dump_name = user_progname;
+ }
+ if (!user_progname) {
+ if (ini_version) {
+ if (input_name) {
+ char *p = input_name + strlen(input_name) - 1;
+ while (p >= input_name) {
+ if (IS_DIR_SEP (*p)) {
+ p++;
+ input_name = p;
+ break;
+ }
+ p--;
+ }
+ user_progname = remove_suffix (input_name);
+ }
+ if (!user_progname) {
+ user_progname = kpse_program_basename(argv[0]);
+ }
+ } else {
+ if (!dump_name) {
+ dump_name = kpse_program_basename(argv[0]);
+ }
+ user_progname = dump_name;
+ }
+ }
+ kpse_set_program_enabled(kpse_fmt_format, MAKE_TEX_FMT_BY_DEFAULT,
+ kpse_src_compile);
+
+ kpse_set_program_name(argv[0], user_progname);
+ init_shell_escape(); /* set up 'restrictedshell' */
+ init_start_time();
+ program_name_set = 1 ;
+ if (recorderoption) {
+ recorder_enabled = 1;
+ }
+}
+
+@ @c
+static void fix_dumpname(void)
+{
+ int dist;
+ if (dump_name) {
+ /* adjust array for Pascal and provide extension, if needed */
+ dist = (int) (strlen(dump_name) - strlen(DUMP_EXT));
+ if (strstr(dump_name, DUMP_EXT) == dump_name + dist)
+ TEX_format_default = dump_name;
+ else
+ TEX_format_default = concat(dump_name, DUMP_EXT);
+ } else {
+ /* For |dump_name| to be NULL is a bug. */
+ if (!ini_version) {
+ fprintf(stdout, "no format given, quitting\n");
+ exit(1);
+ }
+ }
+}
+
+@ lua require patch
+
+@ Auxiliary function for kpse search
+
+@c
+static const char *luatex_kpse_find_aux(lua_State *L, const char *name,
+ kpse_file_format_type format, const char *errname)
+{
+ const char *filename;
+ const char *altname;
+ altname = luaL_gsub(L, name, ".", "/"); /* Lua convention */
+ filename = kpse_find_file(altname, format, false);
+ if (filename == NULL) {
+ filename = kpse_find_file(name, format, false);
+ }
+ if (filename == NULL) {
+ lua_pushfstring(L, "\n\t[kpse %s searcher] file not found: " LUA_QS, errname, name);
+ }
+ return filename;
+}
+
+@ The lua search function.
+
+When kpathsea is not initialized, then it runs the
+normal lua function that is saved in the registry, otherwise
+it uses kpathsea.
+
+two registry ref variables are needed: one for the actual lua
+function, the other for its environment .
+
+@c
+static int lua_loader_function = 0;
+
+static int luatex_kpse_lua_find(lua_State * L)
+{
+ const char *filename;
+ const char *name;
+ name = luaL_checkstring(L, 1);
+ if (program_name_set == 0) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, lua_loader_function);
+ lua_pushvalue(L, -2);
+ lua_call(L, 1, 1);
+ return 1;
+ }
+ filename = luatex_kpse_find_aux(L, name, kpse_lua_format, "lua");
+ if (filename == NULL)
+ return 1; /* library not found in this path */
+ if (luaL_loadfile(L, filename) != 0) {
+ luaL_error(L, "error loading module %s from file %s:\n\t%s",
+ lua_tostring(L, 1), filename, lua_tostring(L, -1));
+ }
+ return 1; /* library loaded successfully */
+}
+
+@ @c
+static int clua_loader_function = 0;
+extern int searcher_C_luatex (lua_State *L, const char *name, const char *filename);
+
+static int luatex_kpse_clua_find(lua_State * L)
+{
+ const char *filename;
+ const char *name;
+ if (safer_option) {
+ lua_pushliteral(L, "\n\t[C searcher disabled in safer mode]");
+ return 1; /* library not found in this path */
+ }
+ name = luaL_checkstring(L, 1);
+ if (program_name_set == 0) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, clua_loader_function);
+ lua_pushvalue(L, -2);
+ lua_call(L, 1, 1);
+ return 1;
+ } else {
+ const char *path_saved;
+ char *prefix, *postfix, *p, *total;
+ char *extensionless;
+ char *temp_name;
+ int j;
+ filename = luatex_kpse_find_aux(L, name, kpse_clua_format, "C");
+ if (filename == NULL)
+ return 1; /* library not found in this path */
+ extensionless = strdup(filename);
+ if (!extensionless)
+ return 1; /* allocation failure */
+ /* Fix Issue 850: replace '.' with LUA_DIRSEP */
+ temp_name = strdup(name);
+ for(j=0; ; j++){
+ if ((unsigned char)temp_name[j]=='\0') {
+ break;
+ }
+ if ((unsigned char)temp_name[j]=='.'){
+ temp_name[j]=LUA_DIRSEP[0];
+ }
+ }
+ p = strstr(extensionless, temp_name);
+ if (!p) return 1; /* this would be exceedingly weird */
+ *p = '\0';
+ prefix = strdup(extensionless);
+ if (!prefix) return 1; /* allocation failure */
+ postfix = strdup(p+strlen(name));
+ if (!postfix) return 1; /* allocation failure */
+ total = malloc(strlen(prefix)+strlen(postfix)+2);
+ if (!total) return 1; /* allocation failure */
+ snprintf(total,strlen(prefix)+strlen(postfix)+2, "%s?%s", prefix, postfix);
+ /* save package.path */
+ lua_getglobal(L,"package");
+ lua_getfield(L,-1,"cpath");
+ path_saved = lua_tostring(L,-1);
+ lua_pop(L,1);
+ /* set package.path = "?" */
+ lua_pushstring(L,total);
+ lua_setfield(L,-2,"cpath");
+ lua_pop(L,1); /* pop "package" */
+ /* run function */
+ lua_rawgeti(L, LUA_REGISTRYINDEX, clua_loader_function);
+ lua_pushstring(L, name);
+ lua_call(L, 1, 1);
+ /* restore package.path */
+ lua_getglobal(L,"package");
+ lua_pushstring(L,path_saved);
+ lua_setfield(L,-2,"cpath");
+ lua_pop(L,1); /* pop "package" */
+ free(extensionless);
+ free(total);
+ free(temp_name);
+ return 1;
+ }
+}
+
+@ Setting up the new search functions.
+
+This replaces package.searchers[2] and package.searchers[3] with the
+functions defined above.
+
+@c
+static void setup_lua_path(lua_State * L)
+{
+ lua_getglobal(L, "package");
+#ifdef LuajitTeX
+ lua_getfield(L, -1, "loaders");
+#else
+ lua_getfield(L, -1, "searchers");
+#endif
+ lua_rawgeti(L, -1, 2); /* package.searchers[2] */
+ lua_loader_function = luaL_ref(L, LUA_REGISTRYINDEX);
+ lua_pushcfunction(L, luatex_kpse_lua_find);
+ lua_rawseti(L, -2, 2); /* replace the normal lua loader */
+
+ lua_rawgeti(L, -1, 3); /* package.searchers[3] */
+ clua_loader_function = luaL_ref(L, LUA_REGISTRYINDEX);
+ lua_pushcfunction(L, luatex_kpse_clua_find);
+ lua_rawseti(L, -2, 3); /* replace the normal lua lib loader */
+
+ lua_pop(L, 2); /* pop the array and table */
+}
+
+@ helper variables for the safe keeping of table ids
+
+@c
+int tex_table_id;
+int pdf_table_id;
+int token_table_id;
+int node_table_id;
+
+@ @c
+int l_pack_type_index [PACK_TYPE_SIZE] ;
+int l_group_code_index [GROUP_CODE_SIZE];
+int l_local_par_index [LOCAL_PAR_SIZE];
+int l_math_style_name_index [MATH_STYLE_NAME_SIZE];
+int l_dir_par_index [DIR_PAR_SIZE];
+int l_dir_text_index [DIR_TEXT_SIZE];
+
+int img_parms [img_parms_max];
+int img_pageboxes [img_pageboxes_max];
+
+int lua_show_valid_list(lua_State *L, const char **list, int max)
+{
+ int i;
+ lua_newtable(L);
+ for (i = 0; i < max; i++) {
+ lua_pushinteger(L,i+1);
+ lua_pushstring(L, list[i]);
+ lua_settable(L, -3);
+ }
+ return 1;
+}
+
+int lua_show_valid_keys(lua_State *L, int *list, int max)
+{
+ int i;
+ lua_newtable(L);
+ for (i = 0; i < max; i++) {
+ lua_pushinteger(L,i+1);
+ lua_rawgeti(L, LUA_REGISTRYINDEX, list[i]);
+ lua_settable(L, -3);
+ }
+ return 1;
+}
+
+#if defined(WIN32) || defined(__MINGW32__) || defined(__CYGWIN__)
+char **suffixlist;
+
+# define EXE_SUFFIXES ".com;.exe;.bat;.cmd;.vbs;.vbe;.js;.jse;.wsf;.wsh;.ws;.tcl;.py;.pyw"
+
+@ @c
+static void mk_suffixlist(void)
+{
+ char **p;
+ char *q, *r, *v;
+ int n;
+
+# if defined(__CYGWIN__)
+ v = xstrdup(EXE_SUFFIXES);
+# else
+ v = (char *) getenv("PATHEXT");
+ if (v) /* strlwr() exists also in MingW */
+ v = (char *) strlwr(xstrdup(v));
+ else
+ v = xstrdup(EXE_SUFFIXES);
+# endif
+
+ q = v;
+ n = 0;
+
+ while ((r = strchr(q, ';')) != NULL) {
+ n++;
+ r++;
+ q = r;
+ }
+ if (*q)
+ n++;
+ suffixlist = (char **) xmalloc((n + 2) * sizeof(char *));
+ p = suffixlist;
+ *p = xstrdup(".dll");
+ p++;
+ q = v;
+ while ((r = strchr(q, ';')) != NULL) {
+ *r = '\0';
+ *p = xstrdup(q);
+ p++;
+ r++;
+ q = r;
+ }
+ if (*q) {
+ *p = xstrdup(q);
+ p++;
+ }
+ *p = NULL;
+ free(v);
+}
+#endif
+
+@ @c
+void lua_initialize(int ac, char **av)
+{
+ char *given_file = NULL;
+ char *banner;
+ /*int kpse_init;*/
+ size_t len;
+ int starttime;
+ int utc;
+ static char LC_CTYPE_C[] = "LC_CTYPE=C";
+ static char LC_COLLATE_C[] = "LC_COLLATE=C";
+ static char LC_NUMERIC_C[] = "LC_NUMERIC=C";
+ static char engine_luatex[] = "engine=" my_name;
+ /* Save to pass along to topenin. */
+ const char *fmt = "This is " MyName ", Version %s" WEB2CVERSION;
+ argc = ac;
+ argv = av;
+ len = strlen(fmt) + strlen(luatex_version_string) ;
+ banner = xmalloc(len);
+ sprintf(banner, fmt, luatex_version_string);
+ luatex_banner = banner;
+ kpse_invocation_name = kpse_program_basename(argv[0]);
+
+ /* be 'luac' */
+ if (argc >1) {
+#ifdef LuajitTeX
+ if (FILESTRCASEEQ(kpse_invocation_name, "texluajitc"))
+ exit(luac_main(ac, av));
+ if (STREQ(argv[1], "--luaconly") || STREQ(argv[1], "--luac")) {
+ char *argv1 = xmalloc (strlen ("luajittex") + 1);
+ av[1] = argv1;
+ strcpy (av[1], "luajittex");
+ exit(luac_main(--ac, ++av));
+ }
+#else
+ if (FILESTRCASEEQ(kpse_invocation_name, "texluac"))
+ exit(luac_main(ac, av));
+ if (STREQ(argv[1], "--luaconly") || STREQ(argv[1], "--luac")) {
+ strcpy(av[1], "luatex");
+ exit(luac_main(--ac, ++av));
+ }
+#endif
+ }
+#if defined(WIN32) || defined(__MINGW32__) || defined(__CYGWIN__)
+ mk_suffixlist();
+#endif
+
+ /* Must be initialized before options are parsed. */
+ interactionoption = 4;
+ dump_name = NULL;
+
+ /* 0 means "disable Synchronize TeXnology".
+ synctexoption is a *.web variable.
+ We initialize it to a weird value to catch the -synctex command line flag
+ At runtime, if synctexoption is not |INT_MAX|, then it contains the command line option provided,
+ otherwise no such option was given by the user. */
+#define SYNCTEX_NO_OPTION INT_MAX
+ synctexoption = SYNCTEX_NO_OPTION;
+
+ /* parse commandline */
+ parse_options(ac, av);
+ if (lua_only)
+ shellenabledp = true;
+
+ /* make sure that the locale is 'sane' (for lua) */
+
+ putenv(LC_CTYPE_C);
+ putenv(LC_COLLATE_C);
+ putenv(LC_NUMERIC_C);
+
+ /* this is sometimes needed */
+ putenv(engine_luatex);
+
+ luainterpreter();
+
+ /* init internalized strings */
+ set_init_keys;
+
+ lua_pushstring(Luas,"lua.functions");
+ lua_newtable(Luas);
+ lua_settable(Luas,LUA_REGISTRYINDEX);
+
+ /* here start the key definitions */
+ set_l_pack_type_index;
+ set_l_group_code_index;
+ set_l_local_par_index;
+ set_l_math_style_name_index;
+ set_l_dir_par_index;
+ set_l_dir_text_index;
+
+ set_l_img_keys_index;
+ set_l_img_pageboxes_index;
+
+ prepare_cmdline(Luas, argv, argc, lua_offset); /* collect arguments */
+ setup_lua_path(Luas);
+
+ if (startup_filename != NULL) {
+ given_file = xstrdup(startup_filename);
+ if (lua_only) {
+ xfree(startup_filename);
+ }
+ startup_filename = find_filename(given_file, "LUATEXDIR");
+ }
+ /* now run the file */
+ if (startup_filename != NULL) {
+ char *v1;
+ /* hide the 'tex' and 'pdf' table */
+ tex_table_id = hide_lua_table(Luas, "tex");
+ token_table_id = hide_lua_table(Luas, "token");
+ node_table_id = hide_lua_table(Luas, "node");
+ pdf_table_id = hide_lua_table(Luas, "pdf");
+
+ if (luaL_loadfile(Luas, startup_filename)) {
+ fprintf(stdout, "%s\n", lua_tostring(Luas, -1));
+ exit(1);
+ }
+ /* */
+ init_tex_table(Luas);
+ if (lua_pcall(Luas, 0, 0, 0)) {
+ fprintf(stdout, "%s\n", lua_tostring(Luas, -1));
+ lua_traceback(Luas);
+ exit(1);
+ }
+ /* no filename? quit now! */
+ if (!input_name) {
+ get_lua_string("texconfig", "jobname", &input_name);
+ }
+ if (!dump_name) {
+ get_lua_string("texconfig", "formatname", &dump_name);
+ }
+ if (lua_only) {
+ if (given_file)
+ free(given_file);
+ /* this is not strictly needed but it pleases valgrind */
+ lua_close(Luas);
+ exit(0);
+ }
+ /* unhide the 'tex' and 'pdf' table */
+ unhide_lua_table(Luas, "tex", tex_table_id);
+ unhide_lua_table(Luas, "pdf", pdf_table_id);
+ unhide_lua_table(Luas, "token", token_table_id);
+ unhide_lua_table(Luas, "node", node_table_id);
+
+ /* |kpse_init| */
+ kpse_init = -1;
+ get_lua_boolean("texconfig", "kpse_init", &kpse_init);
+
+ if (kpse_init != 0) {
+ luainit = 0; /* re-enable loading of texmf.cnf values, see luatex.ch */
+ init_kpse();
+ }
+ /* |prohibit_file_trace| (boolean) */
+ tracefilenames = 1;
+ get_lua_boolean("texconfig", "trace_file_names", &tracefilenames);
+
+ /* |file_line_error| */
+ filelineerrorstylep = false;
+ get_lua_boolean("texconfig", "file_line_error", &filelineerrorstylep);
+
+ /* |halt_on_error| */
+ haltonerrorp = false;
+ get_lua_boolean("texconfig", "halt_on_error", &haltonerrorp);
+
+ /* |restrictedshell| */
+ v1 = NULL;
+ get_lua_string("texconfig", "shell_escape", &v1);
+ if (v1) {
+ if (*v1 == 't' || *v1 == 'y' || *v1 == '1') {
+ shellenabledp = 1;
+ } else if (*v1 == 'p') {
+ shellenabledp = 1;
+ restrictedshell = 1;
+ }
+ free(v1);
+ }
+ /* If shell escapes are restricted, get allowed cmds from cnf. */
+ if (shellenabledp && restrictedshell == 1) {
+ v1 = NULL;
+ get_lua_string("texconfig", "shell_escape_commands", &v1);
+ if (v1) {
+ mk_shellcmdlist(v1);
+ free(v1);
+ }
+ }
+
+ starttime = -1 ;
+ get_lua_number("texconfig", "start_time", &starttime);
+ if (starttime < 0) {
+ /*
+ We provide this one for compatibility reasons and therefore also in
+ uppercase.
+ */
+ get_lua_number("texconfig", "SOURCE_DATE_EPOCH", &starttime);
+ }
+ if (starttime >= 0) {
+ set_start_time(starttime);
+ }
+
+ utc = -1 ;
+ get_lua_boolean("texconfig", "use_utc_time", &utc);
+ if (utc >= 0 && utc <= 1) {
+ utc_option = utc;
+ }
+
+ fix_dumpname();
+ } else {
+ if (luainit) {
+ if (given_file) {
+ fprintf(stdout, "%s file %s not found\n", (lua_only ? "Script" : "Configuration"), given_file);
+ free(given_file);
+ } else {
+ fprintf(stdout, "No %s file given\n", (lua_only ? "script" : "configuration"));
+ }
+ exit(1);
+ } else {
+ /* init */
+ init_kpse();
+ fix_dumpname();
+ }
+ }
+}
+
+@ @c
+void check_texconfig_init(void)
+{
+ if (Luas != NULL) {
+ lua_getglobal(Luas, "texconfig");
+ if (lua_istable(Luas, -1)) {
+ lua_getfield(Luas, -1, "init");
+ if (lua_isfunction(Luas, -1)) {
+ int i = lua_pcall(Luas, 0, 0, 0);
+ if (i != 0) {
+ /* Can't be more precise here, called before TeX initialization */
+ fprintf(stderr, "This went wrong: %s\n", lua_tostring(Luas, -1));
+ error();
+ }
+ }
+ }
+ }
+}
diff --git a/Build/source/texk/web2c/luatexdir/lua/luajitstuff.w b/Build/source/texk/web2c/luatexdir/lua/luajitstuff.w
index f219d5bd654..b29de18c9b7 100644
--- a/Build/source/texk/web2c/luatexdir/lua/luajitstuff.w
+++ b/Build/source/texk/web2c/luatexdir/lua/luajitstuff.w
@@ -349,6 +349,10 @@ void luainterpreter(void)
(void) hide_lua_value(L, "lfs", "rmdir");
(void) hide_lua_value(L, "lfs", "mkdir");
}
+ /* Maybe we can extend this way to the others tables, using luac. */
+ if ( safer_option || ((shellenabledp == 0) || (shellenabledp == 1 && restrictedshell == 1)) ) {
+ (void) luaL_dostring(L,"ffi=require[[ffi]]; for k,_ in pairs(ffi) do if k~='gc' then ffi[k]=nil end ;end; ffi=nil;");
+ }
/* fprintf(stdout, "\nLuajitTeX default hash function type:%s\n", */
/* jithash_hashname); */
Luas = L;
diff --git a/Build/source/texk/web2c/luatexdir/lua/luastuff.w b/Build/source/texk/web2c/luatexdir/lua/luastuff.w
index 6fac3afbf32..69526285091 100644
--- a/Build/source/texk/web2c/luatexdir/lua/luastuff.w
+++ b/Build/source/texk/web2c/luatexdir/lua/luastuff.w
@@ -1,561 +1,567 @@
-% luastuff.w
-%
-% Copyright 2006-2013 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
-#include "ptexlib.h"
-#include "lua/luatex-api.h"
-
-@ @c
-lua_State *Luas = NULL;
-
-int luastate_bytes = 0;
-int lua_active = 0;
-
-@ @c
-void make_table(lua_State * L, const char *tab, const char *mttab, const char *getfunc,
- const char *setfunc)
-{
- /* make the table *//* |[{<tex>}]| */
- lua_pushstring(L, tab); /* |[{<tex>},"dimen"]| */
- lua_newtable(L); /* |[{<tex>},"dimen",{}]| */
- lua_settable(L, -3); /* |[{<tex>}]| */
- /* fetch it back */
- lua_pushstring(L, tab); /* |[{<tex>},"dimen"]| */
- lua_gettable(L, -2); /* |[{<tex>},{<dimen>}]| */
- /* make the meta entries */
- luaL_newmetatable(L, mttab); /* |[{<tex>},{<dimen>},{<dimen_m>}]| */
- lua_pushstring(L, "__index"); /* |[{<tex>},{<dimen>},{<dimen_m>},"__index"]| */
- lua_pushstring(L, getfunc); /* |[{<tex>},{<dimen>},{<dimen_m>},"__index","getdimen"]| */
- lua_gettable(L, -5); /* |[{<tex>},{<dimen>},{<dimen_m>},"__index",<tex.getdimen>]| */
- lua_settable(L, -3); /* |[{<tex>},{<dimen>},{<dimen_m>}]| */
- lua_pushstring(L, "__newindex"); /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex"]| */
- lua_pushstring(L, setfunc); /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex","setdimen"]| */
- lua_gettable(L, -5); /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex",<tex.setdimen>]| */
- lua_settable(L, -3); /* |[{<tex>},{<dimen>},{<dimen_m>}]| */
- lua_setmetatable(L, -2); /* |[{<tex>},{<dimen>}]| : assign the metatable */
- lua_pop(L, 1); /* |[{<tex>}]| : clean the stack */
-}
-
-@ @c
-static const char *getS(lua_State * L, void *ud, size_t * size)
-{
- LoadS *ls = (LoadS *) ud;
- (void) L;
- if (ls->size == 0)
- return NULL;
- *size = ls->size;
- ls->size = 0;
- return ls->s;
-}
-
-@ @c
-static void *my_luaalloc(void *ud, void *ptr, size_t osize, size_t nsize)
-{
- void *ret = NULL;
- (void) ud; /* for -Wunused */
- if (nsize == 0)
- free(ptr);
- else
- ret = realloc(ptr, nsize);
- luastate_bytes += (int) (nsize - osize);
- return ret;
-}
-
-@ @c
-static int my_luapanic(lua_State * L)
-{
- (void) L; /* to avoid warnings */
- fprintf(stderr, "PANIC: unprotected error in call to Lua API (%s)\n", lua_tostring(L, -1));
- return 0;
-}
-
-@ @c
-void luafunctioncall(int slot)
-{
- int i ;
- int stacktop = lua_gettop(Luas);
- lua_active++;
- lua_rawgeti(Luas, LUA_REGISTRYINDEX, lua_key_index(lua_functions));
- lua_gettable(Luas, LUA_REGISTRYINDEX);
- lua_rawgeti(Luas, -1,slot);
- if (lua_isfunction(Luas,-1)) {
- int base = lua_gettop(Luas); /* function index */
- lua_pushinteger(Luas, slot);
- lua_pushcfunction(Luas, lua_traceback); /* push traceback function */
- lua_insert(Luas, base); /* put it under chunk */
- i = lua_pcall(Luas, 1, 0, base);
- lua_remove(Luas, base); /* remove traceback function */
- if (i != 0) {
- lua_gc(Luas, LUA_GCCOLLECT, 0);
- Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
- }
- }
- lua_settop(Luas,stacktop);
- lua_active--;
-}
-
-@ @c
-static const luaL_Reg lualibs[] = {
- {"", luaopen_base},
- {"package", luaopen_package},
- {"coroutine", luaopen_coroutine},
- {"table", luaopen_table},
- {"io", open_iolibext},
- {"os", luaopen_os},
- {"string", luaopen_string},
- {"math", luaopen_math},
- {"debug", luaopen_debug},
- {"unicode", luaopen_unicode},
- {"zip", luaopen_zip},
- {"bit32", luaopen_bit32},
- {"md5", luaopen_md5},
- {"lfs", luaopen_lfs},
- {"profiler", luaopen_profiler},
- {"lpeg", luaopen_lpeg},
- {NULL, NULL}
-};
-
-@ @c
-static void do_openlibs(lua_State * L)
-{
- const luaL_Reg *lib;
- for (lib = lualibs; lib->func; lib++) {
- luaL_requiref(L, lib->name, lib->func, 1);
- lua_pop(L, 1); /* remove lib */
- }
-}
-
-@ @c
-static int load_aux (lua_State *L, int status) {
- if (status == 0) /* OK? */
- return 1;
- else {
- lua_pushnil(L);
- lua_insert(L, -2); /* put before error message */
- return 2; /* return nil plus error message */
- }
-}
-
-@ @c
-static int luatex_loadfile (lua_State *L) {
- int status = 0;
- const char *fname = luaL_optstring(L, 1, NULL);
- const char *mode = luaL_optstring(L, 2, NULL);
- int env = !lua_isnone(L, 3); /* 'env' parameter? */
- if (!lua_only && !fname && interaction == batch_mode) {
- lua_pushnil(L);
- lua_pushstring(L, "reading from stdin is disabled in batch mode");
- return 2; /* return nil plus error message */
- }
- status = luaL_loadfilex(L, fname, mode);
- if (status == LUA_OK) {
- recorder_record_input(fname);
- if (env) { /* 'env' parameter? */
- lua_pushvalue(L, 3);
- lua_setupvalue(L, -2, 1); /* set it as 1st upvalue of loaded chunk */
- }
- }
- return load_aux(L, status);
-}
-
-@ @c
-static int luatex_dofile (lua_State *L) {
- const char *fname = luaL_optstring(L, 1, NULL);
- int n = lua_gettop(L);
- if (!lua_only && !fname) {
- if (interaction == batch_mode) {
- lua_pushnil(L);
- lua_pushstring(L, "reading from stdin is disabled in batch mode");
- return 2; /* return nil plus error message */
- } else {
- tprint_nl("lua> ");
- }
- }
- if (luaL_loadfile(L, fname) != 0) lua_error(L);
- recorder_record_input(fname);
- lua_call(L, 0, LUA_MULTRET);
- return lua_gettop(L) - n;
-}
-
-@ @c
-void luainterpreter(void)
-{
- lua_State *L;
- L = lua_newstate(my_luaalloc, NULL);
- if (L == NULL) {
- fprintf(stderr, "Can't create the Lua state.\n");
- return;
- }
- lua_atpanic(L, &my_luapanic);
-
- do_openlibs(L); /* does all the 'simple' libraries */
-
- lua_pushcfunction(L,luatex_dofile);
- lua_setglobal(L, "dofile");
- lua_pushcfunction(L,luatex_loadfile);
- lua_setglobal(L, "loadfile");
-
- luatex_md5_lua_open(L);
-
- open_oslibext(L, safer_option);
-/*
- open_iolibext(L);
-*/
- open_strlibext(L);
- open_lfslibext(L);
-
- /* luasockets */
- /* socket and mime are a bit tricky to open because
- they use a load-time dependency that has to be
- worked around for luatex, where the C module is
- loaded way before the lua module.
- */
- if (!nosocket_option) {
- lua_getglobal(L, "package");
- lua_getfield(L, -1, "loaded");
- if (!lua_istable(L, -1)) {
- lua_newtable(L);
- lua_setfield(L, -2, "loaded");
- lua_getfield(L, -1, "loaded");
- }
- luaopen_socket_core(L);
- lua_setfield(L, -2, "socket.core");
- lua_pushnil(L);
- lua_setfield(L, -2, "socket"); /* package.loaded.socket = nil */
-
- luaopen_mime_core(L);
- lua_setfield(L, -2, "mime.core");
- lua_pushnil(L);
- lua_setfield(L, -2, "mime"); /* package.loaded.mime = nil */
- lua_pop(L, 2); /* pop the tables */
-
- luatex_socketlua_open(L); /* preload the pure lua modules */
- }
- /* zlib. slightly odd calling convention */
- luaopen_zlib(L);
- lua_setglobal(L, "zlib");
- luaopen_gzip(L);
-
- /* our own libraries */
- luaopen_ff(L);
- luaopen_tex(L);
- luaopen_token(L);
- luaopen_node(L);
- luaopen_texio(L);
- luaopen_kpse(L);
- luaopen_callback(L);
- luaopen_lua(L, startup_filename);
- luaopen_stats(L);
- luaopen_font(L);
- luaopen_lang(L);
- luaopen_mplib(L);
- luaopen_vf(L);
-
- /* |luaopen_pdf(L);| */
- /* environment table at |LUA_ENVIRONINDEX| needs to load this way: */
- lua_pushcfunction(L, luaopen_pdf);
- lua_pushstring(L, "pdf");
- lua_call(L, 1, 0);
-
- if (!lua_only) {
- luaL_requiref(L, "img", luaopen_img, 1);
- lua_pop(L, 1);
- }
-
- luaL_requiref(L, "epdf", luaopen_epdf, 1);
- lua_pop(L, 1);
-
- /* |luaopen_pdfscanner(L);| */
- lua_pushcfunction(L, luaopen_pdfscanner);
- lua_pushstring(L, "pdfscanner");
- lua_call(L, 1, 0);
-
- lua_createtable(L, 0, 0);
- lua_setglobal(L, "texconfig");
-
- if (safer_option) {
- /* disable some stuff if --safer */
- (void) hide_lua_value(L, "os", "execute");
- (void) hide_lua_value(L, "os", "rename");
- (void) hide_lua_value(L, "os", "remove");
- (void) hide_lua_value(L, "io", "popen");
- /* make io.open only read files */
- luaL_checkstack(L, 2, "out of stack space");
- lua_getglobal(L, "io");
- lua_getfield(L, -1, "open_ro");
- lua_setfield(L, -2, "open");
- (void) hide_lua_value(L, "io", "tmpfile");
- (void) hide_lua_value(L, "io", "output");
- (void) hide_lua_value(L, "lfs", "chdir");
- (void) hide_lua_value(L, "lfs", "lock");
- (void) hide_lua_value(L, "lfs", "touch");
- (void) hide_lua_value(L, "lfs", "rmdir");
- (void) hide_lua_value(L, "lfs", "mkdir");
- }
- Luas = L;
-}
-
-@ @c
-int hide_lua_table(lua_State * L, const char *name)
-{
- int r = 0;
- lua_getglobal(L, name);
- if (lua_istable(L, -1)) {
- r = luaL_ref(L, LUA_REGISTRYINDEX);
- lua_pushnil(L);
- lua_setglobal(L, name);
- }
- return r;
-}
-
-@ @c
-void unhide_lua_table(lua_State * L, const char *name, int r)
-{
- lua_rawgeti(L, LUA_REGISTRYINDEX, r);
- lua_setglobal(L, name);
- luaL_unref(L, LUA_REGISTRYINDEX, r);
-}
-
-@ @c
-int hide_lua_value(lua_State * L, const char *name, const char *item)
-{
- int r = 0;
- lua_getglobal(L, name);
- if (lua_istable(L, -1)) {
- lua_getfield(L, -1, item);
- r = luaL_ref(L, LUA_REGISTRYINDEX);
- lua_pushnil(L);
- lua_setfield(L, -2, item);
- }
- return r;
-}
-
-@ @c
-void unhide_lua_value(lua_State * L, const char *name, const char *item, int r)
-{
- lua_getglobal(L, name);
- if (lua_istable(L, -1)) {
- lua_rawgeti(L, LUA_REGISTRYINDEX, r);
- lua_setfield(L, -2, item);
- luaL_unref(L, LUA_REGISTRYINDEX, r);
- }
-}
-
-@ @c
-int lua_traceback(lua_State * L)
-{
- lua_getglobal(L, "debug");
- if (!lua_istable(L, -1)) {
- lua_pop(L, 1);
- return 1;
- }
- lua_getfield(L, -1, "traceback");
- if (!lua_isfunction(L, -1)) {
- lua_pop(L, 2);
- return 1;
- }
- lua_pushvalue(L, 1); /* pass error message */
- lua_pushinteger(L, 2); /* skip this function and traceback */
- lua_call(L, 2, 1); /* call debug.traceback */
- return 1;
-}
-
-@ @c
-static void luacall(int p, int nameptr, boolean is_string) /* hh-ls: optimized lua_id resolving */
-{
- LoadS ls;
- int i;
- size_t ll = 0;
- char *lua_id;
- char *s = NULL;
-
- if (Luas == NULL) {
- luainterpreter();
- }
- lua_active++;
- if (is_string) {
- const char *ss = NULL;
- lua_rawgeti(Luas, LUA_REGISTRYINDEX, p);
- if (lua_isfunction(Luas,-1)) {
- int base = lua_gettop(Luas); /* function index */
- lua_checkstack(Luas, 1);
- lua_pushcfunction(Luas, lua_traceback); /* push traceback function */
- lua_insert(Luas, base); /* put it under chunk */
- i = lua_pcall(Luas, 0, 0, base);
- lua_remove(Luas, base); /* remove traceback function */
- if (i != 0) {
- lua_gc(Luas, LUA_GCCOLLECT, 0);
- Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
- }
- lua_active--;
- return ;
- }
- ss = lua_tolstring(Luas, -1, &ll);
- s = xmalloc(ll+1);
- memcpy(s,ss,ll+1);
- lua_pop(Luas,1);
- } else {
- int l = 0;
- s = tokenlist_to_cstring(p, 1, &l);
- ll = (size_t)l;
- }
- ls.s = s;
- ls.size = ll;
- if (ls.size > 0) {
- if (nameptr > 0) {
- int l = 0; /* not used */
- lua_id = tokenlist_to_cstring(nameptr, 1, &l);
- i = lua_load(Luas, getS, &ls, lua_id, NULL);
- xfree(lua_id);
- } else if (nameptr < 0) {
- lua_id = get_lua_name((nameptr + 65536));
- if (lua_id != NULL) {
- i = lua_load(Luas, getS, &ls, lua_id, NULL);
- } else {
- i = lua_load(Luas, getS, &ls, "=[\\latelua]", NULL);
- }
- } else {
- i = lua_load(Luas, getS, &ls, "=[\\latelua]", NULL);
- }
- if (i != 0) {
- Luas = luatex_error(Luas, (i == LUA_ERRSYNTAX ? 0 : 1));
- } else {
- int base = lua_gettop(Luas); /* function index */
- lua_checkstack(Luas, 1);
- lua_pushcfunction(Luas, lua_traceback); /* push traceback function */
- lua_insert(Luas, base); /* put it under chunk */
- i = lua_pcall(Luas, 0, 0, base);
- lua_remove(Luas, base); /* remove traceback function */
- if (i != 0) {
- lua_gc(Luas, LUA_GCCOLLECT, 0);
- Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
- }
- }
- xfree(ls.s);
- }
- lua_active--;
-}
-
-@ @c
-void late_lua(PDF pdf, halfword p)
-{
- (void) pdf;
- if (late_lua_type(p)==normal) {
- expand_macros_in_tokenlist(p); /* sets |def_ref| */
- luacall(def_ref, late_lua_name(p), false);
- flush_list(def_ref);
- } else {
- luacall(late_lua_data(p), late_lua_name(p), true);
- }
-}
-
-@ @c
-void luatokencall(int p, int nameptr) /* hh-ls: optimized lua_id resolving */
-{
- LoadS ls;
- int i, l;
- char *s = NULL;
- char *lua_id;
- assert(Luas);
- l = 0;
- lua_active++;
- s = tokenlist_to_cstring(p, 1, &l);
- ls.s = s;
- ls.size = (size_t) l;
- if (ls.size > 0) {
- if (nameptr > 0) {
- lua_id = tokenlist_to_cstring(nameptr, 1, &l);
- i = lua_load(Luas, getS, &ls, lua_id, NULL);
- xfree(lua_id);
- } else if (nameptr < 0) {
- lua_id = get_lua_name((nameptr + 65536));
- if (lua_id != NULL) {
- i = lua_load(Luas, getS, &ls, lua_id, NULL);
- } else {
- i = lua_load(Luas, getS, &ls, "=[\\directlua]", NULL);
- }
- } else {
- i = lua_load(Luas, getS, &ls, "=[\\directlua]", NULL);
- }
- xfree(s);
- if (i != 0) {
- Luas = luatex_error(Luas, (i == LUA_ERRSYNTAX ? 0 : 1));
- } else {
- int base = lua_gettop(Luas); /* function index */
- lua_checkstack(Luas, 1);
- lua_pushcfunction(Luas, lua_traceback); /* push traceback function */
- lua_insert(Luas, base); /* put it under chunk */
- i = lua_pcall(Luas, 0, 0, base);
- lua_remove(Luas, base); /* remove traceback function */
- if (i != 0) {
- lua_gc(Luas, LUA_GCCOLLECT, 0);
- Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
- }
- }
- }
- lua_active--;
-}
-
-@ @c
-lua_State *luatex_error(lua_State * L, int is_fatal)
-{
-
- const_lstring luaerr;
- char *err = NULL;
- if (lua_type(L, -1) == LUA_TSTRING) {
- luaerr.s = lua_tolstring(L, -1, &luaerr.l);
- /* free last one ? */
- err = (char *) xmalloc((unsigned) (luaerr.l + 1));
- snprintf(err, (luaerr.l + 1), "%s", luaerr.s);
- last_lua_error = err; /* hm, what if we have several .. not freed */
- }
- if (is_fatal > 0) {
- /* Normally a memory error from lua.
- The pool may overflow during the |maketexlstring()|, but we
- are crashing anyway so we may as well abort on the pool size */
- normal_error("lua",err);
- /* never reached */
- lua_close(L);
- return (lua_State *) NULL;
- } else {
- normal_warning("lua",err);
- return L;
- }
-}
-
-@ @c
-void preset_environment(lua_State * L, const parm_struct * p, const char *s)
-{
- int i;
- assert(L != NULL);
- /* double call with same s gives assert(0) */
- lua_pushstring(L, s); /* s */
- lua_gettable(L, LUA_REGISTRYINDEX); /* t */
- assert(lua_isnil(L, -1));
- lua_pop(L, 1); /* - */
- lua_pushstring(L, s); /* s */
- lua_newtable(L); /* t s */
- for (i = 1, ++p; p->name != NULL; i++, p++) {
- assert(i == p->idx);
- lua_pushstring(L, p->name); /* k t s */
- lua_pushinteger(L, p->idx); /* v k t s */
- lua_settable(L, -3); /* t s */
- }
- lua_settable(L, LUA_REGISTRYINDEX); /* - */
-}
+% luastuff.w
+%
+% Copyright 2006-2013 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
+#include "ptexlib.h"
+#include "lua/luatex-api.h"
+
+@ @c
+lua_State *Luas = NULL;
+
+int luastate_bytes = 0;
+int lua_active = 0;
+
+@ @c
+void make_table(lua_State * L, const char *tab, const char *mttab, const char *getfunc,
+ const char *setfunc)
+{
+ /* make the table *//* |[{<tex>}]| */
+ lua_pushstring(L, tab); /* |[{<tex>},"dimen"]| */
+ lua_newtable(L); /* |[{<tex>},"dimen",{}]| */
+ lua_settable(L, -3); /* |[{<tex>}]| */
+ /* fetch it back */
+ lua_pushstring(L, tab); /* |[{<tex>},"dimen"]| */
+ lua_gettable(L, -2); /* |[{<tex>},{<dimen>}]| */
+ /* make the meta entries */
+ luaL_newmetatable(L, mttab); /* |[{<tex>},{<dimen>},{<dimen_m>}]| */
+ lua_pushstring(L, "__index"); /* |[{<tex>},{<dimen>},{<dimen_m>},"__index"]| */
+ lua_pushstring(L, getfunc); /* |[{<tex>},{<dimen>},{<dimen_m>},"__index","getdimen"]| */
+ lua_gettable(L, -5); /* |[{<tex>},{<dimen>},{<dimen_m>},"__index",<tex.getdimen>]| */
+ lua_settable(L, -3); /* |[{<tex>},{<dimen>},{<dimen_m>}]| */
+ lua_pushstring(L, "__newindex"); /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex"]| */
+ lua_pushstring(L, setfunc); /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex","setdimen"]| */
+ lua_gettable(L, -5); /* |[{<tex>},{<dimen>},{<dimen_m>},"__newindex",<tex.setdimen>]| */
+ lua_settable(L, -3); /* |[{<tex>},{<dimen>},{<dimen_m>}]| */
+ lua_setmetatable(L, -2); /* |[{<tex>},{<dimen>}]| : assign the metatable */
+ lua_pop(L, 1); /* |[{<tex>}]| : clean the stack */
+}
+
+@ @c
+static const char *getS(lua_State * L, void *ud, size_t * size)
+{
+ LoadS *ls = (LoadS *) ud;
+ (void) L;
+ if (ls->size == 0)
+ return NULL;
+ *size = ls->size;
+ ls->size = 0;
+ return ls->s;
+}
+
+@ @c
+static void *my_luaalloc(void *ud, void *ptr, size_t osize, size_t nsize)
+{
+ void *ret = NULL;
+ (void) ud; /* for -Wunused */
+ if (nsize == 0)
+ free(ptr);
+ else
+ ret = realloc(ptr, nsize);
+ luastate_bytes += (int) (nsize - osize);
+ return ret;
+}
+
+@ @c
+static int my_luapanic(lua_State * L)
+{
+ (void) L; /* to avoid warnings */
+ fprintf(stderr, "PANIC: unprotected error in call to Lua API (%s)\n", lua_tostring(L, -1));
+ return 0;
+}
+
+@ @c
+void luafunctioncall(int slot)
+{
+ int i ;
+ int stacktop = lua_gettop(Luas);
+ lua_active++;
+ lua_rawgeti(Luas, LUA_REGISTRYINDEX, lua_key_index(lua_functions));
+ lua_gettable(Luas, LUA_REGISTRYINDEX);
+ lua_rawgeti(Luas, -1,slot);
+ if (lua_isfunction(Luas,-1)) {
+ int base = lua_gettop(Luas); /* function index */
+ lua_pushinteger(Luas, slot);
+ lua_pushcfunction(Luas, lua_traceback); /* push traceback function */
+ lua_insert(Luas, base); /* put it under chunk */
+ i = lua_pcall(Luas, 1, 0, base);
+ lua_remove(Luas, base); /* remove traceback function */
+ if (i != 0) {
+ lua_gc(Luas, LUA_GCCOLLECT, 0);
+ Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
+ }
+ }
+ lua_settop(Luas,stacktop);
+ lua_active--;
+}
+
+@ @c
+static const luaL_Reg lualibs[] = {
+ {"", luaopen_base},
+ {"package", luaopen_package},
+ {"coroutine", luaopen_coroutine},
+ {"table", luaopen_table},
+ {"io", open_iolibext},
+ {"os", luaopen_os},
+ {"string", luaopen_string},
+ {"math", luaopen_math},
+ {"debug", luaopen_debug},
+ {"unicode", luaopen_unicode},
+ {"zip", luaopen_zip},
+ {"bit32", luaopen_bit32},
+ {"md5", luaopen_md5},
+ {"ffi", luaopen_ffi},
+ {"lfs", luaopen_lfs},
+ {"profiler", luaopen_profiler},
+ {"lpeg", luaopen_lpeg},
+ {NULL, NULL}
+};
+
+@ @c
+static void do_openlibs(lua_State * L)
+{
+ const luaL_Reg *lib;
+ for (lib = lualibs; lib->func; lib++) {
+ luaL_requiref(L, lib->name, lib->func, 1);
+ lua_pop(L, 1); /* remove lib */
+ }
+}
+
+@ @c
+static int load_aux (lua_State *L, int status) {
+ if (status == 0) /* OK? */
+ return 1;
+ else {
+ lua_pushnil(L);
+ lua_insert(L, -2); /* put before error message */
+ return 2; /* return nil plus error message */
+ }
+}
+
+@ @c
+static int luatex_loadfile (lua_State *L) {
+ int status = 0;
+ const char *fname = luaL_optstring(L, 1, NULL);
+ const char *mode = luaL_optstring(L, 2, NULL);
+ int env = !lua_isnone(L, 3); /* 'env' parameter? */
+ if (!lua_only && !fname && interaction == batch_mode) {
+ lua_pushnil(L);
+ lua_pushstring(L, "reading from stdin is disabled in batch mode");
+ return 2; /* return nil plus error message */
+ }
+ status = luaL_loadfilex(L, fname, mode);
+ if (status == LUA_OK) {
+ recorder_record_input(fname);
+ if (env) { /* 'env' parameter? */
+ lua_pushvalue(L, 3);
+ lua_setupvalue(L, -2, 1); /* set it as 1st upvalue of loaded chunk */
+ }
+ }
+ return load_aux(L, status);
+}
+
+@ @c
+static int luatex_dofile (lua_State *L) {
+ const char *fname = luaL_optstring(L, 1, NULL);
+ int n = lua_gettop(L);
+ if (!lua_only && !fname) {
+ if (interaction == batch_mode) {
+ lua_pushnil(L);
+ lua_pushstring(L, "reading from stdin is disabled in batch mode");
+ return 2; /* return nil plus error message */
+ } else {
+ tprint_nl("lua> ");
+ }
+ }
+ if (luaL_loadfile(L, fname) != 0) lua_error(L);
+ recorder_record_input(fname);
+ lua_call(L, 0, LUA_MULTRET);
+ return lua_gettop(L) - n;
+}
+
+@ @c
+void luainterpreter(void)
+{
+ lua_State *L;
+ L = lua_newstate(my_luaalloc, NULL);
+ if (L == NULL) {
+ fprintf(stderr, "Can't create the Lua state.\n");
+ return;
+ }
+ lua_atpanic(L, &my_luapanic);
+
+ do_openlibs(L); /* does all the 'simple' libraries */
+
+ lua_pushcfunction(L,luatex_dofile);
+ lua_setglobal(L, "dofile");
+ lua_pushcfunction(L,luatex_loadfile);
+ lua_setglobal(L, "loadfile");
+
+ luatex_md5_lua_open(L);
+
+ open_oslibext(L, safer_option);
+/*
+ open_iolibext(L);
+*/
+ open_strlibext(L);
+ open_lfslibext(L);
+
+
+ /* luasockets */
+ /* socket and mime are a bit tricky to open because
+ they use a load-time dependency that has to be
+ worked around for luatex, where the C module is
+ loaded way before the lua module.
+ */
+ if (!nosocket_option) {
+ lua_getglobal(L, "package");
+ lua_getfield(L, -1, "loaded");
+ if (!lua_istable(L, -1)) {
+ lua_newtable(L);
+ lua_setfield(L, -2, "loaded");
+ lua_getfield(L, -1, "loaded");
+ }
+ luaopen_socket_core(L);
+ lua_setfield(L, -2, "socket.core");
+ lua_pushnil(L);
+ lua_setfield(L, -2, "socket"); /* package.loaded.socket = nil */
+
+ luaopen_mime_core(L);
+ lua_setfield(L, -2, "mime.core");
+ lua_pushnil(L);
+ lua_setfield(L, -2, "mime"); /* package.loaded.mime = nil */
+ lua_pop(L, 2); /* pop the tables */
+
+ luatex_socketlua_open(L); /* preload the pure lua modules */
+ }
+ /* zlib. slightly odd calling convention */
+ luaopen_zlib(L);
+ lua_setglobal(L, "zlib");
+ luaopen_gzip(L);
+
+ /* our own libraries */
+ luaopen_ff(L);
+ luaopen_tex(L);
+ luaopen_token(L);
+ luaopen_node(L);
+ luaopen_texio(L);
+ luaopen_kpse(L);
+ luaopen_callback(L);
+ luaopen_lua(L, startup_filename);
+ luaopen_stats(L);
+ luaopen_font(L);
+ luaopen_lang(L);
+ luaopen_mplib(L);
+ luaopen_vf(L);
+
+ /* |luaopen_pdf(L);| */
+ /* environment table at |LUA_ENVIRONINDEX| needs to load this way: */
+ lua_pushcfunction(L, luaopen_pdf);
+ lua_pushstring(L, "pdf");
+ lua_call(L, 1, 0);
+
+ if (!lua_only) {
+ luaL_requiref(L, "img", luaopen_img, 1);
+ lua_pop(L, 1);
+ }
+
+ luaL_requiref(L, "epdf", luaopen_epdf, 1);
+ lua_pop(L, 1);
+
+ /* |luaopen_pdfscanner(L);| */
+ lua_pushcfunction(L, luaopen_pdfscanner);
+ lua_pushstring(L, "pdfscanner");
+ lua_call(L, 1, 0);
+
+ lua_createtable(L, 0, 0);
+ lua_setglobal(L, "texconfig");
+
+ if (safer_option) {
+ /* disable some stuff if --safer */
+ (void) hide_lua_value(L, "os", "execute");
+ (void) hide_lua_value(L, "os", "rename");
+ (void) hide_lua_value(L, "os", "remove");
+ (void) hide_lua_value(L, "io", "popen");
+ /* make io.open only read files */
+ luaL_checkstack(L, 2, "out of stack space");
+ lua_getglobal(L, "io");
+ lua_getfield(L, -1, "open_ro");
+ lua_setfield(L, -2, "open");
+ (void) hide_lua_value(L, "io", "tmpfile");
+ (void) hide_lua_value(L, "io", "output");
+ (void) hide_lua_value(L, "lfs", "chdir");
+ (void) hide_lua_value(L, "lfs", "lock");
+ (void) hide_lua_value(L, "lfs", "touch");
+ (void) hide_lua_value(L, "lfs", "rmdir");
+ (void) hide_lua_value(L, "lfs", "mkdir");
+ }
+ /* Maybe we can extend this way to the others tables, using luac. */
+ if ( safer_option || ((shellenabledp == 0) || (shellenabledp == 1 && restrictedshell == 1)) ) {
+ (void) luaL_dostring(L,"ffi=require[[ffi]]; for k,_ in pairs(ffi) do if k~='gc' then ffi[k]=nil end; end; ffi=nil;");
+ }
+ Luas = L;
+}
+
+@ @c
+int hide_lua_table(lua_State * L, const char *name)
+{
+ int r = 0;
+ lua_getglobal(L, name);
+ if (lua_istable(L, -1)) {
+ r = luaL_ref(L, LUA_REGISTRYINDEX);
+ lua_pushnil(L);
+ lua_setglobal(L, name);
+ }
+ return r;
+}
+
+@ @c
+void unhide_lua_table(lua_State * L, const char *name, int r)
+{
+ lua_rawgeti(L, LUA_REGISTRYINDEX, r);
+ lua_setglobal(L, name);
+ luaL_unref(L, LUA_REGISTRYINDEX, r);
+}
+
+@ @c
+int hide_lua_value(lua_State * L, const char *name, const char *item)
+{
+ int r = 0;
+ lua_getglobal(L, name);
+ if (lua_istable(L, -1)) {
+ lua_getfield(L, -1, item);
+ r = luaL_ref(L, LUA_REGISTRYINDEX);
+ lua_pushnil(L);
+ lua_setfield(L, -2, item);
+ }
+ return r;
+}
+
+@ @c
+void unhide_lua_value(lua_State * L, const char *name, const char *item, int r)
+{
+ lua_getglobal(L, name);
+ if (lua_istable(L, -1)) {
+ lua_rawgeti(L, LUA_REGISTRYINDEX, r);
+ lua_setfield(L, -2, item);
+ luaL_unref(L, LUA_REGISTRYINDEX, r);
+ }
+}
+
+@ @c
+int lua_traceback(lua_State * L)
+{
+ lua_getglobal(L, "debug");
+ if (!lua_istable(L, -1)) {
+ lua_pop(L, 1);
+ return 1;
+ }
+ lua_getfield(L, -1, "traceback");
+ if (!lua_isfunction(L, -1)) {
+ lua_pop(L, 2);
+ return 1;
+ }
+ lua_pushvalue(L, 1); /* pass error message */
+ lua_pushinteger(L, 2); /* skip this function and traceback */
+ lua_call(L, 2, 1); /* call debug.traceback */
+ return 1;
+}
+
+@ @c
+static void luacall(int p, int nameptr, boolean is_string) /* hh-ls: optimized lua_id resolving */
+{
+ LoadS ls;
+ int i;
+ size_t ll = 0;
+ char *lua_id;
+ char *s = NULL;
+
+ if (Luas == NULL) {
+ luainterpreter();
+ }
+ lua_active++;
+ if (is_string) {
+ const char *ss = NULL;
+ lua_rawgeti(Luas, LUA_REGISTRYINDEX, p);
+ if (lua_isfunction(Luas,-1)) {
+ int base = lua_gettop(Luas); /* function index */
+ lua_checkstack(Luas, 1);
+ lua_pushcfunction(Luas, lua_traceback); /* push traceback function */
+ lua_insert(Luas, base); /* put it under chunk */
+ i = lua_pcall(Luas, 0, 0, base);
+ lua_remove(Luas, base); /* remove traceback function */
+ if (i != 0) {
+ lua_gc(Luas, LUA_GCCOLLECT, 0);
+ Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
+ }
+ lua_active--;
+ return ;
+ }
+ ss = lua_tolstring(Luas, -1, &ll);
+ s = xmalloc(ll+1);
+ memcpy(s,ss,ll+1);
+ lua_pop(Luas,1);
+ } else {
+ int l = 0;
+ s = tokenlist_to_cstring(p, 1, &l);
+ ll = (size_t)l;
+ }
+ ls.s = s;
+ ls.size = ll;
+ if (ls.size > 0) {
+ if (nameptr > 0) {
+ int l = 0; /* not used */
+ lua_id = tokenlist_to_cstring(nameptr, 1, &l);
+ i = lua_load(Luas, getS, &ls, lua_id, NULL);
+ xfree(lua_id);
+ } else if (nameptr < 0) {
+ lua_id = get_lua_name((nameptr + 65536));
+ if (lua_id != NULL) {
+ i = lua_load(Luas, getS, &ls, lua_id, NULL);
+ } else {
+ i = lua_load(Luas, getS, &ls, "=[\\latelua]", NULL);
+ }
+ } else {
+ i = lua_load(Luas, getS, &ls, "=[\\latelua]", NULL);
+ }
+ if (i != 0) {
+ Luas = luatex_error(Luas, (i == LUA_ERRSYNTAX ? 0 : 1));
+ } else {
+ int base = lua_gettop(Luas); /* function index */
+ lua_checkstack(Luas, 1);
+ lua_pushcfunction(Luas, lua_traceback); /* push traceback function */
+ lua_insert(Luas, base); /* put it under chunk */
+ i = lua_pcall(Luas, 0, 0, base);
+ lua_remove(Luas, base); /* remove traceback function */
+ if (i != 0) {
+ lua_gc(Luas, LUA_GCCOLLECT, 0);
+ Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
+ }
+ }
+ xfree(ls.s);
+ }
+ lua_active--;
+}
+
+@ @c
+void late_lua(PDF pdf, halfword p)
+{
+ (void) pdf;
+ if (late_lua_type(p)==normal) {
+ expand_macros_in_tokenlist(p); /* sets |def_ref| */
+ luacall(def_ref, late_lua_name(p), false);
+ flush_list(def_ref);
+ } else {
+ luacall(late_lua_data(p), late_lua_name(p), true);
+ }
+}
+
+@ @c
+void luatokencall(int p, int nameptr) /* hh-ls: optimized lua_id resolving */
+{
+ LoadS ls;
+ int i, l;
+ char *s = NULL;
+ char *lua_id;
+ assert(Luas);
+ l = 0;
+ lua_active++;
+ s = tokenlist_to_cstring(p, 1, &l);
+ ls.s = s;
+ ls.size = (size_t) l;
+ if (ls.size > 0) {
+ if (nameptr > 0) {
+ lua_id = tokenlist_to_cstring(nameptr, 1, &l);
+ i = lua_load(Luas, getS, &ls, lua_id, NULL);
+ xfree(lua_id);
+ } else if (nameptr < 0) {
+ lua_id = get_lua_name((nameptr + 65536));
+ if (lua_id != NULL) {
+ i = lua_load(Luas, getS, &ls, lua_id, NULL);
+ } else {
+ i = lua_load(Luas, getS, &ls, "=[\\directlua]", NULL);
+ }
+ } else {
+ i = lua_load(Luas, getS, &ls, "=[\\directlua]", NULL);
+ }
+ xfree(s);
+ if (i != 0) {
+ Luas = luatex_error(Luas, (i == LUA_ERRSYNTAX ? 0 : 1));
+ } else {
+ int base = lua_gettop(Luas); /* function index */
+ lua_checkstack(Luas, 1);
+ lua_pushcfunction(Luas, lua_traceback); /* push traceback function */
+ lua_insert(Luas, base); /* put it under chunk */
+ i = lua_pcall(Luas, 0, 0, base);
+ lua_remove(Luas, base); /* remove traceback function */
+ if (i != 0) {
+ lua_gc(Luas, LUA_GCCOLLECT, 0);
+ Luas = luatex_error(Luas, (i == LUA_ERRRUN ? 0 : 1));
+ }
+ }
+ }
+ lua_active--;
+}
+
+@ @c
+lua_State *luatex_error(lua_State * L, int is_fatal)
+{
+
+ const_lstring luaerr;
+ char *err = NULL;
+ if (lua_type(L, -1) == LUA_TSTRING) {
+ luaerr.s = lua_tolstring(L, -1, &luaerr.l);
+ /* free last one ? */
+ err = (char *) xmalloc((unsigned) (luaerr.l + 1));
+ snprintf(err, (luaerr.l + 1), "%s", luaerr.s);
+ last_lua_error = err; /* hm, what if we have several .. not freed */
+ }
+ if (is_fatal > 0) {
+ /* Normally a memory error from lua.
+ The pool may overflow during the |maketexlstring()|, but we
+ are crashing anyway so we may as well abort on the pool size */
+ normal_error("lua",err);
+ /* never reached */
+ lua_close(L);
+ return (lua_State *) NULL;
+ } else {
+ normal_warning("lua",err);
+ return L;
+ }
+}
+
+@ @c
+void preset_environment(lua_State * L, const parm_struct * p, const char *s)
+{
+ int i;
+ assert(L != NULL);
+ /* double call with same s gives assert(0) */
+ lua_pushstring(L, s); /* s */
+ lua_gettable(L, LUA_REGISTRYINDEX); /* t */
+ assert(lua_isnil(L, -1));
+ lua_pop(L, 1); /* - */
+ lua_pushstring(L, s); /* s */
+ lua_newtable(L); /* t s */
+ for (i = 1, ++p; p->name != NULL; i++, p++) {
+ assert(i == p->idx);
+ lua_pushstring(L, p->name); /* k t s */
+ lua_pushinteger(L, p->idx); /* v k t s */
+ lua_settable(L, -3); /* t s */
+ }
+ lua_settable(L, LUA_REGISTRYINDEX); /* - */
+}
diff --git a/Build/source/texk/web2c/luatexdir/lua/luatex-api.h b/Build/source/texk/web2c/luatexdir/lua/luatex-api.h
index 4c8097a7ceb..4ef40be8b71 100644
--- a/Build/source/texk/web2c/luatexdir/lua/luatex-api.h
+++ b/Build/source/texk/web2c/luatexdir/lua/luatex-api.h
@@ -87,6 +87,10 @@ extern int luaopen_lpeg(lua_State * L);
extern int luaopen_md5(lua_State * L);
extern int luatex_md5_lua_open(lua_State * L);
+#ifndef LuajitTeX
+ extern int luaopen_ffi(lua_State * L);
+#endif
+
extern int luaopen_zlib(lua_State * L);
extern int luaopen_gzip(lua_State * L);
extern int luaopen_ff(lua_State * L);
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/CONTRIBUTING.md b/Build/source/texk/web2c/luatexdir/luaffi/CONTRIBUTING.md
new file mode 100644
index 00000000000..3591e05a0b0
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/CONTRIBUTING.md
@@ -0,0 +1,30 @@
+# Contributing to luaffifb
+We want to make contributing to this project as easy and transparent as
+possible.
+
+## Our Development Process
+... (in particular how this is synced with internal changes to the project)
+
+## Pull Requests
+We actively welcome your pull requests.
+1. Fork the repo and create your branch from `master`.
+2. If you've added code that should be tested, add tests
+3. If you haven't already, complete the Contributor License Agreement ("CLA").
+
+## Contributor License Agreement ("CLA")
+In order to accept your pull request, we need you to submit a CLA. You only need
+to do this once to work on any of Facebook's open source projects.
+
+Complete your CLA here: <https://code.facebook.com/cla>
+
+## Issues
+We use GitHub issues to track public bugs. Please ensure your description is
+clear and has sufficient instructions to be able to reproduce the issue.
+
+## Coding Style
+* Use four spaces for indentation rather than tabs
+* 80 character line length
+
+## License
+By contributing to luaffifb, you agree that your contributions will be licensed
+under its BSD license.
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/LICENSE b/Build/source/texk/web2c/luatexdir/luaffi/LICENSE
new file mode 100644
index 00000000000..d38b1644499
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/LICENSE
@@ -0,0 +1,58 @@
+BSD License
+
+For luaffifb software
+
+Copyright (c) 2015, Facebook, Inc. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice, this
+ list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ * Neither the name Facebook nor the names of its contributors may be used to
+ endorse or promote products derived from this software without specific
+ prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+--------------------------------------------------------------------------
+
+This product contains portions of third party software provided under this license:
+
+luaffi software
+
+Copyright (c) 2011 James R. McKaskill
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.
+
+Facebook provides this code under the BSD License above.
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/Makefile.orig b/Build/source/texk/web2c/luatexdir/luaffi/Makefile.orig
new file mode 100644
index 00000000000..79bbd4cedef
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/Makefile.orig
@@ -0,0 +1,32 @@
+#
+# Use luarocks to install LuaFFI:
+# > git clone https://github.com/facebook/luaffifb
+# > cd luaffifb && luarocks make
+#
+# To rebuild the call_* headers:
+# > rm call_*.h && make headers
+#
+
+.PHONY: build clean headers
+LUA=lua
+
+build:
+ luarocks make
+
+clean:
+ rm -f *.o *.so *.dylib
+
+headers:
+ $(MAKE) call_x86.h call_x64.h call_x64win.h call_arm.h
+
+call_x86.h: call_x86.dasc dynasm/*.lua
+ $(LUA) dynasm/dynasm.lua -LN -o $@ $<
+
+call_x64.h: call_x86.dasc dynasm/*.lua
+ $(LUA) dynasm/dynasm.lua -D X64 -LN -o $@ $<
+
+call_x64win.h: call_x86.dasc dynasm/*.lua
+ $(LUA) dynasm/dynasm.lua -D X64 -D X64WIN -LN -o $@ $<
+
+call_arm.h: call_arm.dasc dynasm/*.lua
+ $(LUA) dynasm/dynasm.lua -LNE -o $@ $<
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/PATENTS b/Build/source/texk/web2c/luatexdir/luaffi/PATENTS
new file mode 100644
index 00000000000..f6388c50d5b
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/PATENTS
@@ -0,0 +1,33 @@
+Additional Grant of Patent Rights Version 2
+
+"Software" means the luaffifb software distributed by Facebook, Inc.
+
+Facebook, Inc. ("Facebook") hereby grants to each recipient of the Software
+("you") a perpetual, worldwide, royalty-free, non-exclusive, irrevocable
+(subject to the termination provision below) license under any Necessary
+Claims, to make, have made, use, sell, offer to sell, import, and otherwise
+transfer the Software. For avoidance of doubt, no license is granted under
+Facebook’s rights in any patent claims that are infringed by (i) modifications
+to the Software made by you or any third party or (ii) the Software in
+combination with any software or other technology.
+
+The license granted hereunder will terminate, automatically and without notice,
+if you (or any of your subsidiaries, corporate affiliates or agents) initiate
+directly or indirectly, or take a direct financial interest in, any Patent
+Assertion: (i) against Facebook or any of its subsidiaries or corporate
+affiliates, (ii) against any party if such Patent Assertion arises in whole or
+in part from any software, technology, product or service of Facebook or any of
+its subsidiaries or corporate affiliates, or (iii) against any party relating
+to the Software. Notwithstanding the foregoing, if Facebook or any of its
+subsidiaries or corporate affiliates files a lawsuit alleging patent
+infringement against you in the first instance, and you respond by filing a
+patent infringement counterclaim in that lawsuit against that party that is
+unrelated to the Software, the license granted hereunder will not terminate
+under section (i) of this paragraph due to such counterclaim.
+
+A "Necessary Claim" is a claim of a patent owned by Facebook that is
+necessarily infringed by the Software standing alone.
+
+A "Patent Assertion" is any lawsuit or other action alleging direct, indirect,
+or contributory infringement or inducement to infringe any patent, including a
+cross-claim or counterclaim.
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/README b/Build/source/texk/web2c/luatexdir/luaffi/README
new file mode 100644
index 00000000000..8093da53c41
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/README
@@ -0,0 +1,78 @@
+This is luaffifb from https://github.com/facebook/luaffifb
+patched to compile for TeXLive..
+
+It should compile even where the ffi is not defined,
+because there is a ffi stub that does nothing:
+
+local info = [[
+The ffi module is available for:
+
+ archictures : ARCH_X86 and ARCH_X64,
+ operating systems : OS_CE, OS_WIN, OS_LINUX, OS BD and OS_POSIX
+
+The ARM processor is currently not supported. There are subtle
+differences between this module and the one in luajitTeX
+and we hope to be in sync around TeXLive 2018.
+Different OS can have different interfaces,
+for instance OS_WIN has not 'complex.h'. If you want portable
+code, stick to the most common concepts.
+]]
+
+local function stub()
+ texio.write_nl(info)
+end
+
+ffi = {
+ fill = stub,
+ cast = stub,
+ offsetof = stub,
+ copy = stub,
+ string = stub,
+ abi = stub,
+ cdef = stub,
+ typeof = stub,
+ sizeof = stub,
+ type = stub,
+ number = stub,
+ gc = stub,
+ metatype = stub,
+ errno = stub,
+ debug = stub,
+ os = '' ,
+ arch = '' ,
+ NULL = nil ,
+ alignof = stub,
+ new = stub,
+ u64 = stub,
+ i64 = stub,
+ istype = stub,
+ load = stub,
+ C = nil ,
+}
+
+
+So the following chunk of code can be used as an
+example of how to check the ffi:
+
+ if ffi then
+ if (ffi.os=='' and ffi.arch=='') then
+ -- ffi is the stub
+ -- or it's not a sane ffi
+ -- This should print something on terminal
+ print(ffi.cdef(''))
+ else
+ -- ffi looks ok
+ end
+ else
+ -- no ffi at all: perhaps an old luatex ?
+ end
+
+The ARCH enabled ARCH_X86 and ARCH_X64,
+the OS enabled are OS_CE, OS_WIN, OS_LINUX, OS BD and OS_POSIX.
+Currently ARM is not supported.
+
+The module is not aligned with luajit-2.1.0.beta2
+(the plan is to be in sync for TeXLive 2018) and
+test.lua can fail. Be careful that different OS have different
+interfaces (i.e. OS_WIN has not complex.h, for example)
+so extra care must be take to ensure code portability.
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/README.md b/Build/source/texk/web2c/luatexdir/luaffi/README.md
new file mode 100644
index 00000000000..b9a168c1006
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/README.md
@@ -0,0 +1,86 @@
+[![Build Status](https://travis-ci.org/facebook/luaffifb.svg?branch=master)](https://travis-ci.org/facebook/luaffifb)
+
+About
+-----
+This is a library for calling C function and manipulating C types from lua. It
+is designed to be interface compatible with the FFI library in LuaJIT (see
+http://luajit.org/ext_ffi.html). It can parse C function declarations and
+struct definitions that have been directly copied out of C header files and
+into lua source as a string.
+
+This is a fork of https://github.com/jmckaskill/luaffi
+
+Source
+------
+https://github.com/facebook/luaffifb
+
+Platforms
+---------
+Currently supported:
+- Linux x86/x64
+- OS X x86/x64
+
+Runs with Lua 5.1, 5.2, and 5.3
+
+Build
+-----
+In a terminal:
+
+```bash
+git clone https://github.com/facebook/luaffifb
+cd luaffifb
+luarocks make
+```
+
+Documentation
+-------------
+This library is designed to be source compatible with LuaJIT's FFI extension. The documentation at http://luajit.org/ext_ffi.html describes the API and semantics.
+
+Pointer Comparison
+------------
+Use `ffi.NULL` instead of `nil` when checking for `NULL` pointers.
+```lua
+ ffi.new('void *', 0) == ffi.NULL -- true
+```
+
+Known Issues
+------------
+- Comparing a ctype pointer to `nil` doesn't work the same as in LuaJIT (see above).
+ This is unfixable with the current metamethod semantics.
+- Constant expressions can't handle non integer intermediate values (eg
+ offsetof won't work because it manipulates pointers)
+- Not all metamethods work with Lua 5.1 (eg char* + number). This is due to
+ the way metamethods are looked up with mixed types in Lua 5.1. If you need
+this upgrade to Lua 5.2 or use boxed numbers (uint64_t and uintptr_t).
+- All bitfields are treated as unsigned (does anyone even use signed
+ bitfields?). Note that "int s:8" is unsigned on unix x86/x64, but signed on
+windows.
+
+
+How it works
+------------
+Types are represented by a struct ctype structure and an associated user value
+table. The table is shared between all related types for structs, unions, and
+functions. It's members have the types of struct members, function argument
+types, etc. The struct ctype structure then contains the modifications from
+the base type (eg number of pointers, array size, etc).
+
+Types are pushed into lua as a userdata containing the struct ctype with a
+user value (or fenv in 5.1) set to the shared type table.
+
+Boxed cdata types are pushed into lua as a userdata containing the struct
+cdata structure (which contains the struct ctype of the data as its header)
+followed by the boxed data.
+
+The functions in `ffi.C` provide the `cdata` and `ctype` metatables and ffi.*
+functions which manipulate these two types.
+
+C functions (and function pointers) are pushed into lua as a lua c function
+with the function pointer cdata as the first upvalue. The actual code is JITed
+using dynasm (see call_x86.dasc). The JITed code does the following in order:
+
+1. Calls the needed unpack functions in `ffi.C` placing each argument on the HW stack
+2. Updates `errno`
+3. Performs the C call
+4. Retrieves `errno`
+5. Pushes the result back into lua from the HW register or stack
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/call.c b/Build/source/texk/web2c/luatexdir/luaffi/call.c
new file mode 100644
index 00000000000..71bb3aea884
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/call.c
@@ -0,0 +1,275 @@
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+#include "ffi.h"
+
+static cfunction compile(Dst_DECL, lua_State* L, cfunction func, int ref);
+
+static void* reserve_code(struct jit* jit, lua_State* L, size_t sz);
+static void commit_code(struct jit* jit, void* p, size_t sz);
+
+static void push_int(lua_State* L, int val)
+{ lua_pushinteger(L, val); }
+
+static void push_uint(lua_State* L, unsigned int val)
+{ lua_pushinteger(L, val); }
+
+static void push_float(lua_State* L, float val)
+{ lua_pushnumber(L, val); }
+
+#ifndef _WIN32
+static int GetLastError(void)
+{ return errno; }
+static void SetLastError(int err)
+{ errno = err; }
+#endif
+
+#ifdef NDEBUG
+#define shred(a,b,c)
+#else
+#define shred(p,s,e) memset((uint8_t*)(p)+(s),0xCC,(e)-(s))
+#endif
+
+
+#ifdef _WIN64
+#include "dynasm/dasm_x86.h"
+#include "call_x64win.h"
+#elif defined __amd64__
+#include "dynasm/dasm_x86.h"
+#include "call_x64.h"
+#elif defined __arm__ || defined __arm || defined __ARM__ || defined __ARM || defined ARM || defined _ARM_ || defined ARMV4I || defined _M_ARM
+#include "dynasm/dasm_arm.h"
+#include "call_arm.h"
+#else
+#include "dynasm/dasm_x86.h"
+#include "call_x86.h"
+#endif
+
+struct jit_head {
+ size_t size;
+ int ref;
+ uint8_t jump[JUMP_SIZE];
+};
+
+#define LINKTABLE_MAX_SIZE (sizeof(extnames) / sizeof(extnames[0]) * (JUMP_SIZE))
+
+static cfunction compile(struct jit* jit, lua_State* L, cfunction func, int ref)
+{
+ struct jit_head* code;
+ size_t codesz;
+ int err;
+
+ dasm_checkstep(jit, -1);
+ if ((err = dasm_link(jit, &codesz)) != 0) {
+ char buf[32];
+ sprintf(buf, "%x", err);
+ luaL_error(L, "dasm_link error %s", buf);
+ }
+
+ codesz += sizeof(struct jit_head);
+ code = (struct jit_head*) reserve_code(jit, L, codesz);
+ code->ref = ref;
+ code->size = codesz;
+ compile_extern_jump(jit, L, func, code->jump);
+
+ if ((err = dasm_encode(jit, code+1)) != 0) {
+ char buf[32];
+ sprintf(buf, "%x", err);
+ commit_code(jit, code, 0);
+ luaL_error(L, "dasm_encode error %s", buf);
+ }
+
+ commit_code(jit, code, codesz);
+ return (cfunction) (code+1);
+}
+
+typedef uint8_t jump_t[JUMP_SIZE];
+
+int get_extern(struct jit* jit, uint8_t* addr, int idx, int type)
+{
+ struct page* page = jit->pages[jit->pagenum-1];
+ jump_t* jumps = (jump_t*) (page+1);
+ struct jit_head* h = (struct jit_head*) ((uint8_t*) page + page->off);
+ uint8_t* jmp;
+ ptrdiff_t off;
+
+ if (idx == jit->function_extern) {
+ jmp = h->jump;
+ } else {
+ jmp = jumps[idx];
+ }
+
+ /* compensate for room taken up for the offset so that we can work rip
+ * relative */
+ addr += BRANCH_OFF;
+
+ /* see if we can fit the offset in the branch displacement, if not use the
+ * jump instruction */
+ off = *(uint8_t**) jmp - addr;
+
+ if (MIN_BRANCH <= off && off <= MAX_BRANCH) {
+ return (int32_t) off;
+ } else {
+ return (int32_t)(jmp + sizeof(uint8_t*) - addr);
+ }
+}
+
+static void* reserve_code(struct jit* jit, lua_State* L, size_t sz)
+{
+ struct page* page;
+ size_t off = (jit->pagenum > 0) ? jit->pages[jit->pagenum-1]->off : 0;
+ size_t size = (jit->pagenum > 0) ? jit->pages[jit->pagenum-1]->size : 0;
+
+ if (off + sz >= size) {
+ int i;
+ uint8_t* pdata;
+ cfunction func;
+
+ /* need to create a new page */
+ jit->pages = (struct page**) realloc(jit->pages, (++jit->pagenum) * sizeof(jit->pages[0]));
+
+ size = ALIGN_UP(sz + LINKTABLE_MAX_SIZE + sizeof(struct page), jit->align_page_size);
+
+ page = (struct page*) AllocPage(size);
+ jit->pages[jit->pagenum-1] = page;
+ pdata = (uint8_t*) page;
+ page->size = size;
+ page->off = sizeof(struct page);
+
+ lua_newtable(L);
+
+#define ADDFUNC(DLL, NAME) \
+ lua_pushliteral(L, #NAME); \
+ func = DLL ? (cfunction) GetProcAddressA(DLL, #NAME) : NULL; \
+ func = func ? func : (cfunction) &NAME; \
+ lua_pushcfunction(L, (lua_CFunction) func); \
+ lua_rawset(L, -3)
+
+ ADDFUNC(NULL, check_double);
+ ADDFUNC(NULL, check_float);
+ ADDFUNC(NULL, check_uint64);
+ ADDFUNC(NULL, check_int64);
+ ADDFUNC(NULL, check_int32);
+ ADDFUNC(NULL, check_uint32);
+ ADDFUNC(NULL, check_uintptr);
+ ADDFUNC(NULL, check_enum);
+ ADDFUNC(NULL, check_typed_pointer);
+ ADDFUNC(NULL, check_typed_cfunction);
+ ADDFUNC(NULL, check_complex_double);
+ ADDFUNC(NULL, check_complex_float);
+ ADDFUNC(NULL, unpack_varargs_stack);
+ ADDFUNC(NULL, unpack_varargs_stack_skip);
+ ADDFUNC(NULL, unpack_varargs_reg);
+ ADDFUNC(NULL, unpack_varargs_float);
+ ADDFUNC(NULL, unpack_varargs_int);
+ ADDFUNC(NULL, push_cdata);
+ ADDFUNC(NULL, push_int);
+ ADDFUNC(NULL, push_uint);
+ ADDFUNC(NULL, lua_pushinteger);
+ ADDFUNC(NULL, push_float);
+ ADDFUNC(jit->kernel32_dll, SetLastError);
+ ADDFUNC(jit->kernel32_dll, GetLastError);
+ ADDFUNC(jit->lua_dll, luaL_error);
+ ADDFUNC(jit->lua_dll, lua_pushnumber);
+ ADDFUNC(jit->lua_dll, lua_pushboolean);
+ ADDFUNC(jit->lua_dll, lua_gettop);
+ ADDFUNC(jit->lua_dll, lua_rawgeti);
+ ADDFUNC(jit->lua_dll, lua_pushnil);
+ ADDFUNC(jit->lua_dll, lua_callk);
+ ADDFUNC(jit->lua_dll, lua_settop);
+ ADDFUNC(jit->lua_dll, lua_remove);
+#undef ADDFUNC
+
+ for (i = 0; extnames[i] != NULL; i++) {
+
+ if (strcmp(extnames[i], "FUNCTION") == 0) {
+ shred(pdata + page->off, 0, JUMP_SIZE);
+ jit->function_extern = i;
+
+ } else {
+ lua_getfield(L, -1, extnames[i]);
+ func = (cfunction) lua_tocfunction(L, -1);
+
+ if (func == NULL) {
+ luaL_error(L, "internal error: missing link for %s", extnames[i]);
+ }
+
+ compile_extern_jump(jit, L, func, pdata + page->off);
+ lua_pop(L, 1);
+ }
+
+ page->off += JUMP_SIZE;
+ }
+
+ page->freed = page->off;
+ lua_pop(L, 1);
+
+ } else {
+ page = jit->pages[jit->pagenum-1];
+ EnableWrite(page, page->size);
+ }
+
+ return (uint8_t*) page + page->off;
+}
+
+static void commit_code(struct jit* jit, void* code, size_t sz)
+{
+ struct page* page = jit->pages[jit->pagenum-1];
+ page->off += sz;
+ EnableExecute(page, page->size);
+ {
+#if 0
+ FILE* out = fopen("\\Hard Disk\\out.bin", "wb");
+ fwrite(page, page->off, 1, out);
+ fclose(out);
+#endif
+ }
+}
+
+/* push_func_ref pushes a copy of the upval table embedded in the compiled
+ * function func.
+ */
+void push_func_ref(lua_State* L, cfunction func)
+{
+ struct jit_head* h = ((struct jit_head*) func) - 1;
+ lua_rawgeti(L, LUA_REGISTRYINDEX, h->ref);
+}
+
+void free_code(struct jit* jit, lua_State* L, cfunction func)
+{
+ size_t i;
+ struct jit_head* h = ((struct jit_head*) func) - 1;
+ for (i = 0; i < jit->pagenum; i++) {
+ struct page* p = jit->pages[i];
+
+ if ((uint8_t*) h < (uint8_t*) p || (uint8_t*) p + p->size <= (uint8_t*) h) {
+ continue;
+ }
+
+ luaL_unref(L, LUA_REGISTRYINDEX, h->ref);
+
+ EnableWrite(p, p->size);
+ p->freed += h->size;
+
+ shred(h, 0, h->size);
+
+ if (p->freed < p->off) {
+ EnableExecute(p, p->size);
+ return;
+ }
+
+ FreePage(p, p->size);
+ memmove(&jit->pages[i], &jit->pages[i+1], (jit->pagenum - (i+1)) * sizeof(jit->pages[0]));
+ jit->pagenum--;
+ return;
+ }
+
+ assert(!"couldn't find func in the jit pages");
+}
+
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/call_arm.dasc b/Build/source/texk/web2c/luatexdir/luaffi/call_arm.dasc
new file mode 100644
index 00000000000..f85753255fb
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/call_arm.dasc
@@ -0,0 +1,610 @@
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+|.arch arm
+|.actionlist build_actionlist
+|.globalnames globnames
+|.externnames extnames
+
+#define JUMP_SIZE 8
+#define MIN_BRANCH ((INT32_MIN) >> 8)
+#define MAX_BRANCH ((INT32_MAX) >> 8)
+#define BRANCH_OFF 4
+
+static void compile_extern_jump(struct jit* jit, lua_State* L, cfunction func, uint8_t* code)
+{
+ /* The jump code is the function pointer followed by a stub to call the
+ * function pointer. The stub exists so we can jump to functions with an
+ * offset greater than 32MB.
+ *
+ * Note we have to manually set this up since there are commands buffered
+ * in the jit state.
+ */
+ *(cfunction*) code = func;
+ /* ldr pc, [pc - 12] */
+ *(uint32_t*) &code[4] = 0xE51FF00CU;
+}
+
+|.define TOP, r4
+|.define L_ARG, r5
+|.define DATA, r6
+|.define DATA2, r7
+
+|.macro load32, reg, val
+| ldr reg, [pc]
+| b >5
+|.long val
+|5:
+|.endmacro
+
+|.macro lcall, func
+| mov r0, L_ARG
+| bl func
+|.endmacro
+
+void compile_globals(struct jit* jit, lua_State* L)
+{
+ (void) jit;
+}
+
+cfunction compile_callback(lua_State* L, int fidx, int ct_usr, const struct ctype* ct)
+{
+ struct jit* Dst = get_jit(L);;
+ int i, nargs, num_upvals, ref;
+ const struct ctype* mt;
+
+ int top = lua_gettop(L);
+
+ ct_usr = lua_absindex(L, ct_usr);
+ fidx = lua_absindex(L, fidx);
+ nargs = (int) lua_rawlen(L, ct_usr);
+
+ dasm_setup(Dst, build_actionlist);
+
+ lua_newtable(L);
+ lua_pushvalue(L, -1);
+ ref = luaL_ref(L, LUA_REGISTRYINDEX);
+ num_upvals = 0;
+
+ if (ct->has_var_arg) {
+ luaL_error(L, "can't create callbacks with varargs");
+ }
+
+ /* prolog and get the upval table */
+ | mov r12, sp
+ | push {r0, r1, r2, r3} // do this first so that r0-r3 is right before stack bound arguments
+ | push {TOP, L_ARG, DATA, DATA2, r12, lr}
+ | sub DATA, r12, #16 // points to r0 on stack
+ | ldr L_ARG, [pc, #8]
+ | ldr r2, [pc, #8]
+ | ldr r1, [pc, #8]
+ | b >1
+ |.long L, ref, LUA_REGISTRYINDEX
+ |1:
+ | lcall extern lua_rawgeti
+
+ /* get the lua function */
+ lua_pushvalue(L, fidx);
+ lua_rawseti(L, -2, ++num_upvals);
+ | mov r2, #num_upvals
+ | mvn r1, #0 // -1
+ | lcall extern lua_rawgeti
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+
+ | mov r2, #num_upvals-1 // usr value
+ | mvn r1, #i // -i-1, stack is upval table, func, i-1 args
+ | lcall extern lua_rawgeti
+ | load32 r2, mt
+ | mvn r1, #0 // -1
+ | lcall extern push_cdata
+ | ldr r2, [DATA], #4
+ | str r2, [r0]
+ | mvn r1, #1 // -2
+ | lcall extern lua_remove // remove the usr value
+
+ } else {
+ switch (mt->type) {
+ case INT64_TYPE:
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ | lcall extern lua_pushnil
+ | load32 r2, mt
+ | mvn r1, #0 // -1
+ | lcall extern push_cdata
+ | ldr r2, [DATA], #4
+ | ldr r3, [DATA], #4
+ | str r2, [r0]
+ | str r3, [r0, #4]
+ | mvn r1, #1 // -2
+ | lcall extern lua_remove // remove the nil usr
+ break;
+
+ case INTPTR_TYPE:
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ | lcall extern lua_pushnil
+ | load32 r2, mt
+ | mvn r1, #0 // -1
+ | lcall extern push_cdata
+ | ldr r2, [DATA], #4
+ | str r2, [r0]
+ | mvn r1, #1 // -2
+ | lcall extern lua_remove // remove the nil usr
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ | ldr r1, [DATA], #4
+ | lcall extern lua_pushboolean
+ break;
+
+ case INT8_TYPE:
+ lua_pop(L, 1);
+ | ldr r1, [DATA], #4
+ | mov r1, r1, lsl #24
+ if (mt->is_unsigned) {
+ | mov r1, r1, lsr #24
+ } else {
+ | mov r1, r1, asr #24
+ }
+ | lcall extern push_int
+ break;
+
+ case INT16_TYPE:
+ lua_pop(L, 1);
+ | ldr r1, [DATA], #4
+ | mov r1, r1, lsl #16
+ if (mt->is_unsigned) {
+ | mov r1, r1, lsr #16
+ } else {
+ | mov r1, r1, asr #16
+ }
+ | lcall extern push_int
+ break;
+
+ case ENUM_TYPE:
+ case INT32_TYPE:
+ lua_pop(L, 1);
+ | ldr r1, [DATA], #4
+ | lcall extern push_int
+ break;
+
+ case FLOAT_TYPE:
+ lua_pop(L, 1);
+ | ldr r1, [DATA], #4
+ | lcall extern push_float
+ break;
+
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ | ldmia DATA!, {r1, r2}
+ | lcall extern lua_pushnumber
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback arg type");
+ }
+ }
+ }
+
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ | mov r3, #0
+ | mov r2, #((mt->pointers || mt->is_reference || mt->type != VOID_TYPE) ? 1 : 0)
+ | mov r1, #nargs
+ | lcall extern lua_callk
+
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+
+ | mov r2, #num_upvals-1 // usr value
+ | mvn r1, #1 // -2 stack is (upval table, ret val)
+ | lcall extern lua_rawgeti
+ | load32 r3, mt
+ | mov r2, #0 // -1 - ct_usr
+ | mvn r1, #1 // -2 - val
+ | lcall extern to_typed_pointer
+ | mov DATA, r0
+ | mvn r1, #3 // -4 - remove 3 (upval table, ret val, usr value)
+ | lcall extern lua_settop
+ | mov r0, DATA
+ } else {
+ switch (mt->type) {
+ case ENUM_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+
+ | mov r2, #num_upvals-1 // usr value
+ | mvn r1, #1 // -2 stack is (upval table, ret val)
+ | lcall extern lua_rawgeti
+ | load32 r3, mt
+ | mvn r2, #0 // -1 - ct_usr
+ | mvn r1, #1 // -2 - val
+ | lcall extern to_enum
+ | mov DATA, r0
+ | mvn r1, #3 // -4 - remove 3 (upval table, ret val, usr value)
+ | lcall extern lua_settop
+ | mov r0, DATA
+ break;
+
+ case VOID_TYPE:
+ | mvn r1, #1 // -2
+ | lcall extern lua_settop
+ lua_pop(L, 1);
+ break;
+
+ case BOOL_TYPE:
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ | mvn r1, #0 // -1
+ if (mt->is_unsigned) {
+ | lcall extern check_uint32
+ } else {
+ | lcall extern check_int32
+ }
+ goto single;
+
+ case INT64_TYPE:
+ | mvn r1, #0 // -1
+ if (mt->is_unsigned) {
+ | lcall extern check_uint64
+ } else {
+ | lcall extern check_int64
+ }
+ goto dual;
+
+ case INTPTR_TYPE:
+ | mvn r1, #0 // -1
+ | lcall extern check_intptr
+ goto single;
+
+ case FLOAT_TYPE:
+ | mvn r1, #0 // -1
+ | lcall extern check_float
+ goto single;
+
+ case DOUBLE_TYPE:
+ | mvn r1, #0 // -1
+ | lcall extern check_double
+ goto dual;
+
+ single:
+ | mov DATA, r0
+ | mvn r1, #2 // -3
+ | lcall extern lua_settop
+ | mov r0, DATA
+ lua_pop(L, 1);
+ break;
+
+ dual:
+ | mov DATA, r0
+ | mov DATA2, r1
+ | mvn r1, #2 // -3
+ | lcall extern lua_settop
+ | mov r0, DATA
+ | mov r1, DATA2
+ lua_pop(L, 1);
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback return type");
+ }
+ }
+
+ | ldmia sp, {TOP, L_ARG, DATA, DATA2, sp, pc}
+
+ lua_pop(L, 1); /* upval table - already in registry */
+ assert(lua_gettop(L) == top);
+
+ {
+ void* p;
+ struct ctype ft;
+ cfunction func;
+
+ func = compile(Dst, L, NULL, ref);
+
+ ft = *ct;
+ ft.is_jitted = 1;
+ p = push_cdata(L, ct_usr, &ft);
+ *(cfunction*) p = func;
+
+ assert(lua_gettop(L) == top + 1);
+
+ return func;
+ }
+}
+
+void compile_function(lua_State* L, cfunction func, int ct_usr, const struct ctype* ct)
+{
+ struct jit* Dst = get_jit(L);;
+ int i, nargs, num_upvals;
+ const struct ctype* mt;
+ void* p;
+
+ int top = lua_gettop(L);
+
+ ct_usr = lua_absindex(L, ct_usr);
+ nargs = (int) lua_rawlen(L, ct_usr);
+
+ p = push_cdata(L, ct_usr, ct);
+ *(cfunction*) p = func;
+ num_upvals = 1;
+
+ dasm_setup(Dst, build_actionlist);
+
+ | mov r12, sp
+ | push {r0}
+ | push {TOP, L_ARG, DATA, DATA2, r11, r12, lr}
+ | sub r11, r12, #4
+ | mov L_ARG, r0
+ | lcall extern lua_gettop
+ | mov TOP, r0
+ | cmp TOP, #nargs
+ | // these should really be in globals - but for some reason dynasm breaks when you do that
+ if (ct->has_var_arg) {
+ | bge >1
+ | load32 r1, "too few arguments"
+ | lcall extern luaL_error
+ |1:
+ } else {
+ | beq >1
+ | load32 r1, "incorrect number of arguments"
+ | lcall extern luaL_error
+ |1:
+ }
+
+ /* reserve enough stack space for all of the arguments (8 bytes per
+ * argument for double and maintains alignment). Add an extra 16 bytes so
+ * that the pop {r0, r1, r2, r3} doesn't clean out our stack frame */
+ | sub sp, sp, TOP, lsl #3
+ | sub sp, sp, #16
+ | mov DATA, sp
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference || mt->type == FUNCTION_PTR_TYPE || mt->type == ENUM_TYPE) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+
+ | ldr r3, [pc, #4]
+ | ldr r2, [pc, #4]
+ | b >1
+ |.long mt, lua_upvalueindex(num_upvals)
+ |1:
+ | mov r1, #i
+ | mov r0, L_ARG
+
+ if (mt->pointers || mt->is_reference) {
+ | bl extern to_typed_pointer
+ } else if (mt->type == FUNCTION_PTR_TYPE) {
+ | bl extern to_typed_function
+ } else if (mt->type == ENUM_TYPE) {
+ | bl extern to_enum
+ }
+
+ | str r0, [DATA], #4
+
+ } else {
+ lua_pop(L, 1);
+ | mov r1, #i
+
+ switch (mt->type) {
+ case INT8_TYPE:
+ | lcall extern check_int32
+ if (mt->is_unsigned) {
+ | and r0, r0, #0xFF
+ } else {
+ | mov r0, r0, lsl #24
+ | mov r0, r0, asr #24
+ }
+ | str r0, [DATA], #4
+ break;
+
+ case INT16_TYPE:
+ | lcall extern check_int32
+ if (mt->is_unsigned) {
+ | mov r0, r0, lsl #16
+ | mov r0, r0, lsr #16
+ } else {
+ | mov r0, r0, lsl #16
+ | mov r0, r0, asr #16
+ }
+ | str r0, [DATA], #4
+ break;
+
+ case INT32_TYPE:
+ if (mt->is_unsigned) {
+ | lcall extern check_uint32
+ } else {
+ | lcall extern check_int32
+ }
+ | str r0, [DATA], #4
+ break;
+
+ case INT64_TYPE:
+ if (mt->is_unsigned) {
+ | lcall extern check_uint64
+ } else {
+ | lcall extern check_int64
+ }
+ | str r0, [DATA], #4
+ | str r1, [DATA], #4
+ break;
+
+ case DOUBLE_TYPE:
+ | lcall extern check_double
+ | str r0, [DATA], #4
+ | str r1, [DATA], #4
+ break;
+
+ case INTPTR_TYPE:
+ | lcall extern check_intptr
+ | str r0, [DATA], #4
+ break;
+
+ case FLOAT_TYPE:
+ | lcall extern check_float
+ | str r0, [DATA], #4
+ break;
+
+ default:
+ luaL_error(L, "NYI: call arg type");
+ }
+ }
+ }
+
+ if (ct->has_var_arg) {
+ | mov r3, DATA
+ | mov r2, TOP
+ | mov r1, #nargs+1
+ | lcall extern unpack_varargs_stack
+ }
+
+ | load32 r0, &Dst->last_errno
+ | ldr r0, [r0]
+ | bl extern SetLastError
+
+ | pop {r0, r1, r2, r3} // this pop is balanced with the sub sp, #16
+ | bl extern FUNCTION
+
+ |.macro get_errno
+ | bl extern GetLastError
+ | load32 r1, &Dst->last_errno
+ | str r0, [r1]
+ |.endmacro
+
+ |.macro return
+ | ldmdb r11, {TOP, L_ARG, DATA, r11, sp, pc}
+ |.endmacro
+
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ | mov DATA, r0
+ | get_errno
+ | ldr r2, [pc, #4]
+ | ldr r1, [pc, #4]
+ | b >1
+ |.long mt, lua_upvalueindex(num_upvals)
+ |1:
+ | lcall extern push_cdata
+ | str DATA, [r0]
+ | mov r0, #1
+ | return
+
+ } else {
+ switch (mt->type) {
+ case INT64_TYPE:
+ num_upvals++;
+ | mov DATA, r0
+ | mov DATA2, r1
+ | get_errno
+ | lcall extern lua_pushnil
+ | load32 r2, mt
+ | mvn r1, #0 // -1
+ | lcall extern push_cdata
+ | str DATA, [r0]
+ | str DATA2, [r0, #4]
+ | mov r0, #1
+ | return
+ break;
+
+ case INTPTR_TYPE:
+ num_upvals++;
+ | mov DATA, r0
+ | get_errno
+ | lcall extern lua_pushnil
+ | load32 r2, mt
+ | mvn r1, #0 // -1
+ | lcall extern push_cdata
+ | str DATA, [r0]
+ | mov r0, #1
+ | return
+ break;
+
+ case VOID_TYPE:
+ lua_pop(L, 1);
+ | get_errno
+ | mov r0, #0
+ | return
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ | mov DATA, r0
+ | get_errno
+ | mov r1, DATA
+ | lcall extern lua_pushboolean
+ | mov r0, #1
+ | return
+ break;
+
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ lua_pop(L, 1);
+ | mov DATA, r0
+ | get_errno
+ | mov r1, DATA
+ if (mt->is_unsigned) {
+ | lcall extern push_uint
+ } else {
+ | lcall extern push_int
+ }
+ | mov r0, #1
+ | return
+ break;
+
+ case FLOAT_TYPE:
+ lua_pop(L, 1);
+ | mov DATA, r0
+ | get_errno
+ | mov r1, DATA
+ | lcall extern push_float
+ | mov r0, #1
+ | return
+ break;
+
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ | mov DATA, r0
+ | mov DATA2, r1
+ | get_errno
+ | mov r2, DATA2
+ | mov r1, DATA
+ | lcall extern lua_pushnumber
+ | mov r0, #1
+ | return
+ break;
+
+ default:
+ luaL_error(L, "NYI: call return type");
+ }
+ }
+
+ assert(lua_gettop(L) == top + num_upvals);
+ lua_pushcclosure(L, (lua_CFunction) compile(Dst, L, func, LUA_NOREF), num_upvals);
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/call_arm.h b/Build/source/texk/web2c/luatexdir/luaffi/call_arm.h
new file mode 100644
index 00000000000..efe7f9567e3
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/call_arm.h
@@ -0,0 +1,1013 @@
+/*
+** This file has been pre-processed with DynASM.
+** http://luajit.org/dynasm.html
+** DynASM version 1.3.0, DynASM arm version 1.3.0
+** DO NOT EDIT! The original file is in "call_arm.dasc".
+*/
+
+#if DASM_VERSION != 10300
+#error "Version mismatch between DynASM and included encoding engine"
+#endif
+
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+static const unsigned int build_actionlist[546] = {
+0xe1a0c00d,
+0xe92d000f,
+0xe92d50f0,
+0xe24c6010,
+0xe59f5008,
+0xe59f2008,
+0xe59f1008,
+0xea000000,
+0x00050001,
+0x00090000,
+0x00090000,
+0x00090000,
+0x0006000b,
+0xe1a00005,
+0xeb000000,
+0x00030000,
+0x00000000,
+0xe3a02000,
+0x000b0000,
+0xe3e01000,
+0xe1a00005,
+0xeb000000,
+0x00030000,
+0x00000000,
+0xe3a02000,
+0x000b0000,
+0xe3e01000,
+0x000b0000,
+0xe1a00005,
+0xeb000000,
+0x00030000,
+0xe59f2000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe3e01000,
+0xe1a00005,
+0xeb000000,
+0x00030001,
+0xe4962004,
+0xe5802000,
+0xe3e01001,
+0xe1a00005,
+0xeb000000,
+0x00030002,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x00030003,
+0xe59f2000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe3e01000,
+0xe1a00005,
+0xeb000000,
+0x00030001,
+0xe4962004,
+0xe4963004,
+0xe5802000,
+0xe5803004,
+0xe3e01001,
+0xe1a00005,
+0xeb000000,
+0x00030002,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x00030003,
+0xe59f2000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe3e01000,
+0xe1a00005,
+0xeb000000,
+0x00030001,
+0xe4962004,
+0xe5802000,
+0xe3e01001,
+0xe1a00005,
+0xeb000000,
+0x00030002,
+0x00000000,
+0xe4961004,
+0xe1a00005,
+0xeb000000,
+0x00030004,
+0x00000000,
+0xe4961004,
+0xe1a01c01,
+0x00000000,
+0xe1a01c21,
+0x00000000,
+0xe1a01c41,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x00030005,
+0x00000000,
+0xe4961004,
+0xe1a01801,
+0x00000000,
+0xe1a01821,
+0x00000000,
+0xe1a01841,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x00030005,
+0x00000000,
+0xe4961004,
+0xe1a00005,
+0xeb000000,
+0x00030005,
+0x00000000,
+0xe4961004,
+0xe1a00005,
+0xeb000000,
+0x00030006,
+0x00000000,
+0xe8b60006,
+0xe1a00005,
+0xeb000000,
+0x00030007,
+0x00000000,
+0xe3a03000,
+0xe3a02000,
+0x000b0000,
+0xe3a01000,
+0x000b0000,
+0xe1a00005,
+0xeb000000,
+0x00030008,
+0x00000000,
+0xe3a02000,
+0x000b0000,
+0xe3e01001,
+0xe1a00005,
+0xeb000000,
+0x00030000,
+0xe59f3000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe3a02000,
+0xe3e01001,
+0xe1a00005,
+0xeb000000,
+0x00030009,
+0xe1a06000,
+0xe3e01003,
+0xe1a00005,
+0xeb000000,
+0x0003000a,
+0xe1a00006,
+0x00000000,
+0xe3a02000,
+0x000b0000,
+0xe3e01001,
+0xe1a00005,
+0xeb000000,
+0x00030000,
+0xe59f3000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe3e02000,
+0xe3e01001,
+0xe1a00005,
+0xeb000000,
+0x0003000b,
+0xe1a06000,
+0xe3e01003,
+0xe1a00005,
+0xeb000000,
+0x0003000a,
+0xe1a00006,
+0x00000000,
+0xe3e01001,
+0xe1a00005,
+0xeb000000,
+0x0003000a,
+0x00000000,
+0xe3e01000,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x0003000c,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x0003000d,
+0x00000000,
+0xe3e01000,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x0003000e,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x0003000f,
+0x00000000,
+0xe3e01000,
+0xe1a00005,
+0xeb000000,
+0x00030010,
+0x00000000,
+0xe3e01000,
+0xe1a00005,
+0xeb000000,
+0x00030011,
+0x00000000,
+0xe3e01000,
+0xe1a00005,
+0xeb000000,
+0x00030012,
+0x00000000,
+0xe1a06000,
+0xe3e01002,
+0xe1a00005,
+0xeb000000,
+0x0003000a,
+0xe1a00006,
+0x00000000,
+0xe1a06000,
+0xe1a07001,
+0xe3e01002,
+0xe1a00005,
+0xeb000000,
+0x0003000a,
+0xe1a00006,
+0xe1a01007,
+0x00000000,
+0xe89da0f0,
+0x00000000,
+0xe1a0c00d,
+0xe92d0001,
+0xe92d58f0,
+0xe24cb004,
+0xe1a05000,
+0xe1a00005,
+0xeb000000,
+0x00030013,
+0xe1a04000,
+0xe3540000,
+0x000b0000,
+0x00000000,
+0xaa000000,
+0x00050001,
+0xe59f1000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe1a00005,
+0xeb000000,
+0x00030014,
+0x0006000b,
+0x00000000,
+0x0a000000,
+0x00050001,
+0xe59f1000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe1a00005,
+0xeb000000,
+0x00030014,
+0x0006000b,
+0x00000000,
+0xe04dd184,
+0xe24dd010,
+0xe1a0600d,
+0x00000000,
+0xe59f3004,
+0xe59f2004,
+0xea000000,
+0x00050001,
+0x00090000,
+0x00090000,
+0x0006000b,
+0xe3a01000,
+0x000b0000,
+0xe1a00005,
+0x00000000,
+0xeb000000,
+0x00030009,
+0x00000000,
+0xeb000000,
+0x00030015,
+0x00000000,
+0xeb000000,
+0x0003000b,
+0x00000000,
+0xe4860004,
+0x00000000,
+0xe3a01000,
+0x000b0000,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x0003000d,
+0x00000000,
+0xe20000ff,
+0x00000000,
+0xe1a00c00,
+0xe1a00c40,
+0x00000000,
+0xe4860004,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x0003000d,
+0x00000000,
+0xe1a00800,
+0xe1a00820,
+0x00000000,
+0xe1a00800,
+0xe1a00840,
+0x00000000,
+0xe4860004,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x0003000c,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x0003000d,
+0x00000000,
+0xe4860004,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x0003000e,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x0003000f,
+0x00000000,
+0xe4860004,
+0xe4861004,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x00030012,
+0xe4860004,
+0xe4861004,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x00030010,
+0xe4860004,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x00030011,
+0xe4860004,
+0x00000000,
+0xe1a03006,
+0xe1a02004,
+0xe3a01000,
+0x000b0000,
+0xe1a00005,
+0xeb000000,
+0x00030016,
+0x00000000,
+0xe59f0000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe5900000,
+0xeb000000,
+0x00030017,
+0x00000000,
+0xe8bd000f,
+0xeb000000,
+0x00030018,
+0x00000000,
+0xe1a06000,
+0xeb000000,
+0x00030019,
+0xe59f1000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe5810000,
+0xe59f2004,
+0xe59f1004,
+0xea000000,
+0x00050001,
+0x00090000,
+0x00090000,
+0x0006000b,
+0xe1a00005,
+0xeb000000,
+0x00030001,
+0xe5806000,
+0xe3a00001,
+0xe91ba870,
+0x00000000,
+0xe1a06000,
+0xe1a07001,
+0xeb000000,
+0x00030019,
+0xe59f1000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe5810000,
+0xe1a00005,
+0xeb000000,
+0x00030003,
+0xe59f2000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe3e01000,
+0xe1a00005,
+0xeb000000,
+0x00030001,
+0xe5806000,
+0xe5807004,
+0xe3a00001,
+0xe91ba870,
+0x00000000,
+0xe1a06000,
+0xeb000000,
+0x00030019,
+0xe59f1000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe5810000,
+0xe1a00005,
+0xeb000000,
+0x00030003,
+0xe59f2000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe3e01000,
+0xe1a00005,
+0xeb000000,
+0x00030001,
+0xe5806000,
+0xe3a00001,
+0xe91ba870,
+0x00000000,
+0xeb000000,
+0x00030019,
+0xe59f1000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe5810000,
+0xe3a00000,
+0xe91ba870,
+0x00000000,
+0xe1a06000,
+0xeb000000,
+0x00030019,
+0xe59f1000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe5810000,
+0xe1a01006,
+0xe1a00005,
+0xeb000000,
+0x00030004,
+0xe3a00001,
+0xe91ba870,
+0x00000000,
+0xe1a06000,
+0xeb000000,
+0x00030019,
+0xe59f1000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe5810000,
+0xe1a01006,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x0003001a,
+0x00000000,
+0xe1a00005,
+0xeb000000,
+0x00030005,
+0x00000000,
+0xe3a00001,
+0xe91ba870,
+0x00000000,
+0xe1a06000,
+0xeb000000,
+0x00030019,
+0xe59f1000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe5810000,
+0xe1a01006,
+0xe1a00005,
+0xeb000000,
+0x00030006,
+0xe3a00001,
+0xe91ba870,
+0x00000000,
+0xe1a06000,
+0xe1a07001,
+0xeb000000,
+0x00030019,
+0xe59f1000,
+0xea000000,
+0x00050005,
+0x00090000,
+0x0006000f,
+0xe5810000,
+0xe1a02007,
+0xe1a01006,
+0xe1a00005,
+0xeb000000,
+0x00030007,
+0xe3a00001,
+0xe91ba870,
+0x00000000
+};
+
+static const char *const globnames[] = {
+ (const char *)0
+};
+static const char *const extnames[] = {
+ "lua_rawgeti",
+ "push_cdata",
+ "lua_remove",
+ "lua_pushnil",
+ "lua_pushboolean",
+ "push_int",
+ "push_float",
+ "lua_pushnumber",
+ "lua_callk",
+ "to_typed_pointer",
+ "lua_settop",
+ "to_enum",
+ "check_uint32",
+ "check_int32",
+ "check_uint64",
+ "check_int64",
+ "check_intptr",
+ "check_float",
+ "check_double",
+ "lua_gettop",
+ "luaL_error",
+ "to_typed_function",
+ "unpack_varargs_stack",
+ "SetLastError",
+ "FUNCTION",
+ "GetLastError",
+ "push_uint",
+ (const char *)0
+};
+
+#define JUMP_SIZE 8
+#define MIN_BRANCH ((INT32_MIN) >> 8)
+#define MAX_BRANCH ((INT32_MAX) >> 8)
+#define BRANCH_OFF 4
+
+static void compile_extern_jump(struct jit* jit, lua_State* L, cfunction func, uint8_t* code)
+{
+ /* The jump code is the function pointer followed by a stub to call the
+ * function pointer. The stub exists so we can jump to functions with an
+ * offset greater than 32MB.
+ *
+ * Note we have to manually set this up since there are commands buffered
+ * in the jit state.
+ */
+ *(cfunction*) code = func;
+ /* ldr pc, [pc - 12] */
+ *(uint32_t*) &code[4] = 0xE51FF00CU;
+}
+
+
+
+
+void compile_globals(struct jit* jit, lua_State* L)
+{
+ (void) jit;
+}
+
+cfunction compile_callback(lua_State* L, int fidx, int ct_usr, const struct ctype* ct)
+{
+ struct jit* Dst = get_jit(L);;
+ int i, nargs, num_upvals, ref;
+ const struct ctype* mt;
+
+ int top = lua_gettop(L);
+
+ ct_usr = lua_absindex(L, ct_usr);
+ fidx = lua_absindex(L, fidx);
+ nargs = (int) lua_rawlen(L, ct_usr);
+
+ dasm_setup(Dst, build_actionlist);
+
+ lua_newtable(L);
+ lua_pushvalue(L, -1);
+ ref = luaL_ref(L, LUA_REGISTRYINDEX);
+ num_upvals = 0;
+
+ if (ct->has_var_arg) {
+ luaL_error(L, "can't create callbacks with varargs");
+ }
+
+ /* prolog and get the upval table */
+ dasm_put(Dst, 0, (uintptr_t)(L), (uintptr_t)(ref), (uintptr_t)(LUA_REGISTRYINDEX));
+
+ /* get the lua function */
+ lua_pushvalue(L, fidx);
+ lua_rawseti(L, -2, ++num_upvals);
+ dasm_put(Dst, 17, num_upvals);
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+
+ dasm_put(Dst, 24, num_upvals-1, i, (uintptr_t)(mt));
+
+ } else {
+ switch (mt->type) {
+ case INT64_TYPE:
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ dasm_put(Dst, 47, (uintptr_t)(mt));
+ break;
+
+ case INTPTR_TYPE:
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ dasm_put(Dst, 68, (uintptr_t)(mt));
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 87);
+ break;
+
+ case INT8_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 92);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 95);
+ } else {
+ dasm_put(Dst, 97);
+ }
+ dasm_put(Dst, 99);
+ break;
+
+ case INT16_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 103);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 106);
+ } else {
+ dasm_put(Dst, 108);
+ }
+ dasm_put(Dst, 110);
+ break;
+
+ case ENUM_TYPE:
+ case INT32_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 114);
+ break;
+
+ case FLOAT_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 119);
+ break;
+
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 124);
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback arg type");
+ }
+ }
+ }
+
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ dasm_put(Dst, 129, ((mt->pointers || mt->is_reference || mt->type != VOID_TYPE) ? 1 : 0), nargs);
+
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+
+ dasm_put(Dst, 138, num_upvals-1, (uintptr_t)(mt));
+ } else {
+ switch (mt->type) {
+ case ENUM_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+
+ dasm_put(Dst, 161, num_upvals-1, (uintptr_t)(mt));
+ break;
+
+ case VOID_TYPE:
+ dasm_put(Dst, 184);
+ lua_pop(L, 1);
+ break;
+
+ case BOOL_TYPE:
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ dasm_put(Dst, 189);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 191);
+ } else {
+ dasm_put(Dst, 195);
+ }
+ goto single;
+
+ case INT64_TYPE:
+ dasm_put(Dst, 199);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 201);
+ } else {
+ dasm_put(Dst, 205);
+ }
+ goto dual;
+
+ case INTPTR_TYPE:
+ dasm_put(Dst, 209);
+ goto single;
+
+ case FLOAT_TYPE:
+ dasm_put(Dst, 214);
+ goto single;
+
+ case DOUBLE_TYPE:
+ dasm_put(Dst, 219);
+ goto dual;
+
+ single:
+ dasm_put(Dst, 224);
+ lua_pop(L, 1);
+ break;
+
+ dual:
+ dasm_put(Dst, 231);
+ lua_pop(L, 1);
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback return type");
+ }
+ }
+
+ dasm_put(Dst, 240);
+
+ lua_pop(L, 1); /* upval table - already in registry */
+ assert(lua_gettop(L) == top);
+
+ {
+ void* p;
+ struct ctype ft;
+ cfunction func;
+
+ func = compile(Dst, L, NULL, ref);
+
+ ft = *ct;
+ ft.is_jitted = 1;
+ p = push_cdata(L, ct_usr, &ft);
+ *(cfunction*) p = func;
+
+ assert(lua_gettop(L) == top + 1);
+
+ return func;
+ }
+}
+
+void compile_function(lua_State* L, cfunction func, int ct_usr, const struct ctype* ct)
+{
+ struct jit* Dst = get_jit(L);;
+ int i, nargs, num_upvals;
+ const struct ctype* mt;
+ void* p;
+
+ int top = lua_gettop(L);
+
+ ct_usr = lua_absindex(L, ct_usr);
+ nargs = (int) lua_rawlen(L, ct_usr);
+
+ p = push_cdata(L, ct_usr, ct);
+ *(cfunction*) p = func;
+ num_upvals = 1;
+
+ dasm_setup(Dst, build_actionlist);
+
+ dasm_put(Dst, 242, nargs);
+ if (ct->has_var_arg) {
+ dasm_put(Dst, 254, (uintptr_t)("too few arguments"));
+ } else {
+ dasm_put(Dst, 266, (uintptr_t)("incorrect number of arguments"));
+ }
+
+ /* reserve enough stack space for all of the arguments (8 bytes per
+ * argument for double and maintains alignment). Add an extra 16 bytes so
+ * that the pop {r0, r1, r2, r3} doesn't clean out our stack frame */
+ dasm_put(Dst, 278);
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference || mt->type == FUNCTION_PTR_TYPE || mt->type == ENUM_TYPE) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+
+ dasm_put(Dst, 282, (uintptr_t)(mt), (uintptr_t)(lua_upvalueindex(num_upvals)), i);
+
+ if (mt->pointers || mt->is_reference) {
+ dasm_put(Dst, 293);
+ } else if (mt->type == FUNCTION_PTR_TYPE) {
+ dasm_put(Dst, 296);
+ } else if (mt->type == ENUM_TYPE) {
+ dasm_put(Dst, 299);
+ }
+
+ dasm_put(Dst, 302);
+
+ } else {
+ lua_pop(L, 1);
+ dasm_put(Dst, 304, i);
+
+ switch (mt->type) {
+ case INT8_TYPE:
+ dasm_put(Dst, 307);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 311);
+ } else {
+ dasm_put(Dst, 313);
+ }
+ dasm_put(Dst, 316);
+ break;
+
+ case INT16_TYPE:
+ dasm_put(Dst, 318);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 322);
+ } else {
+ dasm_put(Dst, 325);
+ }
+ dasm_put(Dst, 328);
+ break;
+
+ case INT32_TYPE:
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 330);
+ } else {
+ dasm_put(Dst, 334);
+ }
+ dasm_put(Dst, 338);
+ break;
+
+ case INT64_TYPE:
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 340);
+ } else {
+ dasm_put(Dst, 344);
+ }
+ dasm_put(Dst, 348);
+ break;
+
+ case DOUBLE_TYPE:
+ dasm_put(Dst, 351);
+ break;
+
+ case INTPTR_TYPE:
+ dasm_put(Dst, 357);
+ break;
+
+ case FLOAT_TYPE:
+ dasm_put(Dst, 362);
+ break;
+
+ default:
+ luaL_error(L, "NYI: call arg type");
+ }
+ }
+ }
+
+ if (ct->has_var_arg) {
+ dasm_put(Dst, 367, nargs+1);
+ }
+
+ dasm_put(Dst, 375, (uintptr_t)(&Dst->last_errno));
+
+ dasm_put(Dst, 384);
+
+
+
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 388, (uintptr_t)(&Dst->last_errno), (uintptr_t)(mt), (uintptr_t)(lua_upvalueindex(num_upvals)));
+
+ } else {
+ switch (mt->type) {
+ case INT64_TYPE:
+ num_upvals++;
+ dasm_put(Dst, 411, (uintptr_t)(&Dst->last_errno), (uintptr_t)(mt));
+ break;
+
+ case INTPTR_TYPE:
+ num_upvals++;
+ dasm_put(Dst, 438, (uintptr_t)(&Dst->last_errno), (uintptr_t)(mt));
+ break;
+
+ case VOID_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 463, (uintptr_t)(&Dst->last_errno));
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 474, (uintptr_t)(&Dst->last_errno));
+ break;
+
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 490, (uintptr_t)(&Dst->last_errno));
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 501);
+ } else {
+ dasm_put(Dst, 505);
+ }
+ dasm_put(Dst, 509);
+ break;
+
+ case FLOAT_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 512, (uintptr_t)(&Dst->last_errno));
+ break;
+
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 528, (uintptr_t)(&Dst->last_errno));
+ break;
+
+ default:
+ luaL_error(L, "NYI: call return type");
+ }
+ }
+
+ assert(lua_gettop(L) == top + num_upvals);
+ lua_pushcclosure(L, (lua_CFunction) compile(Dst, L, func, LUA_NOREF), num_upvals);
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/call_x64.h b/Build/source/texk/web2c/luatexdir/luaffi/call_x64.h
new file mode 100644
index 00000000000..5cf89a0fc03
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/call_x64.h
@@ -0,0 +1,1204 @@
+/*
+** This file has been pre-processed with DynASM.
+** http://luajit.org/dynasm.html
+** DynASM version 1.3.0, DynASM x64 version 1.3.0
+** DO NOT EDIT! The original file is in "call_x86.dasc".
+*/
+
+#if DASM_VERSION != 10300
+#error "Version mismatch between DynASM and included encoding engine"
+#endif
+
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+static const unsigned char build_actionlist[2157] = {
+ 72,139,141,233,255,72,137,132,253,36,233,255,221,133,233,255,217,133,233,
+ 255,252,243,15,126,133,233,255,252,243,15,90,133,233,255,221,156,253,36,233,
+ 255,217,156,253,36,233,255,102,15,214,132,253,36,233,255,252,242,15,90,192,
+ 102,15,214,132,253,36,233,255,252,242,15,90,192,102,15,126,132,253,36,233,
+ 255,85,72,137,229,65,84,72,129,252,236,239,102,15,214,69,252,240,102,15,214,
+ 77,232,102,15,214,85,224,102,15,214,93,216,102,15,214,101,208,102,15,214,
+ 109,200,102,15,214,117,192,102,15,214,125,184,72,137,125,176,72,137,117,168,
+ 72,137,85,160,72,137,77,152,76,137,69,144,76,137,77,136,255,73,188,237,237,
+ 255,72,199,194,237,72,199,198,237,76,137,231,232,251,1,0,255,72,199,194,237,
+ 72,199,198,252,255,252,255,252,255,252,255,76,137,231,232,251,1,0,255,72,
+ 199,194,237,72,199,198,237,76,137,231,232,251,1,0,72,186,237,237,72,199,198,
+ 252,255,252,255,252,255,252,255,76,137,231,232,251,1,1,255,72,137,8,72,199,
+ 198,252,254,252,255,252,255,252,255,76,137,231,232,251,1,2,255,72,186,237,
+ 237,72,199,198,0,0,0,0,76,137,231,232,251,1,1,255,72,137,8,255,102,15,214,
+ 0,255,217,24,255,217,88,4,255,102,15,214,64,8,255,76,137,231,232,251,1,3,
+ 255,15,182,201,72,137,206,76,137,231,232,251,1,4,255,15,182,201,255,15,190,
+ 201,255,72,137,206,76,137,231,232,251,1,5,255,15,183,201,255,15,191,201,255,
+ 72,137,206,76,137,231,232,251,1,6,255,72,185,237,237,72,199,194,237,72,199,
+ 198,237,76,137,231,232,251,1,7,255,72,199,194,237,72,199,198,252,254,252,
+ 255,252,255,252,255,76,137,231,232,251,1,0,72,185,237,237,72,199,194,252,
+ 255,252,255,252,255,252,255,72,199,198,252,254,252,255,252,255,252,255,76,
+ 137,231,232,251,1,8,72,137,68,36,32,72,199,198,252,252,252,255,252,255,252,
+ 255,76,137,231,232,251,1,9,72,139,68,36,32,255,72,199,194,237,72,199,198,
+ 252,254,252,255,252,255,252,255,76,137,231,232,251,1,0,72,185,237,237,72,
+ 199,194,252,255,252,255,252,255,252,255,72,199,198,252,254,252,255,252,255,
+ 252,255,76,137,231,232,251,1,10,137,68,36,32,72,199,198,252,252,252,255,252,
+ 255,252,255,76,137,231,232,251,1,9,139,68,36,32,255,72,199,198,252,254,252,
+ 255,252,255,252,255,76,137,231,232,251,1,9,255,72,199,198,252,255,252,255,
+ 252,255,252,255,76,137,231,232,251,1,11,255,72,199,198,252,255,252,255,252,
+ 255,252,255,76,137,231,232,251,1,12,255,137,68,36,32,72,199,198,252,253,252,
+ 255,252,255,252,255,76,137,231,232,251,1,9,139,68,36,32,255,72,199,198,252,
+ 255,252,255,252,255,252,255,76,137,231,232,251,1,13,255,72,199,198,252,255,
+ 252,255,252,255,252,255,76,137,231,232,251,1,14,255,72,137,68,36,32,72,199,
+ 198,252,253,252,255,252,255,252,255,76,137,231,232,251,1,9,72,139,68,36,32,
+ 255,72,199,198,252,255,252,255,252,255,252,255,76,137,231,232,251,1,15,72,
+ 137,68,36,32,72,199,198,252,253,252,255,252,255,252,255,76,137,231,232,251,
+ 1,9,72,139,68,36,32,255,72,199,198,252,255,252,255,252,255,252,255,76,137,
+ 231,232,251,1,16,102,15,214,68,36,32,72,199,198,252,253,252,255,252,255,252,
+ 255,76,137,231,232,251,1,9,255,252,242,15,90,68,36,32,255,252,243,15,126,
+ 68,36,32,255,72,199,198,252,255,252,255,252,255,252,255,76,137,231,232,251,
+ 1,17,102,15,214,68,36,32,72,199,198,252,253,252,255,252,255,252,255,76,137,
+ 231,232,251,1,9,252,243,15,126,68,36,32,255,72,199,198,252,255,252,255,252,
+ 255,252,255,76,137,231,232,251,1,18,102,15,214,68,36,32,102,15,214,76,36,
+ 40,72,199,198,252,253,252,255,252,255,252,255,76,137,231,232,251,1,9,252,
+ 243,15,126,68,36,32,252,243,15,126,76,36,40,255,72,139,141,233,72,199,194,
+ 252,255,252,255,252,255,252,255,76,137,230,72,137,207,232,251,1,18,72,131,
+ 252,236,4,72,199,198,252,253,252,255,252,255,252,255,76,137,231,232,251,1,
+ 9,255,76,139,101,252,248,72,137,252,236,93,194,236,255,85,72,137,229,65,84,
+ 65,85,73,137,252,252,76,137,231,232,251,1,19,73,137,197,72,129,252,248,239,
+ 255,15,141,244,248,102,184,0,0,72,190,237,237,76,137,231,232,251,1,20,248,
+ 2,15,142,244,247,102,184,0,0,72,190,237,237,76,137,231,232,251,1,20,255,15,
+ 141,244,247,102,184,0,0,72,190,237,237,76,137,231,232,251,1,20,255,248,1,
+ 255,72,193,224,4,72,41,196,72,129,252,236,239,255,72,186,237,237,72,199,198,
+ 0,0,0,0,76,137,231,232,251,1,1,72,131,252,236,16,255,72,185,237,237,72,199,
+ 194,237,72,199,198,237,76,137,231,232,251,1,8,255,72,185,237,237,72,199,194,
+ 237,72,199,198,237,76,137,231,232,251,1,21,255,72,185,237,237,72,199,194,
+ 237,72,199,198,237,76,137,231,232,251,1,10,255,72,199,198,237,76,137,231,
+ 232,251,1,12,255,15,182,192,255,15,190,192,255,15,183,192,255,15,191,192,
+ 255,72,199,198,237,76,137,231,232,251,1,12,131,252,248,0,15,149,208,15,182,
+ 192,255,72,199,198,237,76,137,231,232,251,1,11,255,72,199,198,237,76,137,
+ 231,232,251,1,15,255,72,199,198,237,76,137,231,232,251,1,13,255,72,199,198,
+ 237,76,137,231,232,251,1,14,255,72,199,198,237,76,137,231,232,251,1,16,255,
+ 72,199,198,237,76,137,231,232,251,1,18,255,252,243,15,126,193,255,72,141,
+ 132,253,36,233,72,131,252,236,4,72,199,194,237,76,137,230,72,137,199,232,
+ 251,1,18,255,72,199,198,237,76,137,231,232,251,1,17,255,72,199,198,237,76,
+ 137,231,232,251,1,17,137,4,36,217,4,36,255,137,20,36,217,4,36,255,72,137,
+ 224,72,129,192,239,73,137,192,72,199,193,237,76,137,252,234,72,199,198,237,
+ 76,137,231,232,251,1,22,255,72,137,224,72,129,192,239,73,137,192,72,199,193,
+ 237,76,137,252,234,72,199,198,237,76,137,231,232,251,1,23,255,72,137,224,
+ 72,129,192,239,73,137,193,73,199,192,237,72,199,193,237,76,137,252,234,72,
+ 199,198,237,76,137,231,232,251,1,24,255,72,185,237,237,139,1,72,137,199,232,
+ 251,1,25,255,72,131,196,32,255,252,243,15,126,188,253,36,233,255,252,243,
+ 15,126,180,253,36,233,255,252,243,15,126,172,253,36,233,255,252,243,15,126,
+ 164,253,36,233,255,252,243,15,126,156,253,36,233,255,252,243,15,126,148,253,
+ 36,233,255,252,243,15,126,140,253,36,233,255,252,243,15,126,132,253,36,233,
+ 255,76,139,140,253,36,233,255,76,139,132,253,36,233,255,72,139,140,253,36,
+ 233,255,72,139,148,253,36,233,255,72,139,180,253,36,233,255,72,139,60,36,
+ 255,72,129,196,239,255,176,8,255,232,251,1,26,72,131,252,236,48,255,72,137,
+ 68,36,32,232,251,1,27,72,185,237,237,137,1,72,186,237,237,72,199,198,237,
+ 76,137,231,232,251,1,1,72,139,76,36,32,72,137,8,184,1,0,0,0,76,139,109,252,
+ 240,76,139,101,252,248,72,137,252,236,93,195,255,72,137,68,36,32,232,251,
+ 1,27,72,185,237,237,137,1,72,139,68,36,32,72,137,198,76,137,231,232,251,1,
+ 28,184,1,0,0,0,76,139,109,252,240,76,139,101,252,248,72,137,252,236,93,195,
+ 255,72,137,68,36,32,232,251,1,27,72,185,237,237,137,1,72,186,237,237,72,199,
+ 198,0,0,0,0,76,137,231,232,251,1,1,72,139,76,36,32,72,137,8,184,1,0,0,0,76,
+ 139,109,252,240,76,139,101,252,248,72,137,252,236,93,195,255,102,15,214,68,
+ 36,32,232,251,1,27,72,185,237,237,137,1,72,186,237,237,72,199,198,237,76,
+ 137,231,232,251,1,1,72,139,76,36,32,72,137,8,184,1,0,0,0,76,139,109,252,240,
+ 76,139,101,252,248,72,137,252,236,93,195,255,102,15,214,76,36,40,102,15,214,
+ 68,36,32,232,251,1,27,72,185,237,237,137,1,72,186,237,237,72,199,198,237,
+ 76,137,231,232,251,1,1,72,139,76,36,40,72,137,72,8,72,139,76,36,32,72,137,
+ 8,184,1,0,0,0,76,139,109,252,240,76,139,101,252,248,72,137,252,236,93,195,
+ 255,232,251,1,27,72,185,237,237,137,1,184,0,0,0,0,76,139,109,252,240,76,139,
+ 101,252,248,72,137,252,236,93,195,255,15,182,192,137,68,36,32,232,251,1,27,
+ 72,185,237,237,137,1,139,68,36,32,72,137,198,76,137,231,232,251,1,4,184,1,
+ 0,0,0,76,139,109,252,240,76,139,101,252,248,72,137,252,236,93,195,255,137,
+ 68,36,32,232,251,1,27,72,185,237,237,137,1,139,68,36,32,72,137,198,76,137,
+ 231,232,251,1,5,184,1,0,0,0,76,139,109,252,240,76,139,101,252,248,72,137,
+ 252,236,93,195,255,137,68,36,32,232,251,1,27,72,185,237,237,137,1,139,68,
+ 36,32,72,137,198,76,137,231,232,251,1,6,184,1,0,0,0,76,139,109,252,240,76,
+ 139,101,252,248,72,137,252,236,93,195,255,252,243,15,90,192,102,15,214,68,
+ 36,32,232,251,1,27,72,185,237,237,137,1,252,243,15,126,68,36,32,76,137,231,
+ 232,251,1,3,184,1,0,0,0,76,139,109,252,240,76,139,101,252,248,72,137,252,
+ 236,93,195,255
+};
+
+static const char *const globnames[] = {
+ (const char *)0
+};
+static const char *const extnames[] = {
+ "lua_rawgeti",
+ "push_cdata",
+ "lua_remove",
+ "lua_pushnumber",
+ "lua_pushboolean",
+ "push_int",
+ "push_uint",
+ "lua_callk",
+ "check_typed_pointer",
+ "lua_settop",
+ "check_enum",
+ "check_uint32",
+ "check_int32",
+ "check_uint64",
+ "check_int64",
+ "check_uintptr",
+ "check_double",
+ "check_complex_float",
+ "check_complex_double",
+ "lua_gettop",
+ "luaL_error",
+ "check_typed_cfunction",
+ "unpack_varargs_float",
+ "unpack_varargs_int",
+ "unpack_varargs_stack_skip",
+ "SetLastError",
+ "FUNCTION",
+ "GetLastError",
+ "lua_pushinteger",
+ (const char *)0
+};
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#if defined _WIN64 || defined __amd64__
+#define JUMP_SIZE 14
+#else
+#define JUMP_SIZE 4
+#endif
+
+#define MIN_BRANCH INT32_MIN
+#define MAX_BRANCH INT32_MAX
+#define BRANCH_OFF 4
+
+static void compile_extern_jump(struct jit* jit, lua_State* L, cfunction func, uint8_t* code)
+{
+ /* The jump code is the function pointer followed by a stub to call the
+ * function pointer. The stub exists in 64 bit so we can jump to functions
+ * with an offset greater than 2 GB.
+ *
+ * Note we have to manually set this up since there are commands buffered
+ * in the jit state and dynasm doesn't support rip relative addressing.
+ *
+ * eg on 64 bit:
+ * 0-8: function ptr
+ * 8-14: jmp aword [rip-14]
+ *
+ * for 32 bit we only set the function ptr as it can always fit in a 32
+ * bit displacement
+ */
+#if defined _WIN64 || defined __amd64__
+ *(cfunction*) code = func;
+ code[8] = 0xFF; /* FF /4 operand for jmp */
+ code[9] = 0x25; /* RIP displacement */
+ *(int32_t*) &code[10] = -14;
+#else
+ *(cfunction*) code = func;
+#endif
+}
+
+void compile_globals(struct jit* jit, lua_State* L)
+{
+ struct jit* Dst = jit;
+ int* perr = &jit->last_errno;
+ dasm_setup(Dst, build_actionlist);
+
+ /* Note: since the return code uses EBP to reset the stack pointer, we
+ * don't have to track the amount of stack space used. It also means we
+ * can handle stdcall and cdecl with the same code.
+ */
+
+ /* Note the various call_* functions want 32 bytes of 16 byte aligned
+ * stack
+ */
+
+ compile(Dst, L, NULL, LUA_NOREF);
+}
+
+int x86_return_size(lua_State* L, int usr, const struct ctype* ct)
+{
+ int ret = 0;
+ const struct ctype* mt;
+
+ if (ct->calling_convention != C_CALL) {
+ size_t i;
+ size_t argn = lua_rawlen(L, usr);
+ for (i = 1; i <= argn; i++) {
+ lua_rawgeti(L, usr, (int) i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ ret += sizeof(void*);
+ } else {
+ switch (mt->type) {
+ case DOUBLE_TYPE:
+ case COMPLEX_FLOAT_TYPE:
+ case INT64_TYPE:
+ ret += 8;
+ break;
+ case COMPLEX_DOUBLE_TYPE:
+ ret += 16;
+ break;
+ case INTPTR_TYPE:
+ ret += sizeof(intptr_t);
+ break;
+ case FUNCTION_PTR_TYPE:
+ ret += sizeof(cfunction);
+ break;
+ case BOOL_TYPE:
+ case FLOAT_TYPE:
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ ret += 4;
+ break;
+ default:
+ return luaL_error(L, "NYI - argument type");
+ }
+ }
+
+ lua_pop(L, 1);
+ }
+ }
+
+#if !defined _WIN64 && !defined __amd64__
+ lua_rawgeti(L, usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mt->pointers && !mt->is_reference && mt->type == COMPLEX_DOUBLE_TYPE) {
+ ret += sizeof(void*);
+ }
+ lua_pop(L, 1);
+#endif
+
+ return ret;
+}
+
+#ifdef _WIN64
+#define MAX_REGISTERS(ct) 4 /* rcx, rdx, r8, r9 */
+
+#elif defined __amd64__
+#define MAX_INT_REGISTERS(ct) 6 /* rdi, rsi, rdx, rcx, r8, r9 */
+#define MAX_FLOAT_REGISTERS(ct) 8 /* xmm0-7 */
+
+#else
+#define MAX_INT_REGISTERS(ct) ((ct)->calling_convention == FAST_CALL ? 2 /* ecx, edx */ : 0)
+#define MAX_FLOAT_REGISTERS(ct) 0
+#endif
+
+struct reg_alloc {
+#ifdef _WIN64
+ int regs;
+ int is_float[4];
+ int is_int[4];
+#else
+ int floats;
+ int ints;
+#endif
+ int off;
+};
+
+#ifdef _WIN64
+#define REGISTER_STACK_SPACE(ct) (4*8)
+#elif defined __amd64__
+#define REGISTER_STACK_SPACE(ct) (14*8)
+#else
+#define REGISTER_STACK_SPACE(ct) ALIGN_UP(((ct)->calling_convention == FAST_CALL ? 2*4 : 0), 15)
+#endif
+
+/* Fastcall:
+ * Uses ecx, edx as first two int registers
+ * Everything else on stack (include 64bit ints)
+ * No overflow stack space
+ * Pops the stack before returning
+ * Returns int in eax, float in ST0
+ * We use the same register allocation logic as posix x64 with 2 int regs and 0 float regs
+ */
+
+static void get_int(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_int64)
+{
+ /* grab the register from the shadow space */
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ dasm_put(Dst, 0, 16 + 8*reg->regs);
+ reg->regs++;
+ }
+#elif __amd64__
+ if (reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 0, - 80 - 8*reg->ints);
+ reg->ints++;
+ }
+#else
+ if (!is_int64 && reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 1, - 8 - 4*reg->ints);
+ reg->ints++;
+ }
+#endif
+ else if (is_int64) {
+ dasm_put(Dst, 0, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 1, reg->off);
+ reg->off += 4;
+ }
+}
+
+static void add_int(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_int64)
+{
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ dasm_put(Dst, 5, 32 + 8*(reg->regs));
+ reg->is_int[reg->regs++] = 1;
+ }
+#elif __amd64__
+ if (reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 5, 32 + 8*reg->ints);
+ reg->ints++;
+ }
+#else
+ if (!is_int64 && reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 5, 32 + 4*reg->ints);
+ reg->ints++;
+ }
+#endif
+ else {
+#if defined _WIN64 || defined __amd64__
+ if (reg->off % 8 != 0) {
+ reg->off += 8 - (reg->off % 8);
+ }
+#endif
+ if (is_int64) {
+ dasm_put(Dst, 5, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 6, reg->off);
+ reg->off += 4;
+ }
+ }
+}
+
+static void get_float(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_double)
+{
+#if !defined _WIN64 && !defined __amd64__
+ assert(MAX_FLOAT_REGISTERS(ct) == 0);
+ if (is_double) {
+ dasm_put(Dst, 12, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 16, reg->off);
+ reg->off += 4;
+ }
+#else
+ int off;
+
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ off = -16 - 8*reg->regs;
+ reg->regs++;
+ }
+#else
+ if (reg->floats < MAX_FLOAT_REGISTERS(ct)) {
+ off = -16 - 8*reg->floats;
+ reg->floats++;
+ }
+#endif
+ else {
+ off = reg->off;
+ reg->off += is_double ? 8 : 4;
+ }
+
+ if (is_double) {
+ dasm_put(Dst, 20, off);
+ } else {
+ dasm_put(Dst, 27, off);
+ }
+#endif
+}
+
+static void add_float(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_double)
+{
+#if !defined _WIN64 && !defined __amd64__
+ assert(MAX_FLOAT_REGISTERS(ct) == 0);
+ if (is_double) {
+ dasm_put(Dst, 34, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 40, reg->off);
+ reg->off += 4;
+ }
+#else
+
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ if (is_double) {
+ dasm_put(Dst, 46, 32 + 8*(reg->regs));
+ } else {
+ dasm_put(Dst, 54, 32 + 8*(reg->regs));
+ }
+ reg->is_float[reg->regs++] = 1;
+ }
+#else
+ if (reg->floats < MAX_FLOAT_REGISTERS(ct)) {
+ if (is_double) {
+ dasm_put(Dst, 46, 32 + 8*(MAX_INT_REGISTERS(ct) + reg->floats));
+ } else {
+ dasm_put(Dst, 54, 32 + 8*(MAX_INT_REGISTERS(ct) + reg->floats));
+ }
+ reg->floats++;
+ }
+#endif
+
+ else if (is_double) {
+ dasm_put(Dst, 46, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 67, reg->off);
+ reg->off += 4;
+ }
+#endif
+}
+
+#if defined _WIN64 || defined __amd64__
+#define add_pointer(jit, ct, reg) add_int(jit, ct, reg, 1)
+#define get_pointer(jit, ct, reg) get_int(jit, ct, reg, 1)
+#else
+#define add_pointer(jit, ct, reg) add_int(jit, ct, reg, 0)
+#define get_pointer(jit, ct, reg) get_int(jit, ct, reg, 0)
+#endif
+
+cfunction compile_callback(lua_State* L, int fidx, int ct_usr, const struct ctype* ct)
+{
+ int i, nargs;
+ cfunction* pf;
+ struct ctype ct2 = *ct;
+ const struct ctype* mt;
+ struct reg_alloc reg;
+ int num_upvals = 0;
+ int top = lua_gettop(L);
+ struct jit* Dst = get_jit(L);
+ int ref;
+ int hidden_arg_off = 0;
+
+ ct_usr = lua_absindex(L, ct_usr);
+ fidx = lua_absindex(L, fidx);
+
+ assert(lua_isnil(L, fidx) || lua_isfunction(L, fidx));
+
+ memset(&reg, 0, sizeof(reg));
+#ifdef _WIN64
+ reg.off = 16 + REGISTER_STACK_SPACE(ct); /* stack registers are above the shadow space */
+#elif __amd64__
+ reg.off = 16;
+#else
+ reg.off = 8;
+#endif
+
+ dasm_setup(Dst, build_actionlist);
+
+ // add a table to store ctype and function upvalues
+ // callback_set assumes the first value is the lua function
+ nargs = (int) lua_rawlen(L, ct_usr);
+ lua_newtable(L);
+ lua_pushvalue(L, -1);
+ ref = luaL_ref(L, LUA_REGISTRYINDEX);
+
+ if (ct->has_var_arg) {
+ luaL_error(L, "can't create callbacks with varargs");
+ }
+
+ // setup a stack frame to hold args for the call into lua_call
+
+ dasm_put(Dst, 80, 8 + 16 + 32 + REGISTER_STACK_SPACE(ct));
+ if (ct->calling_convention == FAST_CALL) {
+ }
+
+ // hardcode the lua_State* value into the assembly
+ dasm_put(Dst, 157, (unsigned int)((uintptr_t)(L)), (unsigned int)(((uintptr_t)(L))>>32));
+
+ /* get the upval table */
+ dasm_put(Dst, 162, ref, LUA_REGISTRYINDEX);
+
+ /* get the lua function */
+ lua_pushvalue(L, fidx);
+ lua_rawseti(L, -2, ++num_upvals);
+ assert(num_upvals == CALLBACK_FUNC_USR_IDX);
+ dasm_put(Dst, 178, num_upvals);
+
+#if !defined _WIN64 && !defined __amd64__
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mt->pointers && !mt->is_reference && mt->type == COMPLEX_DOUBLE_TYPE) {
+ hidden_arg_off = reg.off;
+ reg.off += sizeof(void*);
+ }
+ lua_pop(L, 1);
+#else
+ (void) hidden_arg_off;
+#endif
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ /* on the lua stack in the callback:
+ * upval tbl, lua func, i-1 args
+ */
+ dasm_put(Dst, 201, num_upvals-1, -i-1, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ get_pointer(Dst, ct, &reg);
+ dasm_put(Dst, 239);
+ } else {
+ switch (mt->type) {
+ case INT64_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* mt */
+ lua_pop(L, 1);
+ dasm_put(Dst, 261, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ get_int(Dst, ct, &reg, 1);
+ dasm_put(Dst, 280);
+ break;
+
+ case INTPTR_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* mt */
+ lua_pop(L, 1);
+ dasm_put(Dst, 261, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ get_pointer(Dst, ct, &reg);
+ dasm_put(Dst, 280);
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_pop(L, 1);
+#if defined _WIN64 || defined __amd64__
+ /* complex floats are two floats packed into a double */
+ dasm_put(Dst, 261, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ get_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 284);
+#else
+ /* complex floats are real followed by imag on the stack */
+ dasm_put(Dst, 261, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ get_float(Dst, ct, &reg, 0);
+ dasm_put(Dst, 289);
+ get_float(Dst, ct, &reg, 0);
+ dasm_put(Dst, 292);
+#endif
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 261, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ /* real */
+ get_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 284);
+ /* imag */
+ get_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 296);
+ break;
+
+ case FLOAT_TYPE:
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ get_float(Dst, ct, &reg, mt->type == DOUBLE_TYPE);
+ dasm_put(Dst, 302);
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ dasm_put(Dst, 310);
+ break;
+
+ case INT8_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 324);
+ } else {
+ dasm_put(Dst, 328);
+ }
+ dasm_put(Dst, 332);
+ break;
+
+ case INT16_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 343);
+ } else {
+ dasm_put(Dst, 347);
+ }
+ dasm_put(Dst, 332);
+ break;
+
+ case ENUM_TYPE:
+ case INT32_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 351);
+ } else {
+ dasm_put(Dst, 332);
+ }
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback arg type");
+ }
+ }
+ }
+
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ dasm_put(Dst, 362, (unsigned int)((uintptr_t)(0)), (unsigned int)(((uintptr_t)(0))>>32), (mt->pointers || mt->is_reference || mt->type != VOID_TYPE) ? 1 : 0, nargs);
+
+ // Unpack the return argument if not "void", also clean-up the lua stack
+ // to remove the return argument and bind table. Use lua_settop rather
+ // than lua_pop as lua_pop is implemented as a macro.
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ dasm_put(Dst, 382, num_upvals-1, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+
+ } else {
+ switch (mt->type) {
+ case ENUM_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ dasm_put(Dst, 466, num_upvals-1, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ break;
+
+ case VOID_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 548);
+ break;
+
+ case BOOL_TYPE:
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ lua_pop(L, 1);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 567);
+ } else {
+ dasm_put(Dst, 586);
+ }
+ dasm_put(Dst, 605);
+ break;
+
+ case INT64_TYPE:
+ lua_pop(L, 1);
+
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 632);
+ } else {
+ dasm_put(Dst, 651);
+ }
+
+ dasm_put(Dst, 670);
+ break;
+
+ case INTPTR_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 699);
+ break;
+
+ case FLOAT_TYPE:
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 746);
+ if (mt->type == FLOAT_TYPE) {
+ dasm_put(Dst, 789);
+ } else {
+ dasm_put(Dst, 797);
+ }
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_pop(L, 1);
+#if !defined HAVE_COMPLEX
+ luaL_error(L, "ffi lib compiled without complex number support");
+#endif
+ /* on 64 bit complex floats are two floats packed into a double,
+ * on 32 bit returned complex floats use eax and edx */
+ dasm_put(Dst, 805);
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_pop(L, 1);
+#if !defined HAVE_COMPLEX
+ luaL_error(L, "ffi lib compiled without complex number support");
+#endif
+ /* on 64 bit, returned complex doubles use xmm0, xmm1, on 32 bit
+ * there is a hidden first parameter that points to 16 bytes where
+ * the returned arg is stored which is popped by the called
+ * function */
+#if defined _WIN64 || defined __amd64__
+ dasm_put(Dst, 855);
+#else
+ dasm_put(Dst, 918, hidden_arg_off);
+#endif
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback return type");
+ }
+ }
+
+ dasm_put(Dst, 967, x86_return_size(L, ct_usr, ct));
+
+ lua_pop(L, 1); /* upval table - already in registry */
+ assert(lua_gettop(L) == top);
+
+ ct2.is_jitted = 1;
+ pf = (cfunction*) push_cdata(L, ct_usr, &ct2);
+ *pf = compile(Dst, L, NULL, ref);
+
+ assert(lua_gettop(L) == top + 1);
+
+ return *pf;
+}
+
+void compile_function(lua_State* L, cfunction func, int ct_usr, const struct ctype* ct)
+{
+ size_t i, nargs;
+ int num_upvals;
+ const struct ctype* mbr_ct;
+ struct jit* Dst = get_jit(L);
+ struct reg_alloc reg;
+ void* p;
+ int top = lua_gettop(L);
+ int* perr = &Dst->last_errno;
+
+ ct_usr = lua_absindex(L, ct_usr);
+
+ memset(&reg, 0, sizeof(reg));
+ reg.off = 32 + REGISTER_STACK_SPACE(ct);
+
+ dasm_setup(Dst, build_actionlist);
+
+ p = push_cdata(L, ct_usr, ct);
+ *(cfunction*) p = func;
+ num_upvals = 1;
+
+ nargs = lua_rawlen(L, ct_usr);
+
+ if (ct->calling_convention != C_CALL && ct->has_var_arg) {
+ luaL_error(L, "vararg is only allowed with the c calling convention");
+ }
+
+ dasm_put(Dst, 980, nargs);
+ if (!ct->has_var_arg) {
+ dasm_put(Dst, 1008, (unsigned int)((uintptr_t)(&"too few arguments")), (unsigned int)(((uintptr_t)(&"too few arguments"))>>32), (unsigned int)((uintptr_t)(&"too many arguments")), (unsigned int)(((uintptr_t)(&"too many arguments"))>>32));
+ } else {
+ dasm_put(Dst, 1049, (unsigned int)((uintptr_t)(&"too few arguments")), (unsigned int)(((uintptr_t)(&"too few arguments"))>>32));
+ }
+
+ dasm_put(Dst, 1069);
+
+ /* no need to zero extend eax returned by lua_gettop to rax as x86-64
+ * preguarentees that the upper 32 bits will be zero */
+ dasm_put(Dst, 1072, 32 + REGISTER_STACK_SPACE(ct));
+
+#if !defined _WIN64 && !defined __amd64__
+ /* Returned complex doubles require a hidden first parameter where the
+ * data is stored, which is popped by the calling code. */
+ lua_rawgeti(L, ct_usr, 0);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mbr_ct->pointers && !mbr_ct->is_reference && mbr_ct->type == COMPLEX_DOUBLE_TYPE) {
+ /* we can allocate more space for arguments as long as no add_*
+ * function has been called yet, mbr_ct will be added as an upvalue in
+ * the return processing later */
+ dasm_put(Dst, 1085, (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32));
+ add_pointer(Dst, ct, &reg);
+ }
+ lua_pop(L, 1);
+#endif
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, (int) i);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mbr_ct->pointers || mbr_ct->is_reference) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1109, (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals), i);
+ add_pointer(Dst, ct, &reg);
+ } else {
+ switch (mbr_ct->type) {
+ case FUNCTION_PTR_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1129, (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals), i);
+ add_pointer(Dst, ct, &reg);
+ break;
+
+ case ENUM_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1149, (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals), i);
+ add_int(Dst, ct, &reg, 0);
+ break;
+
+ case INT8_TYPE:
+ dasm_put(Dst, 1169, i);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1181);
+ } else {
+ dasm_put(Dst, 1185);
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INT16_TYPE:
+ dasm_put(Dst, 1169, i);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1189);
+ } else {
+ dasm_put(Dst, 1193);
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case BOOL_TYPE:
+ dasm_put(Dst, 1197, i);
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INT32_TYPE:
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1219, i);
+ } else {
+ dasm_put(Dst, 1169, i);
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INTPTR_TYPE:
+ dasm_put(Dst, 1231, i);
+ add_pointer(Dst, ct, &reg);
+ lua_pop(L, 1);
+ break;
+
+ case INT64_TYPE:
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1243, i);
+ } else {
+ dasm_put(Dst, 1255, i);
+ }
+ add_int(Dst, ct, &reg, 1);
+ lua_pop(L, 1);
+ break;
+
+ case DOUBLE_TYPE:
+ dasm_put(Dst, 1267, i);
+ add_float(Dst, ct, &reg, 1);
+ lua_pop(L, 1);
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ /* on 64 bit, returned complex doubles use xmm0, xmm1, on 32 bit
+ * there is a hidden first parameter that points to 16 bytes where
+ * the returned arg is stored (this is popped by the called
+ * function) */
+#if defined _WIN64 || defined __amd64__
+ dasm_put(Dst, 1279, i);
+ add_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 1291);
+ add_float(Dst, ct, &reg, 1);
+#else
+ dasm_put(Dst, 1297, reg.off, i);
+ reg.off += 16;
+#endif
+ lua_pop(L, 1);
+ break;
+
+ case FLOAT_TYPE:
+ dasm_put(Dst, 1267, i);
+ add_float(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+#if defined _WIN64 || defined __amd64__
+ dasm_put(Dst, 1323, i);
+ /* complex floats are two floats packed into a double */
+ add_float(Dst, ct, &reg, 1);
+#else
+ /* returned complex floats use eax and edx */
+ dasm_put(Dst, 1335, i);
+ add_float(Dst, ct, &reg, 0);
+ dasm_put(Dst, 1353);
+ add_float(Dst, ct, &reg, 0);
+#endif
+ lua_pop(L, 1);
+ break;
+
+ default:
+ luaL_error(L, "NYI: call arg type");
+ }
+ }
+ }
+
+ if (ct->has_var_arg) {
+#ifdef _WIN64
+ if (reg.regs < MAX_REGISTERS(ct)) {
+ assert(reg.regs == nargs);
+ } else {
+ }
+
+ for (i = nargs; i < MAX_REGISTERS(ct); i++) {
+ reg.is_int[i] = reg.is_float[i] = 1;
+ }
+ reg.regs = MAX_REGISTERS(ct);
+#elif defined __amd64__
+ if (reg.floats < MAX_FLOAT_REGISTERS(ct)) {
+ dasm_put(Dst, 1360, 32 + 8*(MAX_INT_REGISTERS(ct) + reg.floats), MAX_FLOAT_REGISTERS(ct) - reg.floats, nargs+1);
+ }
+
+ if (reg.ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 1390, 32 + 8*(reg.ints), MAX_INT_REGISTERS(ct) - reg.ints, nargs+1);
+ }
+
+ dasm_put(Dst, 1420, reg.off, MAX_FLOAT_REGISTERS(ct) - reg.floats, MAX_INT_REGISTERS(ct) - reg.ints, nargs+1);
+
+ reg.floats = MAX_FLOAT_REGISTERS(ct);
+ reg.ints = MAX_INT_REGISTERS(ct);
+#else
+#endif
+ }
+
+ dasm_put(Dst, 1454, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+
+ /* remove the stack space to call local functions */
+ dasm_put(Dst, 1468);
+
+#ifdef _WIN64
+ switch (reg.regs) {
+ case 4:
+ if (reg.is_float[3]) {
+ }
+ if (reg.is_int[3]) {
+ }
+ case 3:
+ if (reg.is_float[2]) {
+ }
+ if (reg.is_int[2]) {
+ }
+ case 2:
+ if (reg.is_float[1]) {
+ }
+ if (reg.is_int[1]) {
+ }
+ case 1:
+ if (reg.is_float[0]) {
+ }
+ if (reg.is_int[0]) {
+ }
+ case 0:
+ break;
+ }
+
+ /* don't remove the space for the registers as we need 32 bytes of register overflow space */
+ assert(REGISTER_STACK_SPACE(ct) == 32);
+
+#elif defined __amd64__
+ switch (reg.floats) {
+ case 8:
+ dasm_put(Dst, 1473, 8*(MAX_INT_REGISTERS(ct)+7));
+ case 7:
+ dasm_put(Dst, 1482, 8*(MAX_INT_REGISTERS(ct)+6));
+ case 6:
+ dasm_put(Dst, 1491, 8*(MAX_INT_REGISTERS(ct)+5));
+ case 5:
+ dasm_put(Dst, 1500, 8*(MAX_INT_REGISTERS(ct)+4));
+ case 4:
+ dasm_put(Dst, 1509, 8*(MAX_INT_REGISTERS(ct)+3));
+ case 3:
+ dasm_put(Dst, 1518, 8*(MAX_INT_REGISTERS(ct)+2));
+ case 2:
+ dasm_put(Dst, 1527, 8*(MAX_INT_REGISTERS(ct)+1));
+ case 1:
+ dasm_put(Dst, 1536, 8*(MAX_INT_REGISTERS(ct)));
+ case 0:
+ break;
+ }
+
+ switch (reg.ints) {
+ case 6:
+ dasm_put(Dst, 1545, 8*5);
+ case 5:
+ dasm_put(Dst, 1552, 8*4);
+ case 4:
+ dasm_put(Dst, 1559, 8*3);
+ case 3:
+ dasm_put(Dst, 1566, 8*2);
+ case 2:
+ dasm_put(Dst, 1573, 8*1);
+ case 1:
+ dasm_put(Dst, 1580);
+ case 0:
+ break;
+ }
+
+ dasm_put(Dst, 1585, REGISTER_STACK_SPACE(ct));
+#else
+ if (ct->calling_convention == FAST_CALL) {
+ switch (reg.ints) {
+ case 2:
+ case 1:
+ case 0:
+ break;
+ }
+
+ }
+#endif
+
+#ifdef __amd64__
+ if (ct->has_var_arg) {
+ /* al stores an upper limit on the number of float register, note that
+ * its allowed to be more than the actual number of float registers used as
+ * long as its 0-8 */
+ dasm_put(Dst, 1590);
+ }
+#endif
+
+ dasm_put(Dst, 1593);
+
+ /* note on windows X86 the stack may be only aligned to 4 (stdcall will
+ * have popped a multiple of 4 bytes), but we don't need 16 byte alignment on
+ * that platform
+ */
+
+ lua_rawgeti(L, ct_usr, 0);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mbr_ct->pointers || mbr_ct->is_reference || mbr_ct->type == INTPTR_TYPE) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1603, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32), (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals));
+
+ } else {
+ switch (mbr_ct->type) {
+ case FUNCTION_PTR_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1603, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32), (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals));
+ break;
+
+ case INT64_TYPE:
+#if LUA_VERSION_NUM == 503
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1663, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ } else {
+ dasm_put(Dst, 1663, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ }
+#else
+ num_upvals++;
+ dasm_put(Dst, 1715, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32), (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32));
+#endif
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1778, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32), (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals));
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1839, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32), (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals));
+ break;
+
+ case VOID_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 1915, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 1947, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ case INT8_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1181);
+ } else {
+ dasm_put(Dst, 1185);
+ }
+ dasm_put(Dst, 2000, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ case INT16_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1189);
+ } else {
+ dasm_put(Dst, 1193);
+ }
+ dasm_put(Dst, 2000, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 2050, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ } else {
+ dasm_put(Dst, 2000, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ }
+ break;
+
+ case FLOAT_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 2100, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 2105, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ default:
+ luaL_error(L, "NYI: call return type");
+ }
+ }
+
+ assert(lua_gettop(L) == top + num_upvals);
+ {
+ cfunction f = compile(Dst, L, func, LUA_NOREF);
+ /* add a callback as an upval so that the jitted code gets cleaned up when
+ * the function gets gc'd */
+ push_callback(L, f, func);
+ lua_pushcclosure(L, (lua_CFunction) f, num_upvals+1);
+ }
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/call_x64win.h b/Build/source/texk/web2c/luatexdir/luaffi/call_x64win.h
new file mode 100644
index 00000000000..337266ff351
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/call_x64win.h
@@ -0,0 +1,1191 @@
+/*
+** This file has been pre-processed with DynASM.
+** http://luajit.org/dynasm.html
+** DynASM version 1.3.0, DynASM x64 version 1.3.0
+** DO NOT EDIT! The original file is in "call_x86.dasc".
+*/
+
+#if DASM_VERSION != 10300
+#error "Version mismatch between DynASM and included encoding engine"
+#endif
+
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+static const unsigned char build_actionlist[2100] = {
+ 72,139,141,233,255,72,137,132,253,36,233,255,221,133,233,255,217,133,233,
+ 255,252,243,15,126,133,233,255,252,243,15,90,133,233,255,221,156,253,36,233,
+ 255,217,156,253,36,233,255,102,15,214,132,253,36,233,255,252,242,15,90,192,
+ 102,15,214,132,253,36,233,255,252,242,15,90,192,102,15,126,132,253,36,233,
+ 255,85,72,137,229,65,84,72,129,252,236,239,72,137,77,16,72,137,85,24,76,137,
+ 69,32,76,137,77,40,102,15,214,69,252,240,102,15,214,77,232,102,15,214,85,
+ 224,102,15,214,93,216,255,73,188,237,237,255,73,199,192,237,72,199,194,237,
+ 76,137,225,232,251,1,0,255,73,199,192,237,72,199,194,252,255,252,255,252,
+ 255,252,255,76,137,225,232,251,1,0,255,73,199,192,237,72,199,194,237,76,137,
+ 225,232,251,1,0,73,184,237,237,72,199,194,252,255,252,255,252,255,252,255,
+ 76,137,225,232,251,1,1,255,72,137,8,72,199,194,252,254,252,255,252,255,252,
+ 255,76,137,225,232,251,1,2,255,73,184,237,237,72,199,194,0,0,0,0,76,137,225,
+ 232,251,1,1,255,72,137,8,255,102,15,214,0,255,217,24,255,217,88,4,255,102,
+ 15,214,64,8,255,252,243,15,126,200,76,137,225,232,251,1,3,255,15,182,201,
+ 72,137,202,76,137,225,232,251,1,4,255,15,182,201,255,15,190,201,255,72,137,
+ 202,76,137,225,232,251,1,5,255,15,183,201,255,15,191,201,255,72,137,202,76,
+ 137,225,232,251,1,6,255,73,185,237,237,73,199,192,237,72,199,194,237,76,137,
+ 225,232,251,1,7,255,73,199,192,237,72,199,194,252,254,252,255,252,255,252,
+ 255,76,137,225,232,251,1,0,73,185,237,237,73,199,192,252,255,252,255,252,
+ 255,252,255,72,199,194,252,254,252,255,252,255,252,255,76,137,225,232,251,
+ 1,8,72,137,68,36,32,72,199,194,252,252,252,255,252,255,252,255,76,137,225,
+ 232,251,1,9,72,139,68,36,32,255,73,199,192,237,72,199,194,252,254,252,255,
+ 252,255,252,255,76,137,225,232,251,1,0,73,185,237,237,73,199,192,252,255,
+ 252,255,252,255,252,255,72,199,194,252,254,252,255,252,255,252,255,76,137,
+ 225,232,251,1,10,137,68,36,32,72,199,194,252,252,252,255,252,255,252,255,
+ 76,137,225,232,251,1,9,139,68,36,32,255,72,199,194,252,254,252,255,252,255,
+ 252,255,76,137,225,232,251,1,9,255,72,199,194,252,255,252,255,252,255,252,
+ 255,76,137,225,232,251,1,11,255,72,199,194,252,255,252,255,252,255,252,255,
+ 76,137,225,232,251,1,12,255,137,68,36,32,72,199,194,252,253,252,255,252,255,
+ 252,255,76,137,225,232,251,1,9,139,68,36,32,255,72,199,194,252,255,252,255,
+ 252,255,252,255,76,137,225,232,251,1,13,255,72,199,194,252,255,252,255,252,
+ 255,252,255,76,137,225,232,251,1,14,255,72,137,68,36,32,72,199,194,252,253,
+ 252,255,252,255,252,255,76,137,225,232,251,1,9,72,139,68,36,32,255,72,199,
+ 194,252,255,252,255,252,255,252,255,76,137,225,232,251,1,15,72,137,68,36,
+ 32,72,199,194,252,253,252,255,252,255,252,255,76,137,225,232,251,1,9,72,139,
+ 68,36,32,255,72,199,194,252,255,252,255,252,255,252,255,76,137,225,232,251,
+ 1,16,102,15,214,68,36,32,72,199,194,252,253,252,255,252,255,252,255,76,137,
+ 225,232,251,1,9,255,252,242,15,90,68,36,32,255,252,243,15,126,68,36,32,255,
+ 72,199,194,252,255,252,255,252,255,252,255,76,137,225,232,251,1,17,102,15,
+ 214,68,36,32,72,199,194,252,253,252,255,252,255,252,255,76,137,225,232,251,
+ 1,9,252,243,15,126,68,36,32,255,72,199,194,252,255,252,255,252,255,252,255,
+ 76,137,225,232,251,1,18,102,15,214,68,36,32,102,15,214,76,36,40,72,199,194,
+ 252,253,252,255,252,255,252,255,76,137,225,232,251,1,9,252,243,15,126,68,
+ 36,32,252,243,15,126,76,36,40,255,72,139,141,233,73,199,192,252,255,252,255,
+ 252,255,252,255,76,137,226,72,137,201,232,251,1,18,72,131,252,236,4,72,199,
+ 194,252,253,252,255,252,255,252,255,76,137,225,232,251,1,9,255,76,139,101,
+ 252,248,72,137,252,236,93,194,236,255,85,72,137,229,65,84,65,85,73,137,204,
+ 72,131,252,236,32,76,137,225,232,251,1,19,73,137,197,72,129,252,248,239,255,
+ 15,141,244,248,102,184,0,0,72,186,237,237,76,137,225,232,251,1,20,248,2,15,
+ 142,244,247,102,184,0,0,72,186,237,237,76,137,225,232,251,1,20,255,15,141,
+ 244,247,102,184,0,0,72,186,237,237,76,137,225,232,251,1,20,255,248,1,255,
+ 72,193,224,4,72,41,196,72,129,252,236,239,255,73,184,237,237,72,199,194,0,
+ 0,0,0,76,137,225,232,251,1,1,72,131,252,236,16,255,73,185,237,237,73,199,
+ 192,237,72,199,194,237,76,137,225,232,251,1,8,255,73,185,237,237,73,199,192,
+ 237,72,199,194,237,76,137,225,232,251,1,21,255,73,185,237,237,73,199,192,
+ 237,72,199,194,237,76,137,225,232,251,1,10,255,72,199,194,237,76,137,225,
+ 232,251,1,12,255,15,182,192,255,15,190,192,255,15,183,192,255,15,191,192,
+ 255,72,199,194,237,76,137,225,232,251,1,12,131,252,248,0,15,149,208,15,182,
+ 192,255,72,199,194,237,76,137,225,232,251,1,11,255,72,199,194,237,76,137,
+ 225,232,251,1,15,255,72,199,194,237,76,137,225,232,251,1,13,255,72,199,194,
+ 237,76,137,225,232,251,1,14,255,72,199,194,237,76,137,225,232,251,1,16,255,
+ 72,199,194,237,76,137,225,232,251,1,18,255,252,243,15,126,193,255,72,141,
+ 132,253,36,233,72,131,252,236,4,73,199,192,237,76,137,226,72,137,193,232,
+ 251,1,18,255,72,199,194,237,76,137,225,232,251,1,17,255,72,199,194,237,76,
+ 137,225,232,251,1,17,137,4,36,217,4,36,255,137,20,36,217,4,36,255,73,129,
+ 252,253,239,15,142,244,247,72,137,224,72,129,192,239,73,137,193,77,137,232,
+ 72,199,194,237,76,137,225,232,251,1,22,72,137,224,72,129,192,239,73,137,193,
+ 73,199,192,237,72,199,194,237,76,137,225,232,251,1,23,252,233,244,248,248,
+ 1,72,137,224,72,129,192,239,73,137,193,77,137,232,72,199,194,237,76,137,225,
+ 232,251,1,23,248,2,255,72,137,224,72,129,192,239,73,137,193,77,137,232,72,
+ 199,194,237,76,137,225,232,251,1,22,255,72,185,237,237,139,1,72,137,193,232,
+ 251,1,24,255,72,131,196,32,255,252,243,15,126,156,253,36,233,255,76,139,140,
+ 253,36,233,255,252,243,15,126,148,253,36,233,255,76,139,132,253,36,233,255,
+ 252,243,15,126,140,253,36,233,255,72,139,148,253,36,233,255,252,243,15,126,
+ 4,36,255,72,139,12,36,255,232,251,1,25,72,131,252,236,48,255,72,137,68,36,
+ 32,232,251,1,26,72,185,237,237,137,1,73,184,237,237,72,199,194,237,76,137,
+ 225,232,251,1,1,72,139,76,36,32,72,137,8,184,1,0,0,0,76,139,109,252,240,76,
+ 139,101,252,248,72,137,252,236,93,195,255,72,137,68,36,32,232,251,1,26,72,
+ 185,237,237,137,1,72,139,68,36,32,72,137,194,76,137,225,232,251,1,27,184,
+ 1,0,0,0,76,139,109,252,240,76,139,101,252,248,72,137,252,236,93,195,255,72,
+ 137,68,36,32,232,251,1,26,72,185,237,237,137,1,73,184,237,237,72,199,194,
+ 0,0,0,0,76,137,225,232,251,1,1,72,139,76,36,32,72,137,8,184,1,0,0,0,76,139,
+ 109,252,240,76,139,101,252,248,72,137,252,236,93,195,255,102,15,214,68,36,
+ 32,232,251,1,26,72,185,237,237,137,1,73,184,237,237,72,199,194,237,76,137,
+ 225,232,251,1,1,72,139,76,36,32,72,137,8,184,1,0,0,0,76,139,109,252,240,76,
+ 139,101,252,248,72,137,252,236,93,195,255,102,15,214,76,36,40,102,15,214,
+ 68,36,32,232,251,1,26,72,185,237,237,137,1,73,184,237,237,72,199,194,237,
+ 76,137,225,232,251,1,1,72,139,76,36,40,72,137,72,8,72,139,76,36,32,72,137,
+ 8,184,1,0,0,0,76,139,109,252,240,76,139,101,252,248,72,137,252,236,93,195,
+ 255,232,251,1,26,72,185,237,237,137,1,184,0,0,0,0,76,139,109,252,240,76,139,
+ 101,252,248,72,137,252,236,93,195,255,15,182,192,137,68,36,32,232,251,1,26,
+ 72,185,237,237,137,1,139,68,36,32,72,137,194,76,137,225,232,251,1,4,184,1,
+ 0,0,0,76,139,109,252,240,76,139,101,252,248,72,137,252,236,93,195,255,137,
+ 68,36,32,232,251,1,26,72,185,237,237,137,1,139,68,36,32,72,137,194,76,137,
+ 225,232,251,1,5,184,1,0,0,0,76,139,109,252,240,76,139,101,252,248,72,137,
+ 252,236,93,195,255,137,68,36,32,232,251,1,26,72,185,237,237,137,1,139,68,
+ 36,32,72,137,194,76,137,225,232,251,1,6,184,1,0,0,0,76,139,109,252,240,76,
+ 139,101,252,248,72,137,252,236,93,195,255,252,243,15,90,192,102,15,214,68,
+ 36,32,232,251,1,26,72,185,237,237,137,1,252,243,15,126,76,36,32,76,137,225,
+ 232,251,1,3,184,1,0,0,0,76,139,109,252,240,76,139,101,252,248,72,137,252,
+ 236,93,195,255
+};
+
+static const char *const globnames[] = {
+ (const char *)0
+};
+static const char *const extnames[] = {
+ "lua_rawgeti",
+ "push_cdata",
+ "lua_remove",
+ "lua_pushnumber",
+ "lua_pushboolean",
+ "push_int",
+ "push_uint",
+ "lua_callk",
+ "check_typed_pointer",
+ "lua_settop",
+ "check_enum",
+ "check_uint32",
+ "check_int32",
+ "check_uint64",
+ "check_int64",
+ "check_uintptr",
+ "check_double",
+ "check_complex_float",
+ "check_complex_double",
+ "lua_gettop",
+ "luaL_error",
+ "check_typed_cfunction",
+ "unpack_varargs_stack",
+ "unpack_varargs_reg",
+ "SetLastError",
+ "FUNCTION",
+ "GetLastError",
+ "lua_pushinteger",
+ (const char *)0
+};
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#if defined _WIN64 || defined __amd64__
+#define JUMP_SIZE 14
+#else
+#define JUMP_SIZE 4
+#endif
+
+#define MIN_BRANCH INT32_MIN
+#define MAX_BRANCH INT32_MAX
+#define BRANCH_OFF 4
+
+static void compile_extern_jump(struct jit* jit, lua_State* L, cfunction func, uint8_t* code)
+{
+ /* The jump code is the function pointer followed by a stub to call the
+ * function pointer. The stub exists in 64 bit so we can jump to functions
+ * with an offset greater than 2 GB.
+ *
+ * Note we have to manually set this up since there are commands buffered
+ * in the jit state and dynasm doesn't support rip relative addressing.
+ *
+ * eg on 64 bit:
+ * 0-8: function ptr
+ * 8-14: jmp aword [rip-14]
+ *
+ * for 32 bit we only set the function ptr as it can always fit in a 32
+ * bit displacement
+ */
+#if defined _WIN64 || defined __amd64__
+ *(cfunction*) code = func;
+ code[8] = 0xFF; /* FF /4 operand for jmp */
+ code[9] = 0x25; /* RIP displacement */
+ *(int32_t*) &code[10] = -14;
+#else
+ *(cfunction*) code = func;
+#endif
+}
+
+void compile_globals(struct jit* jit, lua_State* L)
+{
+ struct jit* Dst = jit;
+ int* perr = &jit->last_errno;
+ dasm_setup(Dst, build_actionlist);
+
+ /* Note: since the return code uses EBP to reset the stack pointer, we
+ * don't have to track the amount of stack space used. It also means we
+ * can handle stdcall and cdecl with the same code.
+ */
+
+ /* Note the various call_* functions want 32 bytes of 16 byte aligned
+ * stack
+ */
+
+ compile(Dst, L, NULL, LUA_NOREF);
+}
+
+int x86_return_size(lua_State* L, int usr, const struct ctype* ct)
+{
+ int ret = 0;
+ const struct ctype* mt;
+
+ if (ct->calling_convention != C_CALL) {
+ size_t i;
+ size_t argn = lua_rawlen(L, usr);
+ for (i = 1; i <= argn; i++) {
+ lua_rawgeti(L, usr, (int) i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ ret += sizeof(void*);
+ } else {
+ switch (mt->type) {
+ case DOUBLE_TYPE:
+ case COMPLEX_FLOAT_TYPE:
+ case INT64_TYPE:
+ ret += 8;
+ break;
+ case COMPLEX_DOUBLE_TYPE:
+ ret += 16;
+ break;
+ case INTPTR_TYPE:
+ ret += sizeof(intptr_t);
+ break;
+ case FUNCTION_PTR_TYPE:
+ ret += sizeof(cfunction);
+ break;
+ case BOOL_TYPE:
+ case FLOAT_TYPE:
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ ret += 4;
+ break;
+ default:
+ return luaL_error(L, "NYI - argument type");
+ }
+ }
+
+ lua_pop(L, 1);
+ }
+ }
+
+#if !defined _WIN64 && !defined __amd64__
+ lua_rawgeti(L, usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mt->pointers && !mt->is_reference && mt->type == COMPLEX_DOUBLE_TYPE) {
+ ret += sizeof(void*);
+ }
+ lua_pop(L, 1);
+#endif
+
+ return ret;
+}
+
+#ifdef _WIN64
+#define MAX_REGISTERS(ct) 4 /* rcx, rdx, r8, r9 */
+
+#elif defined __amd64__
+#define MAX_INT_REGISTERS(ct) 6 /* rdi, rsi, rdx, rcx, r8, r9 */
+#define MAX_FLOAT_REGISTERS(ct) 8 /* xmm0-7 */
+
+#else
+#define MAX_INT_REGISTERS(ct) ((ct)->calling_convention == FAST_CALL ? 2 /* ecx, edx */ : 0)
+#define MAX_FLOAT_REGISTERS(ct) 0
+#endif
+
+struct reg_alloc {
+#ifdef _WIN64
+ int regs;
+ int is_float[4];
+ int is_int[4];
+#else
+ int floats;
+ int ints;
+#endif
+ int off;
+};
+
+#ifdef _WIN64
+#define REGISTER_STACK_SPACE(ct) (4*8)
+#elif defined __amd64__
+#define REGISTER_STACK_SPACE(ct) (14*8)
+#else
+#define REGISTER_STACK_SPACE(ct) ALIGN_UP(((ct)->calling_convention == FAST_CALL ? 2*4 : 0), 15)
+#endif
+
+/* Fastcall:
+ * Uses ecx, edx as first two int registers
+ * Everything else on stack (include 64bit ints)
+ * No overflow stack space
+ * Pops the stack before returning
+ * Returns int in eax, float in ST0
+ * We use the same register allocation logic as posix x64 with 2 int regs and 0 float regs
+ */
+
+static void get_int(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_int64)
+{
+ /* grab the register from the shadow space */
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ dasm_put(Dst, 0, 16 + 8*reg->regs);
+ reg->regs++;
+ }
+#elif __amd64__
+ if (reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 0, - 80 - 8*reg->ints);
+ reg->ints++;
+ }
+#else
+ if (!is_int64 && reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 1, - 8 - 4*reg->ints);
+ reg->ints++;
+ }
+#endif
+ else if (is_int64) {
+ dasm_put(Dst, 0, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 1, reg->off);
+ reg->off += 4;
+ }
+}
+
+static void add_int(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_int64)
+{
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ dasm_put(Dst, 5, 32 + 8*(reg->regs));
+ reg->is_int[reg->regs++] = 1;
+ }
+#elif __amd64__
+ if (reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 5, 32 + 8*reg->ints);
+ reg->ints++;
+ }
+#else
+ if (!is_int64 && reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 5, 32 + 4*reg->ints);
+ reg->ints++;
+ }
+#endif
+ else {
+#if defined _WIN64 || defined __amd64__
+ if (reg->off % 8 != 0) {
+ reg->off += 8 - (reg->off % 8);
+ }
+#endif
+ if (is_int64) {
+ dasm_put(Dst, 5, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 6, reg->off);
+ reg->off += 4;
+ }
+ }
+}
+
+static void get_float(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_double)
+{
+#if !defined _WIN64 && !defined __amd64__
+ assert(MAX_FLOAT_REGISTERS(ct) == 0);
+ if (is_double) {
+ dasm_put(Dst, 12, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 16, reg->off);
+ reg->off += 4;
+ }
+#else
+ int off;
+
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ off = -16 - 8*reg->regs;
+ reg->regs++;
+ }
+#else
+ if (reg->floats < MAX_FLOAT_REGISTERS(ct)) {
+ off = -16 - 8*reg->floats;
+ reg->floats++;
+ }
+#endif
+ else {
+ off = reg->off;
+ reg->off += is_double ? 8 : 4;
+ }
+
+ if (is_double) {
+ dasm_put(Dst, 20, off);
+ } else {
+ dasm_put(Dst, 27, off);
+ }
+#endif
+}
+
+static void add_float(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_double)
+{
+#if !defined _WIN64 && !defined __amd64__
+ assert(MAX_FLOAT_REGISTERS(ct) == 0);
+ if (is_double) {
+ dasm_put(Dst, 34, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 40, reg->off);
+ reg->off += 4;
+ }
+#else
+
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ if (is_double) {
+ dasm_put(Dst, 46, 32 + 8*(reg->regs));
+ } else {
+ dasm_put(Dst, 54, 32 + 8*(reg->regs));
+ }
+ reg->is_float[reg->regs++] = 1;
+ }
+#else
+ if (reg->floats < MAX_FLOAT_REGISTERS(ct)) {
+ if (is_double) {
+ dasm_put(Dst, 46, 32 + 8*(MAX_INT_REGISTERS(ct) + reg->floats));
+ } else {
+ dasm_put(Dst, 54, 32 + 8*(MAX_INT_REGISTERS(ct) + reg->floats));
+ }
+ reg->floats++;
+ }
+#endif
+
+ else if (is_double) {
+ dasm_put(Dst, 46, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 67, reg->off);
+ reg->off += 4;
+ }
+#endif
+}
+
+#if defined _WIN64 || defined __amd64__
+#define add_pointer(jit, ct, reg) add_int(jit, ct, reg, 1)
+#define get_pointer(jit, ct, reg) get_int(jit, ct, reg, 1)
+#else
+#define add_pointer(jit, ct, reg) add_int(jit, ct, reg, 0)
+#define get_pointer(jit, ct, reg) get_int(jit, ct, reg, 0)
+#endif
+
+cfunction compile_callback(lua_State* L, int fidx, int ct_usr, const struct ctype* ct)
+{
+ int i, nargs;
+ cfunction* pf;
+ struct ctype ct2 = *ct;
+ const struct ctype* mt;
+ struct reg_alloc reg;
+ int num_upvals = 0;
+ int top = lua_gettop(L);
+ struct jit* Dst = get_jit(L);
+ int ref;
+ int hidden_arg_off = 0;
+
+ ct_usr = lua_absindex(L, ct_usr);
+ fidx = lua_absindex(L, fidx);
+
+ assert(lua_isnil(L, fidx) || lua_isfunction(L, fidx));
+
+ memset(&reg, 0, sizeof(reg));
+#ifdef _WIN64
+ reg.off = 16 + REGISTER_STACK_SPACE(ct); /* stack registers are above the shadow space */
+#elif __amd64__
+ reg.off = 16;
+#else
+ reg.off = 8;
+#endif
+
+ dasm_setup(Dst, build_actionlist);
+
+ // add a table to store ctype and function upvalues
+ // callback_set assumes the first value is the lua function
+ nargs = (int) lua_rawlen(L, ct_usr);
+ lua_newtable(L);
+ lua_pushvalue(L, -1);
+ ref = luaL_ref(L, LUA_REGISTRYINDEX);
+
+ if (ct->has_var_arg) {
+ luaL_error(L, "can't create callbacks with varargs");
+ }
+
+ // setup a stack frame to hold args for the call into lua_call
+
+ dasm_put(Dst, 80, 8 + 16 + 32 + REGISTER_STACK_SPACE(ct));
+ if (ct->calling_convention == FAST_CALL) {
+ }
+
+ // hardcode the lua_State* value into the assembly
+ dasm_put(Dst, 129, (unsigned int)((uintptr_t)(L)), (unsigned int)(((uintptr_t)(L))>>32));
+
+ /* get the upval table */
+ dasm_put(Dst, 134, ref, LUA_REGISTRYINDEX);
+
+ /* get the lua function */
+ lua_pushvalue(L, fidx);
+ lua_rawseti(L, -2, ++num_upvals);
+ assert(num_upvals == CALLBACK_FUNC_USR_IDX);
+ dasm_put(Dst, 150, num_upvals);
+
+#if !defined _WIN64 && !defined __amd64__
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mt->pointers && !mt->is_reference && mt->type == COMPLEX_DOUBLE_TYPE) {
+ hidden_arg_off = reg.off;
+ reg.off += sizeof(void*);
+ }
+ lua_pop(L, 1);
+#else
+ (void) hidden_arg_off;
+#endif
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ /* on the lua stack in the callback:
+ * upval tbl, lua func, i-1 args
+ */
+ dasm_put(Dst, 173, num_upvals-1, -i-1, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ get_pointer(Dst, ct, &reg);
+ dasm_put(Dst, 211);
+ } else {
+ switch (mt->type) {
+ case INT64_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* mt */
+ lua_pop(L, 1);
+ dasm_put(Dst, 233, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ get_int(Dst, ct, &reg, 1);
+ dasm_put(Dst, 252);
+ break;
+
+ case INTPTR_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* mt */
+ lua_pop(L, 1);
+ dasm_put(Dst, 233, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ get_pointer(Dst, ct, &reg);
+ dasm_put(Dst, 252);
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_pop(L, 1);
+#if defined _WIN64 || defined __amd64__
+ /* complex floats are two floats packed into a double */
+ dasm_put(Dst, 233, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ get_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 256);
+#else
+ /* complex floats are real followed by imag on the stack */
+ dasm_put(Dst, 233, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ get_float(Dst, ct, &reg, 0);
+ dasm_put(Dst, 261);
+ get_float(Dst, ct, &reg, 0);
+ dasm_put(Dst, 264);
+#endif
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 233, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ /* real */
+ get_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 256);
+ /* imag */
+ get_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 268);
+ break;
+
+ case FLOAT_TYPE:
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ get_float(Dst, ct, &reg, mt->type == DOUBLE_TYPE);
+ dasm_put(Dst, 274);
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ dasm_put(Dst, 287);
+ break;
+
+ case INT8_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 301);
+ } else {
+ dasm_put(Dst, 305);
+ }
+ dasm_put(Dst, 309);
+ break;
+
+ case INT16_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 320);
+ } else {
+ dasm_put(Dst, 324);
+ }
+ dasm_put(Dst, 309);
+ break;
+
+ case ENUM_TYPE:
+ case INT32_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 328);
+ } else {
+ dasm_put(Dst, 309);
+ }
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback arg type");
+ }
+ }
+ }
+
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ dasm_put(Dst, 339, (unsigned int)((uintptr_t)(0)), (unsigned int)(((uintptr_t)(0))>>32), (mt->pointers || mt->is_reference || mt->type != VOID_TYPE) ? 1 : 0, nargs);
+
+ // Unpack the return argument if not "void", also clean-up the lua stack
+ // to remove the return argument and bind table. Use lua_settop rather
+ // than lua_pop as lua_pop is implemented as a macro.
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ dasm_put(Dst, 359, num_upvals-1, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+
+ } else {
+ switch (mt->type) {
+ case ENUM_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ dasm_put(Dst, 443, num_upvals-1, (unsigned int)((uintptr_t)(mt)), (unsigned int)(((uintptr_t)(mt))>>32));
+ break;
+
+ case VOID_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 525);
+ break;
+
+ case BOOL_TYPE:
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ lua_pop(L, 1);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 544);
+ } else {
+ dasm_put(Dst, 563);
+ }
+ dasm_put(Dst, 582);
+ break;
+
+ case INT64_TYPE:
+ lua_pop(L, 1);
+
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 609);
+ } else {
+ dasm_put(Dst, 628);
+ }
+
+ dasm_put(Dst, 647);
+ break;
+
+ case INTPTR_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 676);
+ break;
+
+ case FLOAT_TYPE:
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 723);
+ if (mt->type == FLOAT_TYPE) {
+ dasm_put(Dst, 766);
+ } else {
+ dasm_put(Dst, 774);
+ }
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_pop(L, 1);
+#if !defined HAVE_COMPLEX
+ luaL_error(L, "ffi lib compiled without complex number support");
+#endif
+ /* on 64 bit complex floats are two floats packed into a double,
+ * on 32 bit returned complex floats use eax and edx */
+ dasm_put(Dst, 782);
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_pop(L, 1);
+#if !defined HAVE_COMPLEX
+ luaL_error(L, "ffi lib compiled without complex number support");
+#endif
+ /* on 64 bit, returned complex doubles use xmm0, xmm1, on 32 bit
+ * there is a hidden first parameter that points to 16 bytes where
+ * the returned arg is stored which is popped by the called
+ * function */
+#if defined _WIN64 || defined __amd64__
+ dasm_put(Dst, 832);
+#else
+ dasm_put(Dst, 895, hidden_arg_off);
+#endif
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback return type");
+ }
+ }
+
+ dasm_put(Dst, 944, x86_return_size(L, ct_usr, ct));
+
+ lua_pop(L, 1); /* upval table - already in registry */
+ assert(lua_gettop(L) == top);
+
+ ct2.is_jitted = 1;
+ pf = (cfunction*) push_cdata(L, ct_usr, &ct2);
+ *pf = compile(Dst, L, NULL, ref);
+
+ assert(lua_gettop(L) == top + 1);
+
+ return *pf;
+}
+
+void compile_function(lua_State* L, cfunction func, int ct_usr, const struct ctype* ct)
+{
+ size_t i, nargs;
+ int num_upvals;
+ const struct ctype* mbr_ct;
+ struct jit* Dst = get_jit(L);
+ struct reg_alloc reg;
+ void* p;
+ int top = lua_gettop(L);
+ int* perr = &Dst->last_errno;
+
+ ct_usr = lua_absindex(L, ct_usr);
+
+ memset(&reg, 0, sizeof(reg));
+ reg.off = 32 + REGISTER_STACK_SPACE(ct);
+
+ dasm_setup(Dst, build_actionlist);
+
+ p = push_cdata(L, ct_usr, ct);
+ *(cfunction*) p = func;
+ num_upvals = 1;
+
+ nargs = lua_rawlen(L, ct_usr);
+
+ if (ct->calling_convention != C_CALL && ct->has_var_arg) {
+ luaL_error(L, "vararg is only allowed with the c calling convention");
+ }
+
+ dasm_put(Dst, 957, nargs);
+ if (!ct->has_var_arg) {
+ dasm_put(Dst, 989, (unsigned int)((uintptr_t)(&"too few arguments")), (unsigned int)(((uintptr_t)(&"too few arguments"))>>32), (unsigned int)((uintptr_t)(&"too many arguments")), (unsigned int)(((uintptr_t)(&"too many arguments"))>>32));
+ } else {
+ dasm_put(Dst, 1030, (unsigned int)((uintptr_t)(&"too few arguments")), (unsigned int)(((uintptr_t)(&"too few arguments"))>>32));
+ }
+
+ dasm_put(Dst, 1050);
+
+ /* no need to zero extend eax returned by lua_gettop to rax as x86-64
+ * preguarentees that the upper 32 bits will be zero */
+ dasm_put(Dst, 1053, 32 + REGISTER_STACK_SPACE(ct));
+
+#if !defined _WIN64 && !defined __amd64__
+ /* Returned complex doubles require a hidden first parameter where the
+ * data is stored, which is popped by the calling code. */
+ lua_rawgeti(L, ct_usr, 0);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mbr_ct->pointers && !mbr_ct->is_reference && mbr_ct->type == COMPLEX_DOUBLE_TYPE) {
+ /* we can allocate more space for arguments as long as no add_*
+ * function has been called yet, mbr_ct will be added as an upvalue in
+ * the return processing later */
+ dasm_put(Dst, 1066, (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32));
+ add_pointer(Dst, ct, &reg);
+ }
+ lua_pop(L, 1);
+#endif
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, (int) i);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mbr_ct->pointers || mbr_ct->is_reference) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1090, (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals), i);
+ add_pointer(Dst, ct, &reg);
+ } else {
+ switch (mbr_ct->type) {
+ case FUNCTION_PTR_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1110, (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals), i);
+ add_pointer(Dst, ct, &reg);
+ break;
+
+ case ENUM_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1130, (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals), i);
+ add_int(Dst, ct, &reg, 0);
+ break;
+
+ case INT8_TYPE:
+ dasm_put(Dst, 1150, i);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1162);
+ } else {
+ dasm_put(Dst, 1166);
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INT16_TYPE:
+ dasm_put(Dst, 1150, i);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1170);
+ } else {
+ dasm_put(Dst, 1174);
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case BOOL_TYPE:
+ dasm_put(Dst, 1178, i);
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INT32_TYPE:
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1200, i);
+ } else {
+ dasm_put(Dst, 1150, i);
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INTPTR_TYPE:
+ dasm_put(Dst, 1212, i);
+ add_pointer(Dst, ct, &reg);
+ lua_pop(L, 1);
+ break;
+
+ case INT64_TYPE:
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1224, i);
+ } else {
+ dasm_put(Dst, 1236, i);
+ }
+ add_int(Dst, ct, &reg, 1);
+ lua_pop(L, 1);
+ break;
+
+ case DOUBLE_TYPE:
+ dasm_put(Dst, 1248, i);
+ add_float(Dst, ct, &reg, 1);
+ lua_pop(L, 1);
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ /* on 64 bit, returned complex doubles use xmm0, xmm1, on 32 bit
+ * there is a hidden first parameter that points to 16 bytes where
+ * the returned arg is stored (this is popped by the called
+ * function) */
+#if defined _WIN64 || defined __amd64__
+ dasm_put(Dst, 1260, i);
+ add_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 1272);
+ add_float(Dst, ct, &reg, 1);
+#else
+ dasm_put(Dst, 1278, reg.off, i);
+ reg.off += 16;
+#endif
+ lua_pop(L, 1);
+ break;
+
+ case FLOAT_TYPE:
+ dasm_put(Dst, 1248, i);
+ add_float(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+#if defined _WIN64 || defined __amd64__
+ dasm_put(Dst, 1304, i);
+ /* complex floats are two floats packed into a double */
+ add_float(Dst, ct, &reg, 1);
+#else
+ /* returned complex floats use eax and edx */
+ dasm_put(Dst, 1316, i);
+ add_float(Dst, ct, &reg, 0);
+ dasm_put(Dst, 1334);
+ add_float(Dst, ct, &reg, 0);
+#endif
+ lua_pop(L, 1);
+ break;
+
+ default:
+ luaL_error(L, "NYI: call arg type");
+ }
+ }
+ }
+
+ if (ct->has_var_arg) {
+#ifdef _WIN64
+ if (reg.regs < MAX_REGISTERS(ct)) {
+ assert(reg.regs == nargs);
+ dasm_put(Dst, 1341, MAX_REGISTERS(ct), 32 + 8*MAX_REGISTERS(ct), MAX_REGISTERS(ct)+1, 32 + 8*(reg.regs), MAX_REGISTERS(ct), nargs+1, 32 + 8*(reg.regs), nargs+1);
+ } else {
+ dasm_put(Dst, 1432, reg.off, nargs+1);
+ }
+
+ for (i = nargs; i < MAX_REGISTERS(ct); i++) {
+ reg.is_int[i] = reg.is_float[i] = 1;
+ }
+ reg.regs = MAX_REGISTERS(ct);
+#elif defined __amd64__
+ if (reg.floats < MAX_FLOAT_REGISTERS(ct)) {
+ }
+
+ if (reg.ints < MAX_INT_REGISTERS(ct)) {
+ }
+
+
+ reg.floats = MAX_FLOAT_REGISTERS(ct);
+ reg.ints = MAX_INT_REGISTERS(ct);
+#else
+#endif
+ }
+
+ dasm_put(Dst, 1457, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+
+ /* remove the stack space to call local functions */
+ dasm_put(Dst, 1471);
+
+#ifdef _WIN64
+ switch (reg.regs) {
+ case 4:
+ if (reg.is_float[3]) {
+ dasm_put(Dst, 1476, 8*3);
+ }
+ if (reg.is_int[3]) {
+ dasm_put(Dst, 1485, 8*3);
+ }
+ case 3:
+ if (reg.is_float[2]) {
+ dasm_put(Dst, 1492, 8*2);
+ }
+ if (reg.is_int[2]) {
+ dasm_put(Dst, 1501, 8*2);
+ }
+ case 2:
+ if (reg.is_float[1]) {
+ dasm_put(Dst, 1508, 8*1);
+ }
+ if (reg.is_int[1]) {
+ dasm_put(Dst, 1517, 8*1);
+ }
+ case 1:
+ if (reg.is_float[0]) {
+ dasm_put(Dst, 1524);
+ }
+ if (reg.is_int[0]) {
+ dasm_put(Dst, 1531);
+ }
+ case 0:
+ break;
+ }
+
+ /* don't remove the space for the registers as we need 32 bytes of register overflow space */
+ assert(REGISTER_STACK_SPACE(ct) == 32);
+
+#elif defined __amd64__
+ switch (reg.floats) {
+ case 8:
+ case 7:
+ case 6:
+ case 5:
+ case 4:
+ case 3:
+ case 2:
+ case 1:
+ case 0:
+ break;
+ }
+
+ switch (reg.ints) {
+ case 6:
+ case 5:
+ case 4:
+ case 3:
+ case 2:
+ case 1:
+ case 0:
+ break;
+ }
+
+#else
+ if (ct->calling_convention == FAST_CALL) {
+ switch (reg.ints) {
+ case 2:
+ case 1:
+ case 0:
+ break;
+ }
+
+ }
+#endif
+
+#ifdef __amd64__
+ if (ct->has_var_arg) {
+ /* al stores an upper limit on the number of float register, note that
+ * its allowed to be more than the actual number of float registers used as
+ * long as its 0-8 */
+ }
+#endif
+
+ dasm_put(Dst, 1536);
+
+ /* note on windows X86 the stack may be only aligned to 4 (stdcall will
+ * have popped a multiple of 4 bytes), but we don't need 16 byte alignment on
+ * that platform
+ */
+
+ lua_rawgeti(L, ct_usr, 0);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mbr_ct->pointers || mbr_ct->is_reference || mbr_ct->type == INTPTR_TYPE) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1546, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32), (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals));
+
+ } else {
+ switch (mbr_ct->type) {
+ case FUNCTION_PTR_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1546, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32), (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals));
+ break;
+
+ case INT64_TYPE:
+#if LUA_VERSION_NUM == 503
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1606, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ } else {
+ dasm_put(Dst, 1606, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ }
+#else
+ num_upvals++;
+ dasm_put(Dst, 1658, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32), (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32));
+#endif
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1721, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32), (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals));
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1782, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32), (unsigned int)((uintptr_t)(mbr_ct)), (unsigned int)(((uintptr_t)(mbr_ct))>>32), lua_upvalueindex(num_upvals));
+ break;
+
+ case VOID_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 1858, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 1890, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ case INT8_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1162);
+ } else {
+ dasm_put(Dst, 1166);
+ }
+ dasm_put(Dst, 1943, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ case INT16_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1170);
+ } else {
+ dasm_put(Dst, 1174);
+ }
+ dasm_put(Dst, 1943, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1993, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ } else {
+ dasm_put(Dst, 1943, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ }
+ break;
+
+ case FLOAT_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 2043, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 2048, (unsigned int)((uintptr_t)(perr)), (unsigned int)(((uintptr_t)(perr))>>32));
+ break;
+
+ default:
+ luaL_error(L, "NYI: call return type");
+ }
+ }
+
+ assert(lua_gettop(L) == top + num_upvals);
+ {
+ cfunction f = compile(Dst, L, func, LUA_NOREF);
+ /* add a callback as an upval so that the jitted code gets cleaned up when
+ * the function gets gc'd */
+ push_callback(L, f, func);
+ lua_pushcclosure(L, (lua_CFunction) f, num_upvals+1);
+ }
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/call_x86.dasc b/Build/source/texk/web2c/luatexdir/luaffi/call_x86.dasc
new file mode 100644
index 00000000000..4a72b98e4ad
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/call_x86.dasc
@@ -0,0 +1,1640 @@
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+|.if X64
+|.arch x64
+|.else
+|.arch x86
+|.endif
+
+|.actionlist build_actionlist
+|.globalnames globnames
+|.externnames extnames
+
+|.if not X64
+|.define RET_H, edx // for int64_t returns
+|.define RET_L, eax
+|.endif
+
+|.if X64
+|.define L_ARG, r12
+|.define TOP, r13
+|.else
+|.define L_ARG, rdi
+|.define TOP, rsi
+|.endif
+
+|.if X64WIN
+|
+|.macro call_rrrp, func, arg0, arg1, arg2, arg3
+| mov64 r9, arg3
+| mov r8, arg2
+| mov rdx, arg1
+| mov rcx, arg0
+| call func
+|.endmacro
+|.macro call_rrrr, func, arg0, arg1, arg2, arg3
+| mov r9, arg3
+| mov r8, arg2
+| mov rdx, arg1
+| mov rcx, arg0
+| call func
+|.endmacro
+|
+|.macro call_rrp, func, arg0, arg1, arg2
+| mov64 r8, arg2
+| mov rdx, arg1
+| mov rcx, arg0
+| call func
+|.endmacro
+|.macro call_rrr, func, arg0, arg1, arg2
+| mov r8, arg2
+| mov rdx, arg1
+| mov rcx, arg0
+| call func
+|.endmacro
+|
+|.macro call_rp, func, arg0, arg1
+| mov64 rdx, arg1
+| mov rcx, arg0
+| call func
+|.endmacro
+|.macro call_rr, func, arg0, arg1
+| mov rdx, arg1
+| mov rcx, arg0
+| call func
+|.endmacro
+|
+|.macro call_r, func, arg0
+| mov rcx, arg0
+| call func
+|.endmacro
+|
+|.elif X64
+|
+| // the 5 and 6 arg forms are only used on posix x64
+|.macro call_rrrrrr, func, arg0, arg1, arg2, arg3, arg4, arg5
+| mov r9, arg5
+| mov r8, arg4
+| mov rcx, arg3
+| mov rdx, arg2
+| mov rsi, arg1
+| mov rdi, arg0
+| call func
+|.endmacro
+|.macro call_rrrrr, func, arg0, arg1, arg2, arg3, arg4
+| mov r8, arg4
+| mov rcx, arg3
+| mov rdx, arg2
+| mov rsi, arg1
+| mov rdi, arg0
+| call func
+|.endmacro
+|
+|.macro call_rrrp, func, arg0, arg1, arg2, arg3
+| mov64 rcx, arg3
+| mov rdx, arg2
+| mov rsi, arg1
+| mov rdi, arg0
+| call func
+|.endmacro
+|.macro call_rrrr, func, arg0, arg1, arg2, arg3
+| mov rcx, arg3
+| mov rdx, arg2
+| mov rsi, arg1
+| mov rdi, arg0
+| call func
+|.endmacro
+|
+|.macro call_rrp, func, arg0, arg1, arg2
+| mov64 rdx, arg2
+| mov rsi, arg1
+| mov rdi, arg0
+| call func
+|.endmacro
+|.macro call_rrr, func, arg0, arg1, arg2
+| mov rdx, arg2
+| mov rsi, arg1
+| mov rdi, arg0
+| call func
+|.endmacro
+|
+|.macro call_rp, func, arg0, arg1
+| mov64 rsi, arg1
+| mov rdi, arg0
+| call func
+|.endmacro
+|.macro call_rr, func, arg0, arg1
+| mov rsi, arg1
+| mov rdi, arg0
+| call func
+|.endmacro
+|
+|.macro call_r, func, arg0
+| mov rdi, arg0
+| call func
+|.endmacro
+|
+|.else
+| // define the 64bit registers to the 32 bit counterparts, so the common
+| // code can use r*x for all pointers
+|.define rax, eax
+|.define rcx, ecx
+|.define rdx, edx
+|.define rsp, esp
+|.define rbp, ebp
+|.define rdi, edi
+|.define rsi, esi
+|.define mov64, mov
+|
+|.macro call_rrrr, func, arg0, arg1, arg2, arg3
+| mov dword [rsp+12], arg3
+| mov dword [rsp+8], arg2
+| mov dword [rsp+4], arg1
+| mov dword [rsp], arg0
+| call func
+|.endmacro
+|.macro call_rrr, func, arg0, arg1, arg2
+| mov dword [rsp+8], arg2
+| mov dword [rsp+4], arg1
+| mov dword [rsp], arg0
+| call func
+|.endmacro
+|.macro call_rr, func, arg0, arg1
+| mov dword [rsp+4], arg1
+| mov dword [rsp], arg0
+| call func
+|.endmacro
+|.macro call_r, func, arg0
+| mov dword [rsp], arg0
+| call func
+|.endmacro
+|
+|.define call_rrrp, call_rrrr
+|.define call_rrp, call_rrr
+|.define call_rp, call_rr
+|
+|.endif
+
+|.macro epilog
+|.if X64
+| mov TOP, [rbp-16]
+| mov L_ARG, [rbp-8]
+|.else
+| mov TOP, [rbp-8]
+| mov L_ARG, [rbp-4]
+|.endif
+| mov rsp, rbp
+| pop rbp
+| ret
+|.endmacro
+
+|.macro get_errno // note trashes registers
+| call extern GetLastError
+| mov64 rcx, perr
+| mov dword [rcx], eax
+|.endmacro
+
+|.macro too_few_arguments
+| mov ax, 0
+| call_rp extern luaL_error, L_ARG, &"too few arguments"
+|.endmacro
+
+|.macro too_many_arguments
+| mov ax, 0
+| call_rp extern luaL_error, L_ARG, &"too many arguments"
+|.endmacro
+
+|.macro lua_return_arg
+| mov eax, 1
+| epilog
+|.endmacro
+
+|.macro lua_return_void
+| get_errno
+| mov eax, 0
+| epilog
+|.endmacro
+
+|.macro lua_return_double
+|.if X64
+| movq qword [rsp+32], xmm0
+|.else
+| fstp qword [rsp+4] // note get_errno doesn't require any stack on x86
+|.endif
+|
+| get_errno
+|
+|.if X64WIN
+| movq xmm1, qword [rsp+32]
+| mov rcx, L_ARG
+|.elif X64
+| movq xmm0, qword [rsp+32]
+| mov rdi, L_ARG
+|.else
+| mov [rsp], L_ARG
+|.endif
+| call extern lua_pushnumber
+| lua_return_arg
+|.endmacro
+
+|.macro lua_return_bool
+| movzx eax, al
+| mov [rsp+32], eax
+| get_errno
+| mov eax, [rsp+32]
+| call_rr extern lua_pushboolean, L_ARG, rax
+| lua_return_arg
+|.endmacro
+
+|.macro lua_return_int
+| mov [rsp+32], eax
+| get_errno
+| mov eax, [rsp+32]
+| call_rr extern push_int, L_ARG, rax
+| lua_return_arg
+|.endmacro
+
+|.macro lua_return_uint
+| mov [rsp+32], eax
+| get_errno
+| mov eax, [rsp+32]
+| call_rr extern push_uint, L_ARG, rax
+| lua_return_arg
+|.endmacro
+
+|.macro lua_return_long
+| mov [rsp+32], rax
+| get_errno
+| mov rax, [rsp+32]
+| call_rr extern lua_pushinteger, L_ARG, rax
+| lua_return_arg
+|.endmacro
+
+|.macro lua_return_ulong
+| mov [rsp+32], rax
+| get_errno
+| mov rax, [rsp+32]
+| call_rr extern lua_pushinteger, L_ARG, rax
+| lua_return_arg
+|.endmacro
+
+|.macro save_registers
+| // use rbp relative so we store values in the outer stack frame
+|.if X64WIN
+| // use the provided shadow space for int registers above prev rbp and
+| // return address
+| mov [rbp+16], rcx
+| mov [rbp+24], rdx
+| mov [rbp+32], r8
+| mov [rbp+40], r9
+| // use the extra space we added for float registers
+| // -16 to store underneath previous value of L_ARG
+| movq qword [rbp-16], xmm0
+| movq qword [rbp-24], xmm1
+| movq qword [rbp-32], xmm2
+| movq qword [rbp-40], xmm3
+|.elif X64
+| movq qword [rbp-16], xmm0
+| movq qword [rbp-24], xmm1
+| movq qword [rbp-32], xmm2
+| movq qword [rbp-40], xmm3
+| movq qword [rbp-48], xmm4
+| movq qword [rbp-56], xmm5
+| movq qword [rbp-64], xmm6
+| movq qword [rbp-72], xmm7
+| mov [rbp-80], rdi
+| mov [rbp-88], rsi
+| mov [rbp-96], rdx
+| mov [rbp-104], rcx
+| mov [rbp-112], r8
+| mov [rbp-120], r9
+|.else
+| // fastcall, -8 to store underneath previous value of L_ARG
+| mov [rbp-8], ecx
+| mov [rbp-12], edx
+|.endif
+|.endmacro
+
+#if defined _WIN64 || defined __amd64__
+#define JUMP_SIZE 14
+#else
+#define JUMP_SIZE 4
+#endif
+
+#define MIN_BRANCH INT32_MIN
+#define MAX_BRANCH INT32_MAX
+#define BRANCH_OFF 4
+
+static void compile_extern_jump(struct jit* jit, lua_State* L, cfunction func, uint8_t* code)
+{
+ /* The jump code is the function pointer followed by a stub to call the
+ * function pointer. The stub exists in 64 bit so we can jump to functions
+ * with an offset greater than 2 GB.
+ *
+ * Note we have to manually set this up since there are commands buffered
+ * in the jit state and dynasm doesn't support rip relative addressing.
+ *
+ * eg on 64 bit:
+ * 0-8: function ptr
+ * 8-14: jmp aword [rip-14]
+ *
+ * for 32 bit we only set the function ptr as it can always fit in a 32
+ * bit displacement
+ */
+#if defined _WIN64 || defined __amd64__
+ *(cfunction*) code = func;
+ code[8] = 0xFF; /* FF /4 operand for jmp */
+ code[9] = 0x25; /* RIP displacement */
+ *(int32_t*) &code[10] = -14;
+#else
+ *(cfunction*) code = func;
+#endif
+}
+
+void compile_globals(struct jit* jit, lua_State* L)
+{
+ struct jit* Dst = jit;
+ int* perr = &jit->last_errno;
+ dasm_setup(Dst, build_actionlist);
+
+ /* Note: since the return code uses EBP to reset the stack pointer, we
+ * don't have to track the amount of stack space used. It also means we
+ * can handle stdcall and cdecl with the same code.
+ */
+
+ /* Note the various call_* functions want 32 bytes of 16 byte aligned
+ * stack
+ */
+
+
+
+ compile(Dst, L, NULL, LUA_NOREF);
+}
+
+int x86_return_size(lua_State* L, int usr, const struct ctype* ct)
+{
+ int ret = 0;
+ const struct ctype* mt;
+
+ if (ct->calling_convention != C_CALL) {
+ size_t i;
+ size_t argn = lua_rawlen(L, usr);
+ for (i = 1; i <= argn; i++) {
+ lua_rawgeti(L, usr, (int) i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ ret += sizeof(void*);
+ } else {
+ switch (mt->type) {
+ case DOUBLE_TYPE:
+ case COMPLEX_FLOAT_TYPE:
+ case INT64_TYPE:
+ ret += 8;
+ break;
+ case COMPLEX_DOUBLE_TYPE:
+ ret += 16;
+ break;
+ case INTPTR_TYPE:
+ ret += sizeof(intptr_t);
+ break;
+ case FUNCTION_PTR_TYPE:
+ ret += sizeof(cfunction);
+ break;
+ case BOOL_TYPE:
+ case FLOAT_TYPE:
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ ret += 4;
+ break;
+ default:
+ return luaL_error(L, "NYI - argument type");
+ }
+ }
+
+ lua_pop(L, 1);
+ }
+ }
+
+#if !defined _WIN64 && !defined __amd64__
+ lua_rawgeti(L, usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mt->pointers && !mt->is_reference && mt->type == COMPLEX_DOUBLE_TYPE) {
+ ret += sizeof(void*);
+ }
+ lua_pop(L, 1);
+#endif
+
+ return ret;
+}
+
+#ifdef _WIN64
+#define MAX_REGISTERS(ct) 4 /* rcx, rdx, r8, r9 */
+
+#elif defined __amd64__
+#define MAX_INT_REGISTERS(ct) 6 /* rdi, rsi, rdx, rcx, r8, r9 */
+#define MAX_FLOAT_REGISTERS(ct) 8 /* xmm0-7 */
+
+#else
+#define MAX_INT_REGISTERS(ct) ((ct)->calling_convention == FAST_CALL ? 2 /* ecx, edx */ : 0)
+#define MAX_FLOAT_REGISTERS(ct) 0
+#endif
+
+struct reg_alloc {
+#ifdef _WIN64
+ int regs;
+ int is_float[4];
+ int is_int[4];
+#else
+ int floats;
+ int ints;
+#endif
+ int off;
+};
+
+#ifdef _WIN64
+#define REGISTER_STACK_SPACE(ct) (4*8)
+#elif defined __amd64__
+#define REGISTER_STACK_SPACE(ct) (14*8)
+#else
+#define REGISTER_STACK_SPACE(ct) ALIGN_UP(((ct)->calling_convention == FAST_CALL ? 2*4 : 0), 15)
+#endif
+
+/* Fastcall:
+ * Uses ecx, edx as first two int registers
+ * Everything else on stack (include 64bit ints)
+ * No overflow stack space
+ * Pops the stack before returning
+ * Returns int in eax, float in ST0
+ * We use the same register allocation logic as posix x64 with 2 int regs and 0 float regs
+ */
+
+static void get_int(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_int64)
+{
+ /* grab the register from the shadow space */
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ | mov rcx, [rbp + 16 + 8*reg->regs]
+ reg->regs++;
+ }
+#elif __amd64__
+ if (reg->ints < MAX_INT_REGISTERS(ct)) {
+ | mov rcx, [rbp - 80 - 8*reg->ints]
+ reg->ints++;
+ }
+#else
+ if (!is_int64 && reg->ints < MAX_INT_REGISTERS(ct)) {
+ | mov ecx, [rbp - 8 - 4*reg->ints]
+ reg->ints++;
+ }
+#endif
+ else if (is_int64) {
+ |.if X64
+ | mov rcx, [rbp + reg->off]
+ |.else
+ | mov rcx, [rbp + reg->off]
+ | mov rdx, [rbp + reg->off + 4]
+ |.endif
+ reg->off += 8;
+ } else {
+ | mov ecx, [rbp + reg->off]
+ reg->off += 4;
+ }
+}
+
+static void add_int(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_int64)
+{
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ | mov [rsp + 32 + 8*(reg->regs)], rax
+ reg->is_int[reg->regs++] = 1;
+ }
+#elif __amd64__
+ if (reg->ints < MAX_INT_REGISTERS(ct)) {
+ | mov [rsp + 32 + 8*reg->ints], rax
+ reg->ints++;
+ }
+#else
+ if (!is_int64 && reg->ints < MAX_INT_REGISTERS(ct)) {
+ | mov [rsp + 32 + 4*reg->ints], rax
+ reg->ints++;
+ }
+#endif
+ else {
+#if defined _WIN64 || defined __amd64__
+ if (reg->off % 8 != 0) {
+ reg->off += 8 - (reg->off % 8);
+ }
+#endif
+ if (is_int64) {
+ |.if X64
+ | mov [rsp + reg->off], rax
+ |.else
+ | mov [rsp + reg->off], RET_L
+ | mov [rsp + reg->off + 4], RET_H
+ |.endif
+ reg->off += 8;
+ } else {
+ | mov [rsp+reg->off], eax
+ reg->off += 4;
+ }
+ }
+}
+
+static void get_float(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_double)
+{
+#if !defined _WIN64 && !defined __amd64__
+ assert(MAX_FLOAT_REGISTERS(ct) == 0);
+ if (is_double) {
+ | fld qword [rbp + reg->off]
+ reg->off += 8;
+ } else {
+ | fld dword [rbp + reg->off]
+ reg->off += 4;
+ }
+#else
+ int off;
+
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ off = -16 - 8*reg->regs;
+ reg->regs++;
+ }
+#else
+ if (reg->floats < MAX_FLOAT_REGISTERS(ct)) {
+ off = -16 - 8*reg->floats;
+ reg->floats++;
+ }
+#endif
+ else {
+ off = reg->off;
+ reg->off += is_double ? 8 : 4;
+ }
+
+ if (is_double) {
+ | movq xmm0, qword [rbp + off]
+ } else {
+ | cvtss2sd xmm0, dword [rbp + off]
+ }
+#endif
+}
+
+static void add_float(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_double)
+{
+#if !defined _WIN64 && !defined __amd64__
+ assert(MAX_FLOAT_REGISTERS(ct) == 0);
+ if (is_double) {
+ | fstp qword [rsp + reg->off]
+ reg->off += 8;
+ } else {
+ | fstp dword [rsp + reg->off]
+ reg->off += 4;
+ }
+#else
+
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ if (is_double) {
+ | movq qword [rsp + 32 + 8*(reg->regs)], xmm0
+ } else {
+ | cvtsd2ss xmm0, xmm0
+ | movq qword [rsp + 32 + 8*(reg->regs)], xmm0
+ }
+ reg->is_float[reg->regs++] = 1;
+ }
+#else
+ if (reg->floats < MAX_FLOAT_REGISTERS(ct)) {
+ if (is_double) {
+ | movq qword [rsp + 32 + 8*(MAX_INT_REGISTERS(ct) + reg->floats)], xmm0
+ } else {
+ | cvtsd2ss xmm0, xmm0
+ | movq qword [rsp + 32 + 8*(MAX_INT_REGISTERS(ct) + reg->floats)], xmm0
+ }
+ reg->floats++;
+ }
+#endif
+
+ else if (is_double) {
+ | movq qword [rsp + reg->off], xmm0
+ reg->off += 8;
+ } else {
+ | cvtsd2ss xmm0, xmm0
+ | movd dword [rsp + reg->off], xmm0
+ reg->off += 4;
+ }
+#endif
+}
+
+#if defined _WIN64 || defined __amd64__
+#define add_pointer(jit, ct, reg) add_int(jit, ct, reg, 1)
+#define get_pointer(jit, ct, reg) get_int(jit, ct, reg, 1)
+#else
+#define add_pointer(jit, ct, reg) add_int(jit, ct, reg, 0)
+#define get_pointer(jit, ct, reg) get_int(jit, ct, reg, 0)
+#endif
+
+cfunction compile_callback(lua_State* L, int fidx, int ct_usr, const struct ctype* ct)
+{
+ int i, nargs;
+ cfunction* pf;
+ struct ctype ct2 = *ct;
+ const struct ctype* mt;
+ struct reg_alloc reg;
+ int num_upvals = 0;
+ int top = lua_gettop(L);
+ struct jit* Dst = get_jit(L);
+ int ref;
+ int hidden_arg_off = 0;
+
+ ct_usr = lua_absindex(L, ct_usr);
+ fidx = lua_absindex(L, fidx);
+
+ assert(lua_isnil(L, fidx) || lua_isfunction(L, fidx));
+
+ memset(&reg, 0, sizeof(reg));
+#ifdef _WIN64
+ reg.off = 16 + REGISTER_STACK_SPACE(ct); /* stack registers are above the shadow space */
+#elif __amd64__
+ reg.off = 16;
+#else
+ reg.off = 8;
+#endif
+
+ dasm_setup(Dst, build_actionlist);
+
+ // add a table to store ctype and function upvalues
+ // callback_set assumes the first value is the lua function
+ nargs = (int) lua_rawlen(L, ct_usr);
+ lua_newtable(L);
+ lua_pushvalue(L, -1);
+ ref = luaL_ref(L, LUA_REGISTRYINDEX);
+
+ if (ct->has_var_arg) {
+ luaL_error(L, "can't create callbacks with varargs");
+ }
+
+ // setup a stack frame to hold args for the call into lua_call
+
+ | push rbp
+ | mov rbp, rsp
+ | push L_ARG
+ | // stack is 4 or 8 (mod 16) (L_ARG, rbp, rip)
+ |.if X64
+ | // 8 to realign, 16 for return vars, 32 for local calls, rest to save registers
+ | sub rsp, 8 + 16 + 32 + REGISTER_STACK_SPACE(ct)
+ | save_registers
+ |.else
+ | // 4 to realign, 16 for return vars, 32 for local calls, rest to save registers
+ | sub rsp, 4 + 16 + 32 + REGISTER_STACK_SPACE(ct)
+ if (ct->calling_convention == FAST_CALL) {
+ | save_registers
+ }
+ |.endif
+
+ // hardcode the lua_State* value into the assembly
+ | mov64 L_ARG, L
+
+ /* get the upval table */
+ | call_rrr extern lua_rawgeti, L_ARG, LUA_REGISTRYINDEX, ref
+
+ /* get the lua function */
+ lua_pushvalue(L, fidx);
+ lua_rawseti(L, -2, ++num_upvals);
+ assert(num_upvals == CALLBACK_FUNC_USR_IDX);
+ | call_rrr extern lua_rawgeti, L_ARG, -1, num_upvals
+
+#if !defined _WIN64 && !defined __amd64__
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mt->pointers && !mt->is_reference && mt->type == COMPLEX_DOUBLE_TYPE) {
+ hidden_arg_off = reg.off;
+ reg.off += sizeof(void*);
+ }
+ lua_pop(L, 1);
+#else
+ (void) hidden_arg_off;
+#endif
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ /* on the lua stack in the callback:
+ * upval tbl, lua func, i-1 args
+ */
+ | call_rrr extern lua_rawgeti, L_ARG, -i-1, num_upvals-1
+ | call_rrp extern push_cdata, L_ARG, -1, mt
+ get_pointer(Dst, ct, &reg);
+ | mov [rax], rcx
+ | call_rr, extern lua_remove, L_ARG, -2
+ } else {
+ switch (mt->type) {
+ case INT64_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* mt */
+ lua_pop(L, 1);
+ | call_rrp extern push_cdata, L_ARG, 0, mt
+ get_int(Dst, ct, &reg, 1);
+ |.if X64
+ | mov [rax], rcx
+ |.else
+ | mov [rax], ecx
+ | mov [rax+4], edx
+ |.endif
+ break;
+
+ case INTPTR_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* mt */
+ lua_pop(L, 1);
+ | call_rrp extern push_cdata, L_ARG, 0, mt
+ get_pointer(Dst, ct, &reg);
+ | mov [rax], rcx
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_pop(L, 1);
+#if defined _WIN64 || defined __amd64__
+ /* complex floats are two floats packed into a double */
+ | call_rrp extern push_cdata, L_ARG, 0, mt
+ get_float(Dst, ct, &reg, 1);
+ | movq qword [rax], xmm0
+#else
+ /* complex floats are real followed by imag on the stack */
+ | call_rrp extern push_cdata, L_ARG, 0, mt
+ get_float(Dst, ct, &reg, 0);
+ | fstp dword [rax]
+ get_float(Dst, ct, &reg, 0);
+ | fstp dword [rax+4]
+#endif
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_pop(L, 1);
+ | call_rrp extern push_cdata, L_ARG, 0, mt
+ /* real */
+ get_float(Dst, ct, &reg, 1);
+ |.if X64
+ | movq qword [rax], xmm0
+ |.else
+ | fstp qword [rax]
+ |.endif
+ /* imag */
+ get_float(Dst, ct, &reg, 1);
+ |.if X64
+ | movq qword [rax+8], xmm0
+ |.else
+ | fstp qword [rax+8]
+ |.endif
+ break;
+
+ case FLOAT_TYPE:
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ get_float(Dst, ct, &reg, mt->type == DOUBLE_TYPE);
+ |.if X64WIN
+ | movq xmm1, xmm0
+ | mov rcx, L_ARG
+ |.elif X64
+ | // for 64bit xmm0 is already set
+ | mov rdi, L_ARG
+ |.else
+ | fstp qword [rsp+4]
+ | mov [rsp], L_ARG
+ |.endif
+ | call extern lua_pushnumber
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ | movzx ecx, cl
+ | call_rr extern lua_pushboolean, L_ARG, rcx
+ break;
+
+ case INT8_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ | movzx ecx, cl
+ } else {
+ | movsx ecx, cl
+ }
+ | call_rr extern push_int, L_ARG, rcx
+ break;
+
+ case INT16_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ | movzx ecx, cx
+ } else {
+ | movsx ecx, cx
+ }
+ | call_rr extern push_int, L_ARG, rcx
+ break;
+
+ case ENUM_TYPE:
+ case INT32_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ | call_rr extern push_uint, L_ARG, rcx
+ } else {
+ | call_rr extern push_int, L_ARG, rcx
+ }
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback arg type");
+ }
+ }
+ }
+
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ | call_rrrp extern lua_callk, L_ARG, nargs, (mt->pointers || mt->is_reference || mt->type != VOID_TYPE) ? 1 : 0, 0
+
+ // Unpack the return argument if not "void", also clean-up the lua stack
+ // to remove the return argument and bind table. Use lua_settop rather
+ // than lua_pop as lua_pop is implemented as a macro.
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ | call_rrr extern lua_rawgeti, L_ARG, -2, num_upvals-1
+ | call_rrrp extern check_typed_pointer, L_ARG, -2, -1, mt
+ | mov [rsp+32], rax
+ | call_rr extern lua_settop, L_ARG, -4
+ | mov rax, [rsp+32]
+
+ } else {
+ switch (mt->type) {
+ case ENUM_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ | call_rrr extern lua_rawgeti, L_ARG, -2, num_upvals-1
+ | call_rrrp, extern check_enum, L_ARG, -2, -1, mt
+ | mov [rsp+32], eax
+ | call_rr extern lua_settop, L_ARG, -4
+ | mov eax, [rsp+32]
+ break;
+
+ case VOID_TYPE:
+ lua_pop(L, 1);
+ | call_rr extern lua_settop, L_ARG, -2
+ break;
+
+ case BOOL_TYPE:
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ lua_pop(L, 1);
+ if (mt->is_unsigned) {
+ | call_rr extern check_uint32, L_ARG, -1
+ } else {
+ | call_rr extern check_int32, L_ARG, -1
+ }
+ | mov [rsp+32], eax
+ | call_rr extern lua_settop, L_ARG, -3
+ | mov eax, [rsp+32]
+ break;
+
+ case INT64_TYPE:
+ lua_pop(L, 1);
+
+ if (mt->is_unsigned) {
+ | call_rr extern check_uint64, L_ARG, -1
+ } else {
+ | call_rr extern check_int64, L_ARG, -1
+ }
+
+ |.if X64
+ | mov [rsp+32], rax
+ |.else
+ | mov [rsp+32], RET_L
+ | mov [rsp+36], RET_H
+ |.endif
+ | call_rr extern lua_settop, L_ARG, -3
+ |.if X64
+ | mov rax, [rsp+32]
+ |.else
+ | mov RET_L, [rsp+32]
+ | mov RET_H, [rsp+36]
+ |.endif
+ break;
+
+ case INTPTR_TYPE:
+ lua_pop(L, 1);
+ | call_rr extern check_uintptr, L_ARG, -1
+ | mov [rsp+32], rax
+ | call_rr extern lua_settop, L_ARG, -3
+ | mov rax, [rsp+32]
+ break;
+
+ case FLOAT_TYPE:
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ | call_rr extern check_double, L_ARG, -1
+ |.if X64
+ | movq qword [rsp+32], xmm0
+ | call_rr extern lua_settop, L_ARG, -3
+ if (mt->type == FLOAT_TYPE) {
+ | cvtsd2ss xmm0, qword [rsp+32]
+ } else {
+ | movq xmm0, qword [rsp+32]
+ }
+ |.else
+ | fstp qword [rsp+32]
+ | call_rr extern lua_settop, L_ARG, -3
+ | fld qword [rsp+32]
+ |.endif
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_pop(L, 1);
+#if !defined HAVE_COMPLEX
+ luaL_error(L, "ffi lib compiled without complex number support");
+#endif
+ /* on 64 bit complex floats are two floats packed into a double,
+ * on 32 bit returned complex floats use eax and edx */
+ | call_rr extern check_complex_float, L_ARG, -1
+ |
+ |.if X64
+ | movq qword [rsp+32], xmm0
+ |.else
+ | mov [rsp+32], eax
+ | mov [rsp+36], edx
+ |.endif
+ |
+ | call_rr extern lua_settop, L_ARG, -3
+ |
+ |.if X64
+ | movq xmm0, qword [rsp+32]
+ |.else
+ | mov eax, [rsp+32]
+ | mov edx, [rsp+36]
+ |.endif
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_pop(L, 1);
+#if !defined HAVE_COMPLEX
+ luaL_error(L, "ffi lib compiled without complex number support");
+#endif
+ /* on 64 bit, returned complex doubles use xmm0, xmm1, on 32 bit
+ * there is a hidden first parameter that points to 16 bytes where
+ * the returned arg is stored which is popped by the called
+ * function */
+#if defined _WIN64 || defined __amd64__
+ | call_rr extern check_complex_double, L_ARG, -1
+ | movq qword [rsp+32], xmm0
+ | movq qword [rsp+40], xmm1
+ | call_rr extern lua_settop, L_ARG, -3
+ | movq xmm0, qword [rsp+32]
+ | movq xmm1, qword [rsp+40]
+#else
+ | mov rcx, [rbp + hidden_arg_off]
+ | call_rrr extern check_complex_double, rcx, L_ARG, -1
+ | sub rsp, 4 // to realign from popped hidden arg
+ | call_rr extern lua_settop, L_ARG, -3
+#endif
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback return type");
+ }
+ }
+
+ |.if X64
+ | mov L_ARG, [rbp-8]
+ |.else
+ | mov L_ARG, [rbp-4]
+ |.endif
+ | mov rsp, rbp
+ | pop rbp
+ | ret x86_return_size(L, ct_usr, ct)
+
+ lua_pop(L, 1); /* upval table - already in registry */
+ assert(lua_gettop(L) == top);
+
+ ct2.is_jitted = 1;
+ pf = (cfunction*) push_cdata(L, ct_usr, &ct2);
+ *pf = compile(Dst, L, NULL, ref);
+
+ assert(lua_gettop(L) == top + 1);
+
+ return *pf;
+}
+
+void compile_function(lua_State* L, cfunction func, int ct_usr, const struct ctype* ct)
+{
+ size_t i, nargs;
+ int num_upvals;
+ const struct ctype* mbr_ct;
+ struct jit* Dst = get_jit(L);
+ struct reg_alloc reg;
+ void* p;
+ int top = lua_gettop(L);
+ int* perr = &Dst->last_errno;
+
+ ct_usr = lua_absindex(L, ct_usr);
+
+ memset(&reg, 0, sizeof(reg));
+ reg.off = 32 + REGISTER_STACK_SPACE(ct);
+
+ dasm_setup(Dst, build_actionlist);
+
+ p = push_cdata(L, ct_usr, ct);
+ *(cfunction*) p = func;
+ num_upvals = 1;
+
+ nargs = lua_rawlen(L, ct_usr);
+
+ if (ct->calling_convention != C_CALL && ct->has_var_arg) {
+ luaL_error(L, "vararg is only allowed with the c calling convention");
+ }
+
+ | push rbp
+ | mov rbp, rsp
+ | push L_ARG
+ | push TOP
+ | // stack is 0 (mod 16) (TOP, L_ARG, rbp, rip)
+ |
+ | // Get L from our arguments and allocate some stack for lua_gettop
+ |.if X64WIN
+ | mov L_ARG, rcx
+ | sub rsp, 32 // shadow space
+ |.elif X64
+ | mov L_ARG, rdi
+ |.else
+ | mov L_ARG, [rbp + 8]
+ | sub rsp, 16
+ |.endif
+ |
+ | call_r extern lua_gettop, L_ARG
+ | mov TOP, rax // no need for movzxd rax, eax - high word guarenteed to be zero by x86-64
+ | cmp rax, nargs
+ if (!ct->has_var_arg) {
+ | jge >2
+ | too_few_arguments
+ | 2:
+ | jle >1
+ | too_many_arguments
+ } else {
+ | jge >1
+ | too_few_arguments
+ }
+
+ | 1:
+
+ /* no need to zero extend eax returned by lua_gettop to rax as x86-64
+ * preguarentees that the upper 32 bits will be zero */
+ | shl rax, 4 // reserve 16 bytes per argument - this maintains the alignment mod 16
+ | sub rsp, rax
+ | sub rsp, 32 + REGISTER_STACK_SPACE(ct) // reserve an extra 32 to call local functions
+
+#if !defined _WIN64 && !defined __amd64__
+ /* Returned complex doubles require a hidden first parameter where the
+ * data is stored, which is popped by the calling code. */
+ lua_rawgeti(L, ct_usr, 0);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mbr_ct->pointers && !mbr_ct->is_reference && mbr_ct->type == COMPLEX_DOUBLE_TYPE) {
+ /* we can allocate more space for arguments as long as no add_*
+ * function has been called yet, mbr_ct will be added as an upvalue in
+ * the return processing later */
+ | call_rrp extern push_cdata, L_ARG, 0, mbr_ct
+ | sub rsp, 16
+ add_pointer(Dst, ct, &reg);
+ }
+ lua_pop(L, 1);
+#endif
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, (int) i);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mbr_ct->pointers || mbr_ct->is_reference) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ | call_rrrp extern check_typed_pointer, L_ARG, i, lua_upvalueindex(num_upvals), mbr_ct
+ add_pointer(Dst, ct, &reg);
+ } else {
+ switch (mbr_ct->type) {
+ case FUNCTION_PTR_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ | call_rrrp extern check_typed_cfunction, L_ARG, i, lua_upvalueindex(num_upvals), mbr_ct
+ add_pointer(Dst, ct, &reg);
+ break;
+
+ case ENUM_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ | call_rrrp, extern check_enum, L_ARG, i, lua_upvalueindex(num_upvals), mbr_ct
+ add_int(Dst, ct, &reg, 0);
+ break;
+
+ case INT8_TYPE:
+ | call_rr extern check_int32, L_ARG, i
+ if (mbr_ct->is_unsigned) {
+ | movzx eax, al
+ } else {
+ | movsx eax, al
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INT16_TYPE:
+ | call_rr extern check_int32, L_ARG, i
+ if (mbr_ct->is_unsigned) {
+ | movzx eax, ax
+ } else {
+ | movsx eax, ax
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case BOOL_TYPE:
+ | call_rr extern check_int32, L_ARG, i
+ | cmp eax, 0
+ | setne al
+ | movzx eax, al
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INT32_TYPE:
+ if (mbr_ct->is_unsigned) {
+ | call_rr extern check_uint32, L_ARG, i
+ } else {
+ | call_rr extern check_int32, L_ARG, i
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INTPTR_TYPE:
+ | call_rr extern check_uintptr, L_ARG, i
+ add_pointer(Dst, ct, &reg);
+ lua_pop(L, 1);
+ break;
+
+ case INT64_TYPE:
+ if (mbr_ct->is_unsigned) {
+ | call_rr extern check_uint64, L_ARG, i
+ } else {
+ | call_rr extern check_int64, L_ARG, i
+ }
+ add_int(Dst, ct, &reg, 1);
+ lua_pop(L, 1);
+ break;
+
+ case DOUBLE_TYPE:
+ | call_rr extern check_double, L_ARG, i
+ add_float(Dst, ct, &reg, 1);
+ lua_pop(L, 1);
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ /* on 64 bit, returned complex doubles use xmm0, xmm1, on 32 bit
+ * there is a hidden first parameter that points to 16 bytes where
+ * the returned arg is stored (this is popped by the called
+ * function) */
+#if defined _WIN64 || defined __amd64__
+ | call_rr extern check_complex_double, L_ARG, i
+ add_float(Dst, ct, &reg, 1);
+ | movq xmm0, xmm1
+ add_float(Dst, ct, &reg, 1);
+#else
+ | lea rax, [rsp+reg.off]
+ | sub rsp, 4
+ | call_rrr extern check_complex_double, rax, L_ARG, i
+ reg.off += 16;
+#endif
+ lua_pop(L, 1);
+ break;
+
+ case FLOAT_TYPE:
+ | call_rr extern check_double, L_ARG, i
+ add_float(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+#if defined _WIN64 || defined __amd64__
+ | call_rr extern check_complex_float, L_ARG, i
+ /* complex floats are two floats packed into a double */
+ add_float(Dst, ct, &reg, 1);
+#else
+ /* returned complex floats use eax and edx */
+ | call_rr extern check_complex_float, L_ARG, i
+ | mov [rsp], eax
+ | fld dword [rsp]
+ add_float(Dst, ct, &reg, 0);
+ | mov [rsp], edx
+ | fld dword [rsp]
+ add_float(Dst, ct, &reg, 0);
+#endif
+ lua_pop(L, 1);
+ break;
+
+ default:
+ luaL_error(L, "NYI: call arg type");
+ }
+ }
+ }
+
+ if (ct->has_var_arg) {
+#ifdef _WIN64
+ |.if X64WIN
+ if (reg.regs < MAX_REGISTERS(ct)) {
+ assert(reg.regs == nargs);
+ | cmp TOP, MAX_REGISTERS(ct)
+ | jle >1
+ | // unpack onto stack
+ | mov rax, rsp
+ | add rax, 32 + 8*MAX_REGISTERS(ct)
+ | call_rrrr extern unpack_varargs_stack, L_ARG, MAX_REGISTERS(ct)+1, TOP, rax
+ | // unpack to registers
+ | mov rax, rsp
+ | add rax, 32 + 8*(reg.regs)
+ | call_rrrr extern unpack_varargs_reg, L_ARG, nargs+1, MAX_REGISTERS(ct), rax
+ | jmp >2
+ |1:
+ | // unpack just to registers
+ | mov rax, rsp
+ | add rax, 32 + 8*(reg.regs)
+ | call_rrrr extern unpack_varargs_reg, L_ARG, nargs+1, TOP, rax
+ |2:
+ } else {
+ | // unpack just to stack
+ | mov rax, rsp
+ | add rax, reg.off
+ | call_rrrr extern unpack_varargs_stack, L_ARG, nargs+1, TOP, rax
+ }
+
+ for (i = nargs; i < MAX_REGISTERS(ct); i++) {
+ reg.is_int[i] = reg.is_float[i] = 1;
+ }
+ reg.regs = MAX_REGISTERS(ct);
+#elif defined __amd64__
+ |.elif X64
+ if (reg.floats < MAX_FLOAT_REGISTERS(ct)) {
+ | mov rax, rsp
+ | add rax, 32 + 8*(MAX_INT_REGISTERS(ct) + reg.floats)
+ | call_rrrrr extern unpack_varargs_float, L_ARG, nargs+1, TOP, MAX_FLOAT_REGISTERS(ct) - reg.floats, rax
+ }
+
+ if (reg.ints < MAX_INT_REGISTERS(ct)) {
+ | mov rax, rsp
+ | add rax, 32 + 8*(reg.ints)
+ | call_rrrrr extern unpack_varargs_int, L_ARG, nargs+1, TOP, MAX_INT_REGISTERS(ct) - reg.ints, rax
+ }
+
+ | mov rax, rsp
+ | add rax, reg.off
+ | call_rrrrrr extern unpack_varargs_stack_skip, L_ARG, nargs+1, TOP, MAX_INT_REGISTERS(ct) - reg.ints, MAX_FLOAT_REGISTERS(ct) - reg.floats, rax
+
+ reg.floats = MAX_FLOAT_REGISTERS(ct);
+ reg.ints = MAX_INT_REGISTERS(ct);
+#else
+ |.else
+ | mov rax, rsp
+ | add rax, reg.off
+ | call_rrrr extern unpack_varargs_stack, L_ARG, nargs+1, TOP, rax
+ |.endif
+#endif
+ }
+
+ | mov64 rcx, perr
+ | mov eax, dword [rcx]
+ | call_r extern SetLastError, rax
+
+ /* remove the stack space to call local functions */
+ |.if X32WIN
+ | add rsp, 28 // SetLastError will have already popped 4
+ |.else
+ | add rsp, 32
+ |.endif
+
+#ifdef _WIN64
+ |.if X64WIN
+ switch (reg.regs) {
+ case 4:
+ if (reg.is_float[3]) {
+ | movq xmm3, qword [rsp + 8*3]
+ }
+ if (reg.is_int[3]) {
+ | mov r9, [rsp + 8*3]
+ }
+ case 3:
+ if (reg.is_float[2]) {
+ | movq xmm2, qword [rsp + 8*2]
+ }
+ if (reg.is_int[2]) {
+ | mov r8, [rsp + 8*2]
+ }
+ case 2:
+ if (reg.is_float[1]) {
+ | movq xmm1, qword [rsp + 8*1]
+ }
+ if (reg.is_int[1]) {
+ | mov rdx, [rsp + 8*1]
+ }
+ case 1:
+ if (reg.is_float[0]) {
+ | movq xmm0, qword [rsp]
+ }
+ if (reg.is_int[0]) {
+ | mov rcx, [rsp]
+ }
+ case 0:
+ break;
+ }
+
+ /* don't remove the space for the registers as we need 32 bytes of register overflow space */
+ assert(REGISTER_STACK_SPACE(ct) == 32);
+
+#elif defined __amd64__
+ |.elif X64
+ switch (reg.floats) {
+ case 8:
+ | movq xmm7, qword [rsp + 8*(MAX_INT_REGISTERS(ct)+7)]
+ case 7:
+ | movq xmm6, qword [rsp + 8*(MAX_INT_REGISTERS(ct)+6)]
+ case 6:
+ | movq xmm5, qword [rsp + 8*(MAX_INT_REGISTERS(ct)+5)]
+ case 5:
+ | movq xmm4, qword [rsp + 8*(MAX_INT_REGISTERS(ct)+4)]
+ case 4:
+ | movq xmm3, qword [rsp + 8*(MAX_INT_REGISTERS(ct)+3)]
+ case 3:
+ | movq xmm2, qword [rsp + 8*(MAX_INT_REGISTERS(ct)+2)]
+ case 2:
+ | movq xmm1, qword [rsp + 8*(MAX_INT_REGISTERS(ct)+1)]
+ case 1:
+ | movq xmm0, qword [rsp + 8*(MAX_INT_REGISTERS(ct))]
+ case 0:
+ break;
+ }
+
+ switch (reg.ints) {
+ case 6:
+ | mov r9, [rsp + 8*5]
+ case 5:
+ | mov r8, [rsp + 8*4]
+ case 4:
+ | mov rcx, [rsp + 8*3]
+ case 3:
+ | mov rdx, [rsp + 8*2]
+ case 2:
+ | mov rsi, [rsp + 8*1]
+ case 1:
+ | mov rdi, [rsp]
+ case 0:
+ break;
+ }
+
+ | add rsp, REGISTER_STACK_SPACE(ct)
+#else
+ |.else
+ if (ct->calling_convention == FAST_CALL) {
+ switch (reg.ints) {
+ case 2:
+ | mov edx, [rsp + 4]
+ case 1:
+ | mov ecx, [rsp]
+ case 0:
+ break;
+ }
+
+ | add rsp, REGISTER_STACK_SPACE(ct)
+ }
+ |.endif
+#endif
+
+#ifdef __amd64__
+ if (ct->has_var_arg) {
+ /* al stores an upper limit on the number of float register, note that
+ * its allowed to be more than the actual number of float registers used as
+ * long as its 0-8 */
+ |.if X64 and not X64WIN
+ | mov al, 8
+ |.endif
+ }
+#endif
+
+ | call extern FUNCTION
+ | sub rsp, 48 // 32 to be able to call local functions, 16 so we can store some local variables
+
+ /* note on windows X86 the stack may be only aligned to 4 (stdcall will
+ * have popped a multiple of 4 bytes), but we don't need 16 byte alignment on
+ * that platform
+ */
+
+ lua_rawgeti(L, ct_usr, 0);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mbr_ct->pointers || mbr_ct->is_reference || mbr_ct->type == INTPTR_TYPE) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ | mov [rsp+32], rax // save the pointer
+ | get_errno
+ | call_rrp extern push_cdata, L_ARG, lua_upvalueindex(num_upvals), mbr_ct
+ | mov rcx, [rsp+32]
+ | mov [rax], rcx // *(void**) cdata = val
+ | lua_return_arg
+
+ } else {
+ switch (mbr_ct->type) {
+ case FUNCTION_PTR_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ | mov [rsp+32], rax // save the function pointer
+ | get_errno
+ | call_rrp extern push_cdata, L_ARG, lua_upvalueindex(num_upvals), mbr_ct
+ | mov rcx, [rsp+32]
+ | mov [rax], rcx // *(cfunction**) cdata = val
+ | lua_return_arg
+ break;
+
+ case INT64_TYPE:
+#if LUA_VERSION_NUM == 503
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ | lua_return_ulong
+ } else {
+ | lua_return_long
+ }
+#else
+ num_upvals++;
+ | // save the return value
+ |.if X64
+ | mov [rsp+32], rax
+ |.else
+ | mov [rsp+36], edx // high
+ | mov [rsp+32], eax // low
+ |.endif
+ |
+ | get_errno
+ | call_rrp extern push_cdata, L_ARG, 0, mbr_ct
+ |
+ | // *(int64_t*) cdata = val
+ |.if X64
+ | mov rcx, [rsp+32]
+ | mov [rax], rcx
+ |.else
+ | mov rcx, [rsp+36]
+ | mov rdx, [rsp+32]
+ | mov [rax+4], rcx
+ | mov [rax], rdx
+ |.endif
+ |
+ | lua_return_arg
+#endif
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ |.if X64
+ | // complex floats are returned as two floats packed into xmm0
+ | movq qword [rsp+32], xmm0
+ |.else
+ | // complex floats are returned as floats in eax and edx
+ | mov [rsp+32], eax
+ | mov [rsp+36], edx
+ |.endif
+ |
+ | get_errno
+ | call_rrp extern push_cdata, L_ARG, lua_upvalueindex(num_upvals), mbr_ct
+ |
+ | // ((complex_float*) cdata) = val
+ |.if X64
+ | mov rcx, [rsp+32]
+ | mov [rax], rcx
+ |.else
+ | mov ecx, [rsp+32]
+ | mov [rax], ecx
+ | mov ecx, [rsp+36]
+ | mov [rax+4], ecx
+ |.endif
+ |
+ | lua_return_arg
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ |.if X64
+ | // complex doubles are returned as xmm0 and xmm1
+ | movq qword [rsp+40], xmm1
+ | movq qword [rsp+32], xmm0
+ |
+ | get_errno
+ | call_rrp extern push_cdata, L_ARG, lua_upvalueindex(num_upvals), mbr_ct
+ |
+ | // ((complex_double*) cdata)->real = val0
+ | // ((complex_double*) cdata)->imag = val1
+ | mov rcx, [rsp+40]
+ | mov [rax+8], rcx
+ | mov rcx, [rsp+32]
+ | mov [rax], rcx
+ |
+ |.else
+ | // On 32 bit we have already handled this by pushing a new cdata
+ | // and handing the cdata ptr in as the hidden first param, but
+ | // still need to add mbr_ct as an upval as its used earlier.
+ | // Hidden param was popped by called function, we need to realign.
+ | sub rsp, 4
+ | get_errno
+ |.endif
+ |
+ | lua_return_arg
+ break;
+
+ case VOID_TYPE:
+ lua_pop(L, 1);
+ | lua_return_void
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ | lua_return_bool
+ break;
+
+ case INT8_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ | movzx eax, al
+ } else {
+ | movsx eax, al
+ }
+ | lua_return_int
+ break;
+
+ case INT16_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ | movzx eax, ax
+ } else {
+ | movsx eax, ax
+ }
+ | lua_return_int
+ break;
+
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ | lua_return_uint
+ } else {
+ | lua_return_int
+ }
+ break;
+
+ case FLOAT_TYPE:
+ lua_pop(L, 1);
+ |.if X64
+ | cvtss2sd xmm0, xmm0
+ |.endif
+ | lua_return_double
+ break;
+
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ | lua_return_double
+ break;
+
+ default:
+ luaL_error(L, "NYI: call return type");
+ }
+ }
+
+ assert(lua_gettop(L) == top + num_upvals);
+ {
+ cfunction f = compile(Dst, L, func, LUA_NOREF);
+ /* add a callback as an upval so that the jitted code gets cleaned up when
+ * the function gets gc'd */
+ push_callback(L, f, func);
+ lua_pushcclosure(L, (lua_CFunction) f, num_upvals+1);
+ }
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/call_x86.h b/Build/source/texk/web2c/luatexdir/luaffi/call_x86.h
new file mode 100644
index 00000000000..4611a3cec02
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/call_x86.h
@@ -0,0 +1,1172 @@
+/*
+** This file has been pre-processed with DynASM.
+** http://luajit.org/dynasm.html
+** DynASM version 1.3.0, DynASM x86 version 1.3.0
+** DO NOT EDIT! The original file is in "call_x86.dasc".
+*/
+
+#if DASM_VERSION != 10300
+#error "Version mismatch between DynASM and included encoding engine"
+#endif
+
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+static const unsigned char build_actionlist[1915] = {
+ 139,141,233,255,139,141,233,139,149,233,255,137,132,253,36,233,255,137,132,
+ 253,36,233,137,148,253,36,233,255,221,133,233,255,217,133,233,255,252,243,
+ 15,126,133,233,255,252,243,15,90,133,233,255,221,156,253,36,233,255,217,156,
+ 253,36,233,255,102,15,214,132,253,36,233,255,252,242,15,90,192,102,15,214,
+ 132,253,36,233,255,252,242,15,90,192,102,15,126,132,253,36,233,255,85,137,
+ 229,87,129,252,236,239,255,137,77,252,248,137,85,252,244,255,191,237,255,
+ 199,68,36,8,237,199,68,36,4,237,137,60,36,232,251,1,0,255,199,68,36,8,237,
+ 199,68,36,4,252,255,252,255,252,255,252,255,137,60,36,232,251,1,0,255,199,
+ 68,36,8,237,199,68,36,4,237,137,60,36,232,251,1,0,199,68,36,8,237,199,68,
+ 36,4,252,255,252,255,252,255,252,255,137,60,36,232,251,1,1,255,137,8,199,
+ 68,36,4,252,254,252,255,252,255,252,255,137,60,36,232,251,1,2,255,199,68,
+ 36,8,237,199,68,36,4,0,0,0,0,137,60,36,232,251,1,1,255,137,8,137,80,4,255,
+ 137,8,255,102,15,214,0,255,217,24,255,217,88,4,255,221,24,255,221,88,8,255,
+ 221,92,36,4,137,60,36,232,251,1,3,255,15,182,201,137,76,36,4,137,60,36,232,
+ 251,1,4,255,15,182,201,255,15,190,201,255,137,76,36,4,137,60,36,232,251,1,
+ 5,255,15,183,201,255,15,191,201,255,137,76,36,4,137,60,36,232,251,1,6,255,
+ 199,68,36,12,0,0,0,0,199,68,36,8,237,199,68,36,4,237,137,60,36,232,251,1,
+ 7,255,199,68,36,8,237,199,68,36,4,252,254,252,255,252,255,252,255,137,60,
+ 36,232,251,1,0,199,68,36,12,237,199,68,36,8,252,255,252,255,252,255,252,255,
+ 199,68,36,4,252,254,252,255,252,255,252,255,137,60,36,232,251,1,8,137,68,
+ 36,32,199,68,36,4,252,252,252,255,252,255,252,255,137,60,36,232,251,1,9,139,
+ 68,36,32,255,199,68,36,8,237,199,68,36,4,252,254,252,255,252,255,252,255,
+ 137,60,36,232,251,1,0,199,68,36,12,237,199,68,36,8,252,255,252,255,252,255,
+ 252,255,199,68,36,4,252,254,252,255,252,255,252,255,137,60,36,232,251,1,10,
+ 137,68,36,32,199,68,36,4,252,252,252,255,252,255,252,255,137,60,36,232,251,
+ 1,9,139,68,36,32,255,199,68,36,4,252,254,252,255,252,255,252,255,137,60,36,
+ 232,251,1,9,255,199,68,36,4,252,255,252,255,252,255,252,255,137,60,36,232,
+ 251,1,11,255,199,68,36,4,252,255,252,255,252,255,252,255,137,60,36,232,251,
+ 1,12,255,137,68,36,32,199,68,36,4,252,253,252,255,252,255,252,255,137,60,
+ 36,232,251,1,9,139,68,36,32,255,199,68,36,4,252,255,252,255,252,255,252,255,
+ 137,60,36,232,251,1,13,255,199,68,36,4,252,255,252,255,252,255,252,255,137,
+ 60,36,232,251,1,14,255,137,68,36,32,137,84,36,36,199,68,36,4,252,253,252,
+ 255,252,255,252,255,137,60,36,232,251,1,9,139,68,36,32,139,84,36,36,255,199,
+ 68,36,4,252,255,252,255,252,255,252,255,137,60,36,232,251,1,15,137,68,36,
+ 32,199,68,36,4,252,253,252,255,252,255,252,255,137,60,36,232,251,1,9,139,
+ 68,36,32,255,199,68,36,4,252,255,252,255,252,255,252,255,137,60,36,232,251,
+ 1,16,255,221,92,36,32,199,68,36,4,252,253,252,255,252,255,252,255,137,60,
+ 36,232,251,1,9,221,68,36,32,255,199,68,36,4,252,255,252,255,252,255,252,255,
+ 137,60,36,232,251,1,17,137,68,36,32,137,84,36,36,199,68,36,4,252,253,252,
+ 255,252,255,252,255,137,60,36,232,251,1,9,139,68,36,32,139,84,36,36,255,199,
+ 68,36,4,252,255,252,255,252,255,252,255,137,60,36,232,251,1,18,102,15,214,
+ 68,36,32,102,15,214,76,36,40,199,68,36,4,252,253,252,255,252,255,252,255,
+ 137,60,36,232,251,1,9,252,243,15,126,68,36,32,252,243,15,126,76,36,40,255,
+ 139,141,233,199,68,36,8,252,255,252,255,252,255,252,255,137,124,36,4,137,
+ 12,36,232,251,1,18,131,252,236,4,199,68,36,4,252,253,252,255,252,255,252,
+ 255,137,60,36,232,251,1,9,255,139,125,252,252,137,252,236,93,194,236,255,
+ 85,137,229,87,86,139,189,233,131,252,236,16,137,60,36,232,251,1,19,137,198,
+ 129,252,248,239,255,15,141,244,248,102,184,0,0,199,68,36,4,237,137,60,36,
+ 232,251,1,20,248,2,15,142,244,247,102,184,0,0,199,68,36,4,237,137,60,36,232,
+ 251,1,20,255,15,141,244,247,102,184,0,0,199,68,36,4,237,137,60,36,232,251,
+ 1,20,255,248,1,255,193,224,4,41,196,129,252,236,239,255,199,68,36,8,237,199,
+ 68,36,4,0,0,0,0,137,60,36,232,251,1,1,131,252,236,16,255,199,68,36,12,237,
+ 199,68,36,8,237,199,68,36,4,237,137,60,36,232,251,1,8,255,199,68,36,12,237,
+ 199,68,36,8,237,199,68,36,4,237,137,60,36,232,251,1,21,255,199,68,36,12,237,
+ 199,68,36,8,237,199,68,36,4,237,137,60,36,232,251,1,10,255,199,68,36,4,237,
+ 137,60,36,232,251,1,12,255,15,182,192,255,15,190,192,255,15,183,192,255,15,
+ 191,192,255,199,68,36,4,237,137,60,36,232,251,1,12,131,252,248,0,15,149,208,
+ 15,182,192,255,199,68,36,4,237,137,60,36,232,251,1,11,255,199,68,36,4,237,
+ 137,60,36,232,251,1,15,255,199,68,36,4,237,137,60,36,232,251,1,13,255,199,
+ 68,36,4,237,137,60,36,232,251,1,14,255,199,68,36,4,237,137,60,36,232,251,
+ 1,16,255,199,68,36,4,237,137,60,36,232,251,1,18,255,252,243,15,126,193,255,
+ 141,132,253,36,233,131,252,236,4,199,68,36,8,237,137,124,36,4,137,4,36,232,
+ 251,1,18,255,199,68,36,4,237,137,60,36,232,251,1,17,255,199,68,36,4,237,137,
+ 60,36,232,251,1,17,137,4,36,217,4,36,255,137,20,36,217,4,36,255,137,224,129,
+ 192,239,137,68,36,12,137,116,36,8,199,68,36,4,237,137,60,36,232,251,1,22,
+ 255,185,237,139,1,137,4,36,232,251,1,23,255,131,196,32,255,139,148,253,36,
+ 233,255,139,12,36,255,129,196,239,255,232,251,1,24,131,252,236,48,255,137,
+ 68,36,32,232,251,1,25,185,237,137,1,199,68,36,8,237,199,68,36,4,237,137,60,
+ 36,232,251,1,1,139,76,36,32,137,8,184,1,0,0,0,139,117,252,248,139,125,252,
+ 252,137,252,236,93,195,255,137,68,36,32,232,251,1,25,185,237,137,1,139,68,
+ 36,32,137,68,36,4,137,60,36,232,251,1,26,184,1,0,0,0,139,117,252,248,139,
+ 125,252,252,137,252,236,93,195,255,137,84,36,36,137,68,36,32,232,251,1,25,
+ 185,237,137,1,199,68,36,8,237,199,68,36,4,0,0,0,0,137,60,36,232,251,1,1,139,
+ 76,36,36,139,84,36,32,137,72,4,137,16,184,1,0,0,0,139,117,252,248,139,125,
+ 252,252,137,252,236,93,195,255,137,68,36,32,137,84,36,36,232,251,1,25,185,
+ 237,137,1,199,68,36,8,237,199,68,36,4,237,137,60,36,232,251,1,1,139,76,36,
+ 32,137,8,139,76,36,36,137,72,4,184,1,0,0,0,139,117,252,248,139,125,252,252,
+ 137,252,236,93,195,255,131,252,236,4,232,251,1,25,185,237,137,1,184,1,0,0,
+ 0,139,117,252,248,139,125,252,252,137,252,236,93,195,255,232,251,1,25,185,
+ 237,137,1,184,0,0,0,0,139,117,252,248,139,125,252,252,137,252,236,93,195,
+ 255,15,182,192,137,68,36,32,232,251,1,25,185,237,137,1,139,68,36,32,137,68,
+ 36,4,137,60,36,232,251,1,4,184,1,0,0,0,139,117,252,248,139,125,252,252,137,
+ 252,236,93,195,255,137,68,36,32,232,251,1,25,185,237,137,1,139,68,36,32,137,
+ 68,36,4,137,60,36,232,251,1,5,184,1,0,0,0,139,117,252,248,139,125,252,252,
+ 137,252,236,93,195,255,137,68,36,32,232,251,1,25,185,237,137,1,139,68,36,
+ 32,137,68,36,4,137,60,36,232,251,1,6,184,1,0,0,0,139,117,252,248,139,125,
+ 252,252,137,252,236,93,195,255,221,92,36,4,232,251,1,25,185,237,137,1,137,
+ 60,36,232,251,1,3,184,1,0,0,0,139,117,252,248,139,125,252,252,137,252,236,
+ 93,195,255
+};
+
+static const char *const globnames[] = {
+ (const char *)0
+};
+static const char *const extnames[] = {
+ "lua_rawgeti",
+ "push_cdata",
+ "lua_remove",
+ "lua_pushnumber",
+ "lua_pushboolean",
+ "push_int",
+ "push_uint",
+ "lua_callk",
+ "check_typed_pointer",
+ "lua_settop",
+ "check_enum",
+ "check_uint32",
+ "check_int32",
+ "check_uint64",
+ "check_int64",
+ "check_uintptr",
+ "check_double",
+ "check_complex_float",
+ "check_complex_double",
+ "lua_gettop",
+ "luaL_error",
+ "check_typed_cfunction",
+ "unpack_varargs_stack",
+ "SetLastError",
+ "FUNCTION",
+ "GetLastError",
+ "lua_pushinteger",
+ (const char *)0
+};
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#if defined _WIN64 || defined __amd64__
+#define JUMP_SIZE 14
+#else
+#define JUMP_SIZE 4
+#endif
+
+#define MIN_BRANCH INT32_MIN
+#define MAX_BRANCH INT32_MAX
+#define BRANCH_OFF 4
+
+static void compile_extern_jump(struct jit* jit, lua_State* L, cfunction func, uint8_t* code)
+{
+ /* The jump code is the function pointer followed by a stub to call the
+ * function pointer. The stub exists in 64 bit so we can jump to functions
+ * with an offset greater than 2 GB.
+ *
+ * Note we have to manually set this up since there are commands buffered
+ * in the jit state and dynasm doesn't support rip relative addressing.
+ *
+ * eg on 64 bit:
+ * 0-8: function ptr
+ * 8-14: jmp aword [rip-14]
+ *
+ * for 32 bit we only set the function ptr as it can always fit in a 32
+ * bit displacement
+ */
+#if defined _WIN64 || defined __amd64__
+ *(cfunction*) code = func;
+ code[8] = 0xFF; /* FF /4 operand for jmp */
+ code[9] = 0x25; /* RIP displacement */
+ *(int32_t*) &code[10] = -14;
+#else
+ *(cfunction*) code = func;
+#endif
+}
+
+void compile_globals(struct jit* jit, lua_State* L)
+{
+ struct jit* Dst = jit;
+ int* perr = &jit->last_errno;
+ dasm_setup(Dst, build_actionlist);
+
+ /* Note: since the return code uses EBP to reset the stack pointer, we
+ * don't have to track the amount of stack space used. It also means we
+ * can handle stdcall and cdecl with the same code.
+ */
+
+ /* Note the various call_* functions want 32 bytes of 16 byte aligned
+ * stack
+ */
+
+ compile(Dst, L, NULL, LUA_NOREF);
+}
+
+int x86_return_size(lua_State* L, int usr, const struct ctype* ct)
+{
+ int ret = 0;
+ const struct ctype* mt;
+
+ if (ct->calling_convention != C_CALL) {
+ size_t i;
+ size_t argn = lua_rawlen(L, usr);
+ for (i = 1; i <= argn; i++) {
+ lua_rawgeti(L, usr, (int) i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ ret += sizeof(void*);
+ } else {
+ switch (mt->type) {
+ case DOUBLE_TYPE:
+ case COMPLEX_FLOAT_TYPE:
+ case INT64_TYPE:
+ ret += 8;
+ break;
+ case COMPLEX_DOUBLE_TYPE:
+ ret += 16;
+ break;
+ case INTPTR_TYPE:
+ ret += sizeof(intptr_t);
+ break;
+ case FUNCTION_PTR_TYPE:
+ ret += sizeof(cfunction);
+ break;
+ case BOOL_TYPE:
+ case FLOAT_TYPE:
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ ret += 4;
+ break;
+ default:
+ return luaL_error(L, "NYI - argument type");
+ }
+ }
+
+ lua_pop(L, 1);
+ }
+ }
+
+#if !defined _WIN64 && !defined __amd64__
+ lua_rawgeti(L, usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mt->pointers && !mt->is_reference && mt->type == COMPLEX_DOUBLE_TYPE) {
+ ret += sizeof(void*);
+ }
+ lua_pop(L, 1);
+#endif
+
+ return ret;
+}
+
+#ifdef _WIN64
+#define MAX_REGISTERS(ct) 4 /* rcx, rdx, r8, r9 */
+
+#elif defined __amd64__
+#define MAX_INT_REGISTERS(ct) 6 /* rdi, rsi, rdx, rcx, r8, r9 */
+#define MAX_FLOAT_REGISTERS(ct) 8 /* xmm0-7 */
+
+#else
+#define MAX_INT_REGISTERS(ct) ((ct)->calling_convention == FAST_CALL ? 2 /* ecx, edx */ : 0)
+#define MAX_FLOAT_REGISTERS(ct) 0
+#endif
+
+struct reg_alloc {
+#ifdef _WIN64
+ int regs;
+ int is_float[4];
+ int is_int[4];
+#else
+ int floats;
+ int ints;
+#endif
+ int off;
+};
+
+#ifdef _WIN64
+#define REGISTER_STACK_SPACE(ct) (4*8)
+#elif defined __amd64__
+#define REGISTER_STACK_SPACE(ct) (14*8)
+#else
+#define REGISTER_STACK_SPACE(ct) ALIGN_UP(((ct)->calling_convention == FAST_CALL ? 2*4 : 0), 15)
+#endif
+
+/* Fastcall:
+ * Uses ecx, edx as first two int registers
+ * Everything else on stack (include 64bit ints)
+ * No overflow stack space
+ * Pops the stack before returning
+ * Returns int in eax, float in ST0
+ * We use the same register allocation logic as posix x64 with 2 int regs and 0 float regs
+ */
+
+static void get_int(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_int64)
+{
+ /* grab the register from the shadow space */
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ dasm_put(Dst, 0, 16 + 8*reg->regs);
+ reg->regs++;
+ }
+#elif __amd64__
+ if (reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 0, - 80 - 8*reg->ints);
+ reg->ints++;
+ }
+#else
+ if (!is_int64 && reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 0, - 8 - 4*reg->ints);
+ reg->ints++;
+ }
+#endif
+ else if (is_int64) {
+ dasm_put(Dst, 4, reg->off, reg->off + 4);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 0, reg->off);
+ reg->off += 4;
+ }
+}
+
+static void add_int(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_int64)
+{
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ dasm_put(Dst, 11, 32 + 8*(reg->regs));
+ reg->is_int[reg->regs++] = 1;
+ }
+#elif __amd64__
+ if (reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 11, 32 + 8*reg->ints);
+ reg->ints++;
+ }
+#else
+ if (!is_int64 && reg->ints < MAX_INT_REGISTERS(ct)) {
+ dasm_put(Dst, 11, 32 + 4*reg->ints);
+ reg->ints++;
+ }
+#endif
+ else {
+#if defined _WIN64 || defined __amd64__
+ if (reg->off % 8 != 0) {
+ reg->off += 8 - (reg->off % 8);
+ }
+#endif
+ if (is_int64) {
+ dasm_put(Dst, 17, reg->off, reg->off + 4);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 11, reg->off);
+ reg->off += 4;
+ }
+ }
+}
+
+static void get_float(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_double)
+{
+#if !defined _WIN64 && !defined __amd64__
+ assert(MAX_FLOAT_REGISTERS(ct) == 0);
+ if (is_double) {
+ dasm_put(Dst, 28, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 32, reg->off);
+ reg->off += 4;
+ }
+#else
+ int off;
+
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ off = -16 - 8*reg->regs;
+ reg->regs++;
+ }
+#else
+ if (reg->floats < MAX_FLOAT_REGISTERS(ct)) {
+ off = -16 - 8*reg->floats;
+ reg->floats++;
+ }
+#endif
+ else {
+ off = reg->off;
+ reg->off += is_double ? 8 : 4;
+ }
+
+ if (is_double) {
+ dasm_put(Dst, 36, off);
+ } else {
+ dasm_put(Dst, 43, off);
+ }
+#endif
+}
+
+static void add_float(Dst_DECL, const struct ctype* ct, struct reg_alloc* reg, int is_double)
+{
+#if !defined _WIN64 && !defined __amd64__
+ assert(MAX_FLOAT_REGISTERS(ct) == 0);
+ if (is_double) {
+ dasm_put(Dst, 50, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 56, reg->off);
+ reg->off += 4;
+ }
+#else
+
+#ifdef _WIN64
+ if (reg->regs < MAX_REGISTERS(ct)) {
+ if (is_double) {
+ dasm_put(Dst, 62, 32 + 8*(reg->regs));
+ } else {
+ dasm_put(Dst, 70, 32 + 8*(reg->regs));
+ }
+ reg->is_float[reg->regs++] = 1;
+ }
+#else
+ if (reg->floats < MAX_FLOAT_REGISTERS(ct)) {
+ if (is_double) {
+ dasm_put(Dst, 62, 32 + 8*(MAX_INT_REGISTERS(ct) + reg->floats));
+ } else {
+ dasm_put(Dst, 70, 32 + 8*(MAX_INT_REGISTERS(ct) + reg->floats));
+ }
+ reg->floats++;
+ }
+#endif
+
+ else if (is_double) {
+ dasm_put(Dst, 62, reg->off);
+ reg->off += 8;
+ } else {
+ dasm_put(Dst, 83, reg->off);
+ reg->off += 4;
+ }
+#endif
+}
+
+#if defined _WIN64 || defined __amd64__
+#define add_pointer(jit, ct, reg) add_int(jit, ct, reg, 1)
+#define get_pointer(jit, ct, reg) get_int(jit, ct, reg, 1)
+#else
+#define add_pointer(jit, ct, reg) add_int(jit, ct, reg, 0)
+#define get_pointer(jit, ct, reg) get_int(jit, ct, reg, 0)
+#endif
+
+cfunction compile_callback(lua_State* L, int fidx, int ct_usr, const struct ctype* ct)
+{
+ int i, nargs;
+ cfunction* pf;
+ struct ctype ct2 = *ct;
+ const struct ctype* mt;
+ struct reg_alloc reg;
+ int num_upvals = 0;
+ int top = lua_gettop(L);
+ struct jit* Dst = get_jit(L);
+ int ref;
+ int hidden_arg_off = 0;
+
+ ct_usr = lua_absindex(L, ct_usr);
+ fidx = lua_absindex(L, fidx);
+
+ assert(lua_isnil(L, fidx) || lua_isfunction(L, fidx));
+
+ memset(&reg, 0, sizeof(reg));
+#ifdef _WIN64
+ reg.off = 16 + REGISTER_STACK_SPACE(ct); /* stack registers are above the shadow space */
+#elif __amd64__
+ reg.off = 16;
+#else
+ reg.off = 8;
+#endif
+
+ dasm_setup(Dst, build_actionlist);
+
+ // add a table to store ctype and function upvalues
+ // callback_set assumes the first value is the lua function
+ nargs = (int) lua_rawlen(L, ct_usr);
+ lua_newtable(L);
+ lua_pushvalue(L, -1);
+ ref = luaL_ref(L, LUA_REGISTRYINDEX);
+
+ if (ct->has_var_arg) {
+ luaL_error(L, "can't create callbacks with varargs");
+ }
+
+ // setup a stack frame to hold args for the call into lua_call
+
+ dasm_put(Dst, 96, 4 + 16 + 32 + REGISTER_STACK_SPACE(ct));
+ if (ct->calling_convention == FAST_CALL) {
+ dasm_put(Dst, 105);
+ }
+
+ // hardcode the lua_State* value into the assembly
+ dasm_put(Dst, 114, L);
+
+ /* get the upval table */
+ dasm_put(Dst, 117, ref, LUA_REGISTRYINDEX);
+
+ /* get the lua function */
+ lua_pushvalue(L, fidx);
+ lua_rawseti(L, -2, ++num_upvals);
+ assert(num_upvals == CALLBACK_FUNC_USR_IDX);
+ dasm_put(Dst, 135, num_upvals);
+
+#if !defined _WIN64 && !defined __amd64__
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mt->pointers && !mt->is_reference && mt->type == COMPLEX_DOUBLE_TYPE) {
+ hidden_arg_off = reg.off;
+ reg.off += sizeof(void*);
+ }
+ lua_pop(L, 1);
+#else
+ (void) hidden_arg_off;
+#endif
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, i);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ /* on the lua stack in the callback:
+ * upval tbl, lua func, i-1 args
+ */
+ dasm_put(Dst, 160, num_upvals-1, -i-1, mt);
+ get_pointer(Dst, ct, &reg);
+ dasm_put(Dst, 202);
+ } else {
+ switch (mt->type) {
+ case INT64_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* mt */
+ lua_pop(L, 1);
+ dasm_put(Dst, 224, mt);
+ get_int(Dst, ct, &reg, 1);
+ dasm_put(Dst, 245);
+ break;
+
+ case INTPTR_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* mt */
+ lua_pop(L, 1);
+ dasm_put(Dst, 224, mt);
+ get_pointer(Dst, ct, &reg);
+ dasm_put(Dst, 251);
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_pop(L, 1);
+#if defined _WIN64 || defined __amd64__
+ /* complex floats are two floats packed into a double */
+ dasm_put(Dst, 224, mt);
+ get_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 254);
+#else
+ /* complex floats are real followed by imag on the stack */
+ dasm_put(Dst, 224, mt);
+ get_float(Dst, ct, &reg, 0);
+ dasm_put(Dst, 259);
+ get_float(Dst, ct, &reg, 0);
+ dasm_put(Dst, 262);
+#endif
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 224, mt);
+ /* real */
+ get_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 266);
+ /* imag */
+ get_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 269);
+ break;
+
+ case FLOAT_TYPE:
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ get_float(Dst, ct, &reg, mt->type == DOUBLE_TYPE);
+ dasm_put(Dst, 273);
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ dasm_put(Dst, 285);
+ break;
+
+ case INT8_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 300);
+ } else {
+ dasm_put(Dst, 304);
+ }
+ dasm_put(Dst, 308);
+ break;
+
+ case INT16_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 320);
+ } else {
+ dasm_put(Dst, 324);
+ }
+ dasm_put(Dst, 308);
+ break;
+
+ case ENUM_TYPE:
+ case INT32_TYPE:
+ lua_pop(L, 1);
+ get_int(Dst, ct, &reg, 0);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 328);
+ } else {
+ dasm_put(Dst, 308);
+ }
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback arg type");
+ }
+ }
+ }
+
+ lua_rawgeti(L, ct_usr, 0);
+ mt = (const struct ctype*) lua_touserdata(L, -1);
+
+ dasm_put(Dst, 340, (mt->pointers || mt->is_reference || mt->type != VOID_TYPE) ? 1 : 0, nargs);
+
+ // Unpack the return argument if not "void", also clean-up the lua stack
+ // to remove the return argument and bind table. Use lua_settop rather
+ // than lua_pop as lua_pop is implemented as a macro.
+ if (mt->pointers || mt->is_reference) {
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ dasm_put(Dst, 366, num_upvals-1, mt);
+
+ } else {
+ switch (mt->type) {
+ case ENUM_TYPE:
+ lua_getuservalue(L, -1);
+ lua_rawseti(L, -3, ++num_upvals); /* usr value */
+ lua_rawseti(L, -2, ++num_upvals); /* mt */
+ dasm_put(Dst, 454, num_upvals-1, mt);
+ break;
+
+ case VOID_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 542);
+ break;
+
+ case BOOL_TYPE:
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ lua_pop(L, 1);
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 562);
+ } else {
+ dasm_put(Dst, 582);
+ }
+ dasm_put(Dst, 602);
+ break;
+
+ case INT64_TYPE:
+ lua_pop(L, 1);
+
+ if (mt->is_unsigned) {
+ dasm_put(Dst, 630);
+ } else {
+ dasm_put(Dst, 650);
+ }
+
+ dasm_put(Dst, 670);
+ break;
+
+ case INTPTR_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 706);
+ break;
+
+ case FLOAT_TYPE:
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 753);
+ if (mt->type == FLOAT_TYPE) {
+ } else {
+ }
+ dasm_put(Dst, 773);
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_pop(L, 1);
+#if !defined HAVE_COMPLEX
+ luaL_error(L, "ffi lib compiled without complex number support");
+#endif
+ /* on 64 bit complex floats are two floats packed into a double,
+ * on 32 bit returned complex floats use eax and edx */
+ dasm_put(Dst, 801);
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_pop(L, 1);
+#if !defined HAVE_COMPLEX
+ luaL_error(L, "ffi lib compiled without complex number support");
+#endif
+ /* on 64 bit, returned complex doubles use xmm0, xmm1, on 32 bit
+ * there is a hidden first parameter that points to 16 bytes where
+ * the returned arg is stored which is popped by the called
+ * function */
+#if defined _WIN64 || defined __amd64__
+ dasm_put(Dst, 856);
+#else
+ dasm_put(Dst, 921, hidden_arg_off);
+#endif
+ break;
+
+ default:
+ luaL_error(L, "NYI: callback return type");
+ }
+ }
+
+ dasm_put(Dst, 971, x86_return_size(L, ct_usr, ct));
+
+ lua_pop(L, 1); /* upval table - already in registry */
+ assert(lua_gettop(L) == top);
+
+ ct2.is_jitted = 1;
+ pf = (cfunction*) push_cdata(L, ct_usr, &ct2);
+ *pf = compile(Dst, L, NULL, ref);
+
+ assert(lua_gettop(L) == top + 1);
+
+ return *pf;
+}
+
+void compile_function(lua_State* L, cfunction func, int ct_usr, const struct ctype* ct)
+{
+ size_t i, nargs;
+ int num_upvals;
+ const struct ctype* mbr_ct;
+ struct jit* Dst = get_jit(L);
+ struct reg_alloc reg;
+ void* p;
+ int top = lua_gettop(L);
+ int* perr = &Dst->last_errno;
+
+ ct_usr = lua_absindex(L, ct_usr);
+
+ memset(&reg, 0, sizeof(reg));
+ reg.off = 32 + REGISTER_STACK_SPACE(ct);
+
+ dasm_setup(Dst, build_actionlist);
+
+ p = push_cdata(L, ct_usr, ct);
+ *(cfunction*) p = func;
+ num_upvals = 1;
+
+ nargs = lua_rawlen(L, ct_usr);
+
+ if (ct->calling_convention != C_CALL && ct->has_var_arg) {
+ luaL_error(L, "vararg is only allowed with the c calling convention");
+ }
+
+ dasm_put(Dst, 982, 8, nargs);
+ if (!ct->has_var_arg) {
+ dasm_put(Dst, 1008, (ptrdiff_t)("too few arguments"), (ptrdiff_t)("too many arguments"));
+ } else {
+ dasm_put(Dst, 1051, (ptrdiff_t)("too few arguments"));
+ }
+
+ dasm_put(Dst, 1072);
+
+ /* no need to zero extend eax returned by lua_gettop to rax as x86-64
+ * preguarentees that the upper 32 bits will be zero */
+ dasm_put(Dst, 1075, 32 + REGISTER_STACK_SPACE(ct));
+
+#if !defined _WIN64 && !defined __amd64__
+ /* Returned complex doubles require a hidden first parameter where the
+ * data is stored, which is popped by the calling code. */
+ lua_rawgeti(L, ct_usr, 0);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+ if (!mbr_ct->pointers && !mbr_ct->is_reference && mbr_ct->type == COMPLEX_DOUBLE_TYPE) {
+ /* we can allocate more space for arguments as long as no add_*
+ * function has been called yet, mbr_ct will be added as an upvalue in
+ * the return processing later */
+ dasm_put(Dst, 1085, mbr_ct);
+ add_pointer(Dst, ct, &reg);
+ }
+ lua_pop(L, 1);
+#endif
+
+ for (i = 1; i <= nargs; i++) {
+ lua_rawgeti(L, ct_usr, (int) i);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mbr_ct->pointers || mbr_ct->is_reference) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1110, mbr_ct, lua_upvalueindex(num_upvals), i);
+ add_pointer(Dst, ct, &reg);
+ } else {
+ switch (mbr_ct->type) {
+ case FUNCTION_PTR_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1133, mbr_ct, lua_upvalueindex(num_upvals), i);
+ add_pointer(Dst, ct, &reg);
+ break;
+
+ case ENUM_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1156, mbr_ct, lua_upvalueindex(num_upvals), i);
+ add_int(Dst, ct, &reg, 0);
+ break;
+
+ case INT8_TYPE:
+ dasm_put(Dst, 1179, i);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1192);
+ } else {
+ dasm_put(Dst, 1196);
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INT16_TYPE:
+ dasm_put(Dst, 1179, i);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1200);
+ } else {
+ dasm_put(Dst, 1204);
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case BOOL_TYPE:
+ dasm_put(Dst, 1208, i);
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INT32_TYPE:
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1231, i);
+ } else {
+ dasm_put(Dst, 1179, i);
+ }
+ add_int(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case INTPTR_TYPE:
+ dasm_put(Dst, 1244, i);
+ add_pointer(Dst, ct, &reg);
+ lua_pop(L, 1);
+ break;
+
+ case INT64_TYPE:
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1257, i);
+ } else {
+ dasm_put(Dst, 1270, i);
+ }
+ add_int(Dst, ct, &reg, 1);
+ lua_pop(L, 1);
+ break;
+
+ case DOUBLE_TYPE:
+ dasm_put(Dst, 1283, i);
+ add_float(Dst, ct, &reg, 1);
+ lua_pop(L, 1);
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ /* on 64 bit, returned complex doubles use xmm0, xmm1, on 32 bit
+ * there is a hidden first parameter that points to 16 bytes where
+ * the returned arg is stored (this is popped by the called
+ * function) */
+#if defined _WIN64 || defined __amd64__
+ dasm_put(Dst, 1296, i);
+ add_float(Dst, ct, &reg, 1);
+ dasm_put(Dst, 1309);
+ add_float(Dst, ct, &reg, 1);
+#else
+ dasm_put(Dst, 1315, reg.off, i);
+ reg.off += 16;
+#endif
+ lua_pop(L, 1);
+ break;
+
+ case FLOAT_TYPE:
+ dasm_put(Dst, 1283, i);
+ add_float(Dst, ct, &reg, 0);
+ lua_pop(L, 1);
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+#if defined _WIN64 || defined __amd64__
+ dasm_put(Dst, 1341, i);
+ /* complex floats are two floats packed into a double */
+ add_float(Dst, ct, &reg, 1);
+#else
+ /* returned complex floats use eax and edx */
+ dasm_put(Dst, 1354, i);
+ add_float(Dst, ct, &reg, 0);
+ dasm_put(Dst, 1373);
+ add_float(Dst, ct, &reg, 0);
+#endif
+ lua_pop(L, 1);
+ break;
+
+ default:
+ luaL_error(L, "NYI: call arg type");
+ }
+ }
+ }
+
+ if (ct->has_var_arg) {
+#ifdef _WIN64
+ if (reg.regs < MAX_REGISTERS(ct)) {
+ assert(reg.regs == nargs);
+ } else {
+ }
+
+ for (i = nargs; i < MAX_REGISTERS(ct); i++) {
+ reg.is_int[i] = reg.is_float[i] = 1;
+ }
+ reg.regs = MAX_REGISTERS(ct);
+#elif defined __amd64__
+ if (reg.floats < MAX_FLOAT_REGISTERS(ct)) {
+ }
+
+ if (reg.ints < MAX_INT_REGISTERS(ct)) {
+ }
+
+
+ reg.floats = MAX_FLOAT_REGISTERS(ct);
+ reg.ints = MAX_INT_REGISTERS(ct);
+#else
+ dasm_put(Dst, 1380, reg.off, nargs+1);
+#endif
+ }
+
+ dasm_put(Dst, 1406, perr);
+
+ /* remove the stack space to call local functions */
+ dasm_put(Dst, 1418);
+
+#ifdef _WIN64
+ switch (reg.regs) {
+ case 4:
+ if (reg.is_float[3]) {
+ }
+ if (reg.is_int[3]) {
+ }
+ case 3:
+ if (reg.is_float[2]) {
+ }
+ if (reg.is_int[2]) {
+ }
+ case 2:
+ if (reg.is_float[1]) {
+ }
+ if (reg.is_int[1]) {
+ }
+ case 1:
+ if (reg.is_float[0]) {
+ }
+ if (reg.is_int[0]) {
+ }
+ case 0:
+ break;
+ }
+
+ /* don't remove the space for the registers as we need 32 bytes of register overflow space */
+ assert(REGISTER_STACK_SPACE(ct) == 32);
+
+#elif defined __amd64__
+ switch (reg.floats) {
+ case 8:
+ case 7:
+ case 6:
+ case 5:
+ case 4:
+ case 3:
+ case 2:
+ case 1:
+ case 0:
+ break;
+ }
+
+ switch (reg.ints) {
+ case 6:
+ case 5:
+ case 4:
+ case 3:
+ case 2:
+ case 1:
+ case 0:
+ break;
+ }
+
+#else
+ if (ct->calling_convention == FAST_CALL) {
+ switch (reg.ints) {
+ case 2:
+ dasm_put(Dst, 1422, 4);
+ case 1:
+ dasm_put(Dst, 1428);
+ case 0:
+ break;
+ }
+
+ dasm_put(Dst, 1432, REGISTER_STACK_SPACE(ct));
+ }
+#endif
+
+#ifdef __amd64__
+ if (ct->has_var_arg) {
+ /* al stores an upper limit on the number of float register, note that
+ * its allowed to be more than the actual number of float registers used as
+ * long as its 0-8 */
+ }
+#endif
+
+ dasm_put(Dst, 1436);
+
+ /* note on windows X86 the stack may be only aligned to 4 (stdcall will
+ * have popped a multiple of 4 bytes), but we don't need 16 byte alignment on
+ * that platform
+ */
+
+ lua_rawgeti(L, ct_usr, 0);
+ mbr_ct = (const struct ctype*) lua_touserdata(L, -1);
+
+ if (mbr_ct->pointers || mbr_ct->is_reference || mbr_ct->type == INTPTR_TYPE) {
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1445, perr, mbr_ct, lua_upvalueindex(num_upvals));
+
+ } else {
+ switch (mbr_ct->type) {
+ case FUNCTION_PTR_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1445, perr, mbr_ct, lua_upvalueindex(num_upvals));
+ break;
+
+ case INT64_TYPE:
+#if LUA_VERSION_NUM == 503
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1499, perr);
+ } else {
+ dasm_put(Dst, 1499, perr);
+ }
+#else
+ num_upvals++;
+ dasm_put(Dst, 1545, perr, mbr_ct);
+#endif
+ break;
+
+ case COMPLEX_FLOAT_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1613, perr, mbr_ct, lua_upvalueindex(num_upvals));
+ break;
+
+ case COMPLEX_DOUBLE_TYPE:
+ lua_getuservalue(L, -1);
+ num_upvals += 2;
+ dasm_put(Dst, 1678, perr);
+ break;
+
+ case VOID_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 1709, perr);
+ break;
+
+ case BOOL_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 1736, perr);
+ break;
+
+ case INT8_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1192);
+ } else {
+ dasm_put(Dst, 1196);
+ }
+ dasm_put(Dst, 1785, perr);
+ break;
+
+ case INT16_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1200);
+ } else {
+ dasm_put(Dst, 1204);
+ }
+ dasm_put(Dst, 1785, perr);
+ break;
+
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ lua_pop(L, 1);
+ if (mbr_ct->is_unsigned) {
+ dasm_put(Dst, 1831, perr);
+ } else {
+ dasm_put(Dst, 1785, perr);
+ }
+ break;
+
+ case FLOAT_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 1877, perr);
+ break;
+
+ case DOUBLE_TYPE:
+ lua_pop(L, 1);
+ dasm_put(Dst, 1877, perr);
+ break;
+
+ default:
+ luaL_error(L, "NYI: call return type");
+ }
+ }
+
+ assert(lua_gettop(L) == top + num_upvals);
+ {
+ cfunction f = compile(Dst, L, func, LUA_NOREF);
+ /* add a callback as an upval so that the jitted code gets cleaned up when
+ * the function gets gc'd */
+ push_callback(L, f, func);
+ lua_pushcclosure(L, (lua_CFunction) f, num_upvals+1);
+ }
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/ctype.c b/Build/source/texk/web2c/luatexdir/luaffi/ctype.c
new file mode 100644
index 00000000000..c93fea03210
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/ctype.c
@@ -0,0 +1,272 @@
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+#include "ffi.h"
+
+static int to_define_key;
+
+static void update_on_definition(lua_State* L, int ct_usr, int ct_idx)
+{
+ ct_usr = lua_absindex(L, ct_usr);
+ ct_idx = lua_absindex(L, ct_idx);
+
+ lua_pushlightuserdata(L, &to_define_key);
+ lua_rawget(L, ct_usr);
+
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1); /* pop the nil */
+
+ /* {} */
+ lua_newtable(L);
+
+ /* {__mode='k'} */
+ lua_newtable(L);
+ lua_pushliteral(L, "k");
+ lua_setfield(L, -2, "__mode");
+
+ /* setmetatable({}, {__mode='k'}) */
+ lua_setmetatable(L, -2);
+
+ /* usr[TO_UPDATE_KEY] = setmetatable({}, {__mode='k'}) */
+ lua_pushlightuserdata(L, &to_define_key);
+ lua_pushvalue(L, -2);
+ lua_rawset(L, ct_usr);
+
+ /* leave the table on the stack */
+ }
+
+ /* to_update[ctype or cdata] = true */
+ lua_pushvalue(L, ct_idx);
+ lua_pushboolean(L, 1);
+ lua_rawset(L, -3);
+
+ /* pop the to_update table */
+ lua_pop(L, 1);
+}
+
+void set_defined(lua_State* L, int ct_usr, struct ctype* ct)
+{
+ ct_usr = lua_absindex(L, ct_usr);
+
+ ct->is_defined = 1;
+
+ /* update ctypes and cdatas that were created before the definition came in */
+ lua_pushlightuserdata(L, &to_define_key);
+ lua_rawget(L, ct_usr);
+
+ if (!lua_isnil(L, -1)) {
+ lua_pushnil(L);
+
+ while (lua_next(L, -2)) {
+ struct ctype* upd = (struct ctype*) lua_touserdata(L, -2);
+ upd->base_size = ct->base_size;
+ upd->align_mask = ct->align_mask;
+ upd->is_defined = 1;
+ upd->is_variable_struct = ct->is_variable_struct;
+ upd->variable_increment = ct->variable_increment;
+ assert(!upd->variable_size_known);
+ lua_pop(L, 1);
+ }
+
+ lua_pop(L, 1);
+ /* usr[TO_UPDATE_KEY] = nil */
+ lua_pushlightuserdata(L, &to_define_key);
+ lua_pushnil(L);
+ lua_rawset(L, ct_usr);
+ } else {
+ lua_pop(L, 1);
+ }
+}
+
+struct ctype* push_ctype(lua_State* L, int ct_usr, const struct ctype* ct)
+{
+ struct ctype* ret;
+ ct_usr = lua_absindex(L, ct_usr);
+
+ ret = (struct ctype*) lua_newuserdata(L, sizeof(struct ctype));
+ *ret = *ct;
+
+ push_upval(L, &ctype_mt_key);
+ lua_setmetatable(L, -2);
+
+#if LUA_VERSION_NUM == 501
+ if (!ct_usr || lua_isnil(L, ct_usr)) {
+ push_upval(L, &niluv_key);
+ lua_setfenv(L, -2);
+ }
+#endif
+
+ if (ct_usr && !lua_isnil(L, ct_usr)) {
+ lua_pushvalue(L, ct_usr);
+ lua_setuservalue(L, -2);
+ }
+
+ if (!ct->is_defined && ct_usr && !lua_isnil(L, ct_usr)) {
+ update_on_definition(L, ct_usr, -1);
+ }
+
+ return ret;
+}
+
+size_t ctype_size(lua_State* L, const struct ctype* ct)
+{
+ if (ct->pointers - ct->is_array) {
+ return sizeof(void*) * (ct->is_array ? ct->array_size : 1);
+
+ } else if (!ct->is_defined || ct->type == VOID_TYPE) {
+ return luaL_error(L, "can't calculate size of an undefined type");
+
+ } else if (ct->variable_size_known) {
+ assert(ct->is_variable_struct && !ct->is_array);
+ return ct->base_size + ct->variable_increment;
+
+ } else if (ct->is_variable_array || ct->is_variable_struct) {
+ return luaL_error(L, "internal error: calc size of variable type with unknown size");
+
+ } else {
+ return ct->base_size * (ct->is_array ? ct->array_size : 1);
+ }
+}
+
+void* push_cdata(lua_State* L, int ct_usr, const struct ctype* ct)
+{
+ struct cdata* cd;
+ size_t sz = ct->is_reference ? sizeof(void*) : ctype_size(L, ct);
+ ct_usr = lua_absindex(L, ct_usr);
+
+ /* This is to stop valgrind from complaining. Bitfields are accessed in 8
+ * byte chunks so that the code doesn't have to deal with different access
+ * patterns, but this means that occasionally it will read past the end of
+ * the struct. As its not setting the bits past the end (only reading and
+ * then writing the bits back) and the read is aligned its a non-issue,
+ * but valgrind complains nonetheless.
+ */
+ if (ct->has_bitfield) {
+ sz = ALIGN_UP(sz, 7);
+ }
+
+ cd = (struct cdata*) lua_newuserdata(L, sizeof(struct cdata) + sz);
+ *(struct ctype*) &cd->type = *ct;
+ memset(cd+1, 0, sz);
+
+ /* TODO: handle cases where lua_newuserdata returns a pointer that is not
+ * aligned */
+#if 0
+ assert((uintptr_t) (cd + 1) % 8 == 0);
+#endif
+
+#if LUA_VERSION_NUM == 501
+ if (!ct_usr || lua_isnil(L, ct_usr)) {
+ push_upval(L, &niluv_key);
+ lua_setfenv(L, -2);
+ }
+#endif
+
+ if (ct_usr && !lua_isnil(L, ct_usr)) {
+ lua_pushvalue(L, ct_usr);
+ lua_setuservalue(L, -2);
+ }
+
+ push_upval(L, &cdata_mt_key);
+ lua_setmetatable(L, -2);
+
+ if (!ct->is_defined && ct_usr && !lua_isnil(L, ct_usr)) {
+ update_on_definition(L, ct_usr, -1);
+ }
+
+ return cd+1;
+}
+
+void push_callback(lua_State* L, cfunction luafunc, cfunction cfunc)
+{
+ cfunction* pf = (cfunction*) lua_newuserdata(L, 2 * sizeof(cfunction));
+ pf[0] = luafunc;
+ pf[1] = cfunc;
+
+ push_upval(L, &callback_mt_key);
+ lua_setmetatable(L, -2);
+}
+
+/* returns the value as a ctype, pushes the user value onto the stack */
+void check_ctype(lua_State* L, int idx, struct ctype* ct)
+{
+ if (lua_isstring(L, idx)) {
+ struct parser P;
+ P.line = 1;
+ P.prev = P.next = lua_tostring(L, idx);
+ P.align_mask = DEFAULT_ALIGN_MASK;
+ parse_type(L, &P, ct);
+ parse_argument(L, &P, -1, ct, NULL, NULL);
+ lua_remove(L, -2); /* remove the user value from parse_type */
+
+ } else if (lua_getmetatable(L, idx)) {
+ if (!equals_upval(L, -1, &ctype_mt_key)
+ && !equals_upval(L, -1, &cdata_mt_key)) {
+ goto err;
+ }
+
+ lua_pop(L, 1); /* pop the metatable */
+ *ct = *(struct ctype*) lua_touserdata(L, idx);
+ lua_getuservalue(L, idx);
+
+ } else {
+ goto err;
+ }
+
+ return;
+
+err:
+ luaL_error(L, "expected cdata, ctype or string for arg #%d", idx);
+}
+
+/* to_cdata returns the struct cdata* and pushes the user value onto the
+ * stack. If the index is not a ctype then ct is set to the zero value such
+ * that ct->type is INVALID_TYPE, a nil is pushed, and NULL is returned. */
+void* to_cdata(lua_State* L, int idx, struct ctype* ct)
+{
+ struct cdata* cd;
+
+ memset(ct, 0, sizeof(struct ctype));
+ if (!lua_isuserdata(L, idx) || !lua_getmetatable(L, idx)) {
+ lua_pushnil(L);
+ return NULL;
+ }
+
+ if (!equals_upval(L, -1, &cdata_mt_key)) {
+ lua_pop(L, 1); /* mt */
+ lua_pushnil(L);
+ return NULL;
+ }
+
+ lua_pop(L, 1); /* mt */
+ cd = (struct cdata*) lua_touserdata(L, idx);
+ *ct = cd->type;
+ lua_getuservalue(L, idx);
+
+ if (ct->is_reference) {
+ return *(void**) (cd+1);
+
+ } else if (ct->pointers && !ct->is_array) {
+ return *(void**) (cd+1);
+
+ } else {
+ return cd + 1;
+ }
+}
+
+/* check_cdata returns the struct cdata* and pushes the user value onto the
+ * stack. Also dereferences references. */
+void* check_cdata(lua_State* L, int idx, struct ctype* ct)
+{
+ void* p = to_cdata(L, idx, ct);
+ if (ct->type == INVALID_TYPE) {
+ luaL_error(L, "expected cdata for arg #%d", idx);
+ }
+ return p;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_arm.h b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_arm.h
new file mode 100644
index 00000000000..71a4979193f
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_arm.h
@@ -0,0 +1,455 @@
+/*
+** DynASM ARM encoding engine.
+** Copyright (C) 2005-2011 Mike Pall. All rights reserved.
+** Released under the MIT/X license. See dynasm.lua for full copyright notice.
+*/
+
+#include <stddef.h>
+#include <stdarg.h>
+#include <string.h>
+#include <stdlib.h>
+
+#define DASM_ARCH "arm"
+
+#ifndef DASM_EXTERN
+#define DASM_EXTERN(a,b,c,d) 0
+#endif
+
+/* Action definitions. */
+enum {
+ DASM_STOP, DASM_SECTION, DASM_ESC, DASM_REL_EXT,
+ /* The following actions need a buffer position. */
+ DASM_ALIGN, DASM_REL_LG, DASM_LABEL_LG,
+ /* The following actions also have an argument. */
+ DASM_REL_PC, DASM_LABEL_PC,
+ DASM_LONG, DASM_IMM, DASM_IMM12, DASM_IMM16, DASM_IMML8, DASM_IMML12,
+ DASM__MAX
+};
+
+/* Maximum number of section buffer positions for a single dasm_put() call. */
+#define DASM_MAXSECPOS 25
+
+/* DynASM encoder status codes. Action list offset or number are or'ed in. */
+#define DASM_S_OK 0x00000000
+#define DASM_S_NOMEM 0x01000000
+#define DASM_S_PHASE 0x02000000
+#define DASM_S_MATCH_SEC 0x03000000
+#define DASM_S_RANGE_I 0x11000000
+#define DASM_S_RANGE_SEC 0x12000000
+#define DASM_S_RANGE_LG 0x13000000
+#define DASM_S_RANGE_PC 0x14000000
+#define DASM_S_RANGE_REL 0x15000000
+#define DASM_S_UNDEF_LG 0x21000000
+#define DASM_S_UNDEF_PC 0x22000000
+
+/* Macros to convert positions (8 bit section + 24 bit index). */
+#define DASM_POS2IDX(pos) ((pos)&0x00ffffff)
+#define DASM_POS2BIAS(pos) ((pos)&0xff000000)
+#define DASM_SEC2POS(sec) ((sec)<<24)
+#define DASM_POS2SEC(pos) ((pos)>>24)
+#define DASM_POS2PTR(D, pos) (D->sections[DASM_POS2SEC(pos)].rbuf + (pos))
+
+/* Action list type. */
+typedef const unsigned int *dasm_ActList;
+
+/* Per-section structure. */
+typedef struct dasm_Section {
+ int *rbuf; /* Biased buffer pointer (negative section bias). */
+ int *buf; /* True buffer pointer. */
+ size_t bsize; /* Buffer size in bytes. */
+ int pos; /* Biased buffer position. */
+ int epos; /* End of biased buffer position - max single put. */
+ int ofs; /* Byte offset into section. */
+} dasm_Section;
+
+/* Core structure holding the DynASM encoding state. */
+struct dasm_State {
+ size_t psize; /* Allocated size of this structure. */
+ dasm_ActList actionlist; /* Current actionlist pointer. */
+ int *lglabels; /* Local/global chain/pos ptrs. */
+ size_t lgsize;
+ int *pclabels; /* PC label chains/pos ptrs. */
+ size_t pcsize;
+ void **globals; /* Array of globals (bias -10). */
+ dasm_Section *section; /* Pointer to active section. */
+ size_t codesize; /* Total size of all code sections. */
+ int maxsection; /* 0 <= sectionidx < maxsection. */
+ int status; /* Status code. */
+ dasm_Section sections[1]; /* All sections. Alloc-extended. */
+};
+
+/* The size of the core structure depends on the max. number of sections. */
+#define DASM_PSZ(ms) (sizeof(dasm_State)+(ms-1)*sizeof(dasm_Section))
+
+
+/* Initialize DynASM state. */
+void dasm_init(Dst_DECL, int maxsection)
+{
+ dasm_State *D;
+ size_t psz = 0;
+ int i;
+ Dst_REF = NULL;
+ DASM_M_GROW(Dst, struct dasm_State, Dst_REF, psz, DASM_PSZ(maxsection));
+ D = Dst_REF;
+ D->psize = psz;
+ D->lglabels = NULL;
+ D->lgsize = 0;
+ D->pclabels = NULL;
+ D->pcsize = 0;
+ D->globals = NULL;
+ D->maxsection = maxsection;
+ for (i = 0; i < maxsection; i++) {
+ D->sections[i].buf = NULL; /* Need this for pass3. */
+ D->sections[i].rbuf = D->sections[i].buf - DASM_SEC2POS(i);
+ D->sections[i].bsize = 0;
+ D->sections[i].epos = 0; /* Wrong, but is recalculated after resize. */
+ }
+}
+
+/* Free DynASM state. */
+void dasm_free(Dst_DECL)
+{
+ dasm_State *D = Dst_REF;
+ int i;
+ for (i = 0; i < D->maxsection; i++)
+ if (D->sections[i].buf)
+ DASM_M_FREE(Dst, D->sections[i].buf, D->sections[i].bsize);
+ if (D->pclabels) DASM_M_FREE(Dst, D->pclabels, D->pcsize);
+ if (D->lglabels) DASM_M_FREE(Dst, D->lglabels, D->lgsize);
+ DASM_M_FREE(Dst, D, D->psize);
+}
+
+/* Setup global label array. Must be called before dasm_setup(). */
+void dasm_setupglobal(Dst_DECL, void **gl, unsigned int maxgl)
+{
+ dasm_State *D = Dst_REF;
+ D->globals = gl - 10; /* Negative bias to compensate for locals. */
+ DASM_M_GROW(Dst, int, D->lglabels, D->lgsize, (10+maxgl)*sizeof(int));
+}
+
+/* Grow PC label array. Can be called after dasm_setup(), too. */
+void dasm_growpc(Dst_DECL, unsigned int maxpc)
+{
+ dasm_State *D = Dst_REF;
+ size_t osz = D->pcsize;
+ DASM_M_GROW(Dst, int, D->pclabels, D->pcsize, maxpc*sizeof(int));
+ memset((void *)(((unsigned char *)D->pclabels)+osz), 0, D->pcsize-osz);
+}
+
+/* Setup encoder. */
+void dasm_setup(Dst_DECL, const void *actionlist)
+{
+ dasm_State *D = Dst_REF;
+ int i;
+ D->actionlist = (dasm_ActList)actionlist;
+ D->status = DASM_S_OK;
+ D->section = &D->sections[0];
+ memset((void *)D->lglabels, 0, D->lgsize);
+ if (D->pclabels) memset((void *)D->pclabels, 0, D->pcsize);
+ for (i = 0; i < D->maxsection; i++) {
+ D->sections[i].pos = DASM_SEC2POS(i);
+ D->sections[i].ofs = 0;
+ }
+}
+
+
+#ifdef DASM_CHECKS
+#define CK(x, st) \
+ do { if (!(x)) { \
+ D->status = DASM_S_##st|(p-D->actionlist-1); return; } } while (0)
+#define CKPL(kind, st) \
+ do { if ((size_t)((char *)pl-(char *)D->kind##labels) >= D->kind##size) { \
+ D->status = DASM_S_RANGE_##st|(p-D->actionlist-1); return; } } while (0)
+#else
+#define CK(x, st) ((void)0)
+#define CKPL(kind, st) ((void)0)
+#endif
+
+static int dasm_imm12(unsigned int n)
+{
+ int i;
+ for (i = 0; i < 16; i++, n = (n << 2) | (n >> 30))
+ if (n <= 255) return (int)(n + (i << 8));
+ return -1;
+}
+
+/* Pass 1: Store actions and args, link branches/labels, estimate offsets. */
+void dasm_put(Dst_DECL, int start, ...)
+{
+ va_list ap;
+ dasm_State *D = Dst_REF;
+ dasm_ActList p = D->actionlist + start;
+ dasm_Section *sec = D->section;
+ int pos = sec->pos, ofs = sec->ofs;
+ int *b;
+
+ if (pos >= sec->epos) {
+ DASM_M_GROW(Dst, int, sec->buf, sec->bsize,
+ sec->bsize + 2*DASM_MAXSECPOS*sizeof(int));
+ sec->rbuf = sec->buf - DASM_POS2BIAS(pos);
+ sec->epos = (int)sec->bsize/sizeof(int) - DASM_MAXSECPOS+DASM_POS2BIAS(pos);
+ }
+
+ b = sec->rbuf;
+ b[pos++] = start;
+
+ va_start(ap, start);
+ while (1) {
+ unsigned int ins = *p++;
+ unsigned int action = (ins >> 16);
+ if (action >= DASM__MAX) {
+ ofs += 4;
+ } else {
+ int *pl, n = action >= DASM_REL_PC ? va_arg(ap, int) : 0;
+ switch (action) {
+ case DASM_STOP: goto stop;
+ case DASM_SECTION:
+ n = (ins & 255); CK(n < D->maxsection, RANGE_SEC);
+ D->section = &D->sections[n]; goto stop;
+ case DASM_ESC: p++; ofs += 4; break;
+ case DASM_REL_EXT: break;
+ case DASM_ALIGN: ofs += (ins & 255); b[pos++] = ofs; break;
+ case DASM_REL_LG:
+ n = (ins & 2047) - 10; pl = D->lglabels + n;
+ if (n >= 0) { CKPL(lg, LG); goto putrel; } /* Bkwd rel or global. */
+ pl += 10; n = *pl;
+ if (n < 0) n = 0; /* Start new chain for fwd rel if label exists. */
+ goto linkrel;
+ case DASM_REL_PC:
+ pl = D->pclabels + n; CKPL(pc, PC);
+ putrel:
+ n = *pl;
+ if (n < 0) { /* Label exists. Get label pos and store it. */
+ b[pos] = -n;
+ } else {
+ linkrel:
+ b[pos] = n; /* Else link to rel chain, anchored at label. */
+ *pl = pos;
+ }
+ pos++;
+ break;
+ case DASM_LABEL_LG:
+ pl = D->lglabels + (ins & 2047) - 10; CKPL(lg, LG); goto putlabel;
+ case DASM_LABEL_PC:
+ pl = D->pclabels + n; CKPL(pc, PC);
+ putlabel:
+ n = *pl; /* n > 0: Collapse rel chain and replace with label pos. */
+ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = pos;
+ }
+ *pl = -pos; /* Label exists now. */
+ b[pos++] = ofs; /* Store pass1 offset estimate. */
+ break;
+ case DASM_LONG:
+ ofs += 4;
+ b[pos++] = n;
+ break;
+ case DASM_IMM:
+ case DASM_IMM16:
+#ifdef DASM_CHECKS
+ CK((n & ((1<<((ins>>10)&31))-1)) == 0, RANGE_I);
+ if ((ins & 0x8000))
+ CK(((n + (1<<(((ins>>5)&31)-1)))>>((ins>>5)&31)) == 0, RANGE_I);
+ else
+ CK((n>>((ins>>5)&31)) == 0, RANGE_I);
+#endif
+ b[pos++] = n;
+ break;
+ case DASM_IMML8:
+ case DASM_IMML12:
+ CK(n >= 0 ? ((n>>((ins>>5)&31)) == 0) :
+ (((-n)>>((ins>>5)&31)) == 0), RANGE_I);
+ b[pos++] = n;
+ break;
+ case DASM_IMM12:
+ CK(dasm_imm12((unsigned int)n) != -1, RANGE_I);
+ b[pos++] = n;
+ break;
+ }
+ }
+ }
+stop:
+ va_end(ap);
+ sec->pos = pos;
+ sec->ofs = ofs;
+}
+#undef CK
+
+/* Pass 2: Link sections, shrink aligns, fix label offsets. */
+int dasm_link(Dst_DECL, size_t *szp)
+{
+ dasm_State *D = Dst_REF;
+ int secnum;
+ int ofs = 0;
+
+#ifdef DASM_CHECKS
+ *szp = 0;
+ if (D->status != DASM_S_OK) return D->status;
+ {
+ int pc;
+ for (pc = 0; pc*sizeof(int) < D->pcsize; pc++)
+ if (D->pclabels[pc] > 0) return DASM_S_UNDEF_PC|pc;
+ }
+#endif
+
+ { /* Handle globals not defined in this translation unit. */
+ int idx;
+ for (idx = 20; idx*sizeof(int) < D->lgsize; idx++) {
+ int n = D->lglabels[idx];
+ /* Undefined label: Collapse rel chain and replace with marker (< 0). */
+ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = -idx; }
+ }
+ }
+
+ /* Combine all code sections. No support for data sections (yet). */
+ for (secnum = 0; secnum < D->maxsection; secnum++) {
+ dasm_Section *sec = D->sections + secnum;
+ int *b = sec->rbuf;
+ int pos = DASM_SEC2POS(secnum);
+ int lastpos = sec->pos;
+
+ while (pos != lastpos) {
+ dasm_ActList p = D->actionlist + b[pos++];
+ while (1) {
+ unsigned int ins = *p++;
+ unsigned int action = (ins >> 16);
+ switch (action) {
+ case DASM_STOP: case DASM_SECTION: goto stop;
+ case DASM_ESC: p++; break;
+ case DASM_REL_EXT: break;
+ case DASM_ALIGN: ofs -= (b[pos++] + ofs) & (ins & 255); break;
+ case DASM_REL_LG: case DASM_REL_PC: pos++; break;
+ case DASM_LABEL_LG: case DASM_LABEL_PC: b[pos++] += ofs; break;
+ case DASM_LONG: case DASM_IMM: case DASM_IMM12: case DASM_IMM16:
+ case DASM_IMML8: case DASM_IMML12: pos++; break;
+ }
+ }
+ stop: (void)0;
+ }
+ ofs += sec->ofs; /* Next section starts right after current section. */
+ }
+
+ D->codesize = ofs; /* Total size of all code sections */
+ *szp = ofs;
+ return DASM_S_OK;
+}
+
+#ifdef DASM_CHECKS
+#define CK(x, st) \
+ do { if (!(x)) return DASM_S_##st|(p-D->actionlist-1); } while (0)
+#else
+#define CK(x, st) ((void)0)
+#endif
+
+/* Pass 3: Encode sections. */
+int dasm_encode(Dst_DECL, void *buffer)
+{
+ dasm_State *D = Dst_REF;
+ char *base = (char *)buffer;
+ unsigned int *cp = (unsigned int *)buffer;
+ int secnum;
+
+ /* Encode all code sections. No support for data sections (yet). */
+ for (secnum = 0; secnum < D->maxsection; secnum++) {
+ dasm_Section *sec = D->sections + secnum;
+ int *b = sec->buf;
+ int *endb = sec->rbuf + sec->pos;
+
+ while (b != endb) {
+ dasm_ActList p = D->actionlist + *b++;
+ while (1) {
+ unsigned int ins = *p++;
+ unsigned int action = (ins >> 16);
+ int n = (action >= DASM_ALIGN && action < DASM__MAX) ? *b++ : 0;
+ switch (action) {
+ case DASM_STOP: case DASM_SECTION: goto stop;
+ case DASM_ESC: *cp++ = *p++; break;
+ case DASM_REL_EXT:
+ n = DASM_EXTERN(Dst, (unsigned char *)cp, (ins&2047), !(ins&2048));
+ goto patchrel;
+ case DASM_ALIGN:
+ ins &= 255; while ((((char *)cp - base) & ins)) *cp++ = 0xe1a00000;
+ break;
+ case DASM_REL_LG:
+ CK(n >= 0, UNDEF_LG);
+ case DASM_REL_PC:
+ CK(n >= 0, UNDEF_PC);
+ n = *DASM_POS2PTR(D, n) - (int)((char *)cp - base) - 4;
+ patchrel:
+ if ((ins & 0x800) == 0) {
+ CK((n & 3) == 0 && ((n+0x02000000) >> 26) == 0, RANGE_REL);
+ cp[-1] |= ((n >> 2) & 0x00ffffff);
+ } else if ((ins & 0x1000)) {
+ CK((n & 3) == 0 && -256 <= n && n <= 256, RANGE_REL);
+ goto patchimml8;
+ } else {
+ CK((n & 3) == 0 && -4096 <= n && n <= 4096, RANGE_REL);
+ goto patchimml12;
+ }
+ break;
+ case DASM_LABEL_LG:
+ ins &= 2047; if (ins >= 20) D->globals[ins-10] = (void *)(base + n);
+ break;
+ case DASM_LABEL_PC: break;
+ case DASM_LONG:
+ *cp++ = n;
+ break;
+ case DASM_IMM:
+ cp[-1] |= ((n>>((ins>>10)&31)) & ((1<<((ins>>5)&31))-1)) << (ins&31);
+ break;
+ case DASM_IMM12:
+ cp[-1] |= dasm_imm12((unsigned int)n);
+ break;
+ case DASM_IMM16:
+ cp[-1] |= ((n & 0xf000) << 4) | (n & 0x0fff);
+ break;
+ case DASM_IMML8: patchimml8:
+ cp[-1] |= n >= 0 ? (0x00800000 | (n & 0x0f) | ((n & 0xf0) << 4)) :
+ ((-n & 0x0f) | ((-n & 0xf0) << 4));
+ break;
+ case DASM_IMML12: patchimml12:
+ cp[-1] |= n >= 0 ? (0x00800000 | n) : (-n);
+ break;
+ default: *cp++ = ins; break;
+ }
+ }
+ stop: (void)0;
+ }
+ }
+
+ if (base + D->codesize != (char *)cp) /* Check for phase errors. */
+ return DASM_S_PHASE;
+ return DASM_S_OK;
+}
+#undef CK
+
+/* Get PC label offset. */
+int dasm_getpclabel(Dst_DECL, unsigned int pc)
+{
+ dasm_State *D = Dst_REF;
+ if (pc*sizeof(int) < D->pcsize) {
+ int pos = D->pclabels[pc];
+ if (pos < 0) return *DASM_POS2PTR(D, -pos);
+ if (pos > 0) return -1; /* Undefined. */
+ }
+ return -2; /* Unused or out of range. */
+}
+
+#ifdef DASM_CHECKS
+/* Optional sanity checker to call between isolated encoding steps. */
+int dasm_checkstep(Dst_DECL, int secmatch)
+{
+ dasm_State *D = Dst_REF;
+ if (D->status == DASM_S_OK) {
+ int i;
+ for (i = 1; i <= 9; i++) {
+ if (D->lglabels[i] > 0) { D->status = DASM_S_UNDEF_LG|i; break; }
+ D->lglabels[i] = 0;
+ }
+ }
+ if (D->status == DASM_S_OK && secmatch >= 0 &&
+ D->section != &D->sections[secmatch])
+ D->status = DASM_S_MATCH_SEC|(D->section-D->sections);
+ return D->status;
+}
+#endif
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_arm.lua b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_arm.lua
new file mode 100644
index 00000000000..a54230db370
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_arm.lua
@@ -0,0 +1,952 @@
+------------------------------------------------------------------------------
+-- DynASM ARM module.
+--
+-- Copyright (C) 2005-2011 Mike Pall. All rights reserved.
+-- See dynasm.lua for full copyright notice.
+------------------------------------------------------------------------------
+
+-- Module information:
+local _info = {
+ arch = "arm",
+ description = "DynASM ARM module",
+ version = "1.3.0",
+ vernum = 10300,
+ release = "2011-05-05",
+ author = "Mike Pall",
+ license = "MIT",
+}
+
+-- Exported glue functions for the arch-specific module.
+local _M = { _info = _info }
+
+-- Cache library functions.
+local type, tonumber, pairs, ipairs = type, tonumber, pairs, ipairs
+local assert, setmetatable, rawget = assert, setmetatable, rawget
+local _s = string
+local sub, format, byte, char = _s.sub, _s.format, _s.byte, _s.char
+local match, gmatch, gsub = _s.match, _s.gmatch, _s.gsub
+local concat, sort, insert = table.concat, table.sort, table.insert
+
+-- Inherited tables and callbacks.
+local g_opt, g_arch
+local wline, werror, wfatal, wwarn
+
+-- Action name list.
+-- CHECK: Keep this in sync with the C code!
+local action_names = {
+ "STOP", "SECTION", "ESC", "REL_EXT",
+ "ALIGN", "REL_LG", "LABEL_LG",
+ "REL_PC", "LABEL_PC", "LONG", "IMM", "IMM12", "IMM16", "IMML8", "IMML12",
+}
+
+-- Maximum number of section buffer positions for dasm_put().
+-- CHECK: Keep this in sync with the C code!
+local maxsecpos = 25 -- Keep this low, to avoid excessively long C lines.
+
+-- Action name -> action number.
+local map_action = {}
+for n,name in ipairs(action_names) do
+ map_action[name] = n-1
+end
+
+-- Action list buffer.
+local actlist = {}
+
+-- Argument list for next dasm_put(). Start with offset 0 into action list.
+local actargs = { 0 }
+
+-- Current number of section buffer positions for dasm_put().
+local secpos = 1
+
+------------------------------------------------------------------------------
+
+-- Return 8 digit hex number.
+local function tohex(x)
+ return sub(format("%08x", x), -8) -- Avoid 64 bit portability problem in Lua.
+end
+
+-- Dump action names and numbers.
+local function dumpactions(out)
+ out:write("DynASM encoding engine action codes:\n")
+ for n,name in ipairs(action_names) do
+ local num = map_action[name]
+ out:write(format(" %-10s %02X %d\n", name, num, num))
+ end
+ out:write("\n")
+end
+
+-- Write action list buffer as a huge static C array.
+local function writeactions(out, name)
+ local nn = #actlist
+ if nn == 0 then nn = 1; actlist[0] = map_action.STOP end
+ out:write("static const unsigned int ", name, "[", nn, "] = {\n")
+ for i = 1,nn-1 do
+ assert(out:write("0x", tohex(actlist[i]), ",\n"))
+ end
+ assert(out:write("0x", tohex(actlist[nn]), "\n};\n\n"))
+end
+
+------------------------------------------------------------------------------
+
+-- Add word to action list.
+local function wputxw(n)
+ assert(n >= 0 and n <= 0xffffffff and n % 1 == 0, "word out of range")
+ actlist[#actlist+1] = n
+end
+
+-- Add action to list with optional arg. Advance buffer pos, too.
+local function waction(action, val, a, num)
+ local w = assert(map_action[action], "bad action name `"..action.."'")
+ wputxw(w * 0x10000 + (val or 0))
+ if a then actargs[#actargs+1] = a end
+ if a or num then secpos = secpos + (num or 1) end
+end
+
+-- Flush action list (intervening C code or buffer pos overflow).
+local function wflush(term)
+ if #actlist == actargs[1] then return end -- Nothing to flush.
+ if not term then waction("STOP") end -- Terminate action list.
+ wline(format("dasm_put(Dst, %s);", concat(actargs, ", ")), true)
+ actargs = { #actlist } -- Actionlist offset is 1st arg to next dasm_put().
+ secpos = 1 -- The actionlist offset occupies a buffer position, too.
+end
+
+-- Put escaped word.
+local function wputw(n)
+ if n <= 0x000fffff then waction("ESC") end
+ wputxw(n)
+end
+
+-- Reserve position for word.
+local function wpos()
+ local pos = #actlist+1
+ actlist[pos] = ""
+ return pos
+end
+
+-- Store word to reserved position.
+local function wputpos(pos, n)
+ assert(n >= 0 and n <= 0xffffffff and n % 1 == 0, "word out of range")
+ if n <= 0x000fffff then
+ insert(actlist, pos+1, n)
+ n = map_action.ESC * 0x10000
+ end
+ actlist[pos] = n
+end
+
+------------------------------------------------------------------------------
+
+-- Global label name -> global label number. With auto assignment on 1st use.
+local next_global = 20
+local map_global = setmetatable({}, { __index = function(t, name)
+ if not match(name, "^[%a_][%w_]*$") then werror("bad global label") end
+ local n = next_global
+ if n > 2047 then werror("too many global labels") end
+ next_global = n + 1
+ t[name] = n
+ return n
+end})
+
+-- Dump global labels.
+local function dumpglobals(out, lvl)
+ local t = {}
+ for name, n in pairs(map_global) do t[n] = name end
+ out:write("Global labels:\n")
+ for i=20,next_global-1 do
+ out:write(format(" %s\n", t[i]))
+ end
+ out:write("\n")
+end
+
+-- Write global label enum.
+local function writeglobals(out, prefix)
+ local t = {}
+ for name, n in pairs(map_global) do t[n] = name end
+ out:write("enum {\n")
+ for i=20,next_global-1 do
+ out:write(" ", prefix, t[i], ",\n")
+ end
+ out:write(" ", prefix, "_MAX\n};\n")
+end
+
+-- Write global label names.
+local function writeglobalnames(out, name)
+ local t = {}
+ for name, n in pairs(map_global) do t[n] = name end
+ out:write("static const char *const ", name, "[] = {\n")
+ for i=20,next_global-1 do
+ out:write(" \"", t[i], "\",\n")
+ end
+ out:write(" (const char *)0\n};\n")
+end
+
+------------------------------------------------------------------------------
+
+-- Extern label name -> extern label number. With auto assignment on 1st use.
+local next_extern = 0
+local map_extern_ = {}
+local map_extern = setmetatable({}, { __index = function(t, name)
+ -- No restrictions on the name for now.
+ local n = next_extern
+ if n > 2047 then werror("too many extern labels") end
+ next_extern = n + 1
+ t[name] = n
+ map_extern_[n] = name
+ return n
+end})
+
+-- Dump extern labels.
+local function dumpexterns(out, lvl)
+ out:write("Extern labels:\n")
+ for i=0,next_extern-1 do
+ out:write(format(" %s\n", map_extern_[i]))
+ end
+ out:write("\n")
+end
+
+-- Write extern label names.
+local function writeexternnames(out, name)
+ out:write("static const char *const ", name, "[] = {\n")
+ for i=0,next_extern-1 do
+ out:write(" \"", map_extern_[i], "\",\n")
+ end
+ out:write(" (const char *)0\n};\n")
+end
+
+------------------------------------------------------------------------------
+
+-- Arch-specific maps.
+
+-- Ext. register name -> int. name.
+local map_archdef = { sp = "r13", lr = "r14", pc = "r15", }
+
+-- Int. register name -> ext. name.
+local map_reg_rev = { r13 = "sp", r14 = "lr", r15 = "pc", }
+
+local map_type = {} -- Type name -> { ctype, reg }
+local ctypenum = 0 -- Type number (for Dt... macros).
+
+-- Reverse defines for registers.
+function _M.revdef(s)
+ return map_reg_rev[s] or s
+end
+
+local map_shift = { lsl = 0, lsr = 1, asr = 2, ror = 3, }
+
+local map_cond = {
+ eq = 0, ne = 1, cs = 2, cc = 3, mi = 4, pl = 5, vs = 6, vc = 7,
+ hi = 8, ls = 9, ge = 10, lt = 11, gt = 12, le = 13, al = 14,
+ hs = 2, lo = 3,
+}
+
+------------------------------------------------------------------------------
+
+-- Template strings for ARM instructions.
+local map_op = {
+ -- Basic data processing instructions.
+ and_3 = "e0000000DNPs",
+ eor_3 = "e0200000DNPs",
+ sub_3 = "e0400000DNPs",
+ rsb_3 = "e0600000DNPs",
+ add_3 = "e0800000DNPs",
+ adc_3 = "e0a00000DNPs",
+ sbc_3 = "e0c00000DNPs",
+ rsc_3 = "e0e00000DNPs",
+ tst_2 = "e1100000NP",
+ teq_2 = "e1300000NP",
+ cmp_2 = "e1500000NP",
+ cmn_2 = "e1700000NP",
+ orr_3 = "e1800000DNPs",
+ mov_2 = "e1a00000DPs",
+ bic_3 = "e1c00000DNPs",
+ mvn_2 = "e1e00000DPs",
+
+ and_4 = "e0000000DNMps",
+ eor_4 = "e0200000DNMps",
+ sub_4 = "e0400000DNMps",
+ rsb_4 = "e0600000DNMps",
+ add_4 = "e0800000DNMps",
+ adc_4 = "e0a00000DNMps",
+ sbc_4 = "e0c00000DNMps",
+ rsc_4 = "e0e00000DNMps",
+ tst_3 = "e1100000NMp",
+ teq_3 = "e1300000NMp",
+ cmp_3 = "e1500000NMp",
+ cmn_3 = "e1700000NMp",
+ orr_4 = "e1800000DNMps",
+ mov_3 = "e1a00000DMps",
+ bic_4 = "e1c00000DNMps",
+ mvn_3 = "e1e00000DMps",
+
+ lsl_3 = "e1a00000DMws",
+ lsr_3 = "e1a00020DMws",
+ asr_3 = "e1a00040DMws",
+ ror_3 = "e1a00060DMws",
+ rrx_2 = "e1a00060DMs",
+
+ -- Multiply and multiply-accumulate.
+ mul_3 = "e0000090NMSs",
+ mla_4 = "e0200090NMSDs",
+ umaal_4 = "e0400090DNMSs", -- v6
+ mls_4 = "e0600090DNMSs", -- v6T2
+ umull_4 = "e0800090DNMSs",
+ umlal_4 = "e0a00090DNMSs",
+ smull_4 = "e0c00090DNMSs",
+ smlal_4 = "e0e00090DNMSs",
+
+ -- Halfword multiply and multiply-accumulate.
+ smlabb_4 = "e1000080NMSD", -- v5TE
+ smlatb_4 = "e10000a0NMSD", -- v5TE
+ smlabt_4 = "e10000c0NMSD", -- v5TE
+ smlatt_4 = "e10000e0NMSD", -- v5TE
+ smlawb_4 = "e1200080NMSD", -- v5TE
+ smulwb_3 = "e12000a0NMS", -- v5TE
+ smlawt_4 = "e12000c0NMSD", -- v5TE
+ smulwt_3 = "e12000e0NMS", -- v5TE
+ smlalbb_4 = "e1400080NMSD", -- v5TE
+ smlaltb_4 = "e14000a0NMSD", -- v5TE
+ smlalbt_4 = "e14000c0NMSD", -- v5TE
+ smlaltt_4 = "e14000e0NMSD", -- v5TE
+ smulbb_3 = "e1600080NMS", -- v5TE
+ smultb_3 = "e16000a0NMS", -- v5TE
+ smulbt_3 = "e16000c0NMS", -- v5TE
+ smultt_3 = "e16000e0NMS", -- v5TE
+
+ -- Miscellaneous data processing instructions.
+ clz_2 = "e16f0f10DM", -- v5T
+ rev_2 = "e6bf0f30DM", -- v6
+ rev16_2 = "e6bf0fb0DM", -- v6
+ revsh_2 = "e6ff0fb0DM", -- v6
+ sel_3 = "e6800fb0DNM", -- v6
+ usad8_3 = "e780f010NMS", -- v6
+ usada8_4 = "e7800010NMSD", -- v6
+ rbit_2 = "e6ff0f30DM", -- v6T2
+ movw_2 = "e3000000DW", -- v6T2
+ movt_2 = "e3400000DW", -- v6T2
+ -- Note: the X encodes width-1, not width.
+ sbfx_4 = "e7a00050DMvX", -- v6T2
+ ubfx_4 = "e7e00050DMvX", -- v6T2
+ -- Note: the X encodes the msb field, not the width.
+ bfc_3 = "e7c0001fDvX", -- v6T2
+ bfi_4 = "e7c00010DMvX", -- v6T2
+
+ -- Packing and unpacking instructions.
+ pkhbt_3 = "e6800010DNM", pkhbt_4 = "e6800010DNMv", -- v6
+ pkhtb_3 = "e6800050DNM", pkhtb_4 = "e6800050DNMv", -- v6
+ sxtab_3 = "e6a00070DNM", sxtab_4 = "e6a00070DNMv", -- v6
+ sxtab16_3 = "e6800070DNM", sxtab16_4 = "e6800070DNMv", -- v6
+ sxtah_3 = "e6b00070DNM", sxtah_4 = "e6b00070DNMv", -- v6
+ sxtb_2 = "e6af0070DM", sxtb_3 = "e6af0070DMv", -- v6
+ sxtb16_2 = "e68f0070DM", sxtb16_3 = "e68f0070DMv", -- v6
+ sxth_2 = "e6bf0070DM", sxth_3 = "e6bf0070DMv", -- v6
+ uxtab_3 = "e6e00070DNM", uxtab_4 = "e6e00070DNMv", -- v6
+ uxtab16_3 = "e6c00070DNM", uxtab16_4 = "e6c00070DNMv", -- v6
+ uxtah_3 = "e6f00070DNM", uxtah_4 = "e6f00070DNMv", -- v6
+ uxtb_2 = "e6ef0070DM", uxtb_3 = "e6ef0070DMv", -- v6
+ uxtb16_2 = "e6cf0070DM", uxtb16_3 = "e6cf0070DMv", -- v6
+ uxth_2 = "e6ff0070DM", uxth_3 = "e6ff0070DMv", -- v6
+
+ -- Saturating instructions.
+ qadd_3 = "e1000050DMN", -- v5TE
+ qsub_3 = "e1200050DMN", -- v5TE
+ qdadd_3 = "e1400050DMN", -- v5TE
+ qdsub_3 = "e1600050DMN", -- v5TE
+ -- Note: the X for ssat* encodes sat_imm-1, not sat_imm.
+ ssat_3 = "e6a00010DXM", ssat_4 = "e6a00010DXMp", -- v6
+ usat_3 = "e6e00010DXM", usat_4 = "e6e00010DXMp", -- v6
+ ssat16_3 = "e6a00f30DXM", -- v6
+ usat16_3 = "e6e00f30DXM", -- v6
+
+ -- Parallel addition and subtraction.
+ sadd16_3 = "e6100f10DNM", -- v6
+ sasx_3 = "e6100f30DNM", -- v6
+ ssax_3 = "e6100f50DNM", -- v6
+ ssub16_3 = "e6100f70DNM", -- v6
+ sadd8_3 = "e6100f90DNM", -- v6
+ ssub8_3 = "e6100ff0DNM", -- v6
+ qadd16_3 = "e6200f10DNM", -- v6
+ qasx_3 = "e6200f30DNM", -- v6
+ qsax_3 = "e6200f50DNM", -- v6
+ qsub16_3 = "e6200f70DNM", -- v6
+ qadd8_3 = "e6200f90DNM", -- v6
+ qsub8_3 = "e6200ff0DNM", -- v6
+ shadd16_3 = "e6300f10DNM", -- v6
+ shasx_3 = "e6300f30DNM", -- v6
+ shsax_3 = "e6300f50DNM", -- v6
+ shsub16_3 = "e6300f70DNM", -- v6
+ shadd8_3 = "e6300f90DNM", -- v6
+ shsub8_3 = "e6300ff0DNM", -- v6
+ uadd16_3 = "e6500f10DNM", -- v6
+ uasx_3 = "e6500f30DNM", -- v6
+ usax_3 = "e6500f50DNM", -- v6
+ usub16_3 = "e6500f70DNM", -- v6
+ uadd8_3 = "e6500f90DNM", -- v6
+ usub8_3 = "e6500ff0DNM", -- v6
+ uqadd16_3 = "e6600f10DNM", -- v6
+ uqasx_3 = "e6600f30DNM", -- v6
+ uqsax_3 = "e6600f50DNM", -- v6
+ uqsub16_3 = "e6600f70DNM", -- v6
+ uqadd8_3 = "e6600f90DNM", -- v6
+ uqsub8_3 = "e6600ff0DNM", -- v6
+ uhadd16_3 = "e6700f10DNM", -- v6
+ uhasx_3 = "e6700f30DNM", -- v6
+ uhsax_3 = "e6700f50DNM", -- v6
+ uhsub16_3 = "e6700f70DNM", -- v6
+ uhadd8_3 = "e6700f90DNM", -- v6
+ uhsub8_3 = "e6700ff0DNM", -- v6
+
+ -- Load/store instructions.
+ str_2 = "e4000000DL", str_3 = "e4000000DL", str_4 = "e4000000DL",
+ strb_2 = "e4400000DL", strb_3 = "e4400000DL", strb_4 = "e4400000DL",
+ ldr_2 = "e4100000DL", ldr_3 = "e4100000DL", ldr_4 = "e4100000DL",
+ ldrb_2 = "e4500000DL", ldrb_3 = "e4500000DL", ldrb_4 = "e4500000DL",
+ strh_2 = "e00000b0DL", strh_3 = "e00000b0DL",
+ ldrh_2 = "e01000b0DL", ldrh_3 = "e01000b0DL",
+ ldrd_2 = "e00000d0DL", ldrd_3 = "e00000d0DL", -- v5TE
+ ldrsb_2 = "e01000d0DL", ldrsb_3 = "e01000d0DL",
+ strd_2 = "e00000f0DL", strd_3 = "e00000f0DL", -- v5TE
+ ldrsh_2 = "e01000f0DL", ldrsh_3 = "e01000f0DL",
+
+ ldm_2 = "e8900000nR", ldmia_2 = "e8900000nR", ldmfd_2 = "e8900000nR",
+ ldmda_2 = "e8100000nR", ldmfa_2 = "e8100000nR",
+ ldmdb_2 = "e9100000nR", ldmea_2 = "e9100000nR",
+ ldmib_2 = "e9900000nR", ldmed_2 = "e9900000nR",
+ stm_2 = "e8800000nR", stmia_2 = "e8800000nR", stmfd_2 = "e8800000nR",
+ stmda_2 = "e8000000nR", stmfa_2 = "e8000000nR",
+ stmdb_2 = "e9000000nR", stmea_2 = "e9000000nR",
+ stmib_2 = "e9800000nR", stmed_2 = "e9800000nR",
+ pop_1 = "e8bd0000R", push_1 = "e92d0000R",
+
+ -- Branch instructions.
+ b_1 = "ea000000B",
+ bl_1 = "eb000000B",
+ blx_1 = "e12fff30C",
+ bx_1 = "e12fff10M",
+
+ -- Miscellaneous instructions.
+ nop_0 = "e1a00000",
+ mrs_1 = "e10f0000D",
+ bkpt_1 = "e1200070K", -- v5T
+ svc_1 = "ef000000T", swi_1 = "ef000000T",
+ ud_0 = "e7f001f0",
+
+ -- NYI: Advanced SIMD and VFP instructions.
+
+ -- NYI instructions, since I have no need for them right now:
+ -- swp, swpb, strex, ldrex, strexd, ldrexd, strexb, ldrexb, strexh, ldrexh
+ -- msr, nopv6, yield, wfe, wfi, sev, dbg, bxj, smc, srs, rfe
+ -- cps, setend, pli, pld, pldw, clrex, dsb, dmb, isb
+ -- stc, ldc, mcr, mcr2, mrc, mrc2, mcrr, mcrr2, mrrc, mrrc2, cdp, cdp2
+}
+
+-- Add mnemonics for "s" variants.
+do
+ local t = {}
+ for k,v in pairs(map_op) do
+ if sub(v, -1) == "s" then
+ local v2 = sub(v, 1, 2)..char(byte(v, 3)+1)..sub(v, 4, -2)
+ t[sub(k, 1, -3).."s"..sub(k, -2)] = v2
+ end
+ end
+ for k,v in pairs(t) do
+ map_op[k] = v
+ end
+end
+
+------------------------------------------------------------------------------
+
+local function parse_gpr(expr)
+ local tname, ovreg = match(expr, "^([%w_]+):(r1?[0-9])$")
+ local tp = map_type[tname or expr]
+ if tp then
+ local reg = ovreg or tp.reg
+ if not reg then
+ werror("type `"..(tname or expr).."' needs a register override")
+ end
+ expr = reg
+ end
+ local r = match(expr, "^r(1?[0-9])$")
+ if r then
+ r = tonumber(r)
+ if r <= 15 then return r, tp end
+ end
+ werror("bad register name `"..expr.."'")
+end
+
+local function parse_gpr_pm(expr)
+ local pm, expr2 = match(expr, "^([+-]?)(.*)$")
+ return parse_gpr(expr2), (pm == "-")
+end
+
+local function parse_reglist(reglist)
+ reglist = match(reglist, "^{%s*([^}]*)}$")
+ if not reglist then werror("register list expected") end
+ local rr = 0
+ for p in gmatch(reglist..",", "%s*([^,]*),") do
+ local rbit = 2^parse_gpr(gsub(p, "%s+$", ""))
+ if ((rr - (rr % rbit)) / rbit) % 2 ~= 0 then
+ werror("duplicate register `"..p.."'")
+ end
+ rr = rr + rbit
+ end
+ return rr
+end
+
+local function parse_imm(imm, bits, shift, scale, signed)
+ imm = match(imm, "^#(.*)$")
+ if not imm then werror("expected immediate operand") end
+ local n = tonumber(imm)
+ if n then
+ if n % 2^scale == 0 then
+ n = n / 2^scale
+ if signed then
+ if n >= 0 then
+ if n < 2^(bits-1) then return n*2^shift end
+ else
+ if n >= -(2^(bits-1))-1 then return (n+2^bits)*2^shift end
+ end
+ else
+ if n >= 0 and n <= 2^bits-1 then return n*2^shift end
+ end
+ end
+ werror("out of range immediate `"..imm.."'")
+ else
+ waction("IMM", (signed and 32768 or 0)+scale*1024+bits*32+shift, imm)
+ return 0
+ end
+end
+
+local function parse_imm12(imm)
+ local n = tonumber(imm)
+ if n then
+ local m = n
+ for i=0,-15,-1 do
+ if m >= 0 and m <= 255 and n % 1 == 0 then return m + (i%16) * 256 end
+ local t = m % 4
+ m = (m - t) / 4 + t * 2^30
+ end
+ werror("out of range immediate `"..imm.."'")
+ else
+ waction("IMM12", 0, imm)
+ return 0
+ end
+end
+
+local function parse_imm16(imm)
+ imm = match(imm, "^#(.*)$")
+ if not imm then werror("expected immediate operand") end
+ local n = tonumber(imm)
+ if n then
+ if n >= 0 and n <= 65535 and n % 1 == 0 then
+ local t = n % 4096
+ return (n - t) * 16 + t
+ end
+ werror("out of range immediate `"..imm.."'")
+ else
+ waction("IMM16", 32*16, imm)
+ return 0
+ end
+end
+
+local function parse_imm_load(imm, ext)
+ local n = tonumber(imm)
+ if n then
+ if ext then
+ if n >= -255 and n <= 255 then
+ local up = 0x00800000
+ if n < 0 then n = -n; up = 0 end
+ return (n-(n%16))*16+(n%16) + up
+ end
+ else
+ if n >= -4095 and n <= 4095 then
+ if n >= 0 then return n+0x00800000 end
+ return -n
+ end
+ end
+ werror("out of range immediate `"..imm.."'")
+ else
+ waction(ext and "IMML8" or "IMML12", 32768 + 32*(ext and 8 or 12), imm)
+ return 0
+ end
+end
+
+local function parse_shift(shift, gprok)
+ if shift == "rrx" then
+ return 3 * 32
+ else
+ local s, s2 = match(shift, "^(%S+)%s*(.*)$")
+ s = map_shift[s]
+ if not s then werror("expected shift operand") end
+ if sub(s2, 1, 1) == "#" then
+ return parse_imm(s2, 5, 7, 0, false) + s * 32
+ else
+ if not gprok then werror("expected immediate shift operand") end
+ return parse_gpr(s2) * 256 + s * 32 + 16
+ end
+ end
+end
+
+local function parse_label(label, def)
+ local prefix = sub(label, 1, 2)
+ -- =>label (pc label reference)
+ if prefix == "=>" then
+ return "PC", 0, sub(label, 3)
+ end
+ -- ->name (global label reference)
+ if prefix == "->" then
+ return "LG", map_global[sub(label, 3)]
+ end
+ if def then
+ -- [1-9] (local label definition)
+ if match(label, "^[1-9]$") then
+ return "LG", 10+tonumber(label)
+ end
+ else
+ -- [<>][1-9] (local label reference)
+ local dir, lnum = match(label, "^([<>])([1-9])$")
+ if dir then -- Fwd: 1-9, Bkwd: 11-19.
+ return "LG", lnum + (dir == ">" and 0 or 10)
+ end
+ -- extern label (extern label reference)
+ local extname = match(label, "^extern%s+(%S+)$")
+ if extname then
+ return "EXT", map_extern[extname]
+ end
+ end
+ werror("bad label `"..label.."'")
+end
+
+local function parse_load(params, nparams, n, op)
+ local oplo = op % 256
+ local ext, ldrd = (oplo ~= 0), (oplo == 208)
+ local d
+ if (ldrd or oplo == 240) then
+ d = ((op - (op % 4096)) / 4096) % 16
+ if d % 2 ~= 0 then werror("odd destination register") end
+ end
+ local pn = params[n]
+ local p1, wb = match(pn, "^%[%s*(.-)%s*%](!?)$")
+ local p2 = params[n+1]
+ if not p1 then
+ if not p2 then
+ if match(pn, "^[<>=%-]") or match(pn, "^extern%s+") then
+ local mode, n, s = parse_label(pn, false)
+ waction("REL_"..mode, n + (ext and 0x1800 or 0x0800), s, 1)
+ return op + 15 * 65536 + 0x01000000 + (ext and 0x00400000 or 0)
+ end
+ local reg, tailr = match(pn, "^([%w_:]+)%s*(.*)$")
+ if reg and tailr ~= "" then
+ local d, tp = parse_gpr(reg)
+ if tp then
+ waction(ext and "IMML8" or "IMML12", 32768 + 32*(ext and 8 or 12),
+ format(tp.ctypefmt, tailr))
+ return op + d * 65536 + 0x01000000 + (ext and 0x00400000 or 0)
+ end
+ end
+ end
+ werror("expected address operand")
+ end
+ if wb == "!" then op = op + 0x00200000 end
+ if p2 then
+ if wb == "!" then werror("bad use of '!'") end
+ local p3 = params[n+2]
+ op = op + parse_gpr(p1) * 65536
+ local imm = match(p2, "^#(.*)$")
+ if imm then
+ local m = parse_imm_load(imm, ext)
+ if p3 then werror("too many parameters") end
+ op = op + m + (ext and 0x00400000 or 0)
+ else
+ local m, neg = parse_gpr_pm(p2)
+ if ldrd and (m == d or m-1 == d) then werror("register conflict") end
+ op = op + m + (neg and 0 or 0x00800000) + (ext and 0 or 0x02000000)
+ if p3 then op = op + parse_shift(p3) end
+ end
+ else
+ local p1a, p2 = match(p1, "^([^,%s]*)%s*(.*)$")
+ op = op + parse_gpr(p1a) * 65536 + 0x01000000
+ if p2 ~= "" then
+ local imm = match(p2, "^,%s*#(.*)$")
+ if imm then
+ local m = parse_imm_load(imm, ext)
+ op = op + m + (ext and 0x00400000 or 0)
+ else
+ local p2a, p3 = match(p2, "^,%s*([^,%s]*)%s*,?%s*(.*)$")
+ local m, neg = parse_gpr_pm(p2a)
+ if ldrd and (m == d or m-1 == d) then werror("register conflict") end
+ op = op + m + (neg and 0 or 0x00800000) + (ext and 0 or 0x02000000)
+ if p3 ~= "" then
+ if ext then werror("too many parameters") end
+ op = op + parse_shift(p3)
+ end
+ end
+ else
+ if wb == "!" then werror("bad use of '!'") end
+ op = op + (ext and 0x00c00000 or 0x00800000)
+ end
+ end
+ return op
+end
+
+------------------------------------------------------------------------------
+
+-- Handle opcodes defined with template strings.
+map_op[".template__"] = function(params, template, nparams)
+ if not params then return sub(template, 9) end
+ local op = tonumber(sub(template, 1, 8), 16)
+ local n = 1
+
+ -- Limit number of section buffer positions used by a single dasm_put().
+ -- A single opcode needs a maximum of 3 positions.
+ if secpos+3 > maxsecpos then wflush() end
+ local pos = wpos()
+
+ -- Process each character.
+ for p in gmatch(sub(template, 9), ".") do
+ if p == "D" then
+ op = op + parse_gpr(params[n]) * 4096; n = n + 1
+ elseif p == "N" then
+ op = op + parse_gpr(params[n]) * 65536; n = n + 1
+ elseif p == "S" then
+ op = op + parse_gpr(params[n]) * 256; n = n + 1
+ elseif p == "M" then
+ op = op + parse_gpr(params[n]); n = n + 1
+ elseif p == "P" then
+ local imm = match(params[n], "^#(.*)$")
+ if imm then
+ op = op + parse_imm12(imm) + 0x02000000
+ else
+ op = op + parse_gpr(params[n])
+ end
+ n = n + 1
+ elseif p == "p" then
+ op = op + parse_shift(params[n], true); n = n + 1
+ elseif p == "L" then
+ op = parse_load(params, nparams, n, op)
+ elseif p == "B" then
+ local mode, n, s = parse_label(params[n], false)
+ waction("REL_"..mode, n, s, 1)
+ elseif p == "C" then -- blx gpr vs. blx label.
+ local p = params[n]
+ if match(p, "^([%w_]+):(r1?[0-9])$") or match(p, "^r(1?[0-9])$") then
+ op = op + parse_gpr(p)
+ else
+ if op < 0xe0000000 then werror("unconditional instruction") end
+ local mode, n, s = parse_label(p, false)
+ waction("REL_"..mode, n, s, 1)
+ op = 0xfa000000
+ end
+ elseif p == "n" then
+ local r, wb = match(params[n], "^([^!]*)(!?)$")
+ op = op + parse_gpr(r) * 65536 + (wb == "!" and 0x00200000 or 0)
+ n = n + 1
+ elseif p == "R" then
+ op = op + parse_reglist(params[n]); n = n + 1
+ elseif p == "W" then
+ op = op + parse_imm16(params[n]); n = n + 1
+ elseif p == "v" then
+ op = op + parse_imm(params[n], 5, 7, 0, false); n = n + 1
+ elseif p == "w" then
+ local imm = match(params[n], "^#(.*)$")
+ if imm then
+ op = op + parse_imm(params[n], 5, 7, 0, false); n = n + 1
+ else
+ op = op + parse_gpr(params[n]) * 256 + 16
+ end
+ elseif p == "X" then
+ op = op + parse_imm(params[n], 5, 16, 0, false); n = n + 1
+ elseif p == "K" then
+ local imm = tonumber(match(params[n], "^#(.*)$")); n = n + 1
+ if not imm or imm % 1 ~= 0 or imm < 0 or imm > 0xffff then
+ werror("bad immediate operand")
+ end
+ local t = imm % 16
+ op = op + (imm - t) * 16 + t
+ elseif p == "T" then
+ op = op + parse_imm(params[n], 24, 0, 0, false); n = n + 1
+ elseif p == "s" then
+ -- Ignored.
+ else
+ assert(false)
+ end
+ end
+ wputpos(pos, op)
+end
+
+------------------------------------------------------------------------------
+
+-- Pseudo-opcode to mark the position where the action list is to be emitted.
+map_op[".actionlist_1"] = function(params)
+ if not params then return "cvar" end
+ local name = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeactions(out, name) end)
+end
+
+-- Pseudo-opcode to mark the position where the global enum is to be emitted.
+map_op[".globals_1"] = function(params)
+ if not params then return "prefix" end
+ local prefix = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeglobals(out, prefix) end)
+end
+
+-- Pseudo-opcode to mark the position where the global names are to be emitted.
+map_op[".globalnames_1"] = function(params)
+ if not params then return "cvar" end
+ local name = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeglobalnames(out, name) end)
+end
+
+-- Pseudo-opcode to mark the position where the extern names are to be emitted.
+map_op[".externnames_1"] = function(params)
+ if not params then return "cvar" end
+ local name = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeexternnames(out, name) end)
+end
+
+------------------------------------------------------------------------------
+
+-- Label pseudo-opcode (converted from trailing colon form).
+map_op[".label_1"] = function(params)
+ if not params then return "[1-9] | ->global | =>pcexpr" end
+ if secpos+1 > maxsecpos then wflush() end
+ local mode, n, s = parse_label(params[1], true)
+ if mode == "EXT" then werror("bad label definition") end
+ waction("LABEL_"..mode, n, s, 1)
+end
+
+------------------------------------------------------------------------------
+
+-- Pseudo-opcodes for data storage.
+map_op[".long_*"] = function(params)
+ if not params then return "imm..." end
+ for _,p in ipairs(params) do
+ local n = tonumber(p)
+ if n then
+ if n < 0 then n = n + 2^32 end
+ wputw(n)
+ if secpos+2 > maxsecpos then wflush() end
+ else
+ waction("LONG", 0, format("(uintptr_t)(%s)", p))
+ end
+ end
+end
+
+-- Alignment pseudo-opcode.
+map_op[".align_1"] = function(params)
+ if not params then return "numpow2" end
+ if secpos+1 > maxsecpos then wflush() end
+ local align = tonumber(params[1])
+ if align then
+ local x = align
+ -- Must be a power of 2 in the range (2 ... 256).
+ for i=1,8 do
+ x = x / 2
+ if x == 1 then
+ waction("ALIGN", align-1, nil, 1) -- Action byte is 2**n-1.
+ return
+ end
+ end
+ end
+ werror("bad alignment")
+end
+
+------------------------------------------------------------------------------
+
+-- Pseudo-opcode for (primitive) type definitions (map to C types).
+map_op[".type_3"] = function(params, nparams)
+ if not params then
+ return nparams == 2 and "name, ctype" or "name, ctype, reg"
+ end
+ local name, ctype, reg = params[1], params[2], params[3]
+ if not match(name, "^[%a_][%w_]*$") then
+ werror("bad type name `"..name.."'")
+ end
+ local tp = map_type[name]
+ if tp then
+ werror("duplicate type `"..name.."'")
+ end
+ -- Add #type to defines. A bit unclean to put it in map_archdef.
+ map_archdef["#"..name] = "sizeof("..ctype..")"
+ -- Add new type and emit shortcut define.
+ local num = ctypenum + 1
+ map_type[name] = {
+ ctype = ctype,
+ ctypefmt = format("Dt%X(%%s)", num),
+ reg = reg,
+ }
+ wline(format("#define Dt%X(_V) (int)(ptrdiff_t)&(((%s *)0)_V)", num, ctype))
+ ctypenum = num
+end
+map_op[".type_2"] = map_op[".type_3"]
+
+-- Dump type definitions.
+local function dumptypes(out, lvl)
+ local t = {}
+ for name in pairs(map_type) do t[#t+1] = name end
+ sort(t)
+ out:write("Type definitions:\n")
+ for _,name in ipairs(t) do
+ local tp = map_type[name]
+ local reg = tp.reg or ""
+ out:write(format(" %-20s %-20s %s\n", name, tp.ctype, reg))
+ end
+ out:write("\n")
+end
+
+------------------------------------------------------------------------------
+
+-- Set the current section.
+function _M.section(num)
+ waction("SECTION", num)
+ wflush(true) -- SECTION is a terminal action.
+end
+
+------------------------------------------------------------------------------
+
+-- Dump architecture description.
+function _M.dumparch(out)
+ out:write(format("DynASM %s version %s, released %s\n\n",
+ _info.arch, _info.version, _info.release))
+ dumpactions(out)
+end
+
+-- Dump all user defined elements.
+function _M.dumpdef(out, lvl)
+ dumptypes(out, lvl)
+ dumpglobals(out, lvl)
+ dumpexterns(out, lvl)
+end
+
+------------------------------------------------------------------------------
+
+-- Pass callbacks from/to the DynASM core.
+function _M.passcb(wl, we, wf, ww)
+ wline, werror, wfatal, wwarn = wl, we, wf, ww
+ return wflush
+end
+
+-- Setup the arch-specific module.
+function _M.setup(arch, opt)
+ g_arch, g_opt = arch, opt
+end
+
+-- Merge the core maps and the arch-specific maps.
+function _M.mergemaps(map_coreop, map_def)
+ setmetatable(map_op, { __index = function(t, k)
+ local v = map_coreop[k]
+ if v then return v end
+ local cc = sub(k, -4, -3)
+ local cv = map_cond[cc]
+ if cv then
+ local v = rawget(t, sub(k, 1, -5)..sub(k, -2))
+ if type(v) == "string" then return format("%x%s", cv, sub(v, 2)) end
+ end
+ end })
+ setmetatable(map_def, { __index = map_archdef })
+ return map_op, map_def
+end
+
+return _M
+
+------------------------------------------------------------------------------
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_ppc.h b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_ppc.h
new file mode 100644
index 00000000000..e928ffedd38
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_ppc.h
@@ -0,0 +1,408 @@
+/*
+** DynASM PPC encoding engine.
+** Copyright (C) 2005-2011 Mike Pall. All rights reserved.
+** Released under the MIT/X license. See dynasm.lua for full copyright notice.
+*/
+
+#include <stddef.h>
+#include <stdarg.h>
+#include <string.h>
+#include <stdlib.h>
+
+#define DASM_ARCH "ppc"
+
+#ifndef DASM_EXTERN
+#define DASM_EXTERN(a,b,c,d) 0
+#endif
+
+/* Action definitions. */
+enum {
+ DASM_STOP, DASM_SECTION, DASM_ESC, DASM_REL_EXT,
+ /* The following actions need a buffer position. */
+ DASM_ALIGN, DASM_REL_LG, DASM_LABEL_LG,
+ /* The following actions also have an argument. */
+ DASM_REL_PC, DASM_LABEL_PC, DASM_IMM,
+ DASM__MAX
+};
+
+/* Maximum number of section buffer positions for a single dasm_put() call. */
+#define DASM_MAXSECPOS 25
+
+/* DynASM encoder status codes. Action list offset or number are or'ed in. */
+#define DASM_S_OK 0x00000000
+#define DASM_S_NOMEM 0x01000000
+#define DASM_S_PHASE 0x02000000
+#define DASM_S_MATCH_SEC 0x03000000
+#define DASM_S_RANGE_I 0x11000000
+#define DASM_S_RANGE_SEC 0x12000000
+#define DASM_S_RANGE_LG 0x13000000
+#define DASM_S_RANGE_PC 0x14000000
+#define DASM_S_RANGE_REL 0x15000000
+#define DASM_S_UNDEF_LG 0x21000000
+#define DASM_S_UNDEF_PC 0x22000000
+
+/* Macros to convert positions (8 bit section + 24 bit index). */
+#define DASM_POS2IDX(pos) ((pos)&0x00ffffff)
+#define DASM_POS2BIAS(pos) ((pos)&0xff000000)
+#define DASM_SEC2POS(sec) ((sec)<<24)
+#define DASM_POS2SEC(pos) ((pos)>>24)
+#define DASM_POS2PTR(D, pos) (D->sections[DASM_POS2SEC(pos)].rbuf + (pos))
+
+/* Action list type. */
+typedef const unsigned int *dasm_ActList;
+
+/* Per-section structure. */
+typedef struct dasm_Section {
+ int *rbuf; /* Biased buffer pointer (negative section bias). */
+ int *buf; /* True buffer pointer. */
+ size_t bsize; /* Buffer size in bytes. */
+ int pos; /* Biased buffer position. */
+ int epos; /* End of biased buffer position - max single put. */
+ int ofs; /* Byte offset into section. */
+} dasm_Section;
+
+/* Core structure holding the DynASM encoding state. */
+struct dasm_State {
+ size_t psize; /* Allocated size of this structure. */
+ dasm_ActList actionlist; /* Current actionlist pointer. */
+ int *lglabels; /* Local/global chain/pos ptrs. */
+ size_t lgsize;
+ int *pclabels; /* PC label chains/pos ptrs. */
+ size_t pcsize;
+ void **globals; /* Array of globals (bias -10). */
+ dasm_Section *section; /* Pointer to active section. */
+ size_t codesize; /* Total size of all code sections. */
+ int maxsection; /* 0 <= sectionidx < maxsection. */
+ int status; /* Status code. */
+ dasm_Section sections[1]; /* All sections. Alloc-extended. */
+};
+
+/* The size of the core structure depends on the max. number of sections. */
+#define DASM_PSZ(ms) (sizeof(dasm_State)+(ms-1)*sizeof(dasm_Section))
+
+
+/* Initialize DynASM state. */
+void dasm_init(Dst_DECL, int maxsection)
+{
+ dasm_State *D;
+ size_t psz = 0;
+ int i;
+ Dst_REF = NULL;
+ DASM_M_GROW(Dst, struct dasm_State, Dst_REF, psz, DASM_PSZ(maxsection));
+ D = Dst_REF;
+ D->psize = psz;
+ D->lglabels = NULL;
+ D->lgsize = 0;
+ D->pclabels = NULL;
+ D->pcsize = 0;
+ D->globals = NULL;
+ D->maxsection = maxsection;
+ for (i = 0; i < maxsection; i++) {
+ D->sections[i].buf = NULL; /* Need this for pass3. */
+ D->sections[i].rbuf = D->sections[i].buf - DASM_SEC2POS(i);
+ D->sections[i].bsize = 0;
+ D->sections[i].epos = 0; /* Wrong, but is recalculated after resize. */
+ }
+}
+
+/* Free DynASM state. */
+void dasm_free(Dst_DECL)
+{
+ dasm_State *D = Dst_REF;
+ int i;
+ for (i = 0; i < D->maxsection; i++)
+ if (D->sections[i].buf)
+ DASM_M_FREE(Dst, D->sections[i].buf, D->sections[i].bsize);
+ if (D->pclabels) DASM_M_FREE(Dst, D->pclabels, D->pcsize);
+ if (D->lglabels) DASM_M_FREE(Dst, D->lglabels, D->lgsize);
+ DASM_M_FREE(Dst, D, D->psize);
+}
+
+/* Setup global label array. Must be called before dasm_setup(). */
+void dasm_setupglobal(Dst_DECL, void **gl, unsigned int maxgl)
+{
+ dasm_State *D = Dst_REF;
+ D->globals = gl - 10; /* Negative bias to compensate for locals. */
+ DASM_M_GROW(Dst, int, D->lglabels, D->lgsize, (10+maxgl)*sizeof(int));
+}
+
+/* Grow PC label array. Can be called after dasm_setup(), too. */
+void dasm_growpc(Dst_DECL, unsigned int maxpc)
+{
+ dasm_State *D = Dst_REF;
+ size_t osz = D->pcsize;
+ DASM_M_GROW(Dst, int, D->pclabels, D->pcsize, maxpc*sizeof(int));
+ memset((void *)(((unsigned char *)D->pclabels)+osz), 0, D->pcsize-osz);
+}
+
+/* Setup encoder. */
+void dasm_setup(Dst_DECL, const void *actionlist)
+{
+ dasm_State *D = Dst_REF;
+ int i;
+ D->actionlist = (dasm_ActList)actionlist;
+ D->status = DASM_S_OK;
+ D->section = &D->sections[0];
+ memset((void *)D->lglabels, 0, D->lgsize);
+ if (D->pclabels) memset((void *)D->pclabels, 0, D->pcsize);
+ for (i = 0; i < D->maxsection; i++) {
+ D->sections[i].pos = DASM_SEC2POS(i);
+ D->sections[i].ofs = 0;
+ }
+}
+
+
+#ifdef DASM_CHECKS
+#define CK(x, st) \
+ do { if (!(x)) { \
+ D->status = DASM_S_##st|(p-D->actionlist-1); return; } } while (0)
+#define CKPL(kind, st) \
+ do { if ((size_t)((char *)pl-(char *)D->kind##labels) >= D->kind##size) { \
+ D->status = DASM_S_RANGE_##st|(p-D->actionlist-1); return; } } while (0)
+#else
+#define CK(x, st) ((void)0)
+#define CKPL(kind, st) ((void)0)
+#endif
+
+/* Pass 1: Store actions and args, link branches/labels, estimate offsets. */
+void dasm_put(Dst_DECL, int start, ...)
+{
+ va_list ap;
+ dasm_State *D = Dst_REF;
+ dasm_ActList p = D->actionlist + start;
+ dasm_Section *sec = D->section;
+ int pos = sec->pos, ofs = sec->ofs;
+ int *b;
+
+ if (pos >= sec->epos) {
+ DASM_M_GROW(Dst, int, sec->buf, sec->bsize,
+ sec->bsize + 2*DASM_MAXSECPOS*sizeof(int));
+ sec->rbuf = sec->buf - DASM_POS2BIAS(pos);
+ sec->epos = (int)sec->bsize/sizeof(int) - DASM_MAXSECPOS+DASM_POS2BIAS(pos);
+ }
+
+ b = sec->rbuf;
+ b[pos++] = start;
+
+ va_start(ap, start);
+ while (1) {
+ unsigned int ins = *p++;
+ unsigned int action = (ins >> 16);
+ if (action >= DASM__MAX) {
+ ofs += 4;
+ } else {
+ int *pl, n = action >= DASM_REL_PC ? va_arg(ap, int) : 0;
+ switch (action) {
+ case DASM_STOP: goto stop;
+ case DASM_SECTION:
+ n = (ins & 255); CK(n < D->maxsection, RANGE_SEC);
+ D->section = &D->sections[n]; goto stop;
+ case DASM_ESC: p++; ofs += 4; break;
+ case DASM_REL_EXT: break;
+ case DASM_ALIGN: ofs += (ins & 255); b[pos++] = ofs; break;
+ case DASM_REL_LG:
+ n = (ins & 2047) - 10; pl = D->lglabels + n;
+ if (n >= 0) { CKPL(lg, LG); goto putrel; } /* Bkwd rel or global. */
+ pl += 10; n = *pl;
+ if (n < 0) n = 0; /* Start new chain for fwd rel if label exists. */
+ goto linkrel;
+ case DASM_REL_PC:
+ pl = D->pclabels + n; CKPL(pc, PC);
+ putrel:
+ n = *pl;
+ if (n < 0) { /* Label exists. Get label pos and store it. */
+ b[pos] = -n;
+ } else {
+ linkrel:
+ b[pos] = n; /* Else link to rel chain, anchored at label. */
+ *pl = pos;
+ }
+ pos++;
+ break;
+ case DASM_LABEL_LG:
+ pl = D->lglabels + (ins & 2047) - 10; CKPL(lg, LG); goto putlabel;
+ case DASM_LABEL_PC:
+ pl = D->pclabels + n; CKPL(pc, PC);
+ putlabel:
+ n = *pl; /* n > 0: Collapse rel chain and replace with label pos. */
+ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = pos;
+ }
+ *pl = -pos; /* Label exists now. */
+ b[pos++] = ofs; /* Store pass1 offset estimate. */
+ break;
+ case DASM_IMM:
+#ifdef DASM_CHECKS
+ CK((n & ((1<<((ins>>10)&31))-1)) == 0, RANGE_I);
+ if (ins & 0x8000)
+ CK(((n + (1<<(((ins>>5)&31)-1)))>>((ins>>5)&31)) == 0, RANGE_I);
+ else
+ CK((n>>((ins>>5)&31)) == 0, RANGE_I);
+#endif
+ b[pos++] = n;
+ break;
+ }
+ }
+ }
+stop:
+ va_end(ap);
+ sec->pos = pos;
+ sec->ofs = ofs;
+}
+#undef CK
+
+/* Pass 2: Link sections, shrink aligns, fix label offsets. */
+int dasm_link(Dst_DECL, size_t *szp)
+{
+ dasm_State *D = Dst_REF;
+ int secnum;
+ int ofs = 0;
+
+#ifdef DASM_CHECKS
+ *szp = 0;
+ if (D->status != DASM_S_OK) return D->status;
+ {
+ int pc;
+ for (pc = 0; pc*sizeof(int) < D->pcsize; pc++)
+ if (D->pclabels[pc] > 0) return DASM_S_UNDEF_PC|pc;
+ }
+#endif
+
+ { /* Handle globals not defined in this translation unit. */
+ int idx;
+ for (idx = 20; idx*sizeof(int) < D->lgsize; idx++) {
+ int n = D->lglabels[idx];
+ /* Undefined label: Collapse rel chain and replace with marker (< 0). */
+ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = -idx; }
+ }
+ }
+
+ /* Combine all code sections. No support for data sections (yet). */
+ for (secnum = 0; secnum < D->maxsection; secnum++) {
+ dasm_Section *sec = D->sections + secnum;
+ int *b = sec->rbuf;
+ int pos = DASM_SEC2POS(secnum);
+ int lastpos = sec->pos;
+
+ while (pos != lastpos) {
+ dasm_ActList p = D->actionlist + b[pos++];
+ while (1) {
+ unsigned int ins = *p++;
+ unsigned int action = (ins >> 16);
+ switch (action) {
+ case DASM_STOP: case DASM_SECTION: goto stop;
+ case DASM_ESC: p++; break;
+ case DASM_REL_EXT: break;
+ case DASM_ALIGN: ofs -= (b[pos++] + ofs) & (ins & 255); break;
+ case DASM_REL_LG: case DASM_REL_PC: pos++; break;
+ case DASM_LABEL_LG: case DASM_LABEL_PC: b[pos++] += ofs; break;
+ case DASM_IMM: pos++; break;
+ }
+ }
+ stop: (void)0;
+ }
+ ofs += sec->ofs; /* Next section starts right after current section. */
+ }
+
+ D->codesize = ofs; /* Total size of all code sections */
+ *szp = ofs;
+ return DASM_S_OK;
+}
+
+#ifdef DASM_CHECKS
+#define CK(x, st) \
+ do { if (!(x)) return DASM_S_##st|(p-D->actionlist-1); } while (0)
+#else
+#define CK(x, st) ((void)0)
+#endif
+
+/* Pass 3: Encode sections. */
+int dasm_encode(Dst_DECL, void *buffer)
+{
+ dasm_State *D = Dst_REF;
+ char *base = (char *)buffer;
+ unsigned int *cp = (unsigned int *)buffer;
+ int secnum;
+
+ /* Encode all code sections. No support for data sections (yet). */
+ for (secnum = 0; secnum < D->maxsection; secnum++) {
+ dasm_Section *sec = D->sections + secnum;
+ int *b = sec->buf;
+ int *endb = sec->rbuf + sec->pos;
+
+ while (b != endb) {
+ dasm_ActList p = D->actionlist + *b++;
+ while (1) {
+ unsigned int ins = *p++;
+ unsigned int action = (ins >> 16);
+ int n = (action >= DASM_ALIGN && action < DASM__MAX) ? *b++ : 0;
+ switch (action) {
+ case DASM_STOP: case DASM_SECTION: goto stop;
+ case DASM_ESC: *cp++ = *p++; break;
+ case DASM_REL_EXT:
+ n = DASM_EXTERN(Dst, (unsigned char *)cp, (ins & 2047), 1);
+ goto patchrel;
+ case DASM_ALIGN:
+ ins &= 255; while ((((char *)cp - base) & ins)) *cp++ = 0x60000000;
+ break;
+ case DASM_REL_LG:
+ CK(n >= 0, UNDEF_LG);
+ case DASM_REL_PC:
+ CK(n >= 0, UNDEF_PC);
+ n = *DASM_POS2PTR(D, n) - (int)((char *)cp - base);
+ patchrel:
+ CK((n & 3) == 0 &&
+ (((n+4) + ((ins & 2048) ? 0x00008000 : 0x02000000)) >>
+ ((ins & 2048) ? 16 : 26)) == 0, RANGE_REL);
+ cp[-1] |= ((n+4) & ((ins & 2048) ? 0x0000fffc: 0x03fffffc));
+ break;
+ case DASM_LABEL_LG:
+ ins &= 2047; if (ins >= 20) D->globals[ins-10] = (void *)(base + n);
+ break;
+ case DASM_LABEL_PC: break;
+ case DASM_IMM:
+ cp[-1] |= ((n>>((ins>>10)&31)) & ((1<<((ins>>5)&31))-1)) << (ins&31);
+ break;
+ default: *cp++ = ins; break;
+ }
+ }
+ stop: (void)0;
+ }
+ }
+
+ if (base + D->codesize != (char *)cp) /* Check for phase errors. */
+ return DASM_S_PHASE;
+ return DASM_S_OK;
+}
+#undef CK
+
+/* Get PC label offset. */
+int dasm_getpclabel(Dst_DECL, unsigned int pc)
+{
+ dasm_State *D = Dst_REF;
+ if (pc*sizeof(int) < D->pcsize) {
+ int pos = D->pclabels[pc];
+ if (pos < 0) return *DASM_POS2PTR(D, -pos);
+ if (pos > 0) return -1; /* Undefined. */
+ }
+ return -2; /* Unused or out of range. */
+}
+
+#ifdef DASM_CHECKS
+/* Optional sanity checker to call between isolated encoding steps. */
+int dasm_checkstep(Dst_DECL, int secmatch)
+{
+ dasm_State *D = Dst_REF;
+ if (D->status == DASM_S_OK) {
+ int i;
+ for (i = 1; i <= 9; i++) {
+ if (D->lglabels[i] > 0) { D->status = DASM_S_UNDEF_LG|i; break; }
+ D->lglabels[i] = 0;
+ }
+ }
+ if (D->status == DASM_S_OK && secmatch >= 0 &&
+ D->section != &D->sections[secmatch])
+ D->status = DASM_S_MATCH_SEC|(D->section-D->sections);
+ return D->status;
+}
+#endif
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_ppc.lua b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_ppc.lua
new file mode 100644
index 00000000000..bb6de01e2ba
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_ppc.lua
@@ -0,0 +1,1225 @@
+------------------------------------------------------------------------------
+-- DynASM PPC module.
+--
+-- Copyright (C) 2005-2011 Mike Pall. All rights reserved.
+-- See dynasm.lua for full copyright notice.
+------------------------------------------------------------------------------
+
+-- Module information:
+local _info = {
+ arch = "ppc",
+ description = "DynASM PPC module",
+ version = "1.3.0",
+ vernum = 10300,
+ release = "2011-05-05",
+ author = "Mike Pall",
+ license = "MIT",
+}
+
+-- Exported glue functions for the arch-specific module.
+local _M = { _info = _info }
+
+-- Cache library functions.
+local type, tonumber, pairs, ipairs = type, tonumber, pairs, ipairs
+local assert, setmetatable = assert, setmetatable
+local _s = string
+local sub, format, byte, char = _s.sub, _s.format, _s.byte, _s.char
+local match, gmatch = _s.match, _s.gmatch
+local concat, sort = table.concat, table.sort
+
+-- Inherited tables and callbacks.
+local g_opt, g_arch
+local wline, werror, wfatal, wwarn
+
+-- Action name list.
+-- CHECK: Keep this in sync with the C code!
+local action_names = {
+ "STOP", "SECTION", "ESC", "REL_EXT",
+ "ALIGN", "REL_LG", "LABEL_LG",
+ "REL_PC", "LABEL_PC", "IMM",
+}
+
+-- Maximum number of section buffer positions for dasm_put().
+-- CHECK: Keep this in sync with the C code!
+local maxsecpos = 25 -- Keep this low, to avoid excessively long C lines.
+
+-- Action name -> action number.
+local map_action = {}
+for n,name in ipairs(action_names) do
+ map_action[name] = n-1
+end
+
+-- Action list buffer.
+local actlist = {}
+
+-- Argument list for next dasm_put(). Start with offset 0 into action list.
+local actargs = { 0 }
+
+-- Current number of section buffer positions for dasm_put().
+local secpos = 1
+
+------------------------------------------------------------------------------
+
+-- Return 8 digit hex number.
+local function tohex(x)
+ return sub(format("%08x", x), -8) -- Avoid 64 bit portability problem in Lua.
+end
+
+-- Dump action names and numbers.
+local function dumpactions(out)
+ out:write("DynASM encoding engine action codes:\n")
+ for n,name in ipairs(action_names) do
+ local num = map_action[name]
+ out:write(format(" %-10s %02X %d\n", name, num, num))
+ end
+ out:write("\n")
+end
+
+-- Write action list buffer as a huge static C array.
+local function writeactions(out, name)
+ local nn = #actlist
+ if nn == 0 then nn = 1; actlist[0] = map_action.STOP end
+ out:write("static const unsigned int ", name, "[", nn, "] = {\n")
+ for i = 1,nn-1 do
+ assert(out:write("0x", tohex(actlist[i]), ",\n"))
+ end
+ assert(out:write("0x", tohex(actlist[nn]), "\n};\n\n"))
+end
+
+------------------------------------------------------------------------------
+
+-- Add word to action list.
+local function wputxw(n)
+ assert(n >= 0 and n <= 0xffffffff and n % 1 == 0, "word out of range")
+ actlist[#actlist+1] = n
+end
+
+-- Add action to list with optional arg. Advance buffer pos, too.
+local function waction(action, val, a, num)
+ local w = assert(map_action[action], "bad action name `"..action.."'")
+ wputxw(w * 0x10000 + (val or 0))
+ if a then actargs[#actargs+1] = a end
+ if a or num then secpos = secpos + (num or 1) end
+end
+
+-- Flush action list (intervening C code or buffer pos overflow).
+local function wflush(term)
+ if #actlist == actargs[1] then return end -- Nothing to flush.
+ if not term then waction("STOP") end -- Terminate action list.
+ wline(format("dasm_put(Dst, %s);", concat(actargs, ", ")), true)
+ actargs = { #actlist } -- Actionlist offset is 1st arg to next dasm_put().
+ secpos = 1 -- The actionlist offset occupies a buffer position, too.
+end
+
+-- Put escaped word.
+local function wputw(n)
+ if n <= 0xffffff then waction("ESC") end
+ wputxw(n)
+end
+
+-- Reserve position for word.
+local function wpos()
+ local pos = #actlist+1
+ actlist[pos] = ""
+ return pos
+end
+
+-- Store word to reserved position.
+local function wputpos(pos, n)
+ assert(n >= 0 and n <= 0xffffffff and n % 1 == 0, "word out of range")
+ actlist[pos] = n
+end
+
+------------------------------------------------------------------------------
+
+-- Global label name -> global label number. With auto assignment on 1st use.
+local next_global = 20
+local map_global = setmetatable({}, { __index = function(t, name)
+ if not match(name, "^[%a_][%w_]*$") then werror("bad global label") end
+ local n = next_global
+ if n > 2047 then werror("too many global labels") end
+ next_global = n + 1
+ t[name] = n
+ return n
+end})
+
+-- Dump global labels.
+local function dumpglobals(out, lvl)
+ local t = {}
+ for name, n in pairs(map_global) do t[n] = name end
+ out:write("Global labels:\n")
+ for i=20,next_global-1 do
+ out:write(format(" %s\n", t[i]))
+ end
+ out:write("\n")
+end
+
+-- Write global label enum.
+local function writeglobals(out, prefix)
+ local t = {}
+ for name, n in pairs(map_global) do t[n] = name end
+ out:write("enum {\n")
+ for i=20,next_global-1 do
+ out:write(" ", prefix, t[i], ",\n")
+ end
+ out:write(" ", prefix, "_MAX\n};\n")
+end
+
+-- Write global label names.
+local function writeglobalnames(out, name)
+ local t = {}
+ for name, n in pairs(map_global) do t[n] = name end
+ out:write("static const char *const ", name, "[] = {\n")
+ for i=20,next_global-1 do
+ out:write(" \"", t[i], "\",\n")
+ end
+ out:write(" (const char *)0\n};\n")
+end
+
+------------------------------------------------------------------------------
+
+-- Extern label name -> extern label number. With auto assignment on 1st use.
+local next_extern = 0
+local map_extern_ = {}
+local map_extern = setmetatable({}, { __index = function(t, name)
+ -- No restrictions on the name for now.
+ local n = next_extern
+ if n > 2047 then werror("too many extern labels") end
+ next_extern = n + 1
+ t[name] = n
+ map_extern_[n] = name
+ return n
+end})
+
+-- Dump extern labels.
+local function dumpexterns(out, lvl)
+ out:write("Extern labels:\n")
+ for i=0,next_extern-1 do
+ out:write(format(" %s\n", map_extern_[i]))
+ end
+ out:write("\n")
+end
+
+-- Write extern label names.
+local function writeexternnames(out, name)
+ out:write("static const char *const ", name, "[] = {\n")
+ for i=0,next_extern-1 do
+ out:write(" \"", map_extern_[i], "\",\n")
+ end
+ out:write(" (const char *)0\n};\n")
+end
+
+------------------------------------------------------------------------------
+
+-- Arch-specific maps.
+local map_archdef = { sp = "r1" } -- Ext. register name -> int. name.
+
+local map_type = {} -- Type name -> { ctype, reg }
+local ctypenum = 0 -- Type number (for Dt... macros).
+
+-- Reverse defines for registers.
+function _M.revdef(s)
+ if s == "r1" then return "sp" end
+ return s
+end
+
+local map_cond = {
+ lt = 0, gt = 1, eq = 2, so = 3,
+ ge = 4, le = 5, ne = 6, ns = 7,
+}
+
+------------------------------------------------------------------------------
+
+-- Template strings for PPC instructions.
+local map_op = {
+ tdi_3 = "08000000ARI",
+ twi_3 = "0c000000ARI",
+ mulli_3 = "1c000000RRI",
+ subfic_3 = "20000000RRI",
+ cmplwi_3 = "28000000XRU",
+ cmplwi_2 = "28000000-RU",
+ cmpldi_3 = "28200000XRU",
+ cmpldi_2 = "28200000-RU",
+ cmpwi_3 = "2c000000XRI",
+ cmpwi_2 = "2c000000-RI",
+ cmpdi_3 = "2c200000XRI",
+ cmpdi_2 = "2c200000-RI",
+ addic_3 = "30000000RRI",
+ ["addic._3"] = "34000000RRI",
+ addi_3 = "38000000RR0I",
+ li_2 = "38000000RI",
+ la_2 = "38000000RD",
+ addis_3 = "3c000000RR0I",
+ lis_2 = "3c000000RI",
+ lus_2 = "3c000000RU",
+ bc_3 = "40000000AAK",
+ bcl_3 = "40000001AAK",
+ bdnz_1 = "42000000K",
+ bdz_1 = "42400000K",
+ sc_0 = "44000000",
+ b_1 = "48000000J",
+ bl_1 = "48000001J",
+ rlwimi_5 = "50000000RR~AAA.",
+ rlwinm_5 = "54000000RR~AAA.",
+ rlwnm_5 = "5c000000RR~RAA.",
+ ori_3 = "60000000RR~U",
+ nop_0 = "60000000",
+ oris_3 = "64000000RR~U",
+ xori_3 = "68000000RR~U",
+ xoris_3 = "6c000000RR~U",
+ ["andi._3"] = "70000000RR~U",
+ ["andis._3"] = "74000000RR~U",
+ lwz_2 = "80000000RD",
+ lwzu_2 = "84000000RD",
+ lbz_2 = "88000000RD",
+ lbzu_2 = "8c000000RD",
+ stw_2 = "90000000RD",
+ stwu_2 = "94000000RD",
+ stb_2 = "98000000RD",
+ stbu_2 = "9c000000RD",
+ lhz_2 = "a0000000RD",
+ lhzu_2 = "a4000000RD",
+ lha_2 = "a8000000RD",
+ lhau_2 = "ac000000RD",
+ sth_2 = "b0000000RD",
+ sthu_2 = "b4000000RD",
+ lmw_2 = "b8000000RD",
+ stmw_2 = "bc000000RD",
+ lfs_2 = "c0000000FD",
+ lfsu_2 = "c4000000FD",
+ lfd_2 = "c8000000FD",
+ lfdu_2 = "cc000000FD",
+ stfs_2 = "d0000000FD",
+ stfsu_2 = "d4000000FD",
+ stfd_2 = "d8000000FD",
+ stfdu_2 = "dc000000FD",
+ ld_2 = "e8000000RD", -- NYI: displacement must be divisible by 4.
+ ldu_2 = "e8000001RD",
+ lwa_2 = "e8000002RD",
+ std_2 = "f8000000RD",
+ stdu_2 = "f8000001RD",
+
+ -- Primary opcode 19:
+ mcrf_2 = "4c000000XX",
+ isync_0 = "4c00012c",
+ crnor_3 = "4c000042CCC",
+ crnot_2 = "4c000042CC=",
+ crandc_3 = "4c000102CCC",
+ crxor_3 = "4c000182CCC",
+ crclr_1 = "4c000182C==",
+ crnand_3 = "4c0001c2CCC",
+ crand_3 = "4c000202CCC",
+ creqv_3 = "4c000242CCC",
+ crset_1 = "4c000242C==",
+ crorc_3 = "4c000342CCC",
+ cror_3 = "4c000382CCC",
+ crmove_2 = "4c000382CC=",
+ bclr_2 = "4c000020AA",
+ bclrl_2 = "4c000021AA",
+ bcctr_2 = "4c000420AA",
+ bcctrl_2 = "4c000421AA",
+ blr_0 = "4e800020",
+ blrl_0 = "4e800021",
+ bctr_0 = "4e800420",
+ bctrl_0 = "4e800421",
+
+ -- Primary opcode 31:
+ cmpw_3 = "7c000000XRR",
+ cmpw_2 = "7c000000-RR",
+ cmpd_3 = "7c200000XRR",
+ cmpd_2 = "7c200000-RR",
+ tw_3 = "7c000008ARR",
+ subfc_3 = "7c000010RRR.",
+ subc_3 = "7c000010RRR~.",
+ mulhdu_3 = "7c000012RRR.",
+ addc_3 = "7c000014RRR.",
+ mulhwu_3 = "7c000016RRR.",
+ isel_4 = "7c00001eRRRC",
+ isellt_3 = "7c00001eRRR",
+ iselgt_3 = "7c00005eRRR",
+ iseleq_3 = "7c00009eRRR",
+ mfcr_1 = "7c000026R",
+ -- NYI: mtcrf, mtocrf, mfocrf
+ lwarx_3 = "7c000028RR0R",
+ ldx_3 = "7c00002aRR0R",
+ lwzx_3 = "7c00002eRR0R",
+ slw_3 = "7c000030RR~R.",
+ cntlzw_2 = "7c000034RR~",
+ sld_3 = "7c000036RR~R.",
+ and_3 = "7c000038RR~R.",
+ cmplw_3 = "7c000040XRR",
+ cmplw_2 = "7c000040-RR",
+ cmpld_3 = "7c200040XRR",
+ cmpld_2 = "7c200040-RR",
+ subf_3 = "7c000050RRR.",
+ sub_3 = "7c000050RRR~.",
+ ldux_3 = "7c00006aRR0R",
+ dcbst_2 = "7c00006c-RR",
+ lwzux_3 = "7c00006eRR0R",
+ cntlzd_2 = "7c000074RR~",
+ andc_3 = "7c000078RR~R.",
+ td_3 = "7c000088ARR",
+ mulhd_3 = "7c000092RRR.",
+ mulhw_3 = "7c000096RRR.",
+ ldarx_3 = "7c0000a8RR0R",
+ dcbf_2 = "7c0000ac-RR",
+ lbzx_3 = "7c0000aeRR0R",
+ neg_2 = "7c0000d0RR.",
+ lbzux_3 = "7c0000eeRR0R",
+ popcntb_2 = "7c0000f4RR~",
+ not_2 = "7c0000f8RR~%.",
+ nor_3 = "7c0000f8RR~R.",
+ subfe_3 = "7c000110RRR.",
+ sube_3 = "7c000110RRR~.",
+ adde_3 = "7c000114RRR.",
+ stdx_3 = "7c00012aRR0R",
+ stwcx_3 = "7c00012cRR0R.",
+ stwx_3 = "7c00012eRR0R",
+ prtyw_2 = "7c000134RR~",
+ stdux_3 = "7c00016aRR0R",
+ stwux_3 = "7c00016eRR0R",
+ prtyd_2 = "7c000174RR~",
+ subfze_2 = "7c000190RR.",
+ addze_2 = "7c000194RR.",
+ stdcx_3 = "7c0001acRR0R.",
+ stbx_3 = "7c0001aeRR0R",
+ subfme_2 = "7c0001d0RR.",
+ mulld_3 = "7c0001d2RRR.",
+ addme_2 = "7c0001d4RR.",
+ mullw_3 = "7c0001d6RRR.",
+ dcbtst_2 = "7c0001ec-RR",
+ stbux_3 = "7c0001eeRR0R",
+ add_3 = "7c000214RRR.",
+ dcbt_2 = "7c00022c-RR",
+ lhzx_3 = "7c00022eRR0R",
+ eqv_3 = "7c000238RR~R.",
+ eciwx_3 = "7c00026cRR0R",
+ lhzux_3 = "7c00026eRR0R",
+ xor_3 = "7c000278RR~R.",
+ mfspefscr_1 = "7c0082a6R",
+ mfxer_1 = "7c0102a6R",
+ mflr_1 = "7c0802a6R",
+ mfctr_1 = "7c0902a6R",
+ lwax_3 = "7c0002aaRR0R",
+ lhax_3 = "7c0002aeRR0R",
+ mftb_1 = "7c0c42e6R",
+ mftbu_1 = "7c0d42e6R",
+ lwaux_3 = "7c0002eaRR0R",
+ lhaux_3 = "7c0002eeRR0R",
+ sthx_3 = "7c00032eRR0R",
+ orc_3 = "7c000338RR~R.",
+ ecowx_3 = "7c00036cRR0R",
+ sthux_3 = "7c00036eRR0R",
+ or_3 = "7c000378RR~R.",
+ mr_2 = "7c000378RR~%.",
+ divdu_3 = "7c000392RRR.",
+ divwu_3 = "7c000396RRR.",
+ mtspefscr_1 = "7c0083a6R",
+ mtxer_1 = "7c0103a6R",
+ mtlr_1 = "7c0803a6R",
+ mtctr_1 = "7c0903a6R",
+ dcbi_2 = "7c0003ac-RR",
+ nand_3 = "7c0003b8RR~R.",
+ divd_3 = "7c0003d2RRR.",
+ divw_3 = "7c0003d6RRR.",
+ cmpb_3 = "7c0003f8RR~R.",
+ mcrxr_1 = "7c000400X",
+ subfco_3 = "7c000410RRR.",
+ subco_3 = "7c000410RRR~.",
+ addco_3 = "7c000414RRR.",
+ ldbrx_3 = "7c000428RR0R",
+ lswx_3 = "7c00042aRR0R",
+ lwbrx_3 = "7c00042cRR0R",
+ lfsx_3 = "7c00042eFR0R",
+ srw_3 = "7c000430RR~R.",
+ srd_3 = "7c000436RR~R.",
+ subfo_3 = "7c000450RRR.",
+ subo_3 = "7c000450RRR~.",
+ lfsux_3 = "7c00046eFR0R",
+ lswi_3 = "7c0004aaRR0A",
+ sync_0 = "7c0004ac",
+ lwsync_0 = "7c2004ac",
+ ptesync_0 = "7c4004ac",
+ lfdx_3 = "7c0004aeFR0R",
+ nego_2 = "7c0004d0RR.",
+ lfdux_3 = "7c0004eeFR0R",
+ subfeo_3 = "7c000510RRR.",
+ subeo_3 = "7c000510RRR~.",
+ addeo_3 = "7c000514RRR.",
+ stdbrx_3 = "7c000528RR0R",
+ stswx_3 = "7c00052aRR0R",
+ stwbrx_3 = "7c00052cRR0R",
+ stfsx_3 = "7c00052eFR0R",
+ stfsux_3 = "7c00056eFR0R",
+ subfzeo_2 = "7c000590RR.",
+ addzeo_2 = "7c000594RR.",
+ stswi_3 = "7c0005aaRR0A",
+ stfdx_3 = "7c0005aeFR0R",
+ subfmeo_2 = "7c0005d0RR.",
+ mulldo_3 = "7c0005d2RRR.",
+ addmeo_2 = "7c0005d4RR.",
+ mullwo_3 = "7c0005d6RRR.",
+ dcba_2 = "7c0005ec-RR",
+ stfdux_3 = "7c0005eeFR0R",
+ addo_3 = "7c000614RRR.",
+ lhbrx_3 = "7c00062cRR0R",
+ sraw_3 = "7c000630RR~R.",
+ srad_3 = "7c000634RR~R.",
+ srawi_3 = "7c000670RR~A.",
+ eieio_0 = "7c0006ac",
+ lfiwax_3 = "7c0006aeFR0R",
+ sthbrx_3 = "7c00072cRR0R",
+ extsh_2 = "7c000734RR~.",
+ extsb_2 = "7c000774RR~.",
+ divduo_3 = "7c000792RRR.",
+ divwou_3 = "7c000796RRR.",
+ icbi_2 = "7c0007ac-RR",
+ stfiwx_3 = "7c0007aeFR0R",
+ extsw_2 = "7c0007b4RR~.",
+ divdo_3 = "7c0007d2RRR.",
+ divwo_3 = "7c0007d6RRR.",
+ dcbz_2 = "7c0007ec-RR",
+
+ -- Primary opcode 59:
+ fdivs_3 = "ec000024FFF.",
+ fsubs_3 = "ec000028FFF.",
+ fadds_3 = "ec00002aFFF.",
+ fsqrts_2 = "ec00002cF-F.",
+ fres_2 = "ec000030F-F.",
+ fmuls_3 = "ec000032FF-F.",
+ frsqrtes_2 = "ec000034F-F.",
+ fmsubs_4 = "ec000038FFFF~.",
+ fmadds_4 = "ec00003aFFFF~.",
+ fnmsubs_4 = "ec00003cFFFF~.",
+ fnmadds_4 = "ec00003eFFFF~.",
+
+ -- Primary opcode 63:
+ fdiv_3 = "fc000024FFF.",
+ fsub_3 = "fc000028FFF.",
+ fadd_3 = "fc00002aFFF.",
+ fsqrt_2 = "fc00002cF-F.",
+ fsel_4 = "fc00002eFFFF~.",
+ fre_2 = "fc000030F-F.",
+ fmul_3 = "fc000032FF-F.",
+ frsqrte_2 = "fc000034F-F.",
+ fmsub_4 = "fc000038FFFF~.",
+ fmadd_4 = "fc00003aFFFF~.",
+ fnmsub_4 = "fc00003cFFFF~.",
+ fnmadd_4 = "fc00003eFFFF~.",
+ fcmpu_3 = "fc000000XFF",
+ fcpsgn_3 = "fc000010FFF.",
+ fcmpo_3 = "fc000040XFF",
+ mtfsb1_1 = "fc00004cA",
+ fneg_2 = "fc000050F-F.",
+ mcrfs_2 = "fc000080XX",
+ mtfsb0_1 = "fc00008cA",
+ fmr_2 = "fc000090F-F.",
+ frsp_2 = "fc000018F-F.",
+ fctiw_2 = "fc00001cF-F.",
+ fctiwz_2 = "fc00001eF-F.",
+ mtfsfi_2 = "fc00010cAA", -- NYI: upshift.
+ fnabs_2 = "fc000110F-F.",
+ fabs_2 = "fc000210F-F.",
+ frin_2 = "fc000310F-F.",
+ friz_2 = "fc000350F-F.",
+ frip_2 = "fc000390F-F.",
+ frim_2 = "fc0003d0F-F.",
+ mffs_1 = "fc00048eF.",
+ mtfsf_1 = "fc00058eF.",
+ fctid_2 = "fc00065cF-F.",
+ fctidz_2 = "fc00065eF-F.",
+ fcfid_2 = "fc00069cF-F.",
+
+ -- Primary opcode 4, SPE APU extension:
+ evaddw_3 = "10000200RRR",
+ evaddiw_3 = "10000202RAR~",
+ evsubw_3 = "10000204RRR~",
+ evsubiw_3 = "10000206RAR~",
+ evabs_2 = "10000208RR",
+ evneg_2 = "10000209RR",
+ evextsb_2 = "1000020aRR",
+ evextsh_2 = "1000020bRR",
+ evrndw_2 = "1000020cRR",
+ evcntlzw_2 = "1000020dRR",
+ evcntlsw_2 = "1000020eRR",
+ brinc_3 = "1000020fRRR",
+ evand_3 = "10000211RRR",
+ evandc_3 = "10000212RRR",
+ evxor_3 = "10000216RRR",
+ evor_3 = "10000217RRR",
+ evmr_2 = "10000217RR=",
+ evnor_3 = "10000218RRR",
+ evnot_2 = "10000218RR=",
+ eveqv_3 = "10000219RRR",
+ evorc_3 = "1000021bRRR",
+ evnand_3 = "1000021eRRR",
+ evsrwu_3 = "10000220RRR",
+ evsrws_3 = "10000221RRR",
+ evsrwiu_3 = "10000222RRA",
+ evsrwis_3 = "10000223RRA",
+ evslw_3 = "10000224RRR",
+ evslwi_3 = "10000226RRA",
+ evrlw_3 = "10000228RRR",
+ evsplati_2 = "10000229RS",
+ evrlwi_3 = "1000022aRRA",
+ evsplatfi_2 = "1000022bRS",
+ evmergehi_3 = "1000022cRRR",
+ evmergelo_3 = "1000022dRRR",
+ evcmpgtu_3 = "10000230XRR",
+ evcmpgtu_2 = "10000230-RR",
+ evcmpgts_3 = "10000231XRR",
+ evcmpgts_2 = "10000231-RR",
+ evcmpltu_3 = "10000232XRR",
+ evcmpltu_2 = "10000232-RR",
+ evcmplts_3 = "10000233XRR",
+ evcmplts_2 = "10000233-RR",
+ evcmpeq_3 = "10000234XRR",
+ evcmpeq_2 = "10000234-RR",
+ evsel_4 = "10000278RRRW",
+ evsel_3 = "10000278RRR",
+ evfsadd_3 = "10000280RRR",
+ evfssub_3 = "10000281RRR",
+ evfsabs_2 = "10000284RR",
+ evfsnabs_2 = "10000285RR",
+ evfsneg_2 = "10000286RR",
+ evfsmul_3 = "10000288RRR",
+ evfsdiv_3 = "10000289RRR",
+ evfscmpgt_3 = "1000028cXRR",
+ evfscmpgt_2 = "1000028c-RR",
+ evfscmplt_3 = "1000028dXRR",
+ evfscmplt_2 = "1000028d-RR",
+ evfscmpeq_3 = "1000028eXRR",
+ evfscmpeq_2 = "1000028e-RR",
+ evfscfui_2 = "10000290R-R",
+ evfscfsi_2 = "10000291R-R",
+ evfscfuf_2 = "10000292R-R",
+ evfscfsf_2 = "10000293R-R",
+ evfsctui_2 = "10000294R-R",
+ evfsctsi_2 = "10000295R-R",
+ evfsctuf_2 = "10000296R-R",
+ evfsctsf_2 = "10000297R-R",
+ evfsctuiz_2 = "10000298R-R",
+ evfsctsiz_2 = "1000029aR-R",
+ evfststgt_3 = "1000029cXRR",
+ evfststgt_2 = "1000029c-RR",
+ evfststlt_3 = "1000029dXRR",
+ evfststlt_2 = "1000029d-RR",
+ evfststeq_3 = "1000029eXRR",
+ evfststeq_2 = "1000029e-RR",
+ efsadd_3 = "100002c0RRR",
+ efssub_3 = "100002c1RRR",
+ efsabs_2 = "100002c4RR",
+ efsnabs_2 = "100002c5RR",
+ efsneg_2 = "100002c6RR",
+ efsmul_3 = "100002c8RRR",
+ efsdiv_3 = "100002c9RRR",
+ efscmpgt_3 = "100002ccXRR",
+ efscmpgt_2 = "100002cc-RR",
+ efscmplt_3 = "100002cdXRR",
+ efscmplt_2 = "100002cd-RR",
+ efscmpeq_3 = "100002ceXRR",
+ efscmpeq_2 = "100002ce-RR",
+ efscfd_2 = "100002cfR-R",
+ efscfui_2 = "100002d0R-R",
+ efscfsi_2 = "100002d1R-R",
+ efscfuf_2 = "100002d2R-R",
+ efscfsf_2 = "100002d3R-R",
+ efsctui_2 = "100002d4R-R",
+ efsctsi_2 = "100002d5R-R",
+ efsctuf_2 = "100002d6R-R",
+ efsctsf_2 = "100002d7R-R",
+ efsctuiz_2 = "100002d8R-R",
+ efsctsiz_2 = "100002daR-R",
+ efststgt_3 = "100002dcXRR",
+ efststgt_2 = "100002dc-RR",
+ efststlt_3 = "100002ddXRR",
+ efststlt_2 = "100002dd-RR",
+ efststeq_3 = "100002deXRR",
+ efststeq_2 = "100002de-RR",
+ efdadd_3 = "100002e0RRR",
+ efdsub_3 = "100002e1RRR",
+ efdcfuid_2 = "100002e2R-R",
+ efdcfsid_2 = "100002e3R-R",
+ efdabs_2 = "100002e4RR",
+ efdnabs_2 = "100002e5RR",
+ efdneg_2 = "100002e6RR",
+ efdmul_3 = "100002e8RRR",
+ efddiv_3 = "100002e9RRR",
+ efdctuidz_2 = "100002eaR-R",
+ efdctsidz_2 = "100002ebR-R",
+ efdcmpgt_3 = "100002ecXRR",
+ efdcmpgt_2 = "100002ec-RR",
+ efdcmplt_3 = "100002edXRR",
+ efdcmplt_2 = "100002ed-RR",
+ efdcmpeq_3 = "100002eeXRR",
+ efdcmpeq_2 = "100002ee-RR",
+ efdcfs_2 = "100002efR-R",
+ efdcfui_2 = "100002f0R-R",
+ efdcfsi_2 = "100002f1R-R",
+ efdcfuf_2 = "100002f2R-R",
+ efdcfsf_2 = "100002f3R-R",
+ efdctui_2 = "100002f4R-R",
+ efdctsi_2 = "100002f5R-R",
+ efdctuf_2 = "100002f6R-R",
+ efdctsf_2 = "100002f7R-R",
+ efdctuiz_2 = "100002f8R-R",
+ efdctsiz_2 = "100002faR-R",
+ efdtstgt_3 = "100002fcXRR",
+ efdtstgt_2 = "100002fc-RR",
+ efdtstlt_3 = "100002fdXRR",
+ efdtstlt_2 = "100002fd-RR",
+ efdtsteq_3 = "100002feXRR",
+ efdtsteq_2 = "100002fe-RR",
+ evlddx_3 = "10000300RR0R",
+ evldd_2 = "10000301R8",
+ evldwx_3 = "10000302RR0R",
+ evldw_2 = "10000303R8",
+ evldhx_3 = "10000304RR0R",
+ evldh_2 = "10000305R8",
+ evlwhex_3 = "10000310RR0R",
+ evlwhe_2 = "10000311R4",
+ evlwhoux_3 = "10000314RR0R",
+ evlwhou_2 = "10000315R4",
+ evlwhosx_3 = "10000316RR0R",
+ evlwhos_2 = "10000317R4",
+ evstddx_3 = "10000320RR0R",
+ evstdd_2 = "10000321R8",
+ evstdwx_3 = "10000322RR0R",
+ evstdw_2 = "10000323R8",
+ evstdhx_3 = "10000324RR0R",
+ evstdh_2 = "10000325R8",
+ evstwhex_3 = "10000330RR0R",
+ evstwhe_2 = "10000331R4",
+ evstwhox_3 = "10000334RR0R",
+ evstwho_2 = "10000335R4",
+ evstwwex_3 = "10000338RR0R",
+ evstwwe_2 = "10000339R4",
+ evstwwox_3 = "1000033cRR0R",
+ evstwwo_2 = "1000033dR4",
+ evmhessf_3 = "10000403RRR",
+ evmhossf_3 = "10000407RRR",
+ evmheumi_3 = "10000408RRR",
+ evmhesmi_3 = "10000409RRR",
+ evmhesmf_3 = "1000040bRRR",
+ evmhoumi_3 = "1000040cRRR",
+ evmhosmi_3 = "1000040dRRR",
+ evmhosmf_3 = "1000040fRRR",
+ evmhessfa_3 = "10000423RRR",
+ evmhossfa_3 = "10000427RRR",
+ evmheumia_3 = "10000428RRR",
+ evmhesmia_3 = "10000429RRR",
+ evmhesmfa_3 = "1000042bRRR",
+ evmhoumia_3 = "1000042cRRR",
+ evmhosmia_3 = "1000042dRRR",
+ evmhosmfa_3 = "1000042fRRR",
+ evmwhssf_3 = "10000447RRR",
+ evmwlumi_3 = "10000448RRR",
+ evmwhumi_3 = "1000044cRRR",
+ evmwhsmi_3 = "1000044dRRR",
+ evmwhsmf_3 = "1000044fRRR",
+ evmwssf_3 = "10000453RRR",
+ evmwumi_3 = "10000458RRR",
+ evmwsmi_3 = "10000459RRR",
+ evmwsmf_3 = "1000045bRRR",
+ evmwhssfa_3 = "10000467RRR",
+ evmwlumia_3 = "10000468RRR",
+ evmwhumia_3 = "1000046cRRR",
+ evmwhsmia_3 = "1000046dRRR",
+ evmwhsmfa_3 = "1000046fRRR",
+ evmwssfa_3 = "10000473RRR",
+ evmwumia_3 = "10000478RRR",
+ evmwsmia_3 = "10000479RRR",
+ evmwsmfa_3 = "1000047bRRR",
+ evmra_2 = "100004c4RR",
+ evdivws_3 = "100004c6RRR",
+ evdivwu_3 = "100004c7RRR",
+ evmwssfaa_3 = "10000553RRR",
+ evmwumiaa_3 = "10000558RRR",
+ evmwsmiaa_3 = "10000559RRR",
+ evmwsmfaa_3 = "1000055bRRR",
+ evmwssfan_3 = "100005d3RRR",
+ evmwumian_3 = "100005d8RRR",
+ evmwsmian_3 = "100005d9RRR",
+ evmwsmfan_3 = "100005dbRRR",
+ evmergehilo_3 = "1000022eRRR",
+ evmergelohi_3 = "1000022fRRR",
+ evlhhesplatx_3 = "10000308RR0R",
+ evlhhesplat_2 = "10000309R2",
+ evlhhousplatx_3 = "1000030cRR0R",
+ evlhhousplat_2 = "1000030dR2",
+ evlhhossplatx_3 = "1000030eRR0R",
+ evlhhossplat_2 = "1000030fR2",
+ evlwwsplatx_3 = "10000318RR0R",
+ evlwwsplat_2 = "10000319R4",
+ evlwhsplatx_3 = "1000031cRR0R",
+ evlwhsplat_2 = "1000031dR4",
+ evaddusiaaw_2 = "100004c0RR",
+ evaddssiaaw_2 = "100004c1RR",
+ evsubfusiaaw_2 = "100004c2RR",
+ evsubfssiaaw_2 = "100004c3RR",
+ evaddumiaaw_2 = "100004c8RR",
+ evaddsmiaaw_2 = "100004c9RR",
+ evsubfumiaaw_2 = "100004caRR",
+ evsubfsmiaaw_2 = "100004cbRR",
+ evmheusiaaw_3 = "10000500RRR",
+ evmhessiaaw_3 = "10000501RRR",
+ evmhessfaaw_3 = "10000503RRR",
+ evmhousiaaw_3 = "10000504RRR",
+ evmhossiaaw_3 = "10000505RRR",
+ evmhossfaaw_3 = "10000507RRR",
+ evmheumiaaw_3 = "10000508RRR",
+ evmhesmiaaw_3 = "10000509RRR",
+ evmhesmfaaw_3 = "1000050bRRR",
+ evmhoumiaaw_3 = "1000050cRRR",
+ evmhosmiaaw_3 = "1000050dRRR",
+ evmhosmfaaw_3 = "1000050fRRR",
+ evmhegumiaa_3 = "10000528RRR",
+ evmhegsmiaa_3 = "10000529RRR",
+ evmhegsmfaa_3 = "1000052bRRR",
+ evmhogumiaa_3 = "1000052cRRR",
+ evmhogsmiaa_3 = "1000052dRRR",
+ evmhogsmfaa_3 = "1000052fRRR",
+ evmwlusiaaw_3 = "10000540RRR",
+ evmwlssiaaw_3 = "10000541RRR",
+ evmwlumiaaw_3 = "10000548RRR",
+ evmwlsmiaaw_3 = "10000549RRR",
+ evmheusianw_3 = "10000580RRR",
+ evmhessianw_3 = "10000581RRR",
+ evmhessfanw_3 = "10000583RRR",
+ evmhousianw_3 = "10000584RRR",
+ evmhossianw_3 = "10000585RRR",
+ evmhossfanw_3 = "10000587RRR",
+ evmheumianw_3 = "10000588RRR",
+ evmhesmianw_3 = "10000589RRR",
+ evmhesmfanw_3 = "1000058bRRR",
+ evmhoumianw_3 = "1000058cRRR",
+ evmhosmianw_3 = "1000058dRRR",
+ evmhosmfanw_3 = "1000058fRRR",
+ evmhegumian_3 = "100005a8RRR",
+ evmhegsmian_3 = "100005a9RRR",
+ evmhegsmfan_3 = "100005abRRR",
+ evmhogumian_3 = "100005acRRR",
+ evmhogsmian_3 = "100005adRRR",
+ evmhogsmfan_3 = "100005afRRR",
+ evmwlusianw_3 = "100005c0RRR",
+ evmwlssianw_3 = "100005c1RRR",
+ evmwlumianw_3 = "100005c8RRR",
+ evmwlsmianw_3 = "100005c9RRR",
+
+ -- NYI: some 64 bit PowerPC and Book E instructions:
+ -- rldicl, rldicr, rldic, rldimi, rldcl, rldcr, sradi, 64 bit ext. add/sub,
+ -- extended addressing branches, cache management, loads and stores
+}
+
+-- Add mnemonics for "." variants.
+do
+ local t = {}
+ for k,v in pairs(map_op) do
+ if sub(v, -1) == "." then
+ local v2 = sub(v, 1, 7)..char(byte(v, 8)+1)..sub(v, 9, -2)
+ t[sub(k, 1, -3).."."..sub(k, -2)] = v2
+ end
+ end
+ for k,v in pairs(t) do
+ map_op[k] = v
+ end
+end
+
+-- Add more branch mnemonics.
+for cond,c in pairs(map_cond) do
+ local b1 = "b"..cond
+ local c1 = (c%4)*0x00010000 + (c < 4 and 0x01000000 or 0)
+ -- bX[l]
+ map_op[b1.."_1"] = tohex(0x40800000 + c1).."K"
+ map_op[b1.."l_1"] = tohex(0x40800001 + c1).."K"
+ map_op[b1.."_2"] = tohex(0x40800000 + c1).."-XK"
+ map_op[b1.."l_2"] = tohex(0x40800001 + c1).."-XK"
+ -- bXlr[l]
+ map_op[b1.."lr_0"] = tohex(0x4c800020 + c1)
+ map_op[b1.."lrl_0"] = tohex(0x4c800021 + c1)
+ map_op[b1.."ctr_0"] = tohex(0x4c800420 + c1)
+ map_op[b1.."ctrl_0"] = tohex(0x4c800421 + c1)
+ -- bXctr[l]
+ map_op[b1.."lr_1"] = tohex(0x4c800020 + c1).."-X"
+ map_op[b1.."lrl_1"] = tohex(0x4c800021 + c1).."-X"
+ map_op[b1.."ctr_1"] = tohex(0x4c800420 + c1).."-X"
+ map_op[b1.."ctrl_1"] = tohex(0x4c800421 + c1).."-X"
+end
+
+------------------------------------------------------------------------------
+
+local function parse_gpr(expr)
+ local tname, ovreg = match(expr, "^([%w_]+):(r[1-3]?[0-9])$")
+ local tp = map_type[tname or expr]
+ if tp then
+ local reg = ovreg or tp.reg
+ if not reg then
+ werror("type `"..(tname or expr).."' needs a register override")
+ end
+ expr = reg
+ end
+ local r = match(expr, "^r([1-3]?[0-9])$")
+ if r then
+ r = tonumber(r)
+ if r <= 31 then return r, tp end
+ end
+ werror("bad register name `"..expr.."'")
+end
+
+local function parse_fpr(expr)
+ local r = match(expr, "^f([1-3]?[0-9])$")
+ if r then
+ r = tonumber(r)
+ if r <= 31 then return r end
+ end
+ werror("bad register name `"..expr.."'")
+end
+
+local function parse_cr(expr)
+ local r = match(expr, "^cr([0-7])$")
+ if r then return tonumber(r) end
+ werror("bad condition register name `"..expr.."'")
+end
+
+local function parse_cond(expr)
+ local r, cond = match(expr, "^4%*cr([0-7])%+(%w%w)$")
+ if r then
+ r = tonumber(r)
+ local c = map_cond[cond]
+ if c and c < 4 then return r*4+c end
+ end
+ werror("bad condition bit name `"..expr.."'")
+end
+
+local function parse_imm(imm, bits, shift, scale, signed)
+ local n = tonumber(imm)
+ if n then
+ if n % 2^scale == 0 then
+ n = n / 2^scale
+ if signed then
+ if n >= 0 then
+ if n < 2^(bits-1) then return n*2^shift end
+ else
+ if n >= -(2^(bits-1))-1 then return (n+2^bits)*2^shift end
+ end
+ else
+ if n >= 0 and n <= 2^bits-1 then return n*2^shift end
+ end
+ end
+ werror("out of range immediate `"..imm.."'")
+ elseif match(imm, "^r([1-3]?[0-9])$") or
+ match(imm, "^([%w_]+):(r[1-3]?[0-9])$") then
+ werror("expected immediate operand, got register")
+ else
+ waction("IMM", (signed and 32768 or 0)+scale*1024+bits*32+shift, imm)
+ return 0
+ end
+end
+
+local function parse_disp(disp)
+ local imm, reg = match(disp, "^(.*)%(([%w_:]+)%)$")
+ if imm then
+ local r = parse_gpr(reg)
+ if r == 0 then werror("cannot use r0 in displacement") end
+ return r*65536 + parse_imm(imm, 16, 0, 0, true)
+ end
+ local reg, tailr = match(disp, "^([%w_:]+)%s*(.*)$")
+ if reg and tailr ~= "" then
+ local r, tp = parse_gpr(reg)
+ if r == 0 then werror("cannot use r0 in displacement") end
+ if tp then
+ waction("IMM", 32768+16*32, format(tp.ctypefmt, tailr))
+ return r*65536
+ end
+ end
+ werror("bad displacement `"..disp.."'")
+end
+
+local function parse_u5disp(disp, scale)
+ local imm, reg = match(disp, "^(.*)%(([%w_:]+)%)$")
+ if imm then
+ local r = parse_gpr(reg)
+ if r == 0 then werror("cannot use r0 in displacement") end
+ return r*65536 + parse_imm(imm, 5, 11, scale, false)
+ end
+ local reg, tailr = match(disp, "^([%w_:]+)%s*(.*)$")
+ if reg and tailr ~= "" then
+ local r, tp = parse_gpr(reg)
+ if r == 0 then werror("cannot use r0 in displacement") end
+ if tp then
+ waction("IMM", scale*1024+5*32+11, format(tp.ctypefmt, tailr))
+ return r*65536
+ end
+ end
+ werror("bad displacement `"..disp.."'")
+end
+
+local function parse_label(label, def)
+ local prefix = sub(label, 1, 2)
+ -- =>label (pc label reference)
+ if prefix == "=>" then
+ return "PC", 0, sub(label, 3)
+ end
+ -- ->name (global label reference)
+ if prefix == "->" then
+ return "LG", map_global[sub(label, 3)]
+ end
+ if def then
+ -- [1-9] (local label definition)
+ if match(label, "^[1-9]$") then
+ return "LG", 10+tonumber(label)
+ end
+ else
+ -- [<>][1-9] (local label reference)
+ local dir, lnum = match(label, "^([<>])([1-9])$")
+ if dir then -- Fwd: 1-9, Bkwd: 11-19.
+ return "LG", lnum + (dir == ">" and 0 or 10)
+ end
+ -- extern label (extern label reference)
+ local extname = match(label, "^extern%s+(%S+)$")
+ if extname then
+ return "EXT", map_extern[extname]
+ end
+ end
+ werror("bad label `"..label.."'")
+end
+
+------------------------------------------------------------------------------
+
+-- Handle opcodes defined with template strings.
+map_op[".template__"] = function(params, template, nparams)
+ if not params then return sub(template, 9) end
+ local op = tonumber(sub(template, 1, 8), 16)
+ local n, rs = 1, 26
+
+ -- Limit number of section buffer positions used by a single dasm_put().
+ -- A single opcode needs a maximum of 3 positions (rlwinm).
+ if secpos+3 > maxsecpos then wflush() end
+ local pos = wpos()
+
+ -- Process each character.
+ for p in gmatch(sub(template, 9), ".") do
+ if p == "R" then
+ rs = rs - 5; op = op + parse_gpr(params[n]) * 2^rs; n = n + 1
+ elseif p == "F" then
+ rs = rs - 5; op = op + parse_fpr(params[n]) * 2^rs; n = n + 1
+ elseif p == "A" then
+ rs = rs - 5; op = op + parse_imm(params[n], 5, rs, 0, false); n = n + 1
+ elseif p == "S" then
+ rs = rs - 5; op = op + parse_imm(params[n], 5, rs, 0, true); n = n + 1
+ elseif p == "I" then
+ op = op + parse_imm(params[n], 16, 0, 0, true); n = n + 1
+ elseif p == "U" then
+ op = op + parse_imm(params[n], 16, 0, 0, false); n = n + 1
+ elseif p == "D" then
+ op = op + parse_disp(params[n]); n = n + 1
+ elseif p == "2" then
+ op = op + parse_u5disp(params[n], 1); n = n + 1
+ elseif p == "4" then
+ op = op + parse_u5disp(params[n], 2); n = n + 1
+ elseif p == "8" then
+ op = op + parse_u5disp(params[n], 3); n = n + 1
+ elseif p == "C" then
+ rs = rs - 5; op = op + parse_cond(params[n]) * 2^rs; n = n + 1
+ elseif p == "X" then
+ rs = rs - 5; op = op + parse_cr(params[n]) * 2^(rs+2); n = n + 1
+ elseif p == "W" then
+ op = op + parse_cr(params[n]); n = n + 1
+ elseif p == "J" or p == "K" then
+ local mode, n, s = parse_label(params[n], false)
+ if p == "K" then n = n + 2048 end
+ waction("REL_"..mode, n, s, 1)
+ n = n + 1
+ elseif p == "0" then
+ local mm = 2^rs
+ local t = op % mm
+ if ((op - t) / mm) % 32 == 0 then werror("cannot use r0") end
+ elseif p == "=" or p == "%" then
+ local mm = 2^(rs + (p == "%" and 5 or 0))
+ local t = ((op - op % mm) / mm) % 32
+ rs = rs - 5
+ op = op + t * 2^rs
+ elseif p == "~" then
+ local mm = 2^rs
+ local t1l = op % mm
+ local t1h = (op - t1l) / mm
+ local t2l = t1h % 32
+ local t2h = (t1h - t2l) / 32
+ local t3l = t2h % 32
+ op = ((t2h - t3l + t2l)*32 + t3l)*mm + t1l
+ elseif p == "-" then
+ rs = rs - 5
+ elseif p == "." then
+ -- Ignored.
+ else
+ assert(false)
+ end
+ end
+ wputpos(pos, op)
+end
+
+------------------------------------------------------------------------------
+
+-- Pseudo-opcode to mark the position where the action list is to be emitted.
+map_op[".actionlist_1"] = function(params)
+ if not params then return "cvar" end
+ local name = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeactions(out, name) end)
+end
+
+-- Pseudo-opcode to mark the position where the global enum is to be emitted.
+map_op[".globals_1"] = function(params)
+ if not params then return "prefix" end
+ local prefix = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeglobals(out, prefix) end)
+end
+
+-- Pseudo-opcode to mark the position where the global names are to be emitted.
+map_op[".globalnames_1"] = function(params)
+ if not params then return "cvar" end
+ local name = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeglobalnames(out, name) end)
+end
+
+-- Pseudo-opcode to mark the position where the extern names are to be emitted.
+map_op[".externnames_1"] = function(params)
+ if not params then return "cvar" end
+ local name = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeexternnames(out, name) end)
+end
+
+------------------------------------------------------------------------------
+
+-- Label pseudo-opcode (converted from trailing colon form).
+map_op[".label_1"] = function(params)
+ if not params then return "[1-9] | ->global | =>pcexpr" end
+ if secpos+1 > maxsecpos then wflush() end
+ local mode, n, s = parse_label(params[1], true)
+ if mode == "EXT" then werror("bad label definition") end
+ waction("LABEL_"..mode, n, s, 1)
+end
+
+------------------------------------------------------------------------------
+
+-- Pseudo-opcodes for data storage.
+map_op[".long_*"] = function(params)
+ if not params then return "imm..." end
+ for _,p in ipairs(params) do
+ local n = tonumber(p)
+ if not n then werror("bad immediate `"..p.."'") end
+ if n < 0 then n = n + 2^32 end
+ wputw(n)
+ if secpos+2 > maxsecpos then wflush() end
+ end
+end
+
+-- Alignment pseudo-opcode.
+map_op[".align_1"] = function(params)
+ if not params then return "numpow2" end
+ if secpos+1 > maxsecpos then wflush() end
+ local align = tonumber(params[1])
+ if align then
+ local x = align
+ -- Must be a power of 2 in the range (2 ... 256).
+ for i=1,8 do
+ x = x / 2
+ if x == 1 then
+ waction("ALIGN", align-1, nil, 1) -- Action byte is 2**n-1.
+ return
+ end
+ end
+ end
+ werror("bad alignment")
+end
+
+------------------------------------------------------------------------------
+
+-- Pseudo-opcode for (primitive) type definitions (map to C types).
+map_op[".type_3"] = function(params, nparams)
+ if not params then
+ return nparams == 2 and "name, ctype" or "name, ctype, reg"
+ end
+ local name, ctype, reg = params[1], params[2], params[3]
+ if not match(name, "^[%a_][%w_]*$") then
+ werror("bad type name `"..name.."'")
+ end
+ local tp = map_type[name]
+ if tp then
+ werror("duplicate type `"..name.."'")
+ end
+ -- Add #type to defines. A bit unclean to put it in map_archdef.
+ map_archdef["#"..name] = "sizeof("..ctype..")"
+ -- Add new type and emit shortcut define.
+ local num = ctypenum + 1
+ map_type[name] = {
+ ctype = ctype,
+ ctypefmt = format("Dt%X(%%s)", num),
+ reg = reg,
+ }
+ wline(format("#define Dt%X(_V) (int)(ptrdiff_t)&(((%s *)0)_V)", num, ctype))
+ ctypenum = num
+end
+map_op[".type_2"] = map_op[".type_3"]
+
+-- Dump type definitions.
+local function dumptypes(out, lvl)
+ local t = {}
+ for name in pairs(map_type) do t[#t+1] = name end
+ sort(t)
+ out:write("Type definitions:\n")
+ for _,name in ipairs(t) do
+ local tp = map_type[name]
+ local reg = tp.reg or ""
+ out:write(format(" %-20s %-20s %s\n", name, tp.ctype, reg))
+ end
+ out:write("\n")
+end
+
+------------------------------------------------------------------------------
+
+-- Set the current section.
+function _M.section(num)
+ waction("SECTION", num)
+ wflush(true) -- SECTION is a terminal action.
+end
+
+------------------------------------------------------------------------------
+
+-- Dump architecture description.
+function _M.dumparch(out)
+ out:write(format("DynASM %s version %s, released %s\n\n",
+ _info.arch, _info.version, _info.release))
+ dumpactions(out)
+end
+
+-- Dump all user defined elements.
+function _M.dumpdef(out, lvl)
+ dumptypes(out, lvl)
+ dumpglobals(out, lvl)
+ dumpexterns(out, lvl)
+end
+
+------------------------------------------------------------------------------
+
+-- Pass callbacks from/to the DynASM core.
+function _M.passcb(wl, we, wf, ww)
+ wline, werror, wfatal, wwarn = wl, we, wf, ww
+ return wflush
+end
+
+-- Setup the arch-specific module.
+function _M.setup(arch, opt)
+ g_arch, g_opt = arch, opt
+end
+
+-- Merge the core maps and the arch-specific maps.
+function _M.mergemaps(map_coreop, map_def)
+ setmetatable(map_op, { __index = map_coreop })
+ setmetatable(map_def, { __index = map_archdef })
+ return map_op, map_def
+end
+
+return _M
+
+------------------------------------------------------------------------------
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_proto.h b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_proto.h
new file mode 100644
index 00000000000..dc9ed51067f
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_proto.h
@@ -0,0 +1,83 @@
+/*
+** DynASM encoding engine prototypes.
+** Copyright (C) 2005-2011 Mike Pall. All rights reserved.
+** Released under the MIT/X license. See dynasm.lua for full copyright notice.
+*/
+
+#ifndef _DASM_PROTO_H
+#define _DASM_PROTO_H
+
+#include <stddef.h>
+#include <stdarg.h>
+
+#define DASM_IDENT "DynASM 1.3.0"
+#define DASM_VERSION 10300 /* 1.3.0 */
+
+#ifndef Dst_DECL
+#define Dst_DECL dasm_State **Dst
+#endif
+
+#ifndef Dst_REF
+#define Dst_REF (*Dst)
+#endif
+
+#ifndef DASM_FDEF
+#define DASM_FDEF extern
+#endif
+
+#ifndef DASM_M_GROW
+#define DASM_M_GROW(ctx, t, p, sz, need) \
+ do { \
+ size_t _sz = (sz), _need = (need); \
+ if (_sz < _need) { \
+ if (_sz < 16) _sz = 16; \
+ while (_sz < _need) _sz += _sz; \
+ (p) = (t *)realloc((p), _sz); \
+ if ((p) == NULL) exit(1); \
+ (sz) = _sz; \
+ } \
+ } while(0)
+#endif
+
+#ifndef DASM_M_FREE
+#define DASM_M_FREE(ctx, p, sz) free(p)
+#endif
+
+/* Internal DynASM encoder state. */
+typedef struct dasm_State dasm_State;
+
+
+/* Initialize and free DynASM state. */
+DASM_FDEF void dasm_init(Dst_DECL, int maxsection);
+DASM_FDEF void dasm_free(Dst_DECL);
+
+/* Setup global array. Must be called before dasm_setup(). */
+DASM_FDEF void dasm_setupglobal(Dst_DECL, void **gl, unsigned int maxgl);
+
+/* Grow PC label array. Can be called after dasm_setup(), too. */
+DASM_FDEF void dasm_growpc(Dst_DECL, unsigned int maxpc);
+
+/* Setup encoder. */
+DASM_FDEF void dasm_setup(Dst_DECL, const void *actionlist);
+
+/* Feed encoder with actions. Calls are generated by pre-processor. */
+DASM_FDEF void dasm_put(Dst_DECL, int start, ...);
+
+/* Link sections and return the resulting size. */
+DASM_FDEF int dasm_link(Dst_DECL, size_t *szp);
+
+/* Encode sections into buffer. */
+DASM_FDEF int dasm_encode(Dst_DECL, void *buffer);
+
+/* Get PC label offset. */
+DASM_FDEF int dasm_getpclabel(Dst_DECL, unsigned int pc);
+
+#ifdef DASM_CHECKS
+/* Optional sanity checker to call between isolated encoding steps. */
+DASM_FDEF int dasm_checkstep(Dst_DECL, int secmatch);
+#else
+#define dasm_checkstep(a, b) 0
+#endif
+
+
+#endif /* _DASM_PROTO_H */
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x64.lua b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x64.lua
new file mode 100644
index 00000000000..73e01e919ac
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x64.lua
@@ -0,0 +1,12 @@
+------------------------------------------------------------------------------
+-- DynASM x64 module.
+--
+-- Copyright (C) 2005-2011 Mike Pall. All rights reserved.
+-- See dynasm.lua for full copyright notice.
+------------------------------------------------------------------------------
+-- This module just sets 64 bit mode for the combined x86/x64 module.
+-- All the interesting stuff is there.
+------------------------------------------------------------------------------
+
+x64 = true -- Using a global is an ugly, but effective solution.
+return require("dasm_x86")
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x86.h b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x86.h
new file mode 100644
index 00000000000..23e213cb6e6
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x86.h
@@ -0,0 +1,470 @@
+/*
+** DynASM x86 encoding engine.
+** Copyright (C) 2005-2011 Mike Pall. All rights reserved.
+** Released under the MIT/X license. See dynasm.lua for full copyright notice.
+*/
+
+#include <stddef.h>
+#include <stdarg.h>
+#include <string.h>
+#include <stdlib.h>
+
+#define DASM_ARCH "x86"
+
+#ifndef DASM_EXTERN
+#define DASM_EXTERN(a,b,c,d) 0
+#endif
+
+/* Action definitions. DASM_STOP must be 255. */
+enum {
+ DASM_DISP = 233,
+ DASM_IMM_S, DASM_IMM_B, DASM_IMM_W, DASM_IMM_D, DASM_IMM_WB, DASM_IMM_DB,
+ DASM_VREG, DASM_SPACE, DASM_SETLABEL, DASM_REL_A, DASM_REL_LG, DASM_REL_PC,
+ DASM_IMM_LG, DASM_IMM_PC, DASM_LABEL_LG, DASM_LABEL_PC, DASM_ALIGN,
+ DASM_EXTERN, DASM_ESC, DASM_MARK, DASM_SECTION, DASM_STOP
+};
+
+/* Maximum number of section buffer positions for a single dasm_put() call. */
+#define DASM_MAXSECPOS 25
+
+/* DynASM encoder status codes. Action list offset or number are or'ed in. */
+#define DASM_S_OK 0x00000000
+#define DASM_S_NOMEM 0x01000000
+#define DASM_S_PHASE 0x02000000
+#define DASM_S_MATCH_SEC 0x03000000
+#define DASM_S_RANGE_I 0x11000000
+#define DASM_S_RANGE_SEC 0x12000000
+#define DASM_S_RANGE_LG 0x13000000
+#define DASM_S_RANGE_PC 0x14000000
+#define DASM_S_RANGE_VREG 0x15000000
+#define DASM_S_UNDEF_L 0x21000000
+#define DASM_S_UNDEF_PC 0x22000000
+
+/* Macros to convert positions (8 bit section + 24 bit index). */
+#define DASM_POS2IDX(pos) ((pos)&0x00ffffff)
+#define DASM_POS2BIAS(pos) ((pos)&0xff000000)
+#define DASM_SEC2POS(sec) ((sec)<<24)
+#define DASM_POS2SEC(pos) ((pos)>>24)
+#define DASM_POS2PTR(D, pos) (D->sections[DASM_POS2SEC(pos)].rbuf + (pos))
+
+/* Action list type. */
+typedef const unsigned char *dasm_ActList;
+
+/* Per-section structure. */
+typedef struct dasm_Section {
+ int *rbuf; /* Biased buffer pointer (negative section bias). */
+ int *buf; /* True buffer pointer. */
+ size_t bsize; /* Buffer size in bytes. */
+ int pos; /* Biased buffer position. */
+ int epos; /* End of biased buffer position - max single put. */
+ int ofs; /* Byte offset into section. */
+} dasm_Section;
+
+/* Core structure holding the DynASM encoding state. */
+struct dasm_State {
+ size_t psize; /* Allocated size of this structure. */
+ dasm_ActList actionlist; /* Current actionlist pointer. */
+ int *lglabels; /* Local/global chain/pos ptrs. */
+ size_t lgsize;
+ int *pclabels; /* PC label chains/pos ptrs. */
+ size_t pcsize;
+ void **globals; /* Array of globals (bias -10). */
+ dasm_Section *section; /* Pointer to active section. */
+ size_t codesize; /* Total size of all code sections. */
+ int maxsection; /* 0 <= sectionidx < maxsection. */
+ int status; /* Status code. */
+ dasm_Section sections[1]; /* All sections. Alloc-extended. */
+};
+
+/* The size of the core structure depends on the max. number of sections. */
+#define DASM_PSZ(ms) (sizeof(dasm_State)+(ms-1)*sizeof(dasm_Section))
+
+
+/* Initialize DynASM state. */
+void dasm_init(Dst_DECL, int maxsection)
+{
+ dasm_State *D;
+ size_t psz = 0;
+ int i;
+ Dst_REF = NULL;
+ DASM_M_GROW(Dst, struct dasm_State, Dst_REF, psz, DASM_PSZ(maxsection));
+ D = Dst_REF;
+ D->psize = psz;
+ D->lglabels = NULL;
+ D->lgsize = 0;
+ D->pclabels = NULL;
+ D->pcsize = 0;
+ D->globals = NULL;
+ D->maxsection = maxsection;
+ for (i = 0; i < maxsection; i++) {
+ D->sections[i].buf = NULL; /* Need this for pass3. */
+ D->sections[i].rbuf = D->sections[i].buf - DASM_SEC2POS(i);
+ D->sections[i].bsize = 0;
+ D->sections[i].epos = 0; /* Wrong, but is recalculated after resize. */
+ }
+}
+
+/* Free DynASM state. */
+void dasm_free(Dst_DECL)
+{
+ dasm_State *D = Dst_REF;
+ int i;
+ for (i = 0; i < D->maxsection; i++)
+ if (D->sections[i].buf)
+ DASM_M_FREE(Dst, D->sections[i].buf, D->sections[i].bsize);
+ if (D->pclabels) DASM_M_FREE(Dst, D->pclabels, D->pcsize);
+ if (D->lglabels) DASM_M_FREE(Dst, D->lglabels, D->lgsize);
+ DASM_M_FREE(Dst, D, D->psize);
+}
+
+/* Setup global label array. Must be called before dasm_setup(). */
+void dasm_setupglobal(Dst_DECL, void **gl, unsigned int maxgl)
+{
+ dasm_State *D = Dst_REF;
+ D->globals = gl - 10; /* Negative bias to compensate for locals. */
+ DASM_M_GROW(Dst, int, D->lglabels, D->lgsize, (10+maxgl)*sizeof(int));
+}
+
+/* Grow PC label array. Can be called after dasm_setup(), too. */
+void dasm_growpc(Dst_DECL, unsigned int maxpc)
+{
+ dasm_State *D = Dst_REF;
+ size_t osz = D->pcsize;
+ DASM_M_GROW(Dst, int, D->pclabels, D->pcsize, maxpc*sizeof(int));
+ memset((void *)(((unsigned char *)D->pclabels)+osz), 0, D->pcsize-osz);
+}
+
+/* Setup encoder. */
+void dasm_setup(Dst_DECL, const void *actionlist)
+{
+ dasm_State *D = Dst_REF;
+ int i;
+ D->actionlist = (dasm_ActList)actionlist;
+ D->status = DASM_S_OK;
+ D->section = &D->sections[0];
+ memset((void *)D->lglabels, 0, D->lgsize);
+ if (D->pclabels) memset((void *)D->pclabels, 0, D->pcsize);
+ for (i = 0; i < D->maxsection; i++) {
+ D->sections[i].pos = DASM_SEC2POS(i);
+ D->sections[i].ofs = 0;
+ }
+}
+
+
+#ifdef DASM_CHECKS
+#define CK(x, st) \
+ do { if (!(x)) { \
+ D->status = DASM_S_##st|(int)(p-D->actionlist-1); return; } } while (0)
+#define CKPL(kind, st) \
+ do { if ((size_t)((char *)pl-(char *)D->kind##labels) >= D->kind##size) { \
+ D->status=DASM_S_RANGE_##st|(int)(p-D->actionlist-1); return; } } while (0)
+#else
+#define CK(x, st) ((void)0)
+#define CKPL(kind, st) ((void)0)
+#endif
+
+/* Pass 1: Store actions and args, link branches/labels, estimate offsets. */
+void dasm_put(Dst_DECL, int start, ...)
+{
+ va_list ap;
+ dasm_State *D = Dst_REF;
+ dasm_ActList p = D->actionlist + start;
+ dasm_Section *sec = D->section;
+ int pos = sec->pos, ofs = sec->ofs, mrm = 4;
+ int *b;
+
+ if (pos >= sec->epos) {
+ DASM_M_GROW(Dst, int, sec->buf, sec->bsize,
+ sec->bsize + 2*DASM_MAXSECPOS*sizeof(int));
+ sec->rbuf = sec->buf - DASM_POS2BIAS(pos);
+ sec->epos = (int)sec->bsize/sizeof(int) - DASM_MAXSECPOS+DASM_POS2BIAS(pos);
+ }
+
+ b = sec->rbuf;
+ b[pos++] = start;
+
+ va_start(ap, start);
+ while (1) {
+ int action = *p++;
+ if (action < DASM_DISP) {
+ ofs++;
+ } else if (action <= DASM_REL_A) {
+ int n = va_arg(ap, int);
+ b[pos++] = n;
+ switch (action) {
+ case DASM_DISP:
+ if (n == 0) { if ((mrm&7) == 4) mrm = p[-2]; if ((mrm&7) != 5) break; }
+ case DASM_IMM_DB: if (((n+128)&-256) == 0) goto ob;
+ case DASM_REL_A: /* Assumes ptrdiff_t is int. !x64 */
+ case DASM_IMM_D: ofs += 4; break;
+ case DASM_IMM_S: CK(((n+128)&-256) == 0, RANGE_I); goto ob;
+ case DASM_IMM_B: CK((n&-256) == 0, RANGE_I); ob: ofs++; break;
+ case DASM_IMM_WB: if (((n+128)&-256) == 0) goto ob;
+ case DASM_IMM_W: CK((n&-65536) == 0, RANGE_I); ofs += 2; break;
+ case DASM_SPACE: p++; ofs += n; break;
+ case DASM_SETLABEL: b[pos-2] = -0x40000000; break; /* Neg. label ofs. */
+ case DASM_VREG: CK((n&-8) == 0 && (n != 4 || (*p&1) == 0), RANGE_VREG);
+ if (*p++ == 1 && *p == DASM_DISP) mrm = n; continue;
+ }
+ mrm = 4;
+ } else {
+ int *pl, n;
+ switch (action) {
+ case DASM_REL_LG:
+ case DASM_IMM_LG:
+ n = *p++; pl = D->lglabels + n;
+ if (n <= 246) { CKPL(lg, LG); goto putrel; } /* Bkwd rel or global. */
+ pl -= 246; n = *pl;
+ if (n < 0) n = 0; /* Start new chain for fwd rel if label exists. */
+ goto linkrel;
+ case DASM_REL_PC:
+ case DASM_IMM_PC: pl = D->pclabels + va_arg(ap, int); CKPL(pc, PC);
+ putrel:
+ n = *pl;
+ if (n < 0) { /* Label exists. Get label pos and store it. */
+ b[pos] = -n;
+ } else {
+ linkrel:
+ b[pos] = n; /* Else link to rel chain, anchored at label. */
+ *pl = pos;
+ }
+ pos++;
+ ofs += 4; /* Maximum offset needed. */
+ if (action == DASM_REL_LG || action == DASM_REL_PC)
+ b[pos++] = ofs; /* Store pass1 offset estimate. */
+ break;
+ case DASM_LABEL_LG: pl = D->lglabels + *p++; CKPL(lg, LG); goto putlabel;
+ case DASM_LABEL_PC: pl = D->pclabels + va_arg(ap, int); CKPL(pc, PC);
+ putlabel:
+ n = *pl; /* n > 0: Collapse rel chain and replace with label pos. */
+ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = pos; }
+ *pl = -pos; /* Label exists now. */
+ b[pos++] = ofs; /* Store pass1 offset estimate. */
+ break;
+ case DASM_ALIGN:
+ ofs += *p++; /* Maximum alignment needed (arg is 2**n-1). */
+ b[pos++] = ofs; /* Store pass1 offset estimate. */
+ break;
+ case DASM_EXTERN: p += 2; ofs += 4; break;
+ case DASM_ESC: p++; ofs++; break;
+ case DASM_MARK: mrm = p[-2]; break;
+ case DASM_SECTION:
+ n = *p; CK(n < D->maxsection, RANGE_SEC); D->section = &D->sections[n];
+ case DASM_STOP: goto stop;
+ }
+ }
+ }
+stop:
+ va_end(ap);
+ sec->pos = pos;
+ sec->ofs = ofs;
+}
+#undef CK
+
+/* Pass 2: Link sections, shrink branches/aligns, fix label offsets. */
+int dasm_link(Dst_DECL, size_t *szp)
+{
+ dasm_State *D = Dst_REF;
+ int secnum;
+ int ofs = 0;
+
+#ifdef DASM_CHECKS
+ *szp = 0;
+ if (D->status != DASM_S_OK) return D->status;
+ {
+ int pc;
+ for (pc = 0; pc*sizeof(int) < D->pcsize; pc++)
+ if (D->pclabels[pc] > 0) return DASM_S_UNDEF_PC|pc;
+ }
+#endif
+
+ { /* Handle globals not defined in this translation unit. */
+ int idx;
+ for (idx = 10; idx*sizeof(int) < D->lgsize; idx++) {
+ int n = D->lglabels[idx];
+ /* Undefined label: Collapse rel chain and replace with marker (< 0). */
+ while (n > 0) { int *pb = DASM_POS2PTR(D, n); n = *pb; *pb = -idx; }
+ }
+ }
+
+ /* Combine all code sections. No support for data sections (yet). */
+ for (secnum = 0; secnum < D->maxsection; secnum++) {
+ dasm_Section *sec = D->sections + secnum;
+ int *b = sec->rbuf;
+ int pos = DASM_SEC2POS(secnum);
+ int lastpos = sec->pos;
+
+ while (pos != lastpos) {
+ dasm_ActList p = D->actionlist + b[pos++];
+ while (1) {
+ int op, action = *p++;
+ switch (action) {
+ case DASM_REL_LG: p++; op = p[-3]; goto rel_pc;
+ case DASM_REL_PC: op = p[-2]; rel_pc: {
+ int shrink = op == 0xe9 ? 3 : ((op&0xf0) == 0x80 ? 4 : 0);
+ if (shrink) { /* Shrinkable branch opcode? */
+ int lofs, lpos = b[pos];
+ if (lpos < 0) goto noshrink; /* Ext global? */
+ lofs = *DASM_POS2PTR(D, lpos);
+ if (lpos > pos) { /* Fwd label: add cumulative section offsets. */
+ int i;
+ for (i = secnum; i < DASM_POS2SEC(lpos); i++)
+ lofs += D->sections[i].ofs;
+ } else {
+ lofs -= ofs; /* Bkwd label: unfix offset. */
+ }
+ lofs -= b[pos+1]; /* Short branch ok? */
+ if (lofs >= -128-shrink && lofs <= 127) ofs -= shrink; /* Yes. */
+ else { noshrink: shrink = 0; } /* No, cannot shrink op. */
+ }
+ b[pos+1] = shrink;
+ pos += 2;
+ break;
+ }
+ case DASM_SPACE: case DASM_IMM_LG: case DASM_VREG: p++;
+ case DASM_DISP: case DASM_IMM_S: case DASM_IMM_B: case DASM_IMM_W:
+ case DASM_IMM_D: case DASM_IMM_WB: case DASM_IMM_DB:
+ case DASM_SETLABEL: case DASM_REL_A: case DASM_IMM_PC: pos++; break;
+ case DASM_LABEL_LG: p++;
+ case DASM_LABEL_PC: b[pos++] += ofs; break; /* Fix label offset. */
+ case DASM_ALIGN: ofs -= (b[pos++]+ofs)&*p++; break; /* Adjust ofs. */
+ case DASM_EXTERN: p += 2; break;
+ case DASM_ESC: p++; break;
+ case DASM_MARK: break;
+ case DASM_SECTION: case DASM_STOP: goto stop;
+ }
+ }
+ stop: (void)0;
+ }
+ ofs += sec->ofs; /* Next section starts right after current section. */
+ }
+
+ D->codesize = ofs; /* Total size of all code sections */
+ *szp = ofs;
+ return DASM_S_OK;
+}
+
+#define dasmb(x) *cp++ = (unsigned char)(x)
+#ifndef DASM_ALIGNED_WRITES
+#define dasmw(x) \
+ do { *((unsigned short *)cp) = (unsigned short)(x); cp+=2; } while (0)
+#define dasmd(x) \
+ do { *((unsigned int *)cp) = (unsigned int)(x); cp+=4; } while (0)
+#else
+#define dasmw(x) do { dasmb(x); dasmb((x)>>8); } while (0)
+#define dasmd(x) do { dasmw(x); dasmw((x)>>16); } while (0)
+#endif
+
+/* Pass 3: Encode sections. */
+int dasm_encode(Dst_DECL, void *buffer)
+{
+ dasm_State *D = Dst_REF;
+ unsigned char *base = (unsigned char *)buffer;
+ unsigned char *cp = base;
+ int secnum;
+
+ /* Encode all code sections. No support for data sections (yet). */
+ for (secnum = 0; secnum < D->maxsection; secnum++) {
+ dasm_Section *sec = D->sections + secnum;
+ int *b = sec->buf;
+ int *endb = sec->rbuf + sec->pos;
+
+ while (b != endb) {
+ dasm_ActList p = D->actionlist + *b++;
+ unsigned char *mark = NULL;
+ while (1) {
+ int action = *p++;
+ int n = (action >= DASM_DISP && action <= DASM_ALIGN) ? *b++ : 0;
+ switch (action) {
+ case DASM_DISP: if (!mark) mark = cp; {
+ unsigned char *mm = mark;
+ if (*p != DASM_IMM_DB && *p != DASM_IMM_WB) mark = NULL;
+ if (n == 0) { int mrm = mm[-1]&7; if (mrm == 4) mrm = mm[0]&7;
+ if (mrm != 5) { mm[-1] -= 0x80; break; } }
+ if (((n+128) & -256) != 0) goto wd; else mm[-1] -= 0x40;
+ }
+ case DASM_IMM_S: case DASM_IMM_B: wb: dasmb(n); break;
+ case DASM_IMM_DB: if (((n+128)&-256) == 0) {
+ db: if (!mark) mark = cp; mark[-2] += 2; mark = NULL; goto wb;
+ } else mark = NULL;
+ case DASM_IMM_D: wd: dasmd(n); break;
+ case DASM_IMM_WB: if (((n+128)&-256) == 0) goto db; else mark = NULL;
+ case DASM_IMM_W: dasmw(n); break;
+ case DASM_VREG: { int t = *p++; if (t >= 2) n<<=3; cp[-1] |= n; break; }
+ case DASM_REL_LG: p++; if (n >= 0) goto rel_pc;
+ b++; n = (int)(ptrdiff_t)D->globals[-n];
+ case DASM_REL_A: rel_a: n -= (int)(ptrdiff_t)(cp+4); goto wd; /* !x64 */
+ case DASM_REL_PC: rel_pc: {
+ int shrink = *b++;
+ int *pb = DASM_POS2PTR(D, n); if (*pb < 0) { n = pb[1]; goto rel_a; }
+ n = *pb - ((int)(cp-base) + 4-shrink);
+ if (shrink == 0) goto wd;
+ if (shrink == 4) { cp--; cp[-1] = *cp-0x10; } else cp[-1] = 0xeb;
+ goto wb;
+ }
+ case DASM_IMM_LG:
+ p++; if (n < 0) { n = (int)(ptrdiff_t)D->globals[-n]; goto wd; }
+ case DASM_IMM_PC: {
+ int *pb = DASM_POS2PTR(D, n);
+ n = *pb < 0 ? pb[1] : (*pb + (int)(ptrdiff_t)base);
+ goto wd;
+ }
+ case DASM_LABEL_LG: {
+ int idx = *p++;
+ if (idx >= 10)
+ D->globals[idx] = (void *)(base + (*p == DASM_SETLABEL ? *b : n));
+ break;
+ }
+ case DASM_LABEL_PC: case DASM_SETLABEL: break;
+ case DASM_SPACE: { int fill = *p++; while (n--) *cp++ = fill; break; }
+ case DASM_ALIGN:
+ n = *p++;
+ while (((cp-base) & n)) *cp++ = 0x90; /* nop */
+ break;
+ case DASM_EXTERN: n = DASM_EXTERN(Dst, cp, p[1], *p); p += 2; goto wd;
+ case DASM_MARK: mark = cp; break;
+ case DASM_ESC: action = *p++;
+ default: *cp++ = action; break;
+ case DASM_SECTION: case DASM_STOP: goto stop;
+ }
+ }
+ stop: (void)0;
+ }
+ }
+
+ if (base + D->codesize != cp) /* Check for phase errors. */
+ return DASM_S_PHASE;
+ return DASM_S_OK;
+}
+
+/* Get PC label offset. */
+int dasm_getpclabel(Dst_DECL, unsigned int pc)
+{
+ dasm_State *D = Dst_REF;
+ if (pc*sizeof(int) < D->pcsize) {
+ int pos = D->pclabels[pc];
+ if (pos < 0) return *DASM_POS2PTR(D, -pos);
+ if (pos > 0) return -1; /* Undefined. */
+ }
+ return -2; /* Unused or out of range. */
+}
+
+#ifdef DASM_CHECKS
+/* Optional sanity checker to call between isolated encoding steps. */
+int dasm_checkstep(Dst_DECL, int secmatch)
+{
+ dasm_State *D = Dst_REF;
+ if (D->status == DASM_S_OK) {
+ int i;
+ for (i = 1; i <= 9; i++) {
+ if (D->lglabels[i] > 0) { D->status = DASM_S_UNDEF_L|i; break; }
+ D->lglabels[i] = 0;
+ }
+ }
+ if (D->status == DASM_S_OK && secmatch >= 0 &&
+ D->section != &D->sections[secmatch])
+ D->status = DASM_S_MATCH_SEC|(int)(D->section-D->sections);
+ return D->status;
+}
+#endif
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x86.lua b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x86.lua
new file mode 100644
index 00000000000..f5c8c5208d7
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dasm_x86.lua
@@ -0,0 +1,1931 @@
+------------------------------------------------------------------------------
+-- DynASM x86/x64 module.
+--
+-- Copyright (C) 2005-2011 Mike Pall. All rights reserved.
+-- See dynasm.lua for full copyright notice.
+------------------------------------------------------------------------------
+
+local x64 = x64
+
+-- Module information:
+local _info = {
+ arch = x64 and "x64" or "x86",
+ description = "DynASM x86/x64 module",
+ version = "1.3.0",
+ vernum = 10300,
+ release = "2011-05-05",
+ author = "Mike Pall",
+ license = "MIT",
+}
+
+-- Exported glue functions for the arch-specific module.
+local _M = { _info = _info }
+
+-- Cache library functions.
+local type, tonumber, pairs, ipairs = type, tonumber, pairs, ipairs
+local assert, unpack, setmetatable = assert, unpack or table.unpack, setmetatable
+local _s = string
+local sub, format, byte, char = _s.sub, _s.format, _s.byte, _s.char
+local find, match, gmatch, gsub = _s.find, _s.match, _s.gmatch, _s.gsub
+local concat, sort = table.concat, table.sort
+
+-- Inherited tables and callbacks.
+local g_opt, g_arch
+local wline, werror, wfatal, wwarn
+
+-- Action name list.
+-- CHECK: Keep this in sync with the C code!
+local action_names = {
+ -- int arg, 1 buffer pos:
+ "DISP", "IMM_S", "IMM_B", "IMM_W", "IMM_D", "IMM_WB", "IMM_DB",
+ -- action arg (1 byte), int arg, 1 buffer pos (reg/num):
+ "VREG", "SPACE", -- !x64: VREG support NYI.
+ -- ptrdiff_t arg, 1 buffer pos (address): !x64
+ "SETLABEL", "REL_A",
+ -- action arg (1 byte) or int arg, 2 buffer pos (link, offset):
+ "REL_LG", "REL_PC",
+ -- action arg (1 byte) or int arg, 1 buffer pos (link):
+ "IMM_LG", "IMM_PC",
+ -- action arg (1 byte) or int arg, 1 buffer pos (offset):
+ "LABEL_LG", "LABEL_PC",
+ -- action arg (1 byte), 1 buffer pos (offset):
+ "ALIGN",
+ -- action args (2 bytes), no buffer pos.
+ "EXTERN",
+ -- action arg (1 byte), no buffer pos.
+ "ESC",
+ -- no action arg, no buffer pos.
+ "MARK",
+ -- action arg (1 byte), no buffer pos, terminal action:
+ "SECTION",
+ -- no args, no buffer pos, terminal action:
+ "STOP"
+}
+
+-- Maximum number of section buffer positions for dasm_put().
+-- CHECK: Keep this in sync with the C code!
+local maxsecpos = 25 -- Keep this low, to avoid excessively long C lines.
+
+-- Action name -> action number (dynamically generated below).
+local map_action = {}
+-- First action number. Everything below does not need to be escaped.
+local actfirst = 256-#action_names
+
+-- Action list buffer and string (only used to remove dupes).
+local actlist = {}
+local actstr = ""
+
+-- Argument list for next dasm_put(). Start with offset 0 into action list.
+local actargs = { 0 }
+
+-- Current number of section buffer positions for dasm_put().
+local secpos = 1
+
+------------------------------------------------------------------------------
+
+-- Compute action numbers for action names.
+for n,name in ipairs(action_names) do
+ local num = actfirst + n - 1
+ map_action[name] = num
+end
+
+-- Dump action names and numbers.
+local function dumpactions(out)
+ out:write("DynASM encoding engine action codes:\n")
+ for n,name in ipairs(action_names) do
+ local num = map_action[name]
+ out:write(format(" %-10s %02X %d\n", name, num, num))
+ end
+ out:write("\n")
+end
+
+-- Write action list buffer as a huge static C array.
+local function writeactions(out, name)
+ local nn = #actlist
+ local last = actlist[nn] or 255
+ actlist[nn] = nil -- Remove last byte.
+ if nn == 0 then nn = 1 end
+ out:write("static const unsigned char ", name, "[", nn, "] = {\n")
+ local s = " "
+ for n,b in ipairs(actlist) do
+ s = s..b..","
+ if #s >= 75 then
+ assert(out:write(s, "\n"))
+ s = " "
+ end
+ end
+ out:write(s, last, "\n};\n\n") -- Add last byte back.
+end
+
+------------------------------------------------------------------------------
+
+-- Add byte to action list.
+local function wputxb(n)
+ assert(n >= 0 and n <= 255 and n % 1 == 0, "byte out of range")
+ actlist[#actlist+1] = n
+end
+
+-- Add action to list with optional arg. Advance buffer pos, too.
+local function waction(action, a, num)
+ wputxb(assert(map_action[action], "bad action name `"..action.."'"))
+ if a then actargs[#actargs+1] = a end
+ if a or num then secpos = secpos + (num or 1) end
+end
+
+-- Add call to embedded DynASM C code.
+local function wcall(func, args)
+ wline(format("dasm_%s(Dst, %s);", func, concat(args, ", ")), true)
+end
+
+-- Delete duplicate action list chunks. A tad slow, but so what.
+local function dedupechunk(offset)
+ local al, as = actlist, actstr
+ local chunk = char(unpack(al, offset+1, #al))
+ local orig = find(as, chunk, 1, true)
+ if orig then
+ actargs[1] = orig-1 -- Replace with original offset.
+ for i=offset+1,#al do al[i] = nil end -- Kill dupe.
+ else
+ actstr = as..chunk
+ end
+end
+
+-- Flush action list (intervening C code or buffer pos overflow).
+local function wflush(term)
+ local offset = actargs[1]
+ if #actlist == offset then return end -- Nothing to flush.
+ if not term then waction("STOP") end -- Terminate action list.
+ dedupechunk(offset)
+ wcall("put", actargs) -- Add call to dasm_put().
+ actargs = { #actlist } -- Actionlist offset is 1st arg to next dasm_put().
+ secpos = 1 -- The actionlist offset occupies a buffer position, too.
+end
+
+-- Put escaped byte.
+local function wputb(n)
+ if n >= actfirst then waction("ESC") end -- Need to escape byte.
+ wputxb(n)
+end
+
+------------------------------------------------------------------------------
+
+-- Global label name -> global label number. With auto assignment on 1st use.
+local next_global = 10
+local map_global = setmetatable({}, { __index = function(t, name)
+ if not match(name, "^[%a_][%w_@]*$") then werror("bad global label") end
+ local n = next_global
+ if n > 246 then werror("too many global labels") end
+ next_global = n + 1
+ t[name] = n
+ return n
+end})
+
+-- Dump global labels.
+local function dumpglobals(out, lvl)
+ local t = {}
+ for name, n in pairs(map_global) do t[n] = name end
+ out:write("Global labels:\n")
+ for i=10,next_global-1 do
+ out:write(format(" %s\n", t[i]))
+ end
+ out:write("\n")
+end
+
+-- Write global label enum.
+local function writeglobals(out, prefix)
+ local t = {}
+ for name, n in pairs(map_global) do t[n] = name end
+ out:write("enum {\n")
+ for i=10,next_global-1 do
+ out:write(" ", prefix, gsub(t[i], "@.*", ""), ",\n")
+ end
+ out:write(" ", prefix, "_MAX\n};\n")
+end
+
+-- Write global label names.
+local function writeglobalnames(out, name)
+ local t = {}
+ for name, n in pairs(map_global) do t[n] = name end
+ out:write("static const char *const ", name, "[] = {\n")
+ for i=10,next_global-1 do
+ out:write(" \"", t[i], "\",\n")
+ end
+ out:write(" (const char *)0\n};\n")
+end
+
+------------------------------------------------------------------------------
+
+-- Extern label name -> extern label number. With auto assignment on 1st use.
+local next_extern = -1
+local map_extern = setmetatable({}, { __index = function(t, name)
+ -- No restrictions on the name for now.
+ local n = next_extern
+ if n < -256 then werror("too many extern labels") end
+ next_extern = n - 1
+ t[name] = n
+ return n
+end})
+
+-- Dump extern labels.
+local function dumpexterns(out, lvl)
+ local t = {}
+ for name, n in pairs(map_extern) do t[-n] = name end
+ out:write("Extern labels:\n")
+ for i=1,-next_extern-1 do
+ out:write(format(" %s\n", t[i]))
+ end
+ out:write("\n")
+end
+
+-- Write extern label names.
+local function writeexternnames(out, name)
+ local t = {}
+ for name, n in pairs(map_extern) do t[-n] = name end
+ out:write("static const char *const ", name, "[] = {\n")
+ for i=1,-next_extern-1 do
+ out:write(" \"", t[i], "\",\n")
+ end
+ out:write(" (const char *)0\n};\n")
+end
+
+------------------------------------------------------------------------------
+
+-- Arch-specific maps.
+local map_archdef = {} -- Ext. register name -> int. name.
+local map_reg_rev = {} -- Int. register name -> ext. name.
+local map_reg_num = {} -- Int. register name -> register number.
+local map_reg_opsize = {} -- Int. register name -> operand size.
+local map_reg_valid_base = {} -- Int. register name -> valid base register?
+local map_reg_valid_index = {} -- Int. register name -> valid index register?
+local map_reg_needrex = {} -- Int. register name -> need rex vs. no rex.
+local reg_list = {} -- Canonical list of int. register names.
+
+local map_type = {} -- Type name -> { ctype, reg }
+local ctypenum = 0 -- Type number (for _PTx macros).
+
+local addrsize = x64 and "q" or "d" -- Size for address operands.
+
+-- Helper functions to fill register maps.
+local function mkrmap(sz, cl, names)
+ local cname = format("@%s", sz)
+ reg_list[#reg_list+1] = cname
+ map_archdef[cl] = cname
+ map_reg_rev[cname] = cl
+ map_reg_num[cname] = -1
+ map_reg_opsize[cname] = sz
+ if sz == addrsize or sz == "d" then
+ map_reg_valid_base[cname] = true
+ map_reg_valid_index[cname] = true
+ end
+ if names then
+ for n,name in ipairs(names) do
+ local iname = format("@%s%x", sz, n-1)
+ reg_list[#reg_list+1] = iname
+ map_archdef[name] = iname
+ map_reg_rev[iname] = name
+ map_reg_num[iname] = n-1
+ map_reg_opsize[iname] = sz
+ if sz == "b" and n > 4 then map_reg_needrex[iname] = false end
+ if sz == addrsize or sz == "d" then
+ map_reg_valid_base[iname] = true
+ map_reg_valid_index[iname] = true
+ end
+ end
+ end
+ for i=0,(x64 and sz ~= "f") and 15 or 7 do
+ local needrex = sz == "b" and i > 3
+ local iname = format("@%s%x%s", sz, i, needrex and "R" or "")
+ if needrex then map_reg_needrex[iname] = true end
+ local name
+ if sz == "o" then name = format("xmm%d", i)
+ elseif sz == "f" then name = format("st%d", i)
+ else name = format("r%d%s", i, sz == addrsize and "" or sz) end
+ map_archdef[name] = iname
+ if not map_reg_rev[iname] then
+ reg_list[#reg_list+1] = iname
+ map_reg_rev[iname] = name
+ map_reg_num[iname] = i
+ map_reg_opsize[iname] = sz
+ if sz == addrsize or sz == "d" then
+ map_reg_valid_base[iname] = true
+ map_reg_valid_index[iname] = true
+ end
+ end
+ end
+ reg_list[#reg_list+1] = ""
+end
+
+-- Integer registers (qword, dword, word and byte sized).
+if x64 then
+ mkrmap("q", "Rq", {"rax", "rcx", "rdx", "rbx", "rsp", "rbp", "rsi", "rdi"})
+end
+mkrmap("d", "Rd", {"eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi"})
+mkrmap("w", "Rw", {"ax", "cx", "dx", "bx", "sp", "bp", "si", "di"})
+mkrmap("b", "Rb", {"al", "cl", "dl", "bl", "ah", "ch", "dh", "bh"})
+map_reg_valid_index[map_archdef.esp] = false
+if x64 then map_reg_valid_index[map_archdef.rsp] = false end
+map_archdef["Ra"] = "@"..addrsize
+
+-- FP registers (internally tword sized, but use "f" as operand size).
+mkrmap("f", "Rf")
+
+-- SSE registers (oword sized, but qword and dword accessible).
+mkrmap("o", "xmm")
+
+-- Operand size prefixes to codes.
+local map_opsize = {
+ byte = "b", word = "w", dword = "d", qword = "q", oword = "o", tword = "t",
+ aword = addrsize,
+}
+
+-- Operand size code to number.
+local map_opsizenum = {
+ b = 1, w = 2, d = 4, q = 8, o = 16, t = 10,
+}
+
+-- Operand size code to name.
+local map_opsizename = {
+ b = "byte", w = "word", d = "dword", q = "qword", o = "oword", t = "tword",
+ f = "fpword",
+}
+
+-- Valid index register scale factors.
+local map_xsc = {
+ ["1"] = 0, ["2"] = 1, ["4"] = 2, ["8"] = 3,
+}
+
+-- Condition codes.
+local map_cc = {
+ o = 0, no = 1, b = 2, nb = 3, e = 4, ne = 5, be = 6, nbe = 7,
+ s = 8, ns = 9, p = 10, np = 11, l = 12, nl = 13, le = 14, nle = 15,
+ c = 2, nae = 2, nc = 3, ae = 3, z = 4, nz = 5, na = 6, a = 7,
+ pe = 10, po = 11, nge = 12, ge = 13, ng = 14, g = 15,
+}
+
+
+-- Reverse defines for registers.
+function _M.revdef(s)
+ return gsub(s, "@%w+", map_reg_rev)
+end
+
+-- Dump register names and numbers
+local function dumpregs(out)
+ out:write("Register names, sizes and internal numbers:\n")
+ for _,reg in ipairs(reg_list) do
+ if reg == "" then
+ out:write("\n")
+ else
+ local name = map_reg_rev[reg]
+ local num = map_reg_num[reg]
+ local opsize = map_opsizename[map_reg_opsize[reg]]
+ out:write(format(" %-5s %-8s %s\n", name, opsize,
+ num < 0 and "(variable)" or num))
+ end
+ end
+end
+
+------------------------------------------------------------------------------
+
+-- Put action for label arg (IMM_LG, IMM_PC, REL_LG, REL_PC).
+local function wputlabel(aprefix, imm, num)
+ if type(imm) == "number" then
+ if imm < 0 then
+ waction("EXTERN")
+ wputxb(aprefix == "IMM_" and 0 or 1)
+ imm = -imm-1
+ else
+ waction(aprefix.."LG", nil, num);
+ end
+ wputxb(imm)
+ else
+ waction(aprefix.."PC", imm, num)
+ end
+end
+
+-- Put signed byte or arg.
+local function wputsbarg(n)
+ if type(n) == "number" then
+ if n < -128 or n > 127 then
+ werror("signed immediate byte out of range")
+ end
+ if n < 0 then n = n + 256 end
+ wputb(n)
+ else waction("IMM_S", n) end
+end
+
+-- Put unsigned byte or arg.
+local function wputbarg(n)
+ if type(n) == "number" then
+ if n < 0 or n > 255 then
+ werror("unsigned immediate byte out of range")
+ end
+ wputb(n)
+ else waction("IMM_B", n) end
+end
+
+-- Put unsigned word or arg.
+local function wputwarg(n)
+ if type(n) == "number" then
+ if n < 0 or n > 65535 then
+ werror("unsigned immediate word out of range")
+ end
+ local r = n%256; n = (n-r)/256; wputb(r); wputb(n);
+ else waction("IMM_W", n) end
+end
+
+-- Put signed or unsigned dword or arg.
+local function wputdarg(n)
+ local tn = type(n)
+ if tn == "number" then
+ if n < 0 then n = n + 4294967296 end
+ local r = n%256; n = (n-r)/256; wputb(r);
+ r = n%256; n = (n-r)/256; wputb(r);
+ r = n%256; n = (n-r)/256; wputb(r); wputb(n);
+ elseif tn == "table" then
+ wputlabel("IMM_", n[1], 1)
+ else
+ waction("IMM_D", n)
+ end
+end
+
+-- Put operand-size dependent number or arg (defaults to dword).
+local function wputszarg(sz, n)
+ if not sz or sz == "d" or sz == "q" then wputdarg(n)
+ elseif sz == "w" then wputwarg(n)
+ elseif sz == "b" then wputbarg(n)
+ elseif sz == "s" then wputsbarg(n)
+ else werror("bad operand size") end
+end
+
+-- Put multi-byte opcode with operand-size dependent modifications.
+local function wputop(sz, op, rex)
+ local r
+ if rex ~= 0 and not x64 then werror("bad operand size") end
+ if sz == "w" then wputb(102) end
+ -- Needs >32 bit numbers, but only for crc32 eax, word [ebx]
+ if op >= 4294967296 then r = op%4294967296 wputb((op-r)/4294967296) op = r end
+ if op >= 16777216 then r = op % 16777216 wputb((op-r) / 16777216) op = r end
+ if op >= 65536 then
+ if rex ~= 0 then
+ local opc3 = op - op % 256
+ if opc3 == 0x0f3a00 or opc3 == 0x0f3800 then
+ wputb(64 + rex % 16); rex = 0
+ end
+ end
+ r = op % 65536 wputb((op-r) / 65536) op = r
+ end
+ if op >= 256 then
+ r = op % 256
+ local b = (op-r) / 256
+ if b == 15 and rex ~= 0 then wputb(64 + rex % 16); rex = 0 end
+ wputb(b)
+ op = r
+ end
+ if rex ~= 0 then wputb(64 + rex % 16) end
+ if sz == "b" then op = op - 1 end
+ wputb(op)
+end
+
+-- Put ModRM or SIB formatted byte.
+local function wputmodrm(m, s, rm, vs, vrm)
+ assert(m < 4 and s < 16 and rm < 16, "bad modrm operands")
+ wputb(64*m + 8*(s%8) + (rm%8))
+end
+
+-- Put ModRM/SIB plus optional displacement.
+local function wputmrmsib(t, imark, s, vsreg)
+ local vreg, vxreg
+ local reg, xreg = t.reg, t.xreg
+ if reg and reg < 0 then reg = 0; vreg = t.vreg end
+ if xreg and xreg < 0 then xreg = 0; vxreg = t.vxreg end
+ if s < 0 then s = 0 end
+
+ -- Register mode.
+ if sub(t.mode, 1, 1) == "r" then
+ wputmodrm(3, s, reg)
+ if vsreg then waction("VREG", vsreg); wputxb(2) end
+ if vreg then waction("VREG", vreg); wputxb(0) end
+ return
+ end
+
+ local disp = t.disp
+ local tdisp = type(disp)
+ -- No base register?
+ if not reg then
+ local riprel = false
+ if xreg then
+ -- Indexed mode with index register only.
+ -- [xreg*xsc+disp] -> (0, s, esp) (xsc, xreg, ebp)
+ wputmodrm(0, s, 4)
+ if imark == "I" then waction("MARK") end
+ if vsreg then waction("VREG", vsreg); wputxb(2) end
+ wputmodrm(t.xsc, xreg, 5)
+ if vxreg then waction("VREG", vxreg); wputxb(3) end
+ else
+ -- Pure 32 bit displacement.
+ if x64 and tdisp ~= "table" then
+ wputmodrm(0, s, 4) -- [disp] -> (0, s, esp) (0, esp, ebp)
+ if imark == "I" then waction("MARK") end
+ wputmodrm(0, 4, 5)
+ else
+ riprel = x64
+ wputmodrm(0, s, 5) -- [disp|rip-label] -> (0, s, ebp)
+ if imark == "I" then waction("MARK") end
+ end
+ if vsreg then waction("VREG", vsreg); wputxb(2) end
+ end
+ if riprel then -- Emit rip-relative displacement.
+ if match("UWSiI", imark) then
+ werror("NYI: rip-relative displacement followed by immediate")
+ end
+ -- The previous byte in the action buffer cannot be 0xe9 or 0x80-0x8f.
+ wputlabel("REL_", disp[1], 2)
+ else
+ wputdarg(disp)
+ end
+ return
+ end
+
+ local m
+ if tdisp == "number" then -- Check displacement size at assembly time.
+ if disp == 0 and (reg%8) ~= 5 then -- [ebp] -> [ebp+0] (in SIB, too)
+ if not vreg then m = 0 end -- Force DISP to allow [Rd(5)] -> [ebp+0]
+ elseif disp >= -128 and disp <= 127 then m = 1
+ else m = 2 end
+ elseif tdisp == "table" then
+ m = 2
+ end
+
+ -- Index register present or esp as base register: need SIB encoding.
+ if xreg or (reg%8) == 4 then
+ wputmodrm(m or 2, s, 4) -- ModRM.
+ if m == nil or imark == "I" then waction("MARK") end
+ if vsreg then waction("VREG", vsreg); wputxb(2) end
+ wputmodrm(t.xsc or 0, xreg or 4, reg) -- SIB.
+ if vxreg then waction("VREG", vxreg); wputxb(3) end
+ if vreg then waction("VREG", vreg); wputxb(1) end
+ else
+ wputmodrm(m or 2, s, reg) -- ModRM.
+ if (imark == "I" and (m == 1 or m == 2)) or
+ (m == nil and (vsreg or vreg)) then waction("MARK") end
+ if vsreg then waction("VREG", vsreg); wputxb(2) end
+ if vreg then waction("VREG", vreg); wputxb(1) end
+ end
+
+ -- Put displacement.
+ if m == 1 then wputsbarg(disp)
+ elseif m == 2 then wputdarg(disp)
+ elseif m == nil then waction("DISP", disp) end
+end
+
+------------------------------------------------------------------------------
+
+-- Return human-readable operand mode string.
+local function opmodestr(op, args)
+ local m = {}
+ for i=1,#args do
+ local a = args[i]
+ m[#m+1] = sub(a.mode, 1, 1)..(a.opsize or "?")
+ end
+ return op.." "..concat(m, ",")
+end
+
+-- Convert number to valid integer or nil.
+local function toint(expr)
+ local n = tonumber(expr)
+ if n then
+ if n % 1 ~= 0 or n < -2147483648 or n > 4294967295 then
+ werror("bad integer number `"..expr.."'")
+ end
+ return n
+ end
+end
+
+-- Parse immediate expression.
+local function immexpr(expr)
+ -- &expr (pointer)
+ if sub(expr, 1, 1) == "&" then
+ return "iPJ", format("(ptrdiff_t)(%s)", sub(expr,2))
+ end
+
+ local prefix = sub(expr, 1, 2)
+ -- =>expr (pc label reference)
+ if prefix == "=>" then
+ return "iJ", sub(expr, 3)
+ end
+ -- ->name (global label reference)
+ if prefix == "->" then
+ return "iJ", map_global[sub(expr, 3)]
+ end
+
+ -- [<>][1-9] (local label reference)
+ local dir, lnum = match(expr, "^([<>])([1-9])$")
+ if dir then -- Fwd: 247-255, Bkwd: 1-9.
+ return "iJ", lnum + (dir == ">" and 246 or 0)
+ end
+
+ local extname = match(expr, "^extern%s+(%S+)$")
+ if extname then
+ return "iJ", map_extern[extname]
+ end
+
+ -- expr (interpreted as immediate)
+ return "iI", expr
+end
+
+-- Parse displacement expression: +-num, +-expr, +-opsize*num
+local function dispexpr(expr)
+ local disp = expr == "" and 0 or toint(expr)
+ if disp then return disp end
+ local c, dispt = match(expr, "^([+-])%s*(.+)$")
+ if c == "+" then
+ expr = dispt
+ elseif not c then
+ werror("bad displacement expression `"..expr.."'")
+ end
+ local opsize, tailops = match(dispt, "^(%w+)%s*%*%s*(.+)$")
+ local ops, imm = map_opsize[opsize], toint(tailops)
+ if ops and imm then
+ if c == "-" then imm = -imm end
+ return imm*map_opsizenum[ops]
+ end
+ local mode, iexpr = immexpr(dispt)
+ if mode == "iJ" then
+ if c == "-" then werror("cannot invert label reference") end
+ return { iexpr }
+ end
+ return expr -- Need to return original signed expression.
+end
+
+-- Parse register or type expression.
+local function rtexpr(expr)
+ if not expr then return end
+ local tname, ovreg = match(expr, "^([%w_]+):(@[%w_]+)$")
+ local tp = map_type[tname or expr]
+ if tp then
+ local reg = ovreg or tp.reg
+ local rnum = map_reg_num[reg]
+ if not rnum then
+ werror("type `"..(tname or expr).."' needs a register override")
+ end
+ if not map_reg_valid_base[reg] then
+ werror("bad base register override `"..(map_reg_rev[reg] or reg).."'")
+ end
+ return reg, rnum, tp
+ end
+ return expr, map_reg_num[expr]
+end
+
+-- Parse operand and return { mode, opsize, reg, xreg, xsc, disp, imm }.
+local function parseoperand(param)
+ local t = {}
+
+ local expr = param
+ local opsize, tailops = match(param, "^(%w+)%s*(.+)$")
+ if opsize then
+ t.opsize = map_opsize[opsize]
+ if t.opsize then expr = tailops end
+ end
+
+ local br = match(expr, "^%[%s*(.-)%s*%]$")
+ repeat
+ if br then
+ t.mode = "xm"
+
+ -- [disp]
+ t.disp = toint(br)
+ if t.disp then
+ t.mode = x64 and "xm" or "xmO"
+ break
+ end
+
+ -- [reg...]
+ local tp
+ local reg, tailr = match(br, "^([@%w_:]+)%s*(.*)$")
+ reg, t.reg, tp = rtexpr(reg)
+ if not t.reg then
+ -- [expr]
+ t.mode = x64 and "xm" or "xmO"
+ t.disp = dispexpr("+"..br)
+ break
+ end
+
+ if t.reg == -1 then
+ t.vreg, tailr = match(tailr, "^(%b())(.*)$")
+ if not t.vreg then werror("bad variable register expression") end
+ end
+
+ -- [xreg*xsc] or [xreg*xsc+-disp] or [xreg*xsc+-expr]
+ local xsc, tailsc = match(tailr, "^%*%s*([1248])%s*(.*)$")
+ if xsc then
+ if not map_reg_valid_index[reg] then
+ werror("bad index register `"..map_reg_rev[reg].."'")
+ end
+ t.xsc = map_xsc[xsc]
+ t.xreg = t.reg
+ t.vxreg = t.vreg
+ t.reg = nil
+ t.vreg = nil
+ t.disp = dispexpr(tailsc)
+ break
+ end
+ if not map_reg_valid_base[reg] then
+ werror("bad base register `"..map_reg_rev[reg].."'")
+ end
+
+ -- [reg] or [reg+-disp]
+ t.disp = toint(tailr) or (tailr == "" and 0)
+ if t.disp then break end
+
+ -- [reg+xreg...]
+ local xreg, tailx = match(tailr, "^+%s*([@%w_:]+)%s*(.*)$")
+ xreg, t.xreg, tp = rtexpr(xreg)
+ if not t.xreg then
+ -- [reg+-expr]
+ t.disp = dispexpr(tailr)
+ break
+ end
+ if not map_reg_valid_index[xreg] then
+ werror("bad index register `"..map_reg_rev[xreg].."'")
+ end
+
+ if t.xreg == -1 then
+ t.vxreg, tailx = match(tailx, "^(%b())(.*)$")
+ if not t.vxreg then werror("bad variable register expression") end
+ end
+
+ -- [reg+xreg*xsc...]
+ local xsc, tailsc = match(tailx, "^%*%s*([1248])%s*(.*)$")
+ if xsc then
+ t.xsc = map_xsc[xsc]
+ tailx = tailsc
+ end
+
+ -- [...] or [...+-disp] or [...+-expr]
+ t.disp = dispexpr(tailx)
+ else
+ -- imm or opsize*imm
+ local imm = toint(expr)
+ if not imm and sub(expr, 1, 1) == "*" and t.opsize then
+ imm = toint(sub(expr, 2))
+ if imm then
+ imm = imm * map_opsizenum[t.opsize]
+ t.opsize = nil
+ end
+ end
+ if imm then
+ if t.opsize then werror("bad operand size override") end
+ local m = "i"
+ if imm == 1 then m = m.."1" end
+ if imm >= 4294967168 and imm <= 4294967295 then imm = imm-4294967296 end
+ if imm >= -128 and imm <= 127 then m = m.."S" end
+ t.imm = imm
+ t.mode = m
+ break
+ end
+
+ local tp
+ local reg, tailr = match(expr, "^([@%w_:]+)%s*(.*)$")
+ reg, t.reg, tp = rtexpr(reg)
+ if t.reg then
+ if t.reg == -1 then
+ t.vreg, tailr = match(tailr, "^(%b())(.*)$")
+ if not t.vreg then werror("bad variable register expression") end
+ end
+ -- reg
+ if tailr == "" then
+ if t.opsize then werror("bad operand size override") end
+ t.opsize = map_reg_opsize[reg]
+ if t.opsize == "f" then
+ t.mode = t.reg == 0 and "fF" or "f"
+ else
+ if reg == "@w4" or (x64 and reg == "@d4") then
+ wwarn("bad idea, try again with `"..(x64 and "rsp'" or "esp'"))
+ end
+ t.mode = t.reg == 0 and "rmR" or (reg == "@b1" and "rmC" or "rm")
+ end
+ t.needrex = map_reg_needrex[reg]
+ break
+ end
+
+ -- type[idx], type[idx].field, type->field -> [reg+offset_expr]
+ if not tp then werror("bad operand `"..param.."'") end
+ t.mode = "xm"
+ t.disp = format(tp.ctypefmt, tailr)
+ else
+ t.mode, t.imm = immexpr(expr)
+ if sub(t.mode, -1) == "J" then
+ if t.opsize and t.opsize ~= addrsize then
+ werror("bad operand size override")
+ end
+ t.opsize = addrsize
+ end
+ end
+ end
+ until true
+ return t
+end
+
+------------------------------------------------------------------------------
+-- x86 Template String Description
+-- ===============================
+--
+-- Each template string is a list of [match:]pattern pairs,
+-- separated by "|". The first match wins. No match means a
+-- bad or unsupported combination of operand modes or sizes.
+--
+-- The match part and the ":" is omitted if the operation has
+-- no operands. Otherwise the first N characters are matched
+-- against the mode strings of each of the N operands.
+--
+-- The mode string for each operand type is (see parseoperand()):
+-- Integer register: "rm", +"R" for eax, ax, al, +"C" for cl
+-- FP register: "f", +"F" for st0
+-- Index operand: "xm", +"O" for [disp] (pure offset)
+-- Immediate: "i", +"S" for signed 8 bit, +"1" for 1,
+-- +"I" for arg, +"P" for pointer
+-- Any: +"J" for valid jump targets
+--
+-- So a match character "m" (mixed) matches both an integer register
+-- and an index operand (to be encoded with the ModRM/SIB scheme).
+-- But "r" matches only a register and "x" only an index operand
+-- (e.g. for FP memory access operations).
+--
+-- The operand size match string starts right after the mode match
+-- characters and ends before the ":". "dwb" or "qdwb" is assumed, if empty.
+-- The effective data size of the operation is matched against this list.
+--
+-- If only the regular "b", "w", "d", "q", "t" operand sizes are
+-- present, then all operands must be the same size. Unspecified sizes
+-- are ignored, but at least one operand must have a size or the pattern
+-- won't match (use the "byte", "word", "dword", "qword", "tword"
+-- operand size overrides. E.g.: mov dword [eax], 1).
+--
+-- If the list has a "1" or "2" prefix, the operand size is taken
+-- from the respective operand and any other operand sizes are ignored.
+-- If the list contains only ".", all operand sizes are ignored.
+-- If the list has a "/" prefix, the concatenated (mixed) operand sizes
+-- are compared to the match.
+--
+-- E.g. "rrdw" matches for either two dword registers or two word
+-- registers. "Fx2dq" matches an st0 operand plus an index operand
+-- pointing to a dword (float) or qword (double).
+--
+-- Every character after the ":" is part of the pattern string:
+-- Hex chars are accumulated to form the opcode (left to right).
+-- "n" disables the standard opcode mods
+-- (otherwise: -1 for "b", o16 prefix for "w", rex.w for "q")
+-- "X" Force REX.W.
+-- "r"/"R" adds the reg. number from the 1st/2nd operand to the opcode.
+-- "m"/"M" generates ModRM/SIB from the 1st/2nd operand.
+-- The spare 3 bits are either filled with the last hex digit or
+-- the result from a previous "r"/"R". The opcode is restored.
+--
+-- All of the following characters force a flush of the opcode:
+-- "o"/"O" stores a pure 32 bit disp (offset) from the 1st/2nd operand.
+-- "S" stores a signed 8 bit immediate from the last operand.
+-- "U" stores an unsigned 8 bit immediate from the last operand.
+-- "W" stores an unsigned 16 bit immediate from the last operand.
+-- "i" stores an operand sized immediate from the last operand.
+-- "I" dito, but generates an action code to optionally modify
+-- the opcode (+2) for a signed 8 bit immediate.
+-- "J" generates one of the REL action codes from the last operand.
+--
+------------------------------------------------------------------------------
+
+-- Template strings for x86 instructions. Ordered by first opcode byte.
+-- Unimplemented opcodes (deliberate omissions) are marked with *.
+local map_op = {
+ -- 00-05: add...
+ -- 06: *push es
+ -- 07: *pop es
+ -- 08-0D: or...
+ -- 0E: *push cs
+ -- 0F: two byte opcode prefix
+ -- 10-15: adc...
+ -- 16: *push ss
+ -- 17: *pop ss
+ -- 18-1D: sbb...
+ -- 1E: *push ds
+ -- 1F: *pop ds
+ -- 20-25: and...
+ es_0 = "26",
+ -- 27: *daa
+ -- 28-2D: sub...
+ cs_0 = "2E",
+ -- 2F: *das
+ -- 30-35: xor...
+ ss_0 = "36",
+ -- 37: *aaa
+ -- 38-3D: cmp...
+ ds_0 = "3E",
+ -- 3F: *aas
+ inc_1 = x64 and "m:FF0m" or "rdw:40r|m:FF0m",
+ dec_1 = x64 and "m:FF1m" or "rdw:48r|m:FF1m",
+ push_1 = (x64 and "rq:n50r|rw:50r|mq:nFF6m|mw:FF6m" or
+ "rdw:50r|mdw:FF6m").."|S.:6AS|ib:n6Ai|i.:68i",
+ pop_1 = x64 and "rq:n58r|rw:58r|mq:n8F0m|mw:8F0m" or "rdw:58r|mdw:8F0m",
+ -- 60: *pusha, *pushad, *pushaw
+ -- 61: *popa, *popad, *popaw
+ -- 62: *bound rdw,x
+ -- 63: x86: *arpl mw,rw
+ movsxd_2 = x64 and "rm/qd:63rM",
+ fs_0 = "64",
+ gs_0 = "65",
+ o16_0 = "66",
+ a16_0 = not x64 and "67" or nil,
+ a32_0 = x64 and "67",
+ -- 68: push idw
+ -- 69: imul rdw,mdw,idw
+ -- 6A: push ib
+ -- 6B: imul rdw,mdw,S
+ -- 6C: *insb
+ -- 6D: *insd, *insw
+ -- 6E: *outsb
+ -- 6F: *outsd, *outsw
+ -- 70-7F: jcc lb
+ -- 80: add... mb,i
+ -- 81: add... mdw,i
+ -- 82: *undefined
+ -- 83: add... mdw,S
+ test_2 = "mr:85Rm|rm:85rM|Ri:A9ri|mi:F70mi",
+ -- 86: xchg rb,mb
+ -- 87: xchg rdw,mdw
+ -- 88: mov mb,r
+ -- 89: mov mdw,r
+ -- 8A: mov r,mb
+ -- 8B: mov r,mdw
+ -- 8C: *mov mdw,seg
+ lea_2 = "rx1dq:8DrM",
+ -- 8E: *mov seg,mdw
+ -- 8F: pop mdw
+ nop_0 = "90",
+ xchg_2 = "Rrqdw:90R|rRqdw:90r|rm:87rM|mr:87Rm",
+ cbw_0 = "6698",
+ cwde_0 = "98",
+ cdqe_0 = "4898",
+ cwd_0 = "6699",
+ cdq_0 = "99",
+ cqo_0 = "4899",
+ -- 9A: *call iw:idw
+ wait_0 = "9B",
+ fwait_0 = "9B",
+ pushf_0 = "9C",
+ pushfd_0 = not x64 and "9C",
+ pushfq_0 = x64 and "9C",
+ popf_0 = "9D",
+ popfd_0 = not x64 and "9D",
+ popfq_0 = x64 and "9D",
+ sahf_0 = "9E",
+ lahf_0 = "9F",
+ mov_2 = "OR:A3o|RO:A1O|mr:89Rm|rm:8BrM|rib:nB0ri|ridw:B8ri|mi:C70mi",
+ movsb_0 = "A4",
+ movsw_0 = "66A5",
+ movsd_0 = "A5",
+ cmpsb_0 = "A6",
+ cmpsw_0 = "66A7",
+ cmpsd_0 = "A7",
+ -- A8: test Rb,i
+ -- A9: test Rdw,i
+ stosb_0 = "AA",
+ stosw_0 = "66AB",
+ stosd_0 = "AB",
+ lodsb_0 = "AC",
+ lodsw_0 = "66AD",
+ lodsd_0 = "AD",
+ scasb_0 = "AE",
+ scasw_0 = "66AF",
+ scasd_0 = "AF",
+ -- B0-B7: mov rb,i
+ -- B8-BF: mov rdw,i
+ -- C0: rol... mb,i
+ -- C1: rol... mdw,i
+ ret_1 = "i.:nC2W",
+ ret_0 = "C3",
+ -- C4: *les rdw,mq
+ -- C5: *lds rdw,mq
+ -- C6: mov mb,i
+ -- C7: mov mdw,i
+ -- C8: *enter iw,ib
+ leave_0 = "C9",
+ -- CA: *retf iw
+ -- CB: *retf
+ int3_0 = "CC",
+ int_1 = "i.:nCDU",
+ into_0 = "CE",
+ -- CF: *iret
+ -- D0: rol... mb,1
+ -- D1: rol... mdw,1
+ -- D2: rol... mb,cl
+ -- D3: rol... mb,cl
+ -- D4: *aam ib
+ -- D5: *aad ib
+ -- D6: *salc
+ -- D7: *xlat
+ -- D8-DF: floating point ops
+ -- E0: *loopne
+ -- E1: *loope
+ -- E2: *loop
+ -- E3: *jcxz, *jecxz
+ -- E4: *in Rb,ib
+ -- E5: *in Rdw,ib
+ -- E6: *out ib,Rb
+ -- E7: *out ib,Rdw
+ call_1 = x64 and "mq:nFF2m|J.:E8nJ" or "md:FF2m|J.:E8J",
+ jmp_1 = x64 and "mq:nFF4m|J.:E9nJ" or "md:FF4m|J.:E9J", -- short: EB
+ -- EA: *jmp iw:idw
+ -- EB: jmp ib
+ -- EC: *in Rb,dx
+ -- ED: *in Rdw,dx
+ -- EE: *out dx,Rb
+ -- EF: *out dx,Rdw
+ -- F0: *lock
+ int1_0 = "F1",
+ repne_0 = "F2",
+ repnz_0 = "F2",
+ rep_0 = "F3",
+ repe_0 = "F3",
+ repz_0 = "F3",
+ -- F4: *hlt
+ cmc_0 = "F5",
+ -- F6: test... mb,i; div... mb
+ -- F7: test... mdw,i; div... mdw
+ clc_0 = "F8",
+ stc_0 = "F9",
+ -- FA: *cli
+ cld_0 = "FC",
+ std_0 = "FD",
+ -- FE: inc... mb
+ -- FF: inc... mdw
+
+ -- misc ops
+ not_1 = "m:F72m",
+ neg_1 = "m:F73m",
+ mul_1 = "m:F74m",
+ imul_1 = "m:F75m",
+ div_1 = "m:F76m",
+ idiv_1 = "m:F77m",
+
+ imul_2 = "rmqdw:0FAFrM|rIqdw:69rmI|rSqdw:6BrmS|riqdw:69rmi",
+ imul_3 = "rmIqdw:69rMI|rmSqdw:6BrMS|rmiqdw:69rMi",
+
+ movzx_2 = "rm/db:0FB6rM|rm/qb:|rm/wb:0FB6rM|rm/dw:0FB7rM|rm/qw:",
+ movsx_2 = "rm/db:0FBErM|rm/qb:|rm/wb:0FBErM|rm/dw:0FBFrM|rm/qw:",
+
+ bswap_1 = "rqd:0FC8r",
+ bsf_2 = "rmqdw:0FBCrM",
+ bsr_2 = "rmqdw:0FBDrM",
+ bt_2 = "mrqdw:0FA3Rm|miqdw:0FBA4mU",
+ btc_2 = "mrqdw:0FBBRm|miqdw:0FBA7mU",
+ btr_2 = "mrqdw:0FB3Rm|miqdw:0FBA6mU",
+ bts_2 = "mrqdw:0FABRm|miqdw:0FBA5mU",
+
+ rdtsc_0 = "0F31", -- P1+
+ cpuid_0 = "0FA2", -- P1+
+
+ -- floating point ops
+ fst_1 = "ff:DDD0r|xd:D92m|xq:nDD2m",
+ fstp_1 = "ff:DDD8r|xd:D93m|xq:nDD3m|xt:DB7m",
+ fld_1 = "ff:D9C0r|xd:D90m|xq:nDD0m|xt:DB5m",
+
+ fpop_0 = "DDD8", -- Alias for fstp st0.
+
+ fist_1 = "xw:nDF2m|xd:DB2m",
+ fistp_1 = "xw:nDF3m|xd:DB3m|xq:nDF7m",
+ fild_1 = "xw:nDF0m|xd:DB0m|xq:nDF5m",
+
+ fxch_0 = "D9C9",
+ fxch_1 = "ff:D9C8r",
+ fxch_2 = "fFf:D9C8r|Fff:D9C8R",
+
+ fucom_1 = "ff:DDE0r",
+ fucom_2 = "Fff:DDE0R",
+ fucomp_1 = "ff:DDE8r",
+ fucomp_2 = "Fff:DDE8R",
+ fucomi_1 = "ff:DBE8r", -- P6+
+ fucomi_2 = "Fff:DBE8R", -- P6+
+ fucomip_1 = "ff:DFE8r", -- P6+
+ fucomip_2 = "Fff:DFE8R", -- P6+
+ fcomi_1 = "ff:DBF0r", -- P6+
+ fcomi_2 = "Fff:DBF0R", -- P6+
+ fcomip_1 = "ff:DFF0r", -- P6+
+ fcomip_2 = "Fff:DFF0R", -- P6+
+ fucompp_0 = "DAE9",
+ fcompp_0 = "DED9",
+
+ fldcw_1 = "xw:nD95m",
+ fstcw_1 = "xw:n9BD97m",
+ fnstcw_1 = "xw:nD97m",
+ fstsw_1 = "Rw:n9BDFE0|xw:n9BDD7m",
+ fnstsw_1 = "Rw:nDFE0|xw:nDD7m",
+ fclex_0 = "9BDBE2",
+ fnclex_0 = "DBE2",
+
+ fnop_0 = "D9D0",
+ -- D9D1-D9DF: unassigned
+
+ fchs_0 = "D9E0",
+ fabs_0 = "D9E1",
+ -- D9E2: unassigned
+ -- D9E3: unassigned
+ ftst_0 = "D9E4",
+ fxam_0 = "D9E5",
+ -- D9E6: unassigned
+ -- D9E7: unassigned
+ fld1_0 = "D9E8",
+ fldl2t_0 = "D9E9",
+ fldl2e_0 = "D9EA",
+ fldpi_0 = "D9EB",
+ fldlg2_0 = "D9EC",
+ fldln2_0 = "D9ED",
+ fldz_0 = "D9EE",
+ -- D9EF: unassigned
+
+ f2xm1_0 = "D9F0",
+ fyl2x_0 = "D9F1",
+ fptan_0 = "D9F2",
+ fpatan_0 = "D9F3",
+ fxtract_0 = "D9F4",
+ fprem1_0 = "D9F5",
+ fdecstp_0 = "D9F6",
+ fincstp_0 = "D9F7",
+ fprem_0 = "D9F8",
+ fyl2xp1_0 = "D9F9",
+ fsqrt_0 = "D9FA",
+ fsincos_0 = "D9FB",
+ frndint_0 = "D9FC",
+ fscale_0 = "D9FD",
+ fsin_0 = "D9FE",
+ fcos_0 = "D9FF",
+
+ -- SSE, SSE2
+ andnpd_2 = "rmo:660F55rM",
+ andnps_2 = "rmo:0F55rM",
+ andpd_2 = "rmo:660F54rM",
+ andps_2 = "rmo:0F54rM",
+ clflush_1 = "x.:0FAE7m",
+ cmppd_3 = "rmio:660FC2rMU",
+ cmpps_3 = "rmio:0FC2rMU",
+ cmpsd_3 = "rrio:F20FC2rMU|rxi/oq:",
+ cmpss_3 = "rrio:F30FC2rMU|rxi/od:",
+ comisd_2 = "rro:660F2FrM|rx/oq:",
+ comiss_2 = "rro:0F2FrM|rx/od:",
+ cvtdq2pd_2 = "rro:F30FE6rM|rx/oq:",
+ cvtdq2ps_2 = "rmo:0F5BrM",
+ cvtpd2dq_2 = "rmo:F20FE6rM",
+ cvtpd2ps_2 = "rmo:660F5ArM",
+ cvtpi2pd_2 = "rx/oq:660F2ArM",
+ cvtpi2ps_2 = "rx/oq:0F2ArM",
+ cvtps2dq_2 = "rmo:660F5BrM",
+ cvtps2pd_2 = "rro:0F5ArM|rx/oq:",
+ cvtsd2si_2 = "rr/do:F20F2DrM|rr/qo:|rx/dq:|rxq:",
+ cvtsd2ss_2 = "rro:F20F5ArM|rx/oq:",
+ cvtsi2sd_2 = "rm/od:F20F2ArM|rm/oq:F20F2ArXM",
+ cvtsi2ss_2 = "rm/od:F30F2ArM|rm/oq:F30F2ArXM",
+ cvtss2sd_2 = "rro:F30F5ArM|rx/od:",
+ cvtss2si_2 = "rr/do:F20F2CrM|rr/qo:|rxd:|rx/qd:",
+ cvttpd2dq_2 = "rmo:660FE6rM",
+ cvttps2dq_2 = "rmo:F30F5BrM",
+ cvttsd2si_2 = "rr/do:F20F2CrM|rr/qo:|rx/dq:|rxq:",
+ cvttss2si_2 = "rr/do:F30F2CrM|rr/qo:|rxd:|rx/qd:",
+ ldmxcsr_1 = "xd:0FAE2m",
+ lfence_0 = "0FAEE8",
+ maskmovdqu_2 = "rro:660FF7rM",
+ mfence_0 = "0FAEF0",
+ movapd_2 = "rmo:660F28rM|mro:660F29Rm",
+ movaps_2 = "rmo:0F28rM|mro:0F29Rm",
+ movd_2 = "rm/od:660F6ErM|rm/oq:660F6ErXM|mr/do:660F7ERm|mr/qo:",
+ movdqa_2 = "rmo:660F6FrM|mro:660F7FRm",
+ movdqu_2 = "rmo:F30F6FrM|mro:F30F7FRm",
+ movhlps_2 = "rro:0F12rM",
+ movhpd_2 = "rx/oq:660F16rM|xr/qo:n660F17Rm",
+ movhps_2 = "rx/oq:0F16rM|xr/qo:n0F17Rm",
+ movlhps_2 = "rro:0F16rM",
+ movlpd_2 = "rx/oq:660F12rM|xr/qo:n660F13Rm",
+ movlps_2 = "rx/oq:0F12rM|xr/qo:n0F13Rm",
+ movmskpd_2 = "rr/do:660F50rM",
+ movmskps_2 = "rr/do:0F50rM",
+ movntdq_2 = "xro:660FE7Rm",
+ movnti_2 = "xrqd:0FC3Rm",
+ movntpd_2 = "xro:660F2BRm",
+ movntps_2 = "xro:0F2BRm",
+ movq_2 = "rro:F30F7ErM|rx/oq:|xr/qo:n660FD6Rm",
+ movsd_2 = "rro:F20F10rM|rx/oq:|xr/qo:nF20F11Rm",
+ movss_2 = "rro:F30F10rM|rx/od:|xr/do:F30F11Rm",
+ movupd_2 = "rmo:660F10rM|mro:660F11Rm",
+ movups_2 = "rmo:0F10rM|mro:0F11Rm",
+ orpd_2 = "rmo:660F56rM",
+ orps_2 = "rmo:0F56rM",
+ packssdw_2 = "rmo:660F6BrM",
+ packsswb_2 = "rmo:660F63rM",
+ packuswb_2 = "rmo:660F67rM",
+ paddb_2 = "rmo:660FFCrM",
+ paddd_2 = "rmo:660FFErM",
+ paddq_2 = "rmo:660FD4rM",
+ paddsb_2 = "rmo:660FECrM",
+ paddsw_2 = "rmo:660FEDrM",
+ paddusb_2 = "rmo:660FDCrM",
+ paddusw_2 = "rmo:660FDDrM",
+ paddw_2 = "rmo:660FFDrM",
+ pand_2 = "rmo:660FDBrM",
+ pandn_2 = "rmo:660FDFrM",
+ pause_0 = "F390",
+ pavgb_2 = "rmo:660FE0rM",
+ pavgw_2 = "rmo:660FE3rM",
+ pcmpeqb_2 = "rmo:660F74rM",
+ pcmpeqd_2 = "rmo:660F76rM",
+ pcmpeqw_2 = "rmo:660F75rM",
+ pcmpgtb_2 = "rmo:660F64rM",
+ pcmpgtd_2 = "rmo:660F66rM",
+ pcmpgtw_2 = "rmo:660F65rM",
+ pextrw_3 = "rri/do:660FC5rMU|xri/wo:660F3A15nrMU", -- Mem op: SSE4.1 only.
+ pinsrw_3 = "rri/od:660FC4rMU|rxi/ow:",
+ pmaddwd_2 = "rmo:660FF5rM",
+ pmaxsw_2 = "rmo:660FEErM",
+ pmaxub_2 = "rmo:660FDErM",
+ pminsw_2 = "rmo:660FEArM",
+ pminub_2 = "rmo:660FDArM",
+ pmovmskb_2 = "rr/do:660FD7rM",
+ pmulhuw_2 = "rmo:660FE4rM",
+ pmulhw_2 = "rmo:660FE5rM",
+ pmullw_2 = "rmo:660FD5rM",
+ pmuludq_2 = "rmo:660FF4rM",
+ por_2 = "rmo:660FEBrM",
+ prefetchnta_1 = "xb:n0F180m",
+ prefetcht0_1 = "xb:n0F181m",
+ prefetcht1_1 = "xb:n0F182m",
+ prefetcht2_1 = "xb:n0F183m",
+ psadbw_2 = "rmo:660FF6rM",
+ pshufd_3 = "rmio:660F70rMU",
+ pshufhw_3 = "rmio:F30F70rMU",
+ pshuflw_3 = "rmio:F20F70rMU",
+ pslld_2 = "rmo:660FF2rM|rio:660F726mU",
+ pslldq_2 = "rio:660F737mU",
+ psllq_2 = "rmo:660FF3rM|rio:660F736mU",
+ psllw_2 = "rmo:660FF1rM|rio:660F716mU",
+ psrad_2 = "rmo:660FE2rM|rio:660F724mU",
+ psraw_2 = "rmo:660FE1rM|rio:660F714mU",
+ psrld_2 = "rmo:660FD2rM|rio:660F722mU",
+ psrldq_2 = "rio:660F733mU",
+ psrlq_2 = "rmo:660FD3rM|rio:660F732mU",
+ psrlw_2 = "rmo:660FD1rM|rio:660F712mU",
+ psubb_2 = "rmo:660FF8rM",
+ psubd_2 = "rmo:660FFArM",
+ psubq_2 = "rmo:660FFBrM",
+ psubsb_2 = "rmo:660FE8rM",
+ psubsw_2 = "rmo:660FE9rM",
+ psubusb_2 = "rmo:660FD8rM",
+ psubusw_2 = "rmo:660FD9rM",
+ psubw_2 = "rmo:660FF9rM",
+ punpckhbw_2 = "rmo:660F68rM",
+ punpckhdq_2 = "rmo:660F6ArM",
+ punpckhqdq_2 = "rmo:660F6DrM",
+ punpckhwd_2 = "rmo:660F69rM",
+ punpcklbw_2 = "rmo:660F60rM",
+ punpckldq_2 = "rmo:660F62rM",
+ punpcklqdq_2 = "rmo:660F6CrM",
+ punpcklwd_2 = "rmo:660F61rM",
+ pxor_2 = "rmo:660FEFrM",
+ rcpps_2 = "rmo:0F53rM",
+ rcpss_2 = "rro:F30F53rM|rx/od:",
+ rsqrtps_2 = "rmo:0F52rM",
+ rsqrtss_2 = "rmo:F30F52rM",
+ sfence_0 = "0FAEF8",
+ shufpd_3 = "rmio:660FC6rMU",
+ shufps_3 = "rmio:0FC6rMU",
+ stmxcsr_1 = "xd:0FAE3m",
+ ucomisd_2 = "rro:660F2ErM|rx/oq:",
+ ucomiss_2 = "rro:0F2ErM|rx/od:",
+ unpckhpd_2 = "rmo:660F15rM",
+ unpckhps_2 = "rmo:0F15rM",
+ unpcklpd_2 = "rmo:660F14rM",
+ unpcklps_2 = "rmo:0F14rM",
+ xorpd_2 = "rmo:660F57rM",
+ xorps_2 = "rmo:0F57rM",
+
+ -- SSE3 ops
+ fisttp_1 = "xw:nDF1m|xd:DB1m|xq:nDD1m",
+ addsubpd_2 = "rmo:660FD0rM",
+ addsubps_2 = "rmo:F20FD0rM",
+ haddpd_2 = "rmo:660F7CrM",
+ haddps_2 = "rmo:F20F7CrM",
+ hsubpd_2 = "rmo:660F7DrM",
+ hsubps_2 = "rmo:F20F7DrM",
+ lddqu_2 = "rxo:F20FF0rM",
+ movddup_2 = "rmo:F20F12rM",
+ movshdup_2 = "rmo:F30F16rM",
+ movsldup_2 = "rmo:F30F12rM",
+
+ -- SSSE3 ops
+ pabsb_2 = "rmo:660F381CrM",
+ pabsd_2 = "rmo:660F381ErM",
+ pabsw_2 = "rmo:660F381DrM",
+ palignr_3 = "rmio:660F3A0FrMU",
+ phaddd_2 = "rmo:660F3802rM",
+ phaddsw_2 = "rmo:660F3803rM",
+ phaddw_2 = "rmo:660F3801rM",
+ phsubd_2 = "rmo:660F3806rM",
+ phsubsw_2 = "rmo:660F3807rM",
+ phsubw_2 = "rmo:660F3805rM",
+ pmaddubsw_2 = "rmo:660F3804rM",
+ pmulhrsw_2 = "rmo:660F380BrM",
+ pshufb_2 = "rmo:660F3800rM",
+ psignb_2 = "rmo:660F3808rM",
+ psignd_2 = "rmo:660F380ArM",
+ psignw_2 = "rmo:660F3809rM",
+
+ -- SSE4.1 ops
+ blendpd_3 = "rmio:660F3A0DrMU",
+ blendps_3 = "rmio:660F3A0CrMU",
+ blendvpd_3 = "rmRo:660F3815rM",
+ blendvps_3 = "rmRo:660F3814rM",
+ dppd_3 = "rmio:660F3A41rMU",
+ dpps_3 = "rmio:660F3A40rMU",
+ extractps_3 = "mri/do:660F3A17RmU|rri/qo:660F3A17RXmU",
+ insertps_3 = "rrio:660F3A41rMU|rxi/od:",
+ movntdqa_2 = "rmo:660F382ArM",
+ mpsadbw_3 = "rmio:660F3A42rMU",
+ packusdw_2 = "rmo:660F382BrM",
+ pblendvb_3 = "rmRo:660F3810rM",
+ pblendw_3 = "rmio:660F3A0ErMU",
+ pcmpeqq_2 = "rmo:660F3829rM",
+ pextrb_3 = "rri/do:660F3A14nRmU|rri/qo:|xri/bo:",
+ pextrd_3 = "mri/do:660F3A16RmU",
+ pextrq_3 = "mri/qo:660F3A16RmU",
+ -- pextrw is SSE2, mem operand is SSE4.1 only
+ phminposuw_2 = "rmo:660F3841rM",
+ pinsrb_3 = "rri/od:660F3A20nrMU|rxi/ob:",
+ pinsrd_3 = "rmi/od:660F3A22rMU",
+ pinsrq_3 = "rmi/oq:660F3A22rXMU",
+ pmaxsb_2 = "rmo:660F383CrM",
+ pmaxsd_2 = "rmo:660F383DrM",
+ pmaxud_2 = "rmo:660F383FrM",
+ pmaxuw_2 = "rmo:660F383ErM",
+ pminsb_2 = "rmo:660F3838rM",
+ pminsd_2 = "rmo:660F3839rM",
+ pminud_2 = "rmo:660F383BrM",
+ pminuw_2 = "rmo:660F383ArM",
+ pmovsxbd_2 = "rro:660F3821rM|rx/od:",
+ pmovsxbq_2 = "rro:660F3822rM|rx/ow:",
+ pmovsxbw_2 = "rro:660F3820rM|rx/oq:",
+ pmovsxdq_2 = "rro:660F3825rM|rx/oq:",
+ pmovsxwd_2 = "rro:660F3823rM|rx/oq:",
+ pmovsxwq_2 = "rro:660F3824rM|rx/od:",
+ pmovzxbd_2 = "rro:660F3831rM|rx/od:",
+ pmovzxbq_2 = "rro:660F3832rM|rx/ow:",
+ pmovzxbw_2 = "rro:660F3830rM|rx/oq:",
+ pmovzxdq_2 = "rro:660F3835rM|rx/oq:",
+ pmovzxwd_2 = "rro:660F3833rM|rx/oq:",
+ pmovzxwq_2 = "rro:660F3834rM|rx/od:",
+ pmuldq_2 = "rmo:660F3828rM",
+ pmulld_2 = "rmo:660F3840rM",
+ ptest_2 = "rmo:660F3817rM",
+ roundpd_3 = "rmio:660F3A09rMU",
+ roundps_3 = "rmio:660F3A08rMU",
+ roundsd_3 = "rrio:660F3A0BrMU|rxi/oq:",
+ roundss_3 = "rrio:660F3A0ArMU|rxi/od:",
+
+ -- SSE4.2 ops
+ crc32_2 = "rmqd:F20F38F1rM|rm/dw:66F20F38F1rM|rm/db:F20F38F0rM|rm/qb:",
+ pcmpestri_3 = "rmio:660F3A61rMU",
+ pcmpestrm_3 = "rmio:660F3A60rMU",
+ pcmpgtq_2 = "rmo:660F3837rM",
+ pcmpistri_3 = "rmio:660F3A63rMU",
+ pcmpistrm_3 = "rmio:660F3A62rMU",
+ popcnt_2 = "rmqdw:F30FB8rM",
+
+ -- SSE4a
+ extrq_2 = "rro:660F79rM",
+ extrq_3 = "riio:660F780mUU",
+ insertq_2 = "rro:F20F79rM",
+ insertq_4 = "rriio:F20F78rMUU",
+ lzcnt_2 = "rmqdw:F30FBDrM",
+ movntsd_2 = "xr/qo:nF20F2BRm",
+ movntss_2 = "xr/do:F30F2BRm",
+ -- popcnt is also in SSE4.2
+}
+
+------------------------------------------------------------------------------
+
+-- Arithmetic ops.
+for name,n in pairs{ add = 0, ["or"] = 1, adc = 2, sbb = 3,
+ ["and"] = 4, sub = 5, xor = 6, cmp = 7 } do
+ local n8 = n * 8
+ map_op[name.."_2"] = format(
+ "mr:%02XRm|rm:%02XrM|mI1qdw:81%XmI|mS1qdw:83%XmS|Ri1qdwb:%02Xri|mi1qdwb:81%Xmi",
+ 1+n8, 3+n8, n, n, 5+n8, n)
+end
+
+-- Shift ops.
+for name,n in pairs{ rol = 0, ror = 1, rcl = 2, rcr = 3,
+ shl = 4, shr = 5, sar = 7, sal = 4 } do
+ map_op[name.."_2"] = format("m1:D1%Xm|mC1qdwb:D3%Xm|mi:C1%XmU", n, n, n)
+end
+
+-- Conditional ops.
+for cc,n in pairs(map_cc) do
+ map_op["j"..cc.."_1"] = format("J.:n0F8%XJ", n) -- short: 7%X
+ map_op["set"..cc.."_1"] = format("mb:n0F9%X2m", n)
+ map_op["cmov"..cc.."_2"] = format("rmqdw:0F4%XrM", n) -- P6+
+end
+
+-- FP arithmetic ops.
+for name,n in pairs{ add = 0, mul = 1, com = 2, comp = 3,
+ sub = 4, subr = 5, div = 6, divr = 7 } do
+ local nc = 192 + n * 8
+ local nr = nc + (n < 4 and 0 or (n % 2 == 0 and 8 or -8))
+ local fn = "f"..name
+ map_op[fn.."_1"] = format("ff:D8%02Xr|xd:D8%Xm|xq:nDC%Xm", nc, n, n)
+ if n == 2 or n == 3 then
+ map_op[fn.."_2"] = format("Fff:D8%02XR|Fx2d:D8%XM|Fx2q:nDC%XM", nc, n, n)
+ else
+ map_op[fn.."_2"] = format("Fff:D8%02XR|fFf:DC%02Xr|Fx2d:D8%XM|Fx2q:nDC%XM", nc, nr, n, n)
+ map_op[fn.."p_1"] = format("ff:DE%02Xr", nr)
+ map_op[fn.."p_2"] = format("fFf:DE%02Xr", nr)
+ end
+ map_op["fi"..name.."_1"] = format("xd:DA%Xm|xw:nDE%Xm", n, n)
+end
+
+-- FP conditional moves.
+for cc,n in pairs{ b=0, e=1, be=2, u=3, nb=4, ne=5, nbe=6, nu=7 } do
+ local n4 = n % 4
+ local nc = 56000 + n4 * 8 + (n-n4) * 64
+ map_op["fcmov"..cc.."_1"] = format("ff:%04Xr", nc) -- P6+
+ map_op["fcmov"..cc.."_2"] = format("Fff:%04XR", nc) -- P6+
+end
+
+-- SSE FP arithmetic ops.
+for name,n in pairs{ sqrt = 1, add = 8, mul = 9,
+ sub = 12, min = 13, div = 14, max = 15 } do
+ map_op[name.."ps_2"] = format("rmo:0F5%XrM", n)
+ map_op[name.."ss_2"] = format("rro:F30F5%XrM|rx/od:", n)
+ map_op[name.."pd_2"] = format("rmo:660F5%XrM", n)
+ map_op[name.."sd_2"] = format("rro:F20F5%XrM|rx/oq:", n)
+end
+
+------------------------------------------------------------------------------
+
+-- Process pattern string.
+local function dopattern(pat, args, sz, op, needrex)
+ local digit, addin
+ local opcode = 0
+ local szov = sz
+ local narg = 1
+ local rex = 0
+
+ -- Limit number of section buffer positions used by a single dasm_put().
+ -- A single opcode needs a maximum of 5 positions.
+ if secpos+5 > maxsecpos then wflush() end
+
+ -- Process each character.
+ for c in gmatch(pat.."|", ".") do
+ if match(c, "%x") then -- Hex digit.
+ digit = byte(c) - 48
+ if digit > 48 then digit = digit - 39
+ elseif digit > 16 then digit = digit - 7 end
+ opcode = opcode*16 + digit
+ addin = nil
+ elseif c == "n" then -- Disable operand size mods for opcode.
+ szov = nil
+ elseif c == "X" then -- Force REX.W.
+ rex = 8
+ elseif c == "r" then -- Merge 1st operand regno. into opcode.
+ addin = args[1]; opcode = opcode + (addin.reg % 8)
+ if narg < 2 then narg = 2 end
+ elseif c == "R" then -- Merge 2nd operand regno. into opcode.
+ addin = args[2]; opcode = opcode + (addin.reg % 8)
+ narg = 3
+ elseif c == "m" or c == "M" then -- Encode ModRM/SIB.
+ local s
+ if addin then
+ s = addin.reg
+ opcode = opcode - (s%8) -- Undo regno opcode merge.
+ else
+ s = opcode % 16 -- Undo last digit.
+ opcode = (opcode - s) / 16
+ end
+ local nn = c == "m" and 1 or 2
+ local t = args[nn]
+ if narg <= nn then narg = nn + 1 end
+ if szov == "q" and rex == 0 then rex = rex + 8 end
+ if t.reg and t.reg > 7 then rex = rex + 1 end
+ if t.xreg and t.xreg > 7 then rex = rex + 2 end
+ if s > 7 then rex = rex + 4 end
+ if needrex then rex = rex + 16 end
+ wputop(szov, opcode, rex); opcode = nil
+ local imark = sub(pat, -1) -- Force a mark (ugly).
+ -- Put ModRM/SIB with regno/last digit as spare.
+ wputmrmsib(t, imark, s, addin and addin.vreg)
+ addin = nil
+ else
+ if opcode then -- Flush opcode.
+ if szov == "q" and rex == 0 then rex = rex + 8 end
+ if needrex then rex = rex + 16 end
+ if addin and addin.reg == -1 then
+ wputop(szov, opcode - 7, rex)
+ waction("VREG", addin.vreg); wputxb(0)
+ else
+ if addin and addin.reg > 7 then rex = rex + 1 end
+ wputop(szov, opcode, rex)
+ end
+ opcode = nil
+ end
+ if c == "|" then break end
+ if c == "o" then -- Offset (pure 32 bit displacement).
+ wputdarg(args[1].disp); if narg < 2 then narg = 2 end
+ elseif c == "O" then
+ wputdarg(args[2].disp); narg = 3
+ else
+ -- Anything else is an immediate operand.
+ local a = args[narg]
+ narg = narg + 1
+ local mode, imm = a.mode, a.imm
+ if mode == "iJ" and not match("iIJ", c) then
+ werror("bad operand size for label")
+ end
+ if c == "S" then
+ wputsbarg(imm)
+ elseif c == "U" then
+ wputbarg(imm)
+ elseif c == "W" then
+ wputwarg(imm)
+ elseif c == "i" or c == "I" then
+ if mode == "iJ" then
+ wputlabel("IMM_", imm, 1)
+ elseif mode == "iI" and c == "I" then
+ waction(sz == "w" and "IMM_WB" or "IMM_DB", imm)
+ else
+ wputszarg(sz, imm)
+ end
+ elseif c == "J" then
+ if mode == "iPJ" then
+ waction("REL_A", imm) -- !x64 (secpos)
+ else
+ wputlabel("REL_", imm, 2)
+ end
+ else
+ werror("bad char `"..c.."' in pattern `"..pat.."' for `"..op.."'")
+ end
+ end
+ end
+ end
+end
+
+------------------------------------------------------------------------------
+
+-- Mapping of operand modes to short names. Suppress output with '#'.
+local map_modename = {
+ r = "reg", R = "eax", C = "cl", x = "mem", m = "mrm", i = "imm",
+ f = "stx", F = "st0", J = "lbl", ["1"] = "1",
+ I = "#", S = "#", O = "#",
+}
+
+-- Return a table/string showing all possible operand modes.
+local function templatehelp(template, nparams)
+ if nparams == 0 then return "" end
+ local t = {}
+ for tm in gmatch(template, "[^%|]+") do
+ local s = map_modename[sub(tm, 1, 1)]
+ s = s..gsub(sub(tm, 2, nparams), ".", function(c)
+ return ", "..map_modename[c]
+ end)
+ if not match(s, "#") then t[#t+1] = s end
+ end
+ return t
+end
+
+-- Match operand modes against mode match part of template.
+local function matchtm(tm, args)
+ for i=1,#args do
+ if not match(args[i].mode, sub(tm, i, i)) then return end
+ end
+ return true
+end
+
+-- Handle opcodes defined with template strings.
+map_op[".template__"] = function(params, template, nparams)
+ if not params then return templatehelp(template, nparams) end
+ local args = {}
+
+ -- Zero-operand opcodes have no match part.
+ if #params == 0 then
+ dopattern(template, args, "d", params.op, nil)
+ return
+ end
+
+ -- Determine common operand size (coerce undefined size) or flag as mixed.
+ local sz, szmix, needrex
+ for i,p in ipairs(params) do
+ args[i] = parseoperand(p)
+ local nsz = args[i].opsize
+ if nsz then
+ if sz and sz ~= nsz then szmix = true else sz = nsz end
+ end
+ local nrex = args[i].needrex
+ if nrex ~= nil then
+ if needrex == nil then
+ needrex = nrex
+ elseif needrex ~= nrex then
+ werror("bad mix of byte-addressable registers")
+ end
+ end
+ end
+
+ -- Try all match:pattern pairs (separated by '|').
+ local gotmatch, lastpat
+ for tm in gmatch(template, "[^%|]+") do
+ -- Split off size match (starts after mode match) and pattern string.
+ local szm, pat = match(tm, "^(.-):(.*)$", #args+1)
+ if pat == "" then pat = lastpat else lastpat = pat end
+ if matchtm(tm, args) then
+ local prefix = sub(szm, 1, 1)
+ if prefix == "/" then -- Match both operand sizes.
+ if args[1].opsize == sub(szm, 2, 2) and
+ args[2].opsize == sub(szm, 3, 3) then
+ dopattern(pat, args, sz, params.op, needrex) -- Process pattern.
+ return
+ end
+ else -- Match common operand size.
+ local szp = sz
+ if szm == "" then szm = x64 and "qdwb" or "dwb" end -- Default sizes.
+ if prefix == "1" then szp = args[1].opsize; szmix = nil
+ elseif prefix == "2" then szp = args[2].opsize; szmix = nil end
+ if not szmix and (prefix == "." or match(szm, szp or "#")) then
+ dopattern(pat, args, szp, params.op, needrex) -- Process pattern.
+ return
+ end
+ end
+ gotmatch = true
+ end
+ end
+
+ local msg = "bad operand mode"
+ if gotmatch then
+ if szmix then
+ msg = "mixed operand size"
+ else
+ msg = sz and "bad operand size" or "missing operand size"
+ end
+ end
+
+ werror(msg.." in `"..opmodestr(params.op, args).."'")
+end
+
+------------------------------------------------------------------------------
+
+-- x64-specific opcode for 64 bit immediates and displacements.
+if x64 then
+ function map_op.mov64_2(params)
+ if not params then return { "reg, imm", "reg, [disp]", "[disp], reg" } end
+ if secpos+2 > maxsecpos then wflush() end
+ local opcode, op64, sz, rex
+ local op64 = match(params[1], "^%[%s*(.-)%s*%]$")
+ if op64 then
+ local a = parseoperand(params[2])
+ if a.mode ~= "rmR" then werror("bad operand mode") end
+ sz = a.opsize
+ rex = sz == "q" and 8 or 0
+ opcode = 0xa3
+ else
+ op64 = match(params[2], "^%[%s*(.-)%s*%]$")
+ local a = parseoperand(params[1])
+ if op64 then
+ if a.mode ~= "rmR" then werror("bad operand mode") end
+ sz = a.opsize
+ rex = sz == "q" and 8 or 0
+ opcode = 0xa1
+ else
+ if sub(a.mode, 1, 1) ~= "r" or a.opsize ~= "q" then
+ werror("bad operand mode")
+ end
+ op64 = params[2]
+ opcode = 0xb8 + (a.reg%8) -- !x64: no VREG support.
+ rex = a.reg > 7 and 9 or 8
+ end
+ end
+ wputop(sz, opcode, rex)
+ waction("IMM_D", format("(unsigned int)((uintptr_t)(%s))", op64))
+ waction("IMM_D", format("(unsigned int)(((uintptr_t)(%s))>>32)", op64))
+ end
+end
+
+------------------------------------------------------------------------------
+
+-- Pseudo-opcodes for data storage.
+local function op_data(params)
+ if not params then return "imm..." end
+ local sz = sub(params.op, 2, 2)
+ if sz == "a" then sz = addrsize end
+ for _,p in ipairs(params) do
+ local a = parseoperand(p)
+ if sub(a.mode, 1, 1) ~= "i" or (a.opsize and a.opsize ~= sz) then
+ werror("bad mode or size in `"..p.."'")
+ end
+ if a.mode == "iJ" then
+ wputlabel("IMM_", a.imm, 1)
+ else
+ wputszarg(sz, a.imm)
+ end
+ if secpos+2 > maxsecpos then wflush() end
+ end
+end
+
+map_op[".byte_*"] = op_data
+map_op[".sbyte_*"] = op_data
+map_op[".word_*"] = op_data
+map_op[".dword_*"] = op_data
+map_op[".aword_*"] = op_data
+
+------------------------------------------------------------------------------
+
+-- Pseudo-opcode to mark the position where the action list is to be emitted.
+map_op[".actionlist_1"] = function(params)
+ if not params then return "cvar" end
+ local name = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeactions(out, name) end)
+end
+
+-- Pseudo-opcode to mark the position where the global enum is to be emitted.
+map_op[".globals_1"] = function(params)
+ if not params then return "prefix" end
+ local prefix = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeglobals(out, prefix) end)
+end
+
+-- Pseudo-opcode to mark the position where the global names are to be emitted.
+map_op[".globalnames_1"] = function(params)
+ if not params then return "cvar" end
+ local name = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeglobalnames(out, name) end)
+end
+
+-- Pseudo-opcode to mark the position where the extern names are to be emitted.
+map_op[".externnames_1"] = function(params)
+ if not params then return "cvar" end
+ local name = params[1] -- No syntax check. You get to keep the pieces.
+ wline(function(out) writeexternnames(out, name) end)
+end
+
+------------------------------------------------------------------------------
+
+-- Label pseudo-opcode (converted from trailing colon form).
+map_op[".label_2"] = function(params)
+ if not params then return "[1-9] | ->global | =>pcexpr [, addr]" end
+ if secpos+2 > maxsecpos then wflush() end
+ local a = parseoperand(params[1])
+ local mode, imm = a.mode, a.imm
+ if type(imm) == "number" and (mode == "iJ" or (imm >= 1 and imm <= 9)) then
+ -- Local label (1: ... 9:) or global label (->global:).
+ waction("LABEL_LG", nil, 1)
+ wputxb(imm)
+ elseif mode == "iJ" then
+ -- PC label (=>pcexpr:).
+ waction("LABEL_PC", imm)
+ else
+ werror("bad label definition")
+ end
+ -- SETLABEL must immediately follow LABEL_LG/LABEL_PC.
+ local addr = params[2]
+ if addr then
+ local a = parseoperand(addr)
+ if a.mode == "iPJ" then
+ waction("SETLABEL", a.imm)
+ else
+ werror("bad label assignment")
+ end
+ end
+end
+map_op[".label_1"] = map_op[".label_2"]
+
+------------------------------------------------------------------------------
+
+-- Alignment pseudo-opcode.
+map_op[".align_1"] = function(params)
+ if not params then return "numpow2" end
+ if secpos+1 > maxsecpos then wflush() end
+ local align = tonumber(params[1]) or map_opsizenum[map_opsize[params[1]]]
+ if align then
+ local x = align
+ -- Must be a power of 2 in the range (2 ... 256).
+ for i=1,8 do
+ x = x / 2
+ if x == 1 then
+ waction("ALIGN", nil, 1)
+ wputxb(align-1) -- Action byte is 2**n-1.
+ return
+ end
+ end
+ end
+ werror("bad alignment")
+end
+
+-- Spacing pseudo-opcode.
+map_op[".space_2"] = function(params)
+ if not params then return "num [, filler]" end
+ if secpos+1 > maxsecpos then wflush() end
+ waction("SPACE", params[1])
+ local fill = params[2]
+ if fill then
+ fill = tonumber(fill)
+ if not fill or fill < 0 or fill > 255 then werror("bad filler") end
+ end
+ wputxb(fill or 0)
+end
+map_op[".space_1"] = map_op[".space_2"]
+
+------------------------------------------------------------------------------
+
+-- Pseudo-opcode for (primitive) type definitions (map to C types).
+map_op[".type_3"] = function(params, nparams)
+ if not params then
+ return nparams == 2 and "name, ctype" or "name, ctype, reg"
+ end
+ local name, ctype, reg = params[1], params[2], params[3]
+ if not match(name, "^[%a_][%w_]*$") then
+ werror("bad type name `"..name.."'")
+ end
+ local tp = map_type[name]
+ if tp then
+ werror("duplicate type `"..name.."'")
+ end
+ if reg and not map_reg_valid_base[reg] then
+ werror("bad base register `"..(map_reg_rev[reg] or reg).."'")
+ end
+ -- Add #type to defines. A bit unclean to put it in map_archdef.
+ map_archdef["#"..name] = "sizeof("..ctype..")"
+ -- Add new type and emit shortcut define.
+ local num = ctypenum + 1
+ map_type[name] = {
+ ctype = ctype,
+ ctypefmt = format("Dt%X(%%s)", num),
+ reg = reg,
+ }
+ wline(format("#define Dt%X(_V) (int)(ptrdiff_t)&(((%s *)0)_V)", num, ctype))
+ ctypenum = num
+end
+map_op[".type_2"] = map_op[".type_3"]
+
+-- Dump type definitions.
+local function dumptypes(out, lvl)
+ local t = {}
+ for name in pairs(map_type) do t[#t+1] = name end
+ sort(t)
+ out:write("Type definitions:\n")
+ for _,name in ipairs(t) do
+ local tp = map_type[name]
+ local reg = tp.reg and map_reg_rev[tp.reg] or ""
+ out:write(format(" %-20s %-20s %s\n", name, tp.ctype, reg))
+ end
+ out:write("\n")
+end
+
+------------------------------------------------------------------------------
+
+-- Set the current section.
+function _M.section(num)
+ waction("SECTION")
+ wputxb(num)
+ wflush(true) -- SECTION is a terminal action.
+end
+
+------------------------------------------------------------------------------
+
+-- Dump architecture description.
+function _M.dumparch(out)
+ out:write(format("DynASM %s version %s, released %s\n\n",
+ _info.arch, _info.version, _info.release))
+ dumpregs(out)
+ dumpactions(out)
+end
+
+-- Dump all user defined elements.
+function _M.dumpdef(out, lvl)
+ dumptypes(out, lvl)
+ dumpglobals(out, lvl)
+ dumpexterns(out, lvl)
+end
+
+------------------------------------------------------------------------------
+
+-- Pass callbacks from/to the DynASM core.
+function _M.passcb(wl, we, wf, ww)
+ wline, werror, wfatal, wwarn = wl, we, wf, ww
+ return wflush
+end
+
+-- Setup the arch-specific module.
+function _M.setup(arch, opt)
+ g_arch, g_opt = arch, opt
+end
+
+-- Merge the core maps and the arch-specific maps.
+function _M.mergemaps(map_coreop, map_def)
+ setmetatable(map_op, { __index = map_coreop })
+ setmetatable(map_def, { __index = map_archdef })
+ return map_op, map_def
+end
+
+return _M
+
+------------------------------------------------------------------------------
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dynasm.lua b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dynasm.lua
new file mode 100644
index 00000000000..2c5062d30a4
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/dynasm/dynasm.lua
@@ -0,0 +1,1096 @@
+------------------------------------------------------------------------------
+-- DynASM. A dynamic assembler for code generation engines.
+-- Originally designed and implemented for LuaJIT.
+--
+-- Copyright (C) 2005-2011 Mike Pall. All rights reserved.
+-- See below for full copyright notice.
+------------------------------------------------------------------------------
+
+-- Application information.
+local _info = {
+ name = "DynASM",
+ description = "A dynamic assembler for code generation engines",
+ version = "1.3.0",
+ vernum = 10300,
+ release = "2011-05-05",
+ author = "Mike Pall",
+ url = "http://luajit.org/dynasm.html",
+ license = "MIT",
+ copyright = [[
+Copyright (C) 2005-2011 Mike Pall. All rights reserved.
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+[ MIT license: http://www.opensource.org/licenses/mit-license.php ]
+]],
+}
+
+-- Cache library functions.
+local type, pairs, ipairs = type, pairs, ipairs
+local pcall, error, assert = pcall, error, assert
+local _s = string
+local sub, match, gmatch, gsub = _s.sub, _s.match, _s.gmatch, _s.gsub
+local format, rep, upper = _s.format, _s.rep, _s.upper
+local _t = table
+local insert, remove, concat, sort = _t.insert, _t.remove, _t.concat, _t.sort
+local exit = os.exit
+local io = io
+local stdin, stdout, stderr = io.stdin, io.stdout, io.stderr
+
+------------------------------------------------------------------------------
+
+-- Program options.
+local g_opt = {}
+
+-- Global state for current file.
+local g_fname, g_curline, g_indent, g_lineno, g_synclineno, g_arch
+local g_errcount = 0
+
+-- Write buffer for output file.
+local g_wbuffer, g_capbuffer
+
+------------------------------------------------------------------------------
+
+-- Write an output line (or callback function) to the buffer.
+local function wline(line, needindent)
+ local buf = g_capbuffer or g_wbuffer
+ buf[#buf+1] = needindent and g_indent..line or line
+ g_synclineno = g_synclineno + 1
+end
+
+-- Write assembler line as a comment, if requestd.
+local function wcomment(aline)
+ if g_opt.comment then
+ wline(g_opt.comment..aline..g_opt.endcomment, true)
+ end
+end
+
+-- Resync CPP line numbers.
+local function wsync()
+ if g_synclineno ~= g_lineno and g_opt.cpp then
+ wline("# "..g_lineno..' "'..g_fname..'"')
+ g_synclineno = g_lineno
+ end
+end
+
+-- Dummy action flush function. Replaced with arch-specific function later.
+local function wflush(term)
+end
+
+-- Dump all buffered output lines.
+local function wdumplines(out, buf)
+ for _,line in ipairs(buf) do
+ if type(line) == "string" then
+ assert(out:write(line, "\n"))
+ else
+ -- Special callback to dynamically insert lines after end of processing.
+ line(out)
+ end
+ end
+end
+
+------------------------------------------------------------------------------
+
+-- Emit an error. Processing continues with next statement.
+local function werror(msg)
+ if g_opt.vserror then
+ error(format("%s(%s) : error: %s:\n%s", g_fname, g_lineno, msg, g_curline), 0)
+ else
+ error(format("%s:%s: error: %s:\n%s", g_fname, g_lineno, msg, g_curline), 0)
+ end
+end
+
+-- Emit a fatal error. Processing stops.
+local function wfatal(msg)
+ g_errcount = "fatal"
+ werror(msg)
+end
+
+-- Print a warning. Processing continues.
+local function wwarn(msg)
+ stderr:write(format("%s:%s: warning: %s:\n%s\n",
+ g_fname, g_lineno, msg, g_curline))
+end
+
+-- Print caught error message. But suppress excessive errors.
+local function wprinterr(...)
+ if type(g_errcount) == "number" then
+ -- Regular error.
+ g_errcount = g_errcount + 1
+ if g_errcount < 21 then -- Seems to be a reasonable limit.
+ stderr:write(...)
+ elseif g_errcount == 21 then
+ stderr:write(g_fname,
+ ":*: warning: too many errors (suppressed further messages).\n")
+ end
+ else
+ -- Fatal error.
+ stderr:write(...)
+ return true -- Stop processing.
+ end
+end
+
+------------------------------------------------------------------------------
+
+-- Map holding all option handlers.
+local opt_map = {}
+local opt_current
+
+-- Print error and exit with error status.
+local function opterror(...)
+ stderr:write("dynasm.lua: ERROR: ", ...)
+ stderr:write("\n")
+ exit(1)
+end
+
+-- Get option parameter.
+local function optparam(args)
+ local argn = args.argn
+ local p = args[argn]
+ if not p then
+ opterror("missing parameter for option `", opt_current, "'.")
+ end
+ args.argn = argn + 1
+ return p
+end
+
+------------------------------------------------------------------------------
+
+-- Core pseudo-opcodes.
+local map_coreop = {}
+-- Dummy opcode map. Replaced by arch-specific map.
+local map_op = {}
+
+-- Forward declarations.
+local dostmt
+local readfile
+
+------------------------------------------------------------------------------
+
+-- Map for defines (initially empty, chains to arch-specific map).
+local map_def = {}
+
+-- Pseudo-opcode to define a substitution.
+map_coreop[".define_2"] = function(params, nparams)
+ if not params then return nparams == 1 and "name" or "name, subst" end
+ local name, def = params[1], params[2] or "1"
+ if not match(name, "^[%a_][%w_]*$") then werror("bad or duplicate define") end
+ map_def[name] = def
+end
+map_coreop[".define_1"] = map_coreop[".define_2"]
+
+-- Define a substitution on the command line.
+function opt_map.D(args)
+ local namesubst = optparam(args)
+ local name, subst = match(namesubst, "^([%a_][%w_]*)=(.*)$")
+ if name then
+ map_def[name] = subst
+ elseif match(namesubst, "^[%a_][%w_]*$") then
+ map_def[namesubst] = "1"
+ else
+ opterror("bad define")
+ end
+end
+
+-- Undefine a substitution on the command line.
+function opt_map.U(args)
+ local name = optparam(args)
+ if match(name, "^[%a_][%w_]*$") then
+ map_def[name] = nil
+ else
+ opterror("bad define")
+ end
+end
+
+-- Helper for definesubst.
+local gotsubst
+
+local function definesubst_one(word)
+ local subst = map_def[word]
+ if subst then gotsubst = word; return subst else return word end
+end
+
+-- Iteratively substitute defines.
+local function definesubst(stmt)
+ -- Limit number of iterations.
+ for i=1,100 do
+ gotsubst = false
+ stmt = gsub(stmt, "#?[%w_]+", definesubst_one)
+ if not gotsubst then break end
+ end
+ if gotsubst then wfatal("recursive define involving `"..gotsubst.."'") end
+ return stmt
+end
+
+-- Dump all defines.
+local function dumpdefines(out, lvl)
+ local t = {}
+ for name in pairs(map_def) do
+ t[#t+1] = name
+ end
+ sort(t)
+ out:write("Defines:\n")
+ for _,name in ipairs(t) do
+ local subst = map_def[name]
+ if g_arch then subst = g_arch.revdef(subst) end
+ out:write(format(" %-20s %s\n", name, subst))
+ end
+ out:write("\n")
+end
+
+------------------------------------------------------------------------------
+
+-- Support variables for conditional assembly.
+local condlevel = 0
+local condstack = {}
+
+local function loadin(source, env)
+ if setfenv then
+ local func, err = loadstring(source)
+ if func then
+ setfenv(func, env)
+ end
+ return func, err
+ else
+ return load(source, nil, nil, env)
+ end
+end
+
+-- Evaluate condition with a Lua expression. Substitutions already performed.
+local function cond_eval(cond)
+ -- No globals. All unknown identifiers evaluate to nil.
+ local func, err = loadin("return "..cond, {})
+ if func then
+ local ok, res = pcall(func)
+ if ok then
+ if res == 0 then return false end -- Oh well.
+ return not not res
+ end
+ err = res
+ end
+ wfatal("bad condition: "..err)
+end
+
+-- Skip statements until next conditional pseudo-opcode at the same level.
+local function stmtskip()
+ local dostmt_save = dostmt
+ local lvl = 0
+ dostmt = function(stmt)
+ local op = match(stmt, "^%s*(%S+)")
+ if op == ".if" then
+ lvl = lvl + 1
+ elseif lvl ~= 0 then
+ if op == ".endif" then lvl = lvl - 1 end
+ elseif op == ".elif" or op == ".else" or op == ".endif" then
+ dostmt = dostmt_save
+ dostmt(stmt)
+ end
+ end
+end
+
+-- Pseudo-opcodes for conditional assembly.
+map_coreop[".if_1"] = function(params)
+ if not params then return "condition" end
+ local lvl = condlevel + 1
+ local res = cond_eval(params[1])
+ condlevel = lvl
+ condstack[lvl] = res
+ if not res then stmtskip() end
+end
+
+map_coreop[".elif_1"] = function(params)
+ if not params then return "condition" end
+ if condlevel == 0 then wfatal(".elif without .if") end
+ local lvl = condlevel
+ local res = condstack[lvl]
+ if res then
+ if res == "else" then wfatal(".elif after .else") end
+ else
+ res = cond_eval(params[1])
+ if res then
+ condstack[lvl] = res
+ return
+ end
+ end
+ stmtskip()
+end
+
+map_coreop[".else_0"] = function(params)
+ if condlevel == 0 then wfatal(".else without .if") end
+ local lvl = condlevel
+ local res = condstack[lvl]
+ condstack[lvl] = "else"
+ if res then
+ if res == "else" then wfatal(".else after .else") end
+ stmtskip()
+ end
+end
+
+map_coreop[".endif_0"] = function(params)
+ local lvl = condlevel
+ if lvl == 0 then wfatal(".endif without .if") end
+ condlevel = lvl - 1
+end
+
+-- Check for unfinished conditionals.
+local function checkconds()
+ if g_errcount ~= "fatal" and condlevel ~= 0 then
+ wprinterr(g_fname, ":*: error: unbalanced conditional\n")
+ end
+end
+
+------------------------------------------------------------------------------
+
+-- Search for a file in the given path and open it for reading.
+local function pathopen(path, name)
+ local dirsep = match(package.path, "\\") and "\\" or "/"
+ for _,p in ipairs(path) do
+ local fullname = p == "" and name or p..dirsep..name
+ local fin = io.open(fullname, "r")
+ if fin then
+ g_fname = fullname
+ return fin
+ end
+ end
+end
+
+-- Include a file.
+map_coreop[".include_1"] = function(params)
+ if not params then return "filename" end
+ local name = params[1]
+ -- Save state. Ugly, I know. but upvalues are fast.
+ local gf, gl, gcl, gi = g_fname, g_lineno, g_curline, g_indent
+ -- Read the included file.
+ local fatal = readfile(pathopen(g_opt.include, name) or
+ wfatal("include file `"..name.."' not found"))
+ -- Restore state.
+ g_synclineno = -1
+ g_fname, g_lineno, g_curline, g_indent = gf, gl, gcl, gi
+ if fatal then wfatal("in include file") end
+end
+
+-- Make .include and conditionals initially available, too.
+map_op[".include_1"] = map_coreop[".include_1"]
+map_op[".if_1"] = map_coreop[".if_1"]
+map_op[".elif_1"] = map_coreop[".elif_1"]
+map_op[".else_0"] = map_coreop[".else_0"]
+map_op[".endif_0"] = map_coreop[".endif_0"]
+
+------------------------------------------------------------------------------
+
+-- Support variables for macros.
+local mac_capture, mac_lineno, mac_name
+local mac_active = {}
+local mac_list = {}
+
+-- Pseudo-opcode to define a macro.
+map_coreop[".macro_*"] = function(mparams)
+ if not mparams then return "name [, params...]" end
+ -- Split off and validate macro name.
+ local name = remove(mparams, 1)
+ if not name then werror("missing macro name") end
+ if not (match(name, "^[%a_][%w_%.]*$") or match(name, "^%.[%w_%.]+$")) then
+ wfatal("bad macro name `"..name.."'")
+ end
+ -- Validate macro parameter names.
+ local mdup = {}
+ for _,mp in ipairs(mparams) do
+ if not match(mp, "^[%a_][%w_]*$") then
+ wfatal("bad macro parameter name `"..mp.."'")
+ end
+ if mdup[mp] then wfatal("duplicate macro parameter name `"..mp.."'") end
+ mdup[mp] = true
+ end
+ -- Check for duplicate or recursive macro definitions.
+ local opname = name.."_"..#mparams
+ if map_op[opname] or map_op[name.."_*"] then
+ wfatal("duplicate macro `"..name.."' ("..#mparams.." parameters)")
+ end
+ if mac_capture then wfatal("recursive macro definition") end
+
+ -- Enable statement capture.
+ local lines = {}
+ mac_lineno = g_lineno
+ mac_name = name
+ mac_capture = function(stmt) -- Statement capture function.
+ -- Stop macro definition with .endmacro pseudo-opcode.
+ if not match(stmt, "^%s*.endmacro%s*$") then
+ lines[#lines+1] = stmt
+ return
+ end
+ mac_capture = nil
+ mac_lineno = nil
+ mac_name = nil
+ mac_list[#mac_list+1] = opname
+ -- Add macro-op definition.
+ map_op[opname] = function(params)
+ if not params then return mparams, lines end
+ -- Protect against recursive macro invocation.
+ if mac_active[opname] then wfatal("recursive macro invocation") end
+ mac_active[opname] = true
+ -- Setup substitution map.
+ local subst = {}
+ for i,mp in ipairs(mparams) do subst[mp] = params[i] end
+ local mcom
+ if g_opt.maccomment and g_opt.comment then
+ mcom = " MACRO "..name.." ("..#mparams..")"
+ wcomment("{"..mcom)
+ end
+ -- Loop through all captured statements
+ for _,stmt in ipairs(lines) do
+ -- Substitute macro parameters.
+ local st = gsub(stmt, "[%w_]+", subst)
+ st = definesubst(st)
+ st = gsub(st, "%s*%.%.%s*", "") -- Token paste a..b.
+ if mcom and sub(st, 1, 1) ~= "|" then wcomment(st) end
+ -- Emit statement. Use a protected call for better diagnostics.
+ local ok, err = pcall(dostmt, st)
+ if not ok then
+ -- Add the captured statement to the error.
+ wprinterr(err, "\n", g_indent, "| ", stmt,
+ "\t[MACRO ", name, " (", #mparams, ")]\n")
+ end
+ end
+ if mcom then wcomment("}"..mcom) end
+ mac_active[opname] = nil
+ end
+ end
+end
+
+-- An .endmacro pseudo-opcode outside of a macro definition is an error.
+map_coreop[".endmacro_0"] = function(params)
+ wfatal(".endmacro without .macro")
+end
+
+-- Dump all macros and their contents (with -PP only).
+local function dumpmacros(out, lvl)
+ sort(mac_list)
+ out:write("Macros:\n")
+ for _,opname in ipairs(mac_list) do
+ local name = sub(opname, 1, -3)
+ local params, lines = map_op[opname]()
+ out:write(format(" %-20s %s\n", name, concat(params, ", ")))
+ if lvl > 1 then
+ for _,line in ipairs(lines) do
+ out:write(" |", line, "\n")
+ end
+ out:write("\n")
+ end
+ end
+ out:write("\n")
+end
+
+-- Check for unfinished macro definitions.
+local function checkmacros()
+ if mac_capture then
+ wprinterr(g_fname, ":", mac_lineno,
+ ": error: unfinished .macro `", mac_name ,"'\n")
+ end
+end
+
+------------------------------------------------------------------------------
+
+-- Support variables for captures.
+local cap_lineno, cap_name
+local cap_buffers = {}
+local cap_used = {}
+
+-- Start a capture.
+map_coreop[".capture_1"] = function(params)
+ if not params then return "name" end
+ wflush()
+ local name = params[1]
+ if not match(name, "^[%a_][%w_]*$") then
+ wfatal("bad capture name `"..name.."'")
+ end
+ if cap_name then
+ wfatal("already capturing to `"..cap_name.."' since line "..cap_lineno)
+ end
+ cap_name = name
+ cap_lineno = g_lineno
+ -- Create or continue a capture buffer and start the output line capture.
+ local buf = cap_buffers[name]
+ if not buf then buf = {}; cap_buffers[name] = buf end
+ g_capbuffer = buf
+ g_synclineno = 0
+end
+
+-- Stop a capture.
+map_coreop[".endcapture_0"] = function(params)
+ wflush()
+ if not cap_name then wfatal(".endcapture without a valid .capture") end
+ cap_name = nil
+ cap_lineno = nil
+ g_capbuffer = nil
+ g_synclineno = 0
+end
+
+-- Dump a capture buffer.
+map_coreop[".dumpcapture_1"] = function(params)
+ if not params then return "name" end
+ wflush()
+ local name = params[1]
+ if not match(name, "^[%a_][%w_]*$") then
+ wfatal("bad capture name `"..name.."'")
+ end
+ cap_used[name] = true
+ wline(function(out)
+ local buf = cap_buffers[name]
+ if buf then wdumplines(out, buf) end
+ end)
+ g_synclineno = 0
+end
+
+-- Dump all captures and their buffers (with -PP only).
+local function dumpcaptures(out, lvl)
+ out:write("Captures:\n")
+ for name,buf in pairs(cap_buffers) do
+ out:write(format(" %-20s %4s)\n", name, "("..#buf))
+ if lvl > 1 then
+ local bar = rep("=", 76)
+ out:write(" ", bar, "\n")
+ for _,line in ipairs(buf) do
+ out:write(" ", line, "\n")
+ end
+ out:write(" ", bar, "\n\n")
+ end
+ end
+ out:write("\n")
+end
+
+-- Check for unfinished or unused captures.
+local function checkcaptures()
+ if cap_name then
+ wprinterr(g_fname, ":", cap_lineno,
+ ": error: unfinished .capture `", cap_name,"'\n")
+ return
+ end
+ for name in pairs(cap_buffers) do
+ if not cap_used[name] then
+ wprinterr(g_fname, ":*: error: missing .dumpcapture ", name ,"\n")
+ end
+ end
+end
+
+------------------------------------------------------------------------------
+
+-- Sections names.
+local map_sections = {}
+
+-- Pseudo-opcode to define code sections.
+-- TODO: Data sections, BSS sections. Needs extra C code and API.
+map_coreop[".section_*"] = function(params)
+ if not params then return "name..." end
+ if #map_sections > 0 then werror("duplicate section definition") end
+ wflush()
+ for sn,name in ipairs(params) do
+ local opname = "."..name.."_0"
+ if not match(name, "^[%a][%w_]*$") or
+ map_op[opname] or map_op["."..name.."_*"] then
+ werror("bad section name `"..name.."'")
+ end
+ map_sections[#map_sections+1] = name
+ wline(format("#define DASM_SECTION_%s\t%d", upper(name), sn-1))
+ map_op[opname] = function(params) g_arch.section(sn-1) end
+ end
+ wline(format("#define DASM_MAXSECTION\t\t%d", #map_sections))
+end
+
+-- Dump all sections.
+local function dumpsections(out, lvl)
+ out:write("Sections:\n")
+ for _,name in ipairs(map_sections) do
+ out:write(format(" %s\n", name))
+ end
+ out:write("\n")
+end
+
+------------------------------------------------------------------------------
+
+-- Load architecture-specific module.
+local function loadarch(arch)
+ if not match(arch, "^[%w_]+$") then return "bad arch name" end
+ local ok, m_arch = pcall(require, "dasm_"..arch)
+ if not ok then return "cannot load module: "..m_arch end
+ g_arch = m_arch
+ wflush = m_arch.passcb(wline, werror, wfatal, wwarn)
+ m_arch.setup(arch, g_opt)
+ map_op, map_def = m_arch.mergemaps(map_coreop, map_def)
+end
+
+-- Dump architecture description.
+function opt_map.dumparch(args)
+ local name = optparam(args)
+ if not g_arch then
+ local err = loadarch(name)
+ if err then opterror(err) end
+ end
+
+ local t = {}
+ for name in pairs(map_coreop) do t[#t+1] = name end
+ for name in pairs(map_op) do t[#t+1] = name end
+ sort(t)
+
+ local out = stdout
+ local _arch = g_arch._info
+ out:write(format("%s version %s, released %s, %s\n",
+ _info.name, _info.version, _info.release, _info.url))
+ g_arch.dumparch(out)
+
+ local pseudo = true
+ out:write("Pseudo-Opcodes:\n")
+ for _,sname in ipairs(t) do
+ local name, nparam = match(sname, "^(.+)_([0-9%*])$")
+ if name then
+ if pseudo and sub(name, 1, 1) ~= "." then
+ out:write("\nOpcodes:\n")
+ pseudo = false
+ end
+ local f = map_op[sname]
+ local s
+ if nparam ~= "*" then nparam = nparam + 0 end
+ if nparam == 0 then
+ s = ""
+ elseif type(f) == "string" then
+ s = map_op[".template__"](nil, f, nparam)
+ else
+ s = f(nil, nparam)
+ end
+ if type(s) == "table" then
+ for _,s2 in ipairs(s) do
+ out:write(format(" %-12s %s\n", name, s2))
+ end
+ else
+ out:write(format(" %-12s %s\n", name, s))
+ end
+ end
+ end
+ out:write("\n")
+ exit(0)
+end
+
+-- Pseudo-opcode to set the architecture.
+-- Only initially available (map_op is replaced when called).
+map_op[".arch_1"] = function(params)
+ if not params then return "name" end
+ local err = loadarch(params[1])
+ if err then wfatal(err) end
+end
+
+-- Dummy .arch pseudo-opcode to improve the error report.
+map_coreop[".arch_1"] = function(params)
+ if not params then return "name" end
+ wfatal("duplicate .arch statement")
+end
+
+------------------------------------------------------------------------------
+
+-- Dummy pseudo-opcode. Don't confuse '.nop' with 'nop'.
+map_coreop[".nop_*"] = function(params)
+ if not params then return "[ignored...]" end
+end
+
+-- Pseudo-opcodes to raise errors.
+map_coreop[".error_1"] = function(params)
+ if not params then return "message" end
+ werror(params[1])
+end
+
+map_coreop[".fatal_1"] = function(params)
+ if not params then return "message" end
+ wfatal(params[1])
+end
+
+-- Dump all user defined elements.
+local function dumpdef(out)
+ local lvl = g_opt.dumpdef
+ if lvl == 0 then return end
+ dumpsections(out, lvl)
+ dumpdefines(out, lvl)
+ if g_arch then g_arch.dumpdef(out, lvl) end
+ dumpmacros(out, lvl)
+ dumpcaptures(out, lvl)
+end
+
+------------------------------------------------------------------------------
+
+-- Helper for splitstmt.
+local splitlvl
+
+local function splitstmt_one(c)
+ if c == "(" then
+ splitlvl = ")"..splitlvl
+ elseif c == "[" then
+ splitlvl = "]"..splitlvl
+ elseif c == "{" then
+ splitlvl = "}"..splitlvl
+ elseif c == ")" or c == "]" or c == "}" then
+ if sub(splitlvl, 1, 1) ~= c then werror("unbalanced (), [] or {}") end
+ splitlvl = sub(splitlvl, 2)
+ elseif splitlvl == "" then
+ return " \0 "
+ end
+ return c
+end
+
+-- Split statement into (pseudo-)opcode and params.
+local function splitstmt(stmt)
+ -- Convert label with trailing-colon into .label statement.
+ local label = match(stmt, "^%s*(.+):%s*$")
+ if label then return ".label", {label} end
+
+ -- Split at commas and equal signs, but obey parentheses and brackets.
+ splitlvl = ""
+ stmt = gsub(stmt, "[,%(%)%[%]{}]", splitstmt_one)
+ if splitlvl ~= "" then werror("unbalanced () or []") end
+
+ -- Split off opcode.
+ local op, other = match(stmt, "^%s*([^%s%z]+)%s*(.*)$")
+ if not op then werror("bad statement syntax") end
+
+ -- Split parameters.
+ local params = {}
+ for p in gmatch(other, "%s*(%Z+)%z?") do
+ params[#params+1] = gsub(p, "%s+$", "")
+ end
+ if #params > 16 then werror("too many parameters") end
+
+ params.op = op
+ return op, params
+end
+
+-- Process a single statement.
+dostmt = function(stmt)
+ -- Ignore empty statements.
+ if match(stmt, "^%s*$") then return end
+
+ -- Capture macro defs before substitution.
+ if mac_capture then return mac_capture(stmt) end
+ stmt = definesubst(stmt)
+
+ -- Emit C code without parsing the line.
+ if sub(stmt, 1, 1) == "|" then
+ local tail = sub(stmt, 2)
+ wflush()
+ if sub(tail, 1, 2) == "//" then wcomment(tail) else wline(tail, true) end
+ return
+ end
+
+ -- Split into (pseudo-)opcode and params.
+ local op, params = splitstmt(stmt)
+
+ -- Get opcode handler (matching # of parameters or generic handler).
+ local f = map_op[op.."_"..#params] or map_op[op.."_*"]
+ if not f then
+ if not g_arch then wfatal("first statement must be .arch") end
+ -- Improve error report.
+ for i=0,9 do
+ if map_op[op.."_"..i] then
+ werror("wrong number of parameters for `"..op.."'")
+ end
+ end
+ werror("unknown statement `"..op.."'")
+ end
+
+ -- Call opcode handler or special handler for template strings.
+ if type(f) == "string" then
+ map_op[".template__"](params, f)
+ else
+ f(params)
+ end
+end
+
+-- Process a single line.
+local function doline(line)
+ if g_opt.flushline then wflush() end
+
+ -- Assembler line?
+ local indent, aline = match(line, "^(%s*)%|(.*)$")
+ if not aline then
+ -- No, plain C code line, need to flush first.
+ wflush()
+ wsync()
+ wline(line, false)
+ return
+ end
+
+ g_indent = indent -- Remember current line indentation.
+
+ -- Emit C code (even from macros). Avoids echo and line parsing.
+ if sub(aline, 1, 1) == "|" then
+ if not mac_capture then
+ wsync()
+ elseif g_opt.comment then
+ wsync()
+ wcomment(aline)
+ end
+ dostmt(aline)
+ return
+ end
+
+ -- Echo assembler line as a comment.
+ if g_opt.comment then
+ wsync()
+ wcomment(aline)
+ end
+
+ -- Strip assembler comments.
+ aline = gsub(aline, "//.*$", "")
+
+ -- Split line into statements at semicolons.
+ if match(aline, ";") then
+ for stmt in gmatch(aline, "[^;]+") do dostmt(stmt) end
+ else
+ dostmt(aline)
+ end
+end
+
+------------------------------------------------------------------------------
+
+-- Write DynASM header.
+local function dasmhead(out)
+ out:write(format([[
+/*
+** This file has been pre-processed with DynASM.
+** %s
+** DynASM version %s, DynASM %s version %s
+** DO NOT EDIT! The original file is in "%s".
+*/
+
+#if DASM_VERSION != %d
+#error "Version mismatch between DynASM and included encoding engine"
+#endif
+
+]], _info.url,
+ _info.version, g_arch._info.arch, g_arch._info.version,
+ g_fname, _info.vernum))
+end
+
+-- Read input file.
+readfile = function(fin)
+ g_indent = ""
+ g_lineno = 0
+ g_synclineno = -1
+
+ -- Process all lines.
+ for line in fin:lines() do
+ g_lineno = g_lineno + 1
+ g_curline = line
+ local ok, err = pcall(doline, line)
+ if not ok and wprinterr(err, "\n") then return true end
+ end
+ wflush()
+
+ -- Close input file.
+ assert(fin == stdin or fin:close())
+end
+
+-- Write output file.
+local function writefile(outfile)
+ local fout
+
+ -- Open output file.
+ if outfile == nil or outfile == "-" then
+ fout = stdout
+ else
+ fout = assert(io.open(outfile, "w"))
+ end
+
+ -- Write all buffered lines
+ wdumplines(fout, g_wbuffer)
+
+ -- Close output file.
+ assert(fout == stdout or fout:close())
+
+ -- Optionally dump definitions.
+ dumpdef(fout == stdout and stderr or stdout)
+end
+
+-- Translate an input file to an output file.
+local function translate(infile, outfile)
+ g_wbuffer = {}
+ g_indent = ""
+ g_lineno = 0
+ g_synclineno = -1
+
+ -- Put header.
+ wline(dasmhead)
+
+ -- Read input file.
+ local fin
+ if infile == "-" then
+ g_fname = "(stdin)"
+ fin = stdin
+ else
+ g_fname = infile
+ fin = assert(io.open(infile, "r"))
+ end
+ readfile(fin)
+
+ -- Check for errors.
+ if not g_arch then
+ wprinterr(g_fname, ":*: error: missing .arch directive\n")
+ end
+ checkconds()
+ checkmacros()
+ checkcaptures()
+
+ if g_errcount ~= 0 then
+ stderr:write(g_fname, ":*: info: ", g_errcount, " error",
+ (type(g_errcount) == "number" and g_errcount > 1) and "s" or "",
+ " in input file -- no output file generated.\n")
+ dumpdef(stderr)
+ exit(1)
+ end
+
+ -- Write output file.
+ writefile(outfile)
+end
+
+------------------------------------------------------------------------------
+
+-- Print help text.
+function opt_map.help()
+ stdout:write("DynASM -- ", _info.description, ".\n")
+ stdout:write("DynASM ", _info.version, " ", _info.release, " ", _info.url, "\n")
+ stdout:write[[
+
+Usage: dynasm [OPTION]... INFILE.dasc|-
+
+ -h, --help Display this help text.
+ -V, --version Display version and copyright information.
+
+ -o, --outfile FILE Output file name (default is stdout).
+ -I, --include DIR Add directory to the include search path.
+
+ -c, --ccomment Use /* */ comments for assembler lines.
+ -C, --cppcomment Use // comments for assembler lines (default).
+ -N, --nocomment Suppress assembler lines in output.
+ -M, --maccomment Show macro expansions as comments (default off).
+
+ -L, --nolineno Suppress CPP line number information in output.
+ -F, --flushline Flush action list for every line.
+
+ -E, --vserror Use Visual Studio style errors file(line) vs file:line
+
+ -D NAME[=SUBST] Define a substitution.
+ -U NAME Undefine a substitution.
+
+ -P, --dumpdef Dump defines, macros, etc. Repeat for more output.
+ -A, --dumparch ARCH Load architecture ARCH and dump description.
+]]
+ exit(0)
+end
+
+-- Print version information.
+function opt_map.version()
+ stdout:write(format("%s version %s, released %s\n%s\n\n%s",
+ _info.name, _info.version, _info.release, _info.url, _info.copyright))
+ exit(0)
+end
+
+-- Misc. options.
+function opt_map.outfile(args) g_opt.outfile = optparam(args) end
+function opt_map.include(args) insert(g_opt.include, 1, optparam(args)) end
+function opt_map.ccomment() g_opt.comment = "/*|"; g_opt.endcomment = " */" end
+function opt_map.cppcomment() g_opt.comment = "//|"; g_opt.endcomment = "" end
+function opt_map.nocomment() g_opt.comment = false end
+function opt_map.maccomment() g_opt.maccomment = true end
+function opt_map.nolineno() g_opt.cpp = false end
+function opt_map.flushline() g_opt.flushline = true end
+function opt_map.vserror() g_opt.vserror = true end
+function opt_map.dumpdef() g_opt.dumpdef = g_opt.dumpdef + 1 end
+
+------------------------------------------------------------------------------
+
+-- Short aliases for long options.
+local opt_alias = {
+ h = "help", ["?"] = "help", V = "version",
+ o = "outfile", I = "include",
+ c = "ccomment", C = "cppcomment", N = "nocomment", M = "maccomment",
+ L = "nolineno", F = "flushline",
+ E = "vserror",
+ P = "dumpdef", A = "dumparch",
+}
+
+-- Parse single option.
+local function parseopt(opt, args)
+ opt_current = #opt == 1 and "-"..opt or "--"..opt
+ local f = opt_map[opt] or opt_map[opt_alias[opt]]
+ if not f then
+ opterror("unrecognized option `", opt_current, "'. Try `--help'.\n")
+ end
+ f(args)
+end
+
+-- Parse arguments.
+local function parseargs(args)
+ -- Default options.
+ g_opt.comment = "//|"
+ g_opt.endcomment = ""
+ g_opt.cpp = true
+ g_opt.dumpdef = 0
+ g_opt.include = { "" }
+
+ -- Process all option arguments.
+ args.argn = 1
+ repeat
+ local a = args[args.argn]
+ if not a then break end
+ local lopt, opt = match(a, "^%-(%-?)(.+)")
+ if not opt then break end
+ args.argn = args.argn + 1
+ if lopt == "" then
+ -- Loop through short options.
+ for o in gmatch(opt, ".") do parseopt(o, args) end
+ else
+ -- Long option.
+ parseopt(opt, args)
+ end
+ until false
+
+ -- Check for proper number of arguments.
+ local nargs = #args - args.argn + 1
+ if nargs ~= 1 then
+ if nargs == 0 then
+ if g_opt.dumpdef > 0 then return dumpdef(stdout) end
+ end
+ opt_map.help()
+ end
+
+ -- Translate a single input file to a single output file
+ -- TODO: Handle multiple files?
+ translate(args[args.argn], g_opt.outfile)
+end
+
+------------------------------------------------------------------------------
+
+-- Add the directory dynasm.lua resides in to the Lua module search path.
+local arg = arg
+if arg and arg[0] then
+ local prefix = match(arg[0], "^(.*[/\\])")
+ if prefix then package.path = prefix.."?.lua;"..package.path end
+end
+
+-- Start DynASM.
+parseargs{...}
+
+------------------------------------------------------------------------------
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/ffi.c b/Build/source/texk/web2c/luatexdir/luaffi/ffi.c
new file mode 100644
index 00000000000..5bfdae26155
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/ffi.c
@@ -0,0 +1,3614 @@
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+#include "ffi.h"
+#include <math.h>
+#include <inttypes.h>
+
+/* Set to 1 to get extra debugging on print */
+#define DEBUG_TOSTRING 0
+
+int jit_key;
+int ctype_mt_key;
+int cdata_mt_key;
+int callback_mt_key;
+int cmodule_mt_key;
+int constants_key;
+int types_key;
+int gc_key;
+int callbacks_key;
+int functions_key;
+int abi_key;
+int next_unnamed_key;
+int niluv_key;
+int asmname_key;
+
+void push_upval(lua_State* L, int* key)
+{
+ lua_pushlightuserdata(L, key);
+ lua_rawget(L, LUA_REGISTRYINDEX);
+}
+
+void set_upval(lua_State* L, int* key)
+{
+ lua_pushlightuserdata(L, key);
+ lua_insert(L, -2);
+ lua_rawset(L, LUA_REGISTRYINDEX);
+}
+
+int equals_upval(lua_State* L, int idx, int* key)
+{
+ int ret;
+ lua_pushvalue(L, idx);
+ push_upval(L, key);
+ ret = lua_rawequal(L, -2, -1);
+ lua_pop(L, 2);
+ return ret;
+}
+
+struct jit* get_jit(lua_State* L)
+{
+ struct jit* jit;
+ push_upval(L, &jit_key);
+ jit = (struct jit*) lua_touserdata(L, -1);
+ jit->L = L;
+ lua_pop(L, 1); /* still in registry */
+ return jit;
+}
+
+static int type_error(lua_State* L, int idx, const char* to_type, int to_usr, const struct ctype* to_ct)
+{
+ luaL_Buffer B;
+ struct ctype ft;
+
+ assert(to_type || (to_usr && to_ct));
+ if (to_usr) {
+ to_usr = lua_absindex(L, to_usr);
+ }
+
+ idx = lua_absindex(L, idx);
+
+ luaL_buffinit(L, &B);
+ to_cdata(L, idx, &ft);
+
+ if (ft.type != INVALID_TYPE) {
+ push_type_name(L, -1, &ft);
+ lua_pushfstring(L, "unable to convert argument %d from cdata<%s> to cdata<", idx, lua_tostring(L, -1));
+ lua_remove(L, -2);
+ luaL_addvalue(&B);
+ } else {
+ lua_pushfstring(L, "unable to convert argument %d from lua<%s> to cdata<", idx, luaL_typename(L, idx));
+ luaL_addvalue(&B);
+ }
+
+ if (to_ct) {
+ push_type_name(L, to_usr, to_ct);
+ luaL_addvalue(&B);
+ } else {
+ luaL_addstring(&B, to_type);
+ }
+
+ luaL_addchar(&B, '>');
+
+ luaL_pushresult(&B);
+ return lua_error(L);
+}
+
+static void* userdata_toptr(lua_State* L, int idx)
+{
+ void* ptr = lua_touserdata(L, idx);
+ int isfile;
+
+ // check for FILE*
+ lua_getmetatable(L, idx);
+ luaL_getmetatable(L, LUA_FILEHANDLE);
+ isfile = lua_rawequal(L, -1, -2);
+ lua_pop(L, 2);
+
+ if (isfile) {
+#if LUA_VERSION_NUM == 501
+ FILE** stream = (FILE**) ptr;
+ return *stream;
+#else
+ luaL_Stream* stream = (luaL_Stream*) ptr;
+ return stream->f;
+#endif
+ }
+
+ return ptr;
+}
+
+static int cdata_tointeger(lua_State* L, int idx, ptrdiff_t* val)
+{
+ struct ctype ct;
+ void* addr = to_cdata(L, idx, &ct);
+ lua_pop(L, 1);
+
+ if (ct.pointers) {
+ return 0;
+ }
+
+ switch (ct.type) {
+ case INT8_TYPE:
+ *val = *(int8_t*)addr;
+ return 1;
+ case INT16_TYPE:
+ *val = *(int16_t*)addr;
+ return 1;
+ case INT32_TYPE:
+ *val = *(int32_t*)addr;
+ return 1;
+ case INT64_TYPE:
+ *val = *(int64_t*)addr;
+ return 1;
+ default:
+ return 0;
+ }
+}
+
+static int64_t check_intptr(lua_State* L, int idx, void* p, struct ctype* ct)
+{
+ if (ct->type == INVALID_TYPE) {
+ int64_t ret;
+ memset(ct, 0, sizeof(*ct));
+ ct->base_size = 8;
+ ct->type = INT64_TYPE;
+ ct->is_defined = 1;
+ ret = luaL_checknumber(L, idx);
+ return ret;
+
+ } else if (ct->pointers) {
+ return (intptr_t) p;
+ }
+
+ switch (ct->type) {
+ case INTPTR_TYPE:
+ case FUNCTION_PTR_TYPE:
+ return *(intptr_t*) p;
+
+ case INT64_TYPE:
+ return *(int64_t*) p;
+
+ case INT32_TYPE:
+ return ct->is_unsigned ? (int64_t) *(uint32_t*) p : (int64_t) *(int32_t*) p;
+
+ case INT16_TYPE:
+ return ct->is_unsigned ? (int64_t) *(uint16_t*) p : (int64_t) *(int16_t*) p;
+
+ case INT8_TYPE:
+ return ct->is_unsigned ? (int64_t) *(uint8_t*) p : (int64_t) *(int8_t*) p;
+
+ default:
+ type_error(L, idx, "intptr_t", 0, NULL);
+ return 0;
+ }
+}
+
+static int get_cfunction_address(lua_State* L, int idx, cfunction* addr);
+
+#define TO_NUMBER(TYPE, ALLOW_POINTERS, LUA_TONUMBER) \
+ TYPE ret = 0; \
+ void* p; \
+ struct ctype ct; \
+ cfunction f; \
+ \
+ switch (lua_type(L, idx)) { \
+ case LUA_TBOOLEAN: \
+ ret = (TYPE) lua_toboolean(L, idx); \
+ break; \
+ \
+ case LUA_TNUMBER: \
+ ret = (TYPE) LUA_TONUMBER(L, idx); \
+ break; \
+ \
+ case LUA_TSTRING: \
+ if (!ALLOW_POINTERS) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ ret = (TYPE) (intptr_t) lua_tostring(L, idx); \
+ break; \
+ \
+ case LUA_TLIGHTUSERDATA: \
+ if (!ALLOW_POINTERS) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ ret = (TYPE) (intptr_t) lua_topointer(L, idx); \
+ break; \
+ \
+ case LUA_TFUNCTION: \
+ if (!ALLOW_POINTERS) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ if (!get_cfunction_address(L, idx, &f)) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ ret = (TYPE) (intptr_t) f; \
+ break; \
+ \
+ case LUA_TUSERDATA: \
+ p = to_cdata(L, idx, &ct); \
+ \
+ if (ct.type == INVALID_TYPE) { \
+ if (!ALLOW_POINTERS) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ ret = (TYPE) (intptr_t) userdata_toptr(L, idx); \
+ } else if (ct.pointers || ct.type == STRUCT_TYPE || ct.type == UNION_TYPE) {\
+ if (!ALLOW_POINTERS) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ ret = (TYPE) (intptr_t) p; \
+ } else if (ct.type == COMPLEX_DOUBLE_TYPE) { \
+ ret = (TYPE) creal(*(complex_double*) p); \
+ } else if (ct.type == COMPLEX_FLOAT_TYPE) { \
+ ret = (TYPE) crealf(*(complex_float*) p); \
+ } else if (ct.type == DOUBLE_TYPE) { \
+ ret = (TYPE) *(double*) p; \
+ } else if (ct.type == FLOAT_TYPE) { \
+ ret = (TYPE) *(float*) p; \
+ } else { \
+ ret = check_intptr(L, idx, p, &ct); \
+ } \
+ lua_pop(L, 1); \
+ break; \
+ \
+ case LUA_TNIL: \
+ ret = (TYPE) 0; \
+ break; \
+ \
+ default: \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+
+static int64_t cast_int64(lua_State* L, int idx, int is_cast)
+{ TO_NUMBER(int64_t, is_cast, lua_tointeger); return ret; }
+
+static uint64_t cast_uint64(lua_State* L, int idx, int is_cast)
+{ TO_NUMBER(uint64_t, is_cast, lua_tointeger); return ret; }
+
+int32_t check_int32(lua_State* L, int idx)
+{ return (int32_t) cast_int64(L, idx, 0); }
+
+uint32_t check_uint32(lua_State* L, int idx)
+{ return (uint32_t) cast_uint64(L, idx, 0); }
+
+int64_t check_int64(lua_State* L, int idx)
+{ return cast_int64(L, idx, 0); }
+
+uint64_t check_uint64(lua_State* L, int idx)
+{ return cast_uint64(L, idx, 0); }
+
+double check_double(lua_State* L, int idx)
+{ TO_NUMBER(double, 0, lua_tonumber); return ret; }
+
+float check_float(lua_State* L, int idx)
+{ TO_NUMBER(double, 0, lua_tonumber); return ret; }
+
+uintptr_t check_uintptr(lua_State* L, int idx)
+{ TO_NUMBER(uintptr_t, 1, lua_tointeger); return ret; }
+
+complex_double check_complex_double(lua_State* L, int idx)
+{
+ double real = 0, imag = 0;
+ void* p;
+ struct ctype ct;
+
+ switch (lua_type(L, idx)) {
+ case LUA_TNUMBER:
+ real = (double) lua_tonumber(L, idx);
+ break;
+ case LUA_TTABLE:
+ lua_rawgeti(L, idx, 1);
+ real = check_double(L, -1);
+ lua_pop(L, 1);
+
+ lua_rawgeti(L, idx, 2);
+ if (lua_isnil(L, -1)) {
+ imag = real;
+ } else {
+ imag = check_double(L, -1);
+ }
+ lua_pop(L, 1);
+ break;
+ case LUA_TUSERDATA:
+ p = to_cdata(L, idx, &ct);
+ if (ct.type == COMPLEX_DOUBLE_TYPE) {
+ real = creal(*(complex_double*) p);
+ imag = cimag(*(complex_double*) p);
+ } else if (ct.type == COMPLEX_FLOAT_TYPE) {
+ real = crealf(*(complex_float*) p);
+ imag = cimagf(*(complex_float*) p);
+ } else if (ct.type == DOUBLE_TYPE) {
+ real = *(double*) p;
+ } else if (ct.type == FLOAT_TYPE) {
+ real = *(float*) p;
+ } else {
+ real = check_intptr(L, idx, p, &ct);
+ }
+ lua_pop(L, 1);
+ break;
+
+ default:
+ type_error(L, idx, "complex", 0, NULL);
+ }
+
+ return mk_complex_double(real, imag);
+}
+
+complex_float check_complex_float(lua_State* L, int idx)
+{
+ complex_double d = check_complex_double(L, idx);
+ return mk_complex_float(creal(d), cimag(d));
+}
+
+static size_t unpack_vararg(lua_State* L, int i, char* to)
+{
+ void* p;
+ struct ctype ct;
+
+ switch (lua_type(L, i)) {
+ case LUA_TBOOLEAN:
+ *(int*) to = lua_toboolean(L, i);
+ return sizeof(int);
+
+ case LUA_TNUMBER:
+ *(double*) to = lua_tonumber(L, i); // TODO in Lua 5.3: lua_tointeger sometimes should be here
+ return sizeof(double);
+
+ case LUA_TSTRING:
+ *(const char**) to = lua_tostring(L, i);
+ return sizeof(const char*);
+
+ case LUA_TLIGHTUSERDATA:
+ *(void**) to = lua_touserdata(L, i);
+ return sizeof(void*);
+
+ case LUA_TUSERDATA:
+ p = to_cdata(L, i, &ct);
+ lua_pop(L, 1);
+
+ if (ct.type == INVALID_TYPE) {
+ *(void**) to = userdata_toptr(L, i);
+ return sizeof(void*);
+
+ } else if (ct.pointers || ct.type == INTPTR_TYPE) {
+ *(void**) to = p;
+ return sizeof(void*);
+
+ } else if (ct.type == INT32_TYPE) {
+ *(int32_t*) to = *(int32_t*) p;
+ return sizeof(int32_t);
+
+ } else if (ct.type == INT64_TYPE) {
+ *(int64_t*) to = *(int64_t*) p;
+ return sizeof(int64_t);
+ }
+ goto err;
+
+ case LUA_TNIL:
+ *(void**) to = NULL;
+ return sizeof(void*);
+
+ default:
+ goto err;
+ }
+
+err:
+ return type_error(L, i, "vararg", 0, NULL);
+}
+
+void unpack_varargs_stack(lua_State* L, int first, int last, char* to)
+{
+ int i;
+
+ for (i = first; i <= last; i++) {
+ to += unpack_vararg(L, i, to);
+ }
+}
+
+void unpack_varargs_stack_skip(lua_State* L, int first, int last, int ints_to_skip, int floats_to_skip, char* to)
+{
+ int i;
+
+ for (i = first; i <= last; i++) {
+ int type = lua_type(L, i);
+
+ if (type == LUA_TNUMBER && --floats_to_skip >= 0) {
+ continue;
+ } else if (type != LUA_TNUMBER && --ints_to_skip >= 0) {
+ continue;
+ }
+
+ to += unpack_vararg(L, i, to);
+ }
+}
+
+void unpack_varargs_float(lua_State* L, int first, int last, int max, char* to)
+{
+ int i;
+
+ for (i = first; i <= last && max > 0; i++) {
+ if (lua_type(L, i) == LUA_TNUMBER) {
+ unpack_vararg(L, i, to);
+ to += sizeof(double);
+ max--;
+ }
+ }
+}
+
+void unpack_varargs_int(lua_State* L, int first, int last, int max, char* to)
+{
+ int i;
+
+ for (i = first; i <= last && max > 0; i++) {
+ if (lua_type(L, i) != LUA_TNUMBER) {
+ unpack_vararg(L, i, to);
+ to += sizeof(void*);
+ max--;
+ }
+ }
+}
+
+void unpack_varargs_reg(lua_State* L, int first, int last, char* to)
+{
+ int i;
+
+ for (i = first; i <= last; i++) {
+ unpack_vararg(L, i, to);
+ to += sizeof(double);
+ }
+}
+
+/* to_enum tries to convert a value at idx to the enum type indicated by to_ct
+ * and uv to_usr. For strings this means it will do a string lookup for the
+ * enum type. It leaves the stack unchanged. Will throw an error if the type
+ * at idx can't be conerted.
+ */
+int32_t check_enum(lua_State* L, int idx, int to_usr, const struct ctype* to_ct)
+{
+ int32_t ret;
+
+ switch (lua_type(L, idx)) {
+ case LUA_TSTRING:
+ /* lookup string in to_usr to find value */
+ to_usr = lua_absindex(L, to_usr);
+ lua_pushvalue(L, idx);
+ lua_rawget(L, to_usr);
+
+ if (lua_isnil(L, -1)) {
+ goto err;
+ }
+
+ ret = (int32_t) lua_tointeger(L, -1);
+ lua_pop(L, 1);
+ return ret;
+
+ case LUA_TUSERDATA:
+ return check_int32(L, idx);
+
+ case LUA_TNIL:
+ return (int32_t) 0;
+
+ case LUA_TNUMBER:
+ return (int32_t) lua_tointeger(L, idx);
+
+ default:
+ goto err;
+ }
+
+err:
+ return type_error(L, idx, NULL, to_usr, to_ct);
+}
+
+/* to_pointer tries converts a value at idx to a pointer. It fills out ct and
+ * pushes the uv of the found type. It will throw a lua error if it can not
+ * convert the value to a pointer. */
+static void* check_pointer(lua_State* L, int idx, struct ctype* ct)
+{
+ void* p;
+ memset(ct, 0, sizeof(*ct));
+ idx = lua_absindex(L, idx);
+
+ switch (lua_type(L, idx)) {
+ case LUA_TNIL:
+ ct->type = VOID_TYPE;
+ ct->pointers = 1;
+ ct->is_null = 1;
+ lua_pushnil(L);
+ return NULL;
+
+ case LUA_TNUMBER:
+ ct->type = INTPTR_TYPE;
+ ct->is_unsigned = 1;
+ ct->pointers = 0;
+ lua_pushnil(L);
+ return (void*) (uintptr_t) lua_tonumber(L, idx); // TODO in Lua 5.3: maybe change to lua_tointeger
+
+ case LUA_TLIGHTUSERDATA:
+ ct->type = VOID_TYPE;
+ ct->pointers = 1;
+ lua_pushnil(L);
+ return lua_touserdata(L, idx);
+
+ case LUA_TSTRING:
+ ct->type = INT8_TYPE;
+ ct->pointers = 1;
+ ct->is_unsigned = IS_CHAR_UNSIGNED;
+ ct->is_array = 1;
+ ct->base_size = 1;
+ ct->const_mask = 2;
+ lua_pushnil(L);
+ return (void*) lua_tolstring(L, idx, &ct->array_size);
+
+ case LUA_TUSERDATA:
+ p = to_cdata(L, idx, ct);
+
+ if (ct->type == INVALID_TYPE) {
+ /* some other type of user data */
+ ct->type = VOID_TYPE;
+ ct->pointers = 1;
+ return userdata_toptr(L, idx);
+ } else if (ct->type == STRUCT_TYPE || ct->type == UNION_TYPE) {
+ return p;
+ } else {
+ return (void*) (intptr_t) check_intptr(L, idx, p, ct);
+ }
+ break;
+ }
+
+ type_error(L, idx, "pointer", 0, NULL);
+ return NULL;
+}
+
+static int is_void_ptr(const struct ctype* ct)
+{
+ return ct->type == VOID_TYPE
+ && ct->pointers == 1;
+}
+
+static int is_same_type(lua_State* L, int usr1, int usr2, const struct ctype* t1, const struct ctype* t2)
+{
+ if (t1->type != t2->type) {
+ return 0;
+ }
+
+#if LUA_VERSION_NUM == 501
+ if (lua_isnil(L, usr1) != lua_isnil(L, usr2)) {
+ int ret;
+ usr1 = lua_absindex(L, usr1);
+ usr2 = lua_absindex(L, usr2);
+ push_upval(L, &niluv_key);
+
+ ret = lua_rawequal(L, usr1, -1)
+ || lua_rawequal(L, usr2, -1);
+
+ lua_pop(L, 1);
+
+ if (ret) {
+ return 1;
+ }
+ }
+#endif
+
+ return lua_rawequal(L, usr1, usr2);
+}
+
+static void set_struct(lua_State* L, int idx, void* to, int to_usr, const struct ctype* tt, int check_pointers);
+
+/* to_typed_pointer converts a value at idx to a type tt with target uv to_usr
+ * checking all types. May push a temporary value so that it can create
+ * structs on the fly. */
+void* check_typed_pointer(lua_State* L, int idx, int to_usr, const struct ctype* tt)
+{
+ struct ctype ft;
+ void* p;
+
+ to_usr = lua_absindex(L, to_usr);
+ idx = lua_absindex(L, idx);
+
+ if (tt->pointers == 1 && (tt->type == STRUCT_TYPE || tt->type == UNION_TYPE) && lua_type(L, idx) == LUA_TTABLE) {
+ /* need to construct a struct of the target type */
+ struct ctype ct = *tt;
+ ct.pointers = ct.is_array = 0;
+ p = push_cdata(L, to_usr, &ct);
+ set_struct(L, idx, p, to_usr, &ct, 1);
+ return p;
+ }
+
+ p = check_pointer(L, idx, &ft);
+
+ if (tt->pointers == 1 && ft.pointers == 0 && (ft.type == STRUCT_TYPE || ft.type == UNION_TYPE)) {
+ /* auto dereference structs */
+ ft.pointers = 1;
+ ft.const_mask <<= 1;
+ }
+
+ if (is_void_ptr(tt)) {
+ /* any pointer can convert to void* */
+ goto suc;
+
+ } else if (is_void_ptr(&ft) && (ft.pointers || ft.is_reference)) {
+ /* void* can convert to any pointer */
+ goto suc;
+
+ } else if (ft.is_null) {
+ /* NULL can convert to any pointer */
+ goto suc;
+
+ } else if (!is_same_type(L, to_usr, -1, tt, &ft)) {
+ /* the base type is different */
+ goto err;
+
+ } else if (tt->pointers != ft.pointers) {
+ goto err;
+
+ } else if (ft.const_mask & ~tt->const_mask) {
+ /* for every const in from it must be in to, there are further rules
+ * for const casting (see the c++ spec), but they are hard to test
+ * quickly */
+ goto err;
+ }
+
+suc:
+ return p;
+
+err:
+ type_error(L, idx, NULL, to_usr, tt);
+ return NULL;
+}
+
+/**
+ * gets the address of the wrapped C function for the lua function value at idx
+ * and returns 1 if it exists; otherwise returns 0 and nothing is pushed */
+static int get_cfunction_address(lua_State* L, int idx, cfunction* addr)
+{
+ int top, n;
+ cfunction* f;
+ if (!lua_isfunction(L, idx)) return 0;
+
+ top = lua_gettop(L);
+
+ // Get the last upvalue
+ n = 2;
+ while (lua_getupvalue(L, idx, n)) {
+ lua_pop(L, 1);
+ n++;
+ }
+
+ if (!lua_getupvalue(L, idx, n - 1))
+ return 0;
+
+ if (!lua_isuserdata(L, -1) || !lua_getmetatable(L, -1)) {
+ lua_pop(L, 1);
+ return 0;
+ }
+
+ push_upval(L, &callback_mt_key);
+ if (!lua_rawequal(L, -1, -2)) {
+ lua_pop(L, 3);
+ return 0;
+ }
+
+ /* stack is:
+ * userdata upval
+ * metatable
+ * callback_mt
+ */
+
+ f = lua_touserdata(L, -3);
+ *addr = f[1];
+ lua_pop(L, 3);
+ return 1;
+}
+
+/* to_cfunction converts a value at idx with usr table at to_usr and type tt
+ * into a function. Leaves the stack unchanged. */
+static cfunction check_cfunction(lua_State* L, int idx, int to_usr, const struct ctype* tt, int check_pointers)
+{
+ void* p;
+ struct ctype ft;
+ cfunction f;
+ int top = lua_gettop(L);
+
+ idx = lua_absindex(L, idx);
+ to_usr = lua_absindex(L, to_usr);
+
+ switch (lua_type(L, idx)) {
+ case LUA_TFUNCTION:
+ if (get_cfunction_address(L, idx, &f)) {
+ return f;
+ }
+
+ /* Function cdatas are pinned and must be manually cleaned up by
+ * calling func:free(). */
+ push_upval(L, &callbacks_key);
+ f = compile_callback(L, idx, to_usr, tt);
+ lua_pushboolean(L, 1);
+ lua_rawset(L, -3);
+ lua_pop(L, 1); /* callbacks tbl */
+ return f;
+
+ case LUA_TNIL:
+ return NULL;
+
+ case LUA_TLIGHTUSERDATA:
+ if (check_pointers) {
+ goto err;
+ } else {
+ return (cfunction) lua_touserdata(L, idx);
+ }
+
+ case LUA_TUSERDATA:
+ p = to_cdata(L, idx, &ft);
+ assert(lua_gettop(L) == top + 1);
+
+ if (ft.type == INVALID_TYPE) {
+ if (check_pointers) {
+ goto err;
+ } else {
+ lua_pop(L, 1);
+ return (cfunction) lua_touserdata(L, idx);
+ }
+
+ } else if (ft.is_null) {
+ lua_pop(L, 1);
+ return NULL;
+
+ } else if (!check_pointers && (ft.pointers || ft.type == INTPTR_TYPE)) {
+ lua_pop(L, 1);
+ return (cfunction) *(void**) p;
+
+ } else if (ft.type != FUNCTION_PTR_TYPE) {
+ goto err;
+
+ } else if (!check_pointers) {
+ lua_pop(L, 1);
+ return *(cfunction*) p;
+
+ } else if (ft.calling_convention != tt->calling_convention) {
+ goto err;
+
+ } else if (!is_same_type(L, -1, to_usr, &ft, tt)) {
+ goto err;
+
+ } else {
+ lua_pop(L, 1);
+ return *(cfunction*) p;
+ }
+
+ default:
+ goto err;
+ }
+
+err:
+ type_error(L, idx, NULL, to_usr, tt);
+ return NULL;
+}
+
+/* to_type_cfunction converts a value at idx with uv at to_usr and type tt to
+ * a cfunction. Leaves the stack unchanged. */
+cfunction check_typed_cfunction(lua_State* L, int idx, int to_usr, const struct ctype* tt)
+{ return check_cfunction(L, idx, to_usr, tt, 1); }
+
+static void set_value(lua_State* L, int idx, void* to, int to_usr, const struct ctype* tt, int check_pointers);
+
+static void set_array(lua_State* L, int idx, void* to, int to_usr, const struct ctype* tt, int check_pointers)
+{
+ size_t i, sz, esz;
+ struct ctype et;
+
+ idx = lua_absindex(L, idx);
+ to_usr = lua_absindex(L, to_usr);
+
+ switch (lua_type(L, idx)) {
+ case LUA_TSTRING:
+ if (tt->pointers == 1 && tt->type == INT8_TYPE) {
+ const char* str = lua_tolstring(L, idx, &sz);
+
+ if (!tt->is_variable_array && sz >= tt->array_size) {
+ memcpy(to, str, tt->array_size);
+ } else {
+ /* include nul terminator */
+ memcpy(to, str, sz+1);
+ }
+ } else {
+ goto err;
+ }
+ break;
+
+ case LUA_TTABLE:
+ et = *tt;
+ et.pointers--;
+ et.const_mask >>= 1;
+ et.is_array = 0;
+ esz = et.pointers ? sizeof(void*) : et.base_size;
+
+ lua_rawgeti(L, idx, 2);
+
+ if (tt->is_variable_array) {
+ /* we have no idea how big the array is, so set values based off
+ * how many items were given to us */
+ lua_pop(L, 1);
+ for (i = 0; i < lua_rawlen(L, idx); i++) {
+ lua_rawgeti(L, idx, (int) i + 1);
+ set_value(L, -1, (char*) to + esz * i, to_usr, &et, check_pointers);
+ lua_pop(L, 1);
+ }
+
+ } else if (lua_isnil(L, -1)) {
+ /* there is no second element, so we set the whole array to the
+ * first element (or nil - ie 0) if there is no first element) */
+ lua_pop(L, 1);
+ lua_rawgeti(L, idx, 1);
+
+ if (lua_isnil(L, -1)) {
+ memset(to, 0, ctype_size(L, tt));
+ } else {
+ /* if its still variable we have no idea how many values to set */
+ for (i = 0; i < tt->array_size; i++) {
+ set_value(L, -1, (char*) to + esz * i, to_usr, &et, check_pointers);
+ }
+ }
+
+ lua_pop(L, 1);
+
+ } else {
+ /* there is a second element, so we set each element using the
+ * equiv index in the table initializer */
+ lua_pop(L, 1);
+ for (i = 0; i < tt->array_size; i++) {
+ lua_rawgeti(L, idx, (int) (i+1));
+
+ if (lua_isnil(L, -1)) {
+ /* we've hit the end of the values provided in the
+ * initializer, so memset the rest to zero */
+ lua_pop(L, 1);
+ memset((char*) to + esz * i, 0, (tt->array_size - i) * esz);
+ break;
+
+ } else {
+ set_value(L, -1, (char*) to + esz * i, to_usr, &et, check_pointers);
+ lua_pop(L, 1);
+ }
+ }
+ }
+ break;
+
+ default:
+ goto err;
+ }
+
+ return;
+
+err:
+ type_error(L, idx, NULL, to_usr, tt);
+}
+
+/* pops the member key from the stack, leaves the member user value on the
+ * stack. Returns the member offset. Returns -ve if the member can not be
+ * found. */
+static ptrdiff_t get_member(lua_State* L, int usr, const struct ctype* ct, struct ctype* mt)
+{
+ ptrdiff_t off;
+ lua_rawget(L, usr);
+
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1);
+ return -1;
+ }
+
+ *mt = *(const struct ctype*) lua_touserdata(L, -1);
+ lua_getuservalue(L, -1);
+ lua_replace(L, -2);
+
+ if (mt->is_variable_array && ct->variable_size_known) {
+ /* eg char mbr[?] */
+ size_t sz = (mt->pointers > 1) ? sizeof(void*) : mt->base_size;
+ assert(ct->is_variable_struct && mt->is_array);
+ mt->array_size = ct->variable_increment / sz;
+ mt->is_variable_array = 0;
+
+ } else if (mt->is_variable_struct && ct->variable_size_known) {
+ /* eg struct {char a; char b[?]} mbr; */
+ assert(ct->is_variable_struct);
+ mt->variable_size_known = 1;
+ mt->variable_increment = ct->variable_increment;
+ }
+
+ off = mt->offset;
+ mt->offset = 0;
+ return off;
+}
+
+static void set_struct(lua_State* L, int idx, void* to, int to_usr, const struct ctype* tt, int check_pointers)
+{
+ int have_first = 0;
+ int have_other = 0;
+ struct ctype mt;
+ void* p;
+
+ to_usr = lua_absindex(L, to_usr);
+ idx = lua_absindex(L, idx);
+
+ switch (lua_type(L, idx)) {
+ case LUA_TTABLE:
+ /* match up to the members based off the table initializers key - this
+ * will match both numbered and named members in the user table
+ * we need a special case for when no entries in the initializer -
+ * zero initialize the c struct, and only one entry in the initializer
+ * - set all members to this value */
+ memset(to, 0, ctype_size(L, tt));
+ lua_pushnil(L);
+ while (lua_next(L, idx)) {
+ ptrdiff_t off;
+
+ if (!have_first && lua_tonumber(L, -2) == 1 && lua_tonumber(L, -1) != 0) {
+ have_first = 1;
+ } else if (!have_other && (lua_type(L, -2) != LUA_TNUMBER || lua_tonumber(L, -2) != 1)) {
+ have_other = 1;
+ }
+
+ lua_pushvalue(L, -2);
+ off = get_member(L, to_usr, tt, &mt);
+ assert(off >= 0);
+ set_value(L, -2, (char*) to + off, -1, &mt, check_pointers);
+
+ /* initializer value, mt usr */
+ lua_pop(L, 2);
+ }
+
+ /* if we only had a single non zero value then initialize all members to that value */
+ if (!have_other && have_first && tt->type != UNION_TYPE) {
+ size_t i, sz;
+ ptrdiff_t off;
+ lua_rawgeti(L, idx, 1);
+ sz = lua_rawlen(L, to_usr);
+
+ for (i = 2; i < sz; i++) {
+ lua_pushinteger(L, i);
+ off = get_member(L, to_usr, tt, &mt);
+ assert(off >= 0);
+ set_value(L, -2, (char*) to + off, -1, &mt, check_pointers);
+ lua_pop(L, 1); /* mt usr */
+ }
+
+ lua_pop(L, 1); /* initializer table */
+ }
+ break;
+
+ case LUA_TUSERDATA:
+ if (check_pointers) {
+ p = check_typed_pointer(L, idx, to_usr, tt);
+ } else {
+ struct ctype ct;
+ p = check_pointer(L, idx, &ct);
+ }
+ memcpy(to, p, tt->base_size);
+ lua_pop(L, 1);
+ break;
+
+ default:
+ goto err;
+ }
+
+ return;
+
+err:
+ type_error(L, idx, NULL, to_usr, tt);
+}
+
+static void set_value(lua_State* L, int idx, void* to, int to_usr, const struct ctype* tt, int check_pointers)
+{
+ int top = lua_gettop(L);
+
+ if (tt->is_array) {
+ set_array(L, idx, to, to_usr, tt, check_pointers);
+
+ } else if (tt->pointers || tt->is_reference) {
+ union {
+ uint8_t c[sizeof(void*)];
+ void* p;
+ } u;
+
+ if (lua_istable(L, idx)) {
+ luaL_error(L, "Can't set a pointer member to a struct that's about to be freed");
+ }
+
+ if (check_pointers) {
+ u.p = check_typed_pointer(L, idx, to_usr, tt);
+ } else {
+ struct ctype ct;
+ u.p = check_pointer(L, idx, &ct);
+ }
+
+#ifndef ALLOW_MISALIGNED_ACCESS
+ if ((uintptr_t) to & PTR_ALIGN_MASK) {
+ memcpy(to, u.c, sizeof(void*));
+ } else
+#endif
+ {
+ *(void**) to = u.p;
+ }
+
+ lua_pop(L, 1);
+
+ } else if (tt->is_bitfield) {
+
+ uint64_t hi_mask = UINT64_C(0) - (UINT64_C(1) << (tt->bit_offset + tt->bit_size));
+ uint64_t low_mask = (UINT64_C(1) << tt->bit_offset) - UINT64_C(1);
+ uint64_t val = check_uint64(L, idx);
+ val &= (UINT64_C(1) << tt->bit_size) - 1;
+ val <<= tt->bit_offset;
+ *(uint64_t*) to = val | (*(uint64_t*) to & (hi_mask | low_mask));
+
+ } else if (tt->type == STRUCT_TYPE || tt->type == UNION_TYPE) {
+ set_struct(L, idx, to, to_usr, tt, check_pointers);
+
+ } else {
+
+#ifndef ALLOW_MISALIGNED_ACCESS
+ union {
+ uint8_t c[8];
+ _Bool b;
+ uint64_t u64;
+ float f;
+ double d;
+ cfunction func;
+ } misalign;
+
+ void* origto = to;
+
+ if ((uintptr_t) origto & (tt->base_size - 1)) {
+ to = misalign.c;
+ }
+#endif
+
+ switch (tt->type) {
+ case BOOL_TYPE:
+ *(_Bool*) to = (cast_int64(L, idx, !check_pointers) != 0);
+ break;
+ case INT8_TYPE:
+ if (tt->is_unsigned) {
+ *(uint8_t*) to = (uint8_t) cast_uint64(L, idx, !check_pointers);
+ } else {
+ *(int8_t*) to = (int8_t) cast_int64(L, idx, !check_pointers);
+ }
+ break;
+ case INT16_TYPE:
+ if (tt->is_unsigned) {
+ *(uint16_t*) to = (uint16_t) cast_uint64(L, idx, !check_pointers);
+ } else {
+ *(int16_t*) to = (int16_t) cast_int64(L, idx, !check_pointers);
+ }
+ break;
+ case INT32_TYPE:
+ if (tt->is_unsigned) {
+ *(uint32_t*) to = (uint32_t) cast_uint64(L, idx, !check_pointers);
+ } else {
+ *(int32_t*) to = (int32_t) cast_int64(L, idx, !check_pointers);
+ }
+ break;
+ case INT64_TYPE:
+ if (tt->is_unsigned) {
+ *(uint64_t*) to = cast_uint64(L, idx, !check_pointers);
+ } else {
+ *(int64_t*) to = cast_int64(L, idx, !check_pointers);
+ }
+ break;
+ case FLOAT_TYPE:
+ *(float*) to = (float) check_double(L, idx);
+ break;
+ case DOUBLE_TYPE:
+ *(double*) to = check_double(L, idx);
+ break;
+ case COMPLEX_FLOAT_TYPE:
+ *(complex_float*) to = check_complex_float(L, idx);
+ break;
+ case COMPLEX_DOUBLE_TYPE:
+ *(complex_double*) to = check_complex_double(L, idx);
+ break;
+ case INTPTR_TYPE:
+ *(uintptr_t*) to = check_uintptr(L, idx);
+ break;
+ case ENUM_TYPE:
+ *(int32_t*) to = check_enum(L, idx, to_usr, tt);
+ break;
+ case FUNCTION_PTR_TYPE:
+ *(cfunction*) to = check_cfunction(L, idx, to_usr, tt, check_pointers);
+ break;
+ default:
+ goto err;
+ }
+
+#ifndef ALLOW_MISALIGNED_ACCESS
+ if ((uintptr_t) origto & (tt->base_size - 1)) {
+ memcpy(origto, misalign.c, tt->base_size);
+ }
+#endif
+ }
+
+ assert(lua_gettop(L) == top);
+ return;
+err:
+ type_error(L, idx, NULL, to_usr, tt);
+}
+
+static int ffi_typeof(lua_State* L)
+{
+ struct ctype ct;
+ check_ctype(L, 1, &ct);
+ push_ctype(L, -1, &ct);
+ return 1;
+}
+
+static void setmintop(lua_State* L, int idx)
+{
+ if (lua_gettop(L) < idx) {
+ lua_settop(L, idx);
+ }
+}
+
+/* warning: in the case that it finds an array size, it removes that index */
+static void get_variable_array_size(lua_State* L, int idx, struct ctype* ct)
+{
+ /* we only care about the variable buisness for the variable array
+ * directly ie ffi.new('char[?]') or the struct that contains the variable
+ * array ffi.new('struct {char v[?]}'). A pointer to the struct doesn't
+ * care about the variable size (it treats it as a zero sized array). */
+
+ if (ct->is_variable_array) {
+ assert(ct->is_array);
+ ct->array_size = (size_t) luaL_checknumber(L, idx);
+ ct->is_variable_array = 0;
+ lua_remove(L, idx);
+
+ } else if (ct->is_variable_struct && !ct->variable_size_known) {
+ assert(ct->type == STRUCT_TYPE && !ct->is_array);
+ ct->variable_increment *= (size_t) luaL_checknumber(L, idx);
+ ct->variable_size_known = 1;
+ lua_remove(L, idx);
+ }
+}
+
+static int is_scalar(struct ctype* ct)
+{
+ int type = ct->type;
+ if (ct->pointers || ct->is_reference) {
+ return !ct->is_array;
+ }
+ return type != STRUCT_TYPE && type != UNION_TYPE && !IS_COMPLEX(type);
+}
+
+static int should_pack(lua_State *L, int ct_usr, struct ctype* ct, int idx)
+{
+ struct ctype argt;
+ int same;
+ ct_usr = lua_absindex(L, ct_usr);
+
+ if (IS_COMPLEX(ct->type)) {
+ return 0;
+ }
+
+ switch (lua_type(L, idx)) {
+ case LUA_TTABLE:
+ return 0;
+ case LUA_TSTRING:
+ return ct->type == STRUCT_TYPE;
+ case LUA_TUSERDATA:
+ // don't pack if the argument is a cdata with the same type
+ to_cdata(L, idx, &argt);
+ same = is_same_type(L, ct_usr, -1, ct, &argt);
+ lua_pop(L, 1);
+ return !same;
+ default:
+ return 1;
+ }
+}
+
+static int do_new(lua_State* L, int is_cast)
+{
+ int cargs, i, scalar;
+ void* p;
+ struct ctype ct;
+ int check_ptrs = !is_cast;
+
+ check_ctype(L, 1, &ct);
+
+ /* don't push a callback when we have a c function, as cb:set needs a
+ * compiled callback from a lua function to work */
+ if (!ct.pointers && ct.type == FUNCTION_PTR_TYPE && (lua_isnil(L, 2) || lua_isfunction(L, 2))) {
+ // Get the bound C function if this is a ffi lua function
+ cfunction func;
+ if (get_cfunction_address(L, 2, &func)) {
+ p = push_cdata(L, -1, &ct);
+ *(cfunction*) p = func;
+ return 1;
+ }
+
+ /* Function cdatas are pinned and must be manually cleaned up by
+ * calling func:free(). */
+ compile_callback(L, 2, -1, &ct);
+ push_upval(L, &callbacks_key);
+ lua_pushvalue(L, -2);
+ lua_pushboolean(L, 1);
+ lua_rawset(L, -3);
+ lua_pop(L, 1); /* callbacks tbl */
+ return 1;
+ }
+
+ /* this removes the vararg argument if its needed, and errors if its invalid */
+ if (!is_cast) {
+ get_variable_array_size(L, 2, &ct);
+ }
+
+ p = push_cdata(L, -1, &ct);
+
+ /* if the user mt has a __gc function then call ffi.gc on this value */
+ if (push_user_mt(L, -2, &ct)) {
+ push_upval(L, &gc_key);
+ lua_pushvalue(L, -3);
+
+ /* user_mt.__gc */
+ lua_pushliteral(L, "__gc");
+ lua_rawget(L, -4);
+
+ lua_rawset(L, -3); /* gc_upval[cdata] = user_mt.__gc */
+ lua_pop(L, 2); /* user_mt and gc_upval */
+ }
+
+ /* stack is:
+ * ctype arg
+ * ctor args ... 0+
+ * ctype usr
+ * cdata
+ */
+
+ cargs = lua_gettop(L) - 3;
+
+ if (cargs == 0) {
+ return 1;
+ }
+
+ scalar = is_scalar(&ct);
+ if (scalar && cargs > 1) {
+ return luaL_error(L, "too many initializers");
+ }
+
+ if (cargs > 1 || (!scalar && should_pack(L, -2, &ct, 2))) {
+ lua_createtable(L, cargs, 0);
+ lua_replace(L, 1);
+ for (i = 1; i <= cargs; i++) {
+ lua_pushvalue(L, i + 1);
+ lua_rawseti(L, 1, i);
+ }
+ assert(lua_gettop(L) == cargs + 3);
+ set_value(L, 1, p, -2, &ct, check_ptrs);
+ return 1;
+ }
+
+ set_value(L, 2, p, -2, &ct, check_ptrs);
+ return 1;
+}
+
+static int ffi_new(lua_State* L)
+{ return do_new(L, 0); }
+
+static int ffi_cast(lua_State* L)
+{ return do_new(L, 1); }
+
+static int ctype_new(lua_State* L)
+{ return do_new(L, 0); }
+
+static int ctype_call(lua_State* L)
+{
+ struct ctype ct;
+ int top = lua_gettop(L);
+
+ check_ctype(L, 1, &ct);
+
+ if (push_user_mt(L, -1, &ct)) {
+ lua_pushstring(L, "__new");
+ lua_rawget(L, -2);
+ if (!lua_isnil(L, -1)) {
+ lua_insert(L, 1); // function at bottom of stack under args
+ lua_pop(L, 2);
+ lua_call(L, top, 1);
+ return 1;
+ }
+ lua_pop(L, 2);
+ }
+ lua_pop(L, 1);
+
+ assert(lua_gettop(L) == top);
+ return do_new(L, 0);
+}
+
+static int ffi_sizeof(lua_State* L)
+{
+ struct ctype ct;
+ check_ctype(L, 1, &ct);
+ get_variable_array_size(L, 2, &ct);
+ lua_pushinteger(L, ctype_size(L, &ct));
+ return 1;
+}
+
+static int ffi_alignof(lua_State* L)
+{
+ struct ctype ct, mt;
+ lua_settop(L, 2);
+ check_ctype(L, 1, &ct);
+
+ /* if no member is specified then we return the alignment of the type */
+ if (lua_isnil(L, 2)) {
+ lua_pushinteger(L, ct.align_mask + 1);
+ return 1;
+ }
+
+ /* get the alignment of the member */
+ lua_pushvalue(L, 2);
+ if (get_member(L, -2, &ct, &mt) < 0) {
+ push_type_name(L, 3, &ct);
+ return luaL_error(L, "type %s has no member %s", lua_tostring(L, -1), lua_tostring(L, 2));
+ }
+
+ lua_pushinteger(L, mt.align_mask + 1);
+ return 1;
+}
+
+static int ffi_offsetof(lua_State* L)
+{
+ ptrdiff_t off;
+ struct ctype ct, mt;
+ lua_settop(L, 2);
+ check_ctype(L, 1, &ct);
+
+ lua_pushvalue(L, 2);
+ off = get_member(L, -2, &ct, &mt); /* this replaces the member key at -1 with the mbr usr value */
+ if (off < 0) {
+ push_type_name(L, 3, &ct);
+ return luaL_error(L, "type %s has no member %s", lua_tostring(L, -1), lua_tostring(L, 2));
+ }
+
+ lua_pushinteger(L, off);
+
+ if (!mt.is_bitfield) {
+ return 1;
+ }
+
+ lua_pushinteger(L, mt.bit_offset);
+ lua_pushinteger(L, mt.bit_size);
+ return 3;
+}
+
+static int ffi_istype(lua_State* L)
+{
+ struct ctype tt, ft;
+ check_ctype(L, 1, &tt);
+ to_cdata(L, 2, &ft);
+
+ if (ft.type == INVALID_TYPE) {
+ goto fail;
+ }
+
+ if (!is_same_type(L, 3, 4, &tt, &ft)) {
+ goto fail;
+ }
+
+ if (tt.pointers != ft.pointers) {
+ goto fail;
+ }
+
+ if (tt.is_array != ft.is_array) {
+ goto fail;
+ }
+
+ if (tt.is_array && tt.array_size != ft.array_size) {
+ goto fail;
+ }
+
+ if (tt.calling_convention != ft.calling_convention) {
+ goto fail;
+ }
+
+ lua_pushboolean(L, 1);
+ return 1;
+
+fail:
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+static int cdata_gc(lua_State* L)
+{
+ struct ctype ct;
+ check_cdata(L, 1, &ct);
+ lua_settop(L, 1);
+
+ /* call the gc func if there is any registered */
+ lua_pushvalue(L, 1);
+ lua_rawget(L, lua_upvalueindex(2));
+ if (!lua_isnil(L, -1)) {
+ lua_pushvalue(L, 1);
+ lua_pcall(L, 1, 0, 0);
+ }
+
+ /* unset the closure */
+ lua_pushvalue(L, 1);
+ lua_pushnil(L);
+ lua_rawset(L, lua_upvalueindex(1));
+
+ return 0;
+}
+
+static int callback_free(lua_State* L)
+{
+ cfunction* p = (cfunction*) lua_touserdata(L, 1);
+ // FIXME: temporarily disabled to prevent SIGTRAP on exit
+ // free_code(get_jit(L), L, *p);
+ return 0;
+}
+
+static int cdata_free(lua_State* L)
+{
+ struct ctype ct;
+ cfunction* p = (cfunction*) check_cdata(L, 1, &ct);
+ lua_settop(L, 1);
+
+ /* unset the closure */
+ lua_pushvalue(L, 1);
+ lua_pushnil(L);
+ lua_rawset(L, lua_upvalueindex(1));
+
+ if (ct.is_jitted) {
+ free_code(get_jit(L), L, *p);
+ *p = NULL;
+ }
+
+ return 0;
+}
+
+static int cdata_set(lua_State* L)
+{
+ struct ctype ct;
+ cfunction* p = (cfunction*) check_cdata(L, 1, &ct);
+ luaL_checktype(L, 2, LUA_TFUNCTION);
+
+ if (!ct.is_jitted) {
+ luaL_error(L, "can't set the function for a non-lua callback");
+ }
+
+ if (*p == NULL) {
+ luaL_error(L, "can't set the function for a free'd callback");
+ }
+
+ push_func_ref(L, *p);
+ lua_pushvalue(L, 2);
+ lua_rawseti(L, -2, CALLBACK_FUNC_USR_IDX);
+
+ /* remove the closure for this callback as it embeds the function pointer
+ * value */
+ lua_pushvalue(L, 1);
+ lua_pushboolean(L, 1);
+ lua_rawset(L, lua_upvalueindex(1));
+
+ return 0;
+}
+
+static int cdata_call(lua_State* L)
+{
+ struct ctype ct;
+ int top = lua_gettop(L);
+ cfunction* p = (cfunction*) check_cdata(L, 1, &ct);
+
+ if (push_user_mt(L, -1, &ct)) {
+ lua_pushliteral(L, "__call");
+ lua_rawget(L, -2);
+
+ if (!lua_isnil(L, -1)) {
+ lua_insert(L, 1);
+ lua_pop(L, 2); /* ct_usr, user_mt */
+ lua_call(L, lua_gettop(L) - 1, LUA_MULTRET);
+ return lua_gettop(L);
+ }
+ }
+ if (ct.pointers || ct.type != FUNCTION_PTR_TYPE) {
+ return luaL_error(L, "only function callbacks are callable");
+ }
+
+ lua_pushvalue(L, 1);
+ lua_rawget(L, lua_upvalueindex(1));
+
+ if (!lua_isfunction(L, -1)) {
+ lua_pop(L, 1);
+ compile_function(L, *p, -1, &ct);
+
+ assert(lua_gettop(L) == top + 2); /* uv, closure */
+
+ /* closures[func] = closure */
+ lua_pushvalue(L, 1);
+ lua_pushvalue(L, -2);
+ lua_rawset(L, lua_upvalueindex(1));
+
+ lua_replace(L, 1);
+ } else {
+ lua_replace(L, 1);
+ }
+
+ lua_pop(L, 1); /* uv */
+ assert(lua_gettop(L) == top);
+
+ lua_call(L, lua_gettop(L) - 1, LUA_MULTRET);
+ return lua_gettop(L);
+}
+
+static int user_mt_key;
+
+static int ffi_metatype(lua_State* L)
+{
+ struct ctype ct;
+ lua_settop(L, 2);
+
+ check_ctype(L, 1, &ct);
+ if (lua_type(L, 2) != LUA_TTABLE && lua_type(L, 2) != LUA_TNIL) {
+ return luaL_argerror(L, 2, "metatable must be a table or nil");
+ }
+
+ lua_pushlightuserdata(L, &user_mt_key);
+ lua_pushvalue(L, 2);
+ lua_rawset(L, 3); /* user[user_mt_key] = mt */
+
+ /* return the passed in ctype */
+ push_ctype(L, 3, &ct);
+ return 1;
+}
+
+/* push_user_mt returns 1 if the type has a user metatable and pushes it onto
+ * the stack, otherwise it returns 0 and pushes nothing */
+int push_user_mt(lua_State* L, int ct_usr, const struct ctype* ct)
+{
+ if (ct->type != STRUCT_TYPE && ct->type != UNION_TYPE && !IS_COMPLEX(ct->type)) {
+ return 0;
+ }
+ if (!lua_istable(L, ct_usr)) {
+ return 0;
+ }
+
+ ct_usr = lua_absindex(L, ct_usr);
+ lua_pushlightuserdata(L, &user_mt_key);
+ lua_rawget(L, ct_usr);
+
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1);
+ return 0;
+ }
+ return 1;
+}
+
+static int ffi_gc(lua_State* L)
+{
+ struct ctype ct;
+ lua_settop(L, 2);
+ check_cdata(L, 1, &ct);
+
+ push_upval(L, &gc_key);
+ lua_pushvalue(L, 1);
+ lua_pushvalue(L, 2);
+ lua_rawset(L, -3);
+
+ /* return the cdata back */
+ lua_settop(L, 1);
+ return 1;
+}
+
+/* lookup_cdata_index returns the offset of the found type and user value on
+ * the stack if valid. Otherwise returns -ve and doesn't touch the stack.
+ */
+static ptrdiff_t lookup_cdata_index(lua_State* L, int idx, int ct_usr, struct ctype* ct)
+{
+ struct ctype mt;
+ ptrdiff_t off;
+ int type;
+
+ ct_usr = lua_absindex(L, ct_usr);
+ type = lua_type(L, idx);
+
+ switch (type) {
+ case LUA_TNUMBER:
+ case LUA_TUSERDATA:
+ /* possibilities are array, pointer */
+
+ if (!ct->pointers || is_void_ptr(ct)) {
+ return -1;
+ }
+
+ // unbox cdata
+ if (type == LUA_TUSERDATA) {
+ if (!cdata_tointeger(L, idx, &off)) {
+ return -1;
+ }
+ } else {
+ off = lua_tointeger(L, idx);
+ }
+
+ ct->is_array = 0;
+ ct->pointers--;
+ ct->const_mask >>= 1;
+ ct->is_reference = 0;
+
+ lua_pushvalue(L, ct_usr);
+
+ return (ct->pointers ? sizeof(void*) : ct->base_size) * off;
+
+ case LUA_TSTRING:
+ /* possibilities are struct/union, pointer to struct/union */
+
+ if ((ct->type != STRUCT_TYPE && ct->type != UNION_TYPE) || ct->is_array || ct->pointers > 1) {
+ return -1;
+ }
+
+ lua_pushvalue(L, idx);
+ off = get_member(L, ct_usr, ct, &mt);
+ if (off < 0) {
+ return -1;
+ }
+
+ *ct = mt;
+ return off;
+
+ default:
+ return -1;
+ }
+}
+
+static int cdata_newindex(lua_State* L)
+{
+ struct ctype tt;
+ char* to;
+ ptrdiff_t off;
+
+ lua_settop(L, 3);
+
+ to = (char*) check_cdata(L, 1, &tt);
+ off = lookup_cdata_index(L, 2, -1, &tt);
+
+ if (off < 0) {
+ if (!push_user_mt(L, -1, &tt)) {
+ goto err;
+ }
+
+ lua_pushliteral(L, "__newindex");
+ lua_rawget(L, -2);
+
+ if (lua_isnil(L, -1)) {
+ goto err;
+ }
+
+ lua_insert(L, 1);
+ lua_settop(L, 4);
+ lua_call(L, 3, LUA_MULTRET);
+ return lua_gettop(L);
+ }
+
+ if (tt.const_mask & 1) {
+ return luaL_error(L, "can't set const data");
+ }
+
+ set_value(L, 3, to + off, -1, &tt, 1);
+ return 0;
+
+err:
+ push_type_name(L, 4, &tt);
+ return luaL_error(L, "type %s has no member %s", lua_tostring(L, -1), lua_tostring(L, 2));
+}
+
+static int cdata_index(lua_State* L)
+{
+ void* to;
+ struct ctype ct;
+ char* data;
+ ptrdiff_t off;
+
+ lua_settop(L, 2);
+ data = (char*) check_cdata(L, 1, &ct);
+ assert(lua_gettop(L) == 3);
+
+ if (!ct.pointers) {
+ switch (ct.type) {
+ case FUNCTION_PTR_TYPE:
+ /* Callbacks use the same metatable as standard cdata values, but have set
+ * and free members. So instead of mt.__index = mt, we do the equiv here. */
+ lua_getmetatable(L, 1);
+ lua_pushvalue(L, 2);
+ lua_rawget(L, -2);
+ return 1;
+
+ /* This provides the .re and .im virtual members */
+ case COMPLEX_DOUBLE_TYPE:
+ case COMPLEX_FLOAT_TYPE:
+ if (!lua_isstring(L, 2)) {
+ luaL_error(L, "invalid member for complex number");
+
+ } else if (strcmp(lua_tostring(L, 2), "re") == 0) {
+ lua_pushnumber(L, ct.type == COMPLEX_DOUBLE_TYPE ? creal(*(complex_double*) data) : crealf(*(complex_float*) data));
+
+ } else if (strcmp(lua_tostring(L, 2), "im") == 0) {
+ lua_pushnumber(L, ct.type == COMPLEX_DOUBLE_TYPE ? cimag(*(complex_double*) data) : cimagf(*(complex_float*) data));
+
+ } else {
+ luaL_error(L, "invalid member for complex number");
+ }
+ return 1;
+ }
+ }
+
+ off = lookup_cdata_index(L, 2, -1, &ct);
+
+ if (off < 0) {
+ assert(lua_gettop(L) == 3);
+ if (!push_user_mt(L, -1, &ct)) {
+ goto err;
+ }
+
+ lua_pushliteral(L, "__index");
+ lua_rawget(L, -2);
+
+ if (lua_isnil(L, -1)) {
+ goto err;
+ }
+
+ if (lua_istable(L, -1)) {
+ lua_pushvalue(L, 2);
+ lua_gettable(L, -2);
+ return 1;
+ }
+
+ lua_insert(L, 1);
+ lua_settop(L, 3);
+ lua_call(L, 2, LUA_MULTRET);
+ return lua_gettop(L);
+
+err:
+ push_type_name(L, 3, &ct);
+ return luaL_error(L, "type %s has no member %s", lua_tostring(L, -1), lua_tostring(L, 2));
+ }
+
+ assert(lua_gettop(L) == 4); /* ct, key, ct_usr, mbr_usr */
+ data += off;
+
+ if (ct.is_array) {
+ /* push a reference to the array */
+ ct.is_reference = 1;
+ to = push_cdata(L, -1, &ct);
+ *(void**) to = data;
+ return 1;
+
+ } else if (ct.is_bitfield) {
+
+ if (ct.type == INT64_TYPE) {
+ struct ctype rt;
+ uint64_t val = *(uint64_t*) data;
+ val >>= ct.bit_offset;
+ val &= (UINT64_C(1) << ct.bit_size) - 1;
+
+ memset(&rt, 0, sizeof(rt));
+ rt.base_size = 8;
+ rt.type = INT64_TYPE;
+ rt.is_unsigned = 1;
+ rt.is_defined = 1;
+
+ to = push_cdata(L, 0, &rt);
+ *(uint64_t*) to = val;
+
+ return 1;
+
+ } else if (ct.type == BOOL_TYPE) {
+ uint64_t val = *(uint64_t*) data;
+ lua_pushboolean(L, (int) (val & (UINT64_C(1) << ct.bit_offset)));
+ return 1;
+
+ } else {
+ uint64_t val = *(uint64_t*) data;
+ val >>= ct.bit_offset;
+ val &= (UINT64_C(1) << ct.bit_size) - 1;
+ lua_pushinteger(L, val);
+ return 1;
+ }
+
+ } else if (ct.pointers) {
+#ifndef ALLOW_MISALIGNED_ACCESS
+ union {
+ uint8_t c[8];
+ void* p;
+ } misalignbuf;
+
+ if ((uintptr_t) data & PTR_ALIGN_MASK) {
+ memcpy(misalignbuf.c, data, sizeof(void*));
+ data = misalignbuf.c;
+ }
+#endif
+ to = push_cdata(L, -1, &ct);
+ *(void**) to = *(void**) data;
+ return 1;
+
+ } else if (ct.type == STRUCT_TYPE || ct.type == UNION_TYPE) {
+ /* push a reference to the member */
+ ct.is_reference = 1;
+ to = push_cdata(L, -1, &ct);
+ *(void**) to = data;
+ return 1;
+
+ } else if (ct.type == FUNCTION_PTR_TYPE) {
+ cfunction* pf = (cfunction*) push_cdata(L, -1, &ct);
+ *pf = *(cfunction*) data;
+ return 1;
+
+ } else {
+#ifndef ALLOW_MISALIGNED_ACCESS
+ union {
+ uint8_t c[8];
+ double d;
+ float f;
+ uint64_t u64;
+ } misalignbuf;
+
+ assert(ct.base_size <= 8);
+
+ if ((uintptr_t) data & (ct.base_size - 1)) {
+ memcpy(misalignbuf.c, data, ct.base_size);
+ data = misalignbuf.c;
+ }
+#endif
+
+ switch (ct.type) {
+ case BOOL_TYPE:
+ lua_pushboolean(L, *(_Bool*) data);
+ break;
+ case INT8_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint8_t*) data : (lua_Integer) *(int8_t*) data);
+ break;
+ case INT16_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint16_t*) data : (lua_Integer) *(int16_t*) data);
+ break;
+ case ENUM_TYPE:
+ case INT32_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint32_t*) data : (lua_Integer) *(int32_t*) data);
+ break;
+ case INT64_TYPE:
+ to = push_cdata(L, -1, &ct);
+ *(int64_t*) to = *(int64_t*) data;
+ break;
+ case INTPTR_TYPE:
+ to = push_cdata(L, -1, &ct);
+ *(intptr_t*) to = *(intptr_t*) data;
+ break;
+ case FLOAT_TYPE:
+ lua_pushnumber(L, *(float*) data);
+ break;
+ case DOUBLE_TYPE:
+ lua_pushnumber(L, *(double*) data);
+ break;
+ case COMPLEX_DOUBLE_TYPE:
+ to = push_cdata(L, -1, &ct);
+ *(complex_double*) to = *(complex_double*) data;
+ break;
+ case COMPLEX_FLOAT_TYPE:
+ to = push_cdata(L, -1, &ct);
+ *(complex_float*) to = *(complex_float*) data;
+ break;
+ default:
+ luaL_error(L, "internal error: invalid member type");
+ }
+
+ return 1;
+ }
+}
+
+static complex_double check_complex(lua_State* L, int idx, void* p, struct ctype* ct)
+{
+ if (ct->type == INVALID_TYPE) {
+ double d = luaL_checknumber(L, idx);
+#ifdef HAVE_COMPLEX
+ return d;
+#else
+ complex_double c;
+ c.real = d;
+ c.imag = 0;
+ return c;
+#endif
+ } else if (ct->type == COMPLEX_DOUBLE_TYPE) {
+ return *(complex_double*) p;
+ } else if (ct->type == COMPLEX_FLOAT_TYPE) {
+ complex_float* f = (complex_float*) p;
+#ifdef HAVE_COMPLEX
+ return *f;
+#else
+ complex_double d;
+ d.real = f->real;
+ d.imag = f->imag;
+ return d;
+#endif
+ } else {
+ complex_double dummy;
+ type_error(L, idx, "complex", 0, NULL);
+ memset(&dummy, 0, sizeof(dummy));
+ return dummy;
+ }
+}
+
+static int rank(const struct ctype* ct)
+{
+ if (ct->pointers) {
+ return 5;
+ }
+
+ switch (ct->type) {
+ case COMPLEX_DOUBLE_TYPE:
+ return 7;
+ case COMPLEX_FLOAT_TYPE:
+ return 6;
+ case INTPTR_TYPE:
+ return sizeof(intptr_t) >= sizeof(int64_t) ? 4 : 1;
+ case INT64_TYPE:
+ return ct->is_unsigned ? 3 : 2;
+ case INT32_TYPE:
+ case INT16_TYPE:
+ case INT8_TYPE:
+ return 2;
+ default:
+ return 0;
+ }
+}
+
+static void push_complex(lua_State* L, complex_double res, int ct_usr, const struct ctype* ct)
+{
+ if (ct->type == COMPLEX_DOUBLE_TYPE) {
+ complex_double* p = (complex_double*) push_cdata(L, ct_usr, ct);
+ *p = res;
+ } else {
+ complex_float* p = (complex_float*) push_cdata(L, ct_usr, ct);
+#ifdef HAVE_COMPLEX
+ *p = (complex float) res;
+#else
+ p->real = (float) res.real;
+ p->imag = (float) res.imag;
+#endif
+ }
+}
+
+static void push_number(lua_State* L, int64_t val, int ct_usr, const struct ctype* ct)
+{
+ if ((ct->pointers || ct->type == INTPTR_TYPE) && sizeof(intptr_t) != sizeof(int64_t)) {
+ intptr_t* p = (intptr_t*) push_cdata(L, ct_usr, ct);
+ *p = val;
+ } else {
+ int64_t* p = (int64_t*) push_cdata(L, ct_usr, ct);
+ *p = val;
+ }
+}
+
+static int call_user_op(lua_State* L, const char* opfield, int idx, int ct_usr, const struct ctype* ct)
+{
+ idx = lua_absindex(L, idx);
+
+ if (push_user_mt(L, ct_usr, ct)) {
+ lua_pushstring(L, opfield);
+ lua_rawget(L, -2);
+ if (!lua_isnil(L, -1)) {
+ int top = lua_gettop(L);
+ lua_pushvalue(L, idx);
+ lua_call(L, 1, LUA_MULTRET);
+ return lua_gettop(L) - top + 1;
+ }
+ lua_pop(L, 2);
+ }
+ return -1;
+}
+
+static int cdata_unm(lua_State* L)
+{
+ struct ctype ct;
+ void* p;
+ int64_t val;
+ int ret;
+
+ lua_settop(L, 1);
+ p = to_cdata(L, 1, &ct);
+
+ ret = call_user_op(L, "__unm", 1, 2, &ct);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ val = check_intptr(L, 1, p, &ct);
+
+ if (ct.pointers) {
+ luaL_error(L, "can't negate a pointer value");
+ } else {
+ memset(&ct, 0, sizeof(ct));
+ ct.type = INT64_TYPE;
+ ct.base_size = 8;
+ ct.is_defined = 1;
+ push_number(L, -val, 0, &ct);
+ }
+
+ return 1;
+}
+
+/* returns -ve if no binop was called otherwise returns the number of return
+ * arguments */
+static int call_user_binop(lua_State* L, const char* opfield, int lidx, int lusr, const struct ctype* lt, int ridx, int rusr, const struct ctype* rt)
+{
+ lidx = lua_absindex(L, lidx);
+ ridx = lua_absindex(L, ridx);
+
+ if (push_user_mt(L, lusr, lt)) {
+ lua_pushstring(L, opfield);
+ lua_rawget(L, -2);
+
+ if (!lua_isnil(L, -1)) {
+ int top = lua_gettop(L);
+ lua_pushvalue(L, lidx);
+ lua_pushvalue(L, ridx);
+ lua_call(L, 2, LUA_MULTRET);
+ return lua_gettop(L) - top + 1;
+ }
+
+ lua_pop(L, 2); /* user_mt and user_mt.op */
+ }
+
+ if (push_user_mt(L, rusr, rt)) {
+ lua_pushstring(L, opfield);
+ lua_rawget(L, -2);
+
+ if (!lua_isnil(L, -1)) {
+ int top = lua_gettop(L);
+ lua_pushvalue(L, lidx);
+ lua_pushvalue(L, ridx);
+ lua_call(L, 2, LUA_MULTRET);
+ return lua_gettop(L) - top + 1;
+ }
+
+ lua_pop(L, 2); /* user_mt and user_mt.op */
+ }
+
+ return -1;
+}
+
+static int cdata_concat(lua_State* L)
+{
+ struct ctype lt, rt;
+ int ret;
+
+ lua_settop(L, 2);
+ to_cdata(L, 1, &lt);
+ to_cdata(L, 2, &rt);
+
+ ret = call_user_binop(L, "__concat", 1, 3, &lt, 2, 4, &rt);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ return luaL_error(L, "NYI");
+}
+
+static int cdata_len(lua_State* L)
+{
+ struct ctype ct;
+ int ret;
+
+ lua_settop(L, 1);
+ to_cdata(L, 1, &ct);
+
+ ret = call_user_op(L, "__len", 1, 2, &ct);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ push_type_name(L, 2, &ct);
+ return luaL_error(L, "type %s does not implement the __len metamethod", lua_tostring(L, -1));
+}
+
+static int cdata_pairs(lua_State* L)
+{
+ struct ctype ct;
+ int ret;
+
+ lua_settop(L, 1);
+ to_cdata(L, 1, &ct);
+
+ ret = call_user_op(L, "__pairs", 1, 2, &ct);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ push_type_name(L, 2, &ct);
+ return luaL_error(L, "type %s does not implement the __pairs metamethod", lua_tostring(L, -1));
+}
+
+static int cdata_ipairs(lua_State* L)
+{
+ struct ctype ct;
+ int ret;
+
+ lua_settop(L, 1);
+ to_cdata(L, 1, &ct);
+
+ ret = call_user_op(L, "__ipairs", 1, 2, &ct);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ push_type_name(L, 2, &ct);
+ return luaL_error(L, "type %s does not implement the __ipairs metamethod", lua_tostring(L, -1));
+}
+
+static int cdata_add(lua_State* L)
+{
+ struct ctype lt, rt, ct;
+ void *lp, *rp;
+ int ct_usr;
+ int ret;
+
+ lua_settop(L, 2);
+
+ lp = to_cdata(L, 1, &lt);
+ rp = to_cdata(L, 2, &rt);
+ assert(lua_gettop(L) == 4);
+
+ ret = call_user_binop(L, "__add", 1, 3, &lt, 2, 4, &rt);
+ if (ret >= 0) {
+ return ret;
+ }
+ assert(lua_gettop(L) == 4);
+
+ ct_usr = rank(&lt) > rank(&rt) ? 3 : 4;
+ ct = rank(&lt) > rank(&rt) ? lt : rt;
+
+ if (IS_COMPLEX(ct.type)) {
+ complex_double left, right, res;
+
+ left = check_complex(L, 1, lp, &lt);
+ right = check_complex(L, 2, rp, &rt);
+ assert(lua_gettop(L) == 4);
+
+#ifdef HAVE_COMPLEX
+ res = left + right;
+#else
+ res.real = left.real + right.real;
+ res.imag = left.imag + right.imag;
+#endif
+
+ push_complex(L, res, ct_usr, &ct);
+ return 1;
+
+ } else {
+ int64_t left = check_intptr(L, 1, lp, &lt);
+ int64_t right = check_intptr(L, 2, rp, &rt);
+ assert(lua_gettop(L) == 4);
+
+ /* note due to 2s complement it doesn't matter if we do the addition as int or uint,
+ * but the result needs to be uint64_t if either of the sources are */
+
+ if (lt.pointers && rt.pointers) {
+ luaL_error(L, "can't add two pointers");
+
+ } else if (lt.pointers) {
+ int64_t res = left + (lt.pointers > 1 ? sizeof(void*) : lt.base_size) * right;
+ lt.is_array = 0;
+ push_number(L, res, 3, &lt);
+
+ } else if (rt.pointers) {
+ int64_t res = right + (rt.pointers > 1 ? sizeof(void*) : rt.base_size) * left;
+ rt.is_array = 0;
+ push_number(L, res, 4, &rt);
+
+ } else {
+ push_number(L, left + right, ct_usr, &ct);
+ }
+
+ return 1;
+ }
+}
+
+static int cdata_sub(lua_State* L)
+{
+ struct ctype lt, rt, ct;
+ void *lp, *rp;
+ int ct_usr;
+ int ret;
+
+ lua_settop(L, 2);
+
+ lp = to_cdata(L, 1, &lt);
+ rp = to_cdata(L, 2, &rt);
+
+ ret = call_user_binop(L, "__sub", 1, 3, &lt, 2, 4, &rt);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ ct_usr = rank(&lt) > rank(&rt) ? 3 : 4;
+ ct = rank(&lt) > rank(&rt) ? lt : rt;
+
+ if (IS_COMPLEX(ct.type)) {
+ complex_double left, right, res;
+
+ left = check_complex(L, 1, lp, &lt);
+ right = check_complex(L, 2, rp, &rt);
+
+#ifdef HAVE_COMPLEX
+ res = left - right;
+#else
+ res.real = left.real - right.real;
+ res.imag = left.imag - right.imag;
+#endif
+
+ push_complex(L, res, ct_usr, &ct);
+ return 1;
+
+ } else {
+ int64_t left = check_intptr(L, 1, lp, &lt);
+ int64_t right = check_intptr(L, 2, rp, &rt);
+
+ if (rt.pointers) {
+ luaL_error(L, "NYI: can't subtract a pointer value");
+
+ } else if (lt.pointers) {
+ int64_t res = left - (lt.pointers > 1 ? sizeof(void*) : lt.base_size) * right;
+ lt.is_array = 0;
+ push_number(L, res, 3, &lt);
+
+ } else {
+ int64_t res = left - right;
+ push_number(L, res, ct_usr, &ct);
+ }
+
+ return 1;
+ }
+}
+
+/* TODO fix for unsigned */
+#define NUMBER_ONLY_BINOP(OPSTR, DO_NORMAL, DO_COMPLEX) \
+ struct ctype lt, rt, ct; \
+ void *lp, *rp; \
+ int ct_usr; \
+ int ret; \
+ \
+ lua_settop(L, 2); \
+ \
+ lp = to_cdata(L, 1, &lt); \
+ rp = to_cdata(L, 2, &rt); \
+ \
+ ret = call_user_binop(L, OPSTR, 1, 3, &lt, 2, 4, &rt); \
+ if (ret >= 0) { \
+ return ret; \
+ } \
+ \
+ ct_usr = rank(&lt) > rank(&rt) ? 3 : 4; \
+ ct = rank(&lt) > rank(&rt) ? lt : rt; \
+ \
+ if (IS_COMPLEX(ct.type)) { \
+ complex_double res; \
+ complex_double left = check_complex(L, 1, lp, &lt); \
+ complex_double right = check_complex(L, 2, rp, &rt); \
+ \
+ DO_COMPLEX(left, right, res); \
+ push_complex(L, res, ct_usr, &ct); \
+ \
+ } else if (lt.pointers || rt.pointers) { \
+ luaL_error(L, "can't operate on a pointer value"); \
+ \
+ } else { \
+ int64_t res; \
+ int64_t left = check_intptr(L, 1, lp, &lt); \
+ int64_t right = check_intptr(L, 2, rp, &rt); \
+ \
+ DO_NORMAL(left, right, res); \
+ push_number(L, res, ct_usr, &ct); \
+ } \
+ \
+ return 1
+
+#define MUL(l,r,s) s = l * r
+#define DIV(l,r,s) s = l / r
+#define MOD(l,r,s) s = l % r
+#define POW(l,r,s) s = pow(l, r)
+
+#ifdef HAVE_COMPLEX
+#define MULC(l,r,s) s = l * r
+#define DIVC(l,r,s) s = l / r
+#define MODC(l,r,s) (void) l, (void) r, memset(&s, 0, sizeof(s)), luaL_error(L, "NYI: complex mod")
+#define POWC(l,r,s) s = cpow(l, r)
+#else
+#define MULC(l,r,s) s.real = l.real * r.real - l.imag * r.imag, s.imag = l.real * r.imag + l.imag * r.real
+#define DIVC(l,r,s) s.real = (l.real * r.real + l.imag * r.imag) / (r.real * r.real + r.imag * r.imag), \
+ s.imag = (l.imag * r.real - l.real * r.imag) / (r.real * r.real + r.imag * r.imag)
+#define MODC(l,r,s) (void) l, (void) r, memset(&s, 0, sizeof(s)), luaL_error(L, "NYI: complex mod")
+#define POWC(l,r,s) (void) l, (void) r, memset(&s, 0, sizeof(s)), luaL_error(L, "NYI: complex pow")
+#endif
+
+static int cdata_mul(lua_State* L)
+{ NUMBER_ONLY_BINOP("__mul", MUL, MULC); }
+
+static int cdata_div(lua_State* L)
+{ NUMBER_ONLY_BINOP("__div", DIV, DIVC); }
+
+static int cdata_mod(lua_State* L)
+{ NUMBER_ONLY_BINOP("__mod", MOD, MODC); }
+
+static int cdata_pow(lua_State* L)
+{ NUMBER_ONLY_BINOP("__pow", POW, POWC); }
+
+#define COMPARE_BINOP(OPSTR, OP, OPC) \
+ struct ctype lt, rt; \
+ void *lp, *rp; \
+ int ret, res; \
+ \
+ lua_settop(L, 2); \
+ \
+ lp = to_cdata(L, 1, &lt); \
+ rp = to_cdata(L, 2, &rt); \
+ \
+ ret = call_user_binop(L, OPSTR, 1, 3, &lt, 2, 4, &rt); \
+ if (ret >= 0) { \
+ return ret; \
+ } \
+ \
+ if (IS_COMPLEX(lt.type) || IS_COMPLEX(rt.type)) { \
+ complex_double left = check_complex(L, 1, lp, &lt); \
+ complex_double right = check_complex(L, 2, rp, &rt); \
+ \
+ res = OPC(left, right); \
+ \
+ lua_pushboolean(L, res); \
+ \
+ } else { \
+ int64_t left = check_intptr(L, 1, lp, &lt); \
+ int64_t right = check_intptr(L, 2, rp, &rt); \
+ \
+ if (lt.pointers && rt.pointers) { \
+ if (is_void_ptr(&lt) || is_void_ptr(&rt) || is_same_type(L, 3, 4, &lt, &rt)) { \
+ res = OP((uint64_t) left, (uint64_t) right); \
+ } else { \
+ goto err; \
+ } \
+ \
+ } else if (lt.is_null && rt.type == FUNCTION_PTR_TYPE) { \
+ res = OP((uint64_t) left, (uint64_t) right); \
+ \
+ } else if (rt.is_null && lt.type == FUNCTION_PTR_TYPE) { \
+ res = OP((uint64_t) left, (uint64_t) right); \
+ \
+ } else if (lt.pointers && rt.type == INTPTR_TYPE && rt.is_unsigned) {\
+ res = OP((uint64_t) left, (uint64_t) right); \
+ \
+ } else if (rt.pointers && lt.type == INTPTR_TYPE && lt.is_unsigned) {\
+ res = OP((uint64_t) left, (uint64_t) right); \
+ \
+ } else if (rt.pointers || lt.pointers) { \
+ goto err; \
+ \
+ } else if (lt.is_unsigned && rt.is_unsigned) { \
+ res = OP((uint64_t) left, (uint64_t) right); \
+ \
+ } else if (lt.is_unsigned) { \
+ res = OP((int64_t) (uint64_t) left, right); \
+ \
+ } else if (rt.is_unsigned) { \
+ res = OP(left, (int64_t) (uint64_t) right); \
+ \
+ } else { \
+ res = OP(left, right); \
+ } \
+ \
+ lua_pushboolean(L, res); \
+ } \
+ return 1
+
+#define EQ(l, r) (l) == (r)
+#define LT(l, r) (l) < (r)
+#define LE(l, r) (l) <= (r)
+
+#ifdef HAVE_COMPLEX
+#define EQC(l, r) (l) == (r)
+#else
+#define EQC(l, r) (l).real == (r).real && (l).imag == (r).imag
+#endif
+
+#define LEC(l, r) EQC(l, r), luaL_error(L, "complex numbers are non-orderable")
+#define LTC(l, r) EQC(l, r), luaL_error(L, "complex numbers are non-orderable")
+
+static int cdata_eq(lua_State* L)
+{
+ COMPARE_BINOP("__eq", EQ, EQC);
+err:
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+static int cdata_lt(lua_State* L)
+{
+ COMPARE_BINOP("__lt", LT, LTC);
+err:
+ lua_getuservalue(L, 1);
+ lua_getuservalue(L, 2);
+ push_type_name(L, -2, &lt);
+ push_type_name(L, -2, &lt);
+ return luaL_error(L, "trying to compare incompatible types %s and %s", lua_tostring(L, -2), lua_tostring(L, -1));
+}
+
+static int cdata_le(lua_State* L)
+{
+ COMPARE_BINOP("__le", LE, LEC);
+err:
+ lua_getuservalue(L, 1);
+ lua_getuservalue(L, 2);
+ push_type_name(L, -2, &lt);
+ push_type_name(L, -2, &lt);
+ return luaL_error(L, "trying to compare incompatible types %s and %s", lua_tostring(L, -2), lua_tostring(L, -1));
+}
+
+static const char* etype_tostring(int type)
+{
+ switch (type) {
+ case VOID_TYPE: return "void";
+ case DOUBLE_TYPE: return "double";
+ case FLOAT_TYPE: return "float";
+ case COMPLEX_DOUBLE_TYPE: return "complex double";
+ case COMPLEX_FLOAT_TYPE: return "complex float";
+ case BOOL_TYPE: return "bool";
+ case INT8_TYPE: return "int8";
+ case INT16_TYPE: return "int16";
+ case INT32_TYPE: return "int32";
+ case INT64_TYPE: return "int64";
+ case INTPTR_TYPE: return "intptr";
+ case ENUM_TYPE: return "enum";
+ case UNION_TYPE: return "union";
+ case STRUCT_TYPE: return "struct";
+ case FUNCTION_PTR_TYPE: return "function ptr";
+ case FUNCTION_TYPE: return "function";
+ default: return "invalid";
+ }
+}
+
+static void print_type(lua_State* L, const struct ctype* ct)
+{
+ lua_pushfstring(L, " sz %d %d %d align %d ptr %d %d %d type %s%s %d %d %d name %d call %d %d var %d %d %d bit %d %d %d %d jit %d",
+ /* sz */
+ ct->base_size,
+ ct->array_size,
+ ct->offset,
+ /* align */
+ ct->align_mask,
+ /* ptr */
+ ct->is_array,
+ ct->pointers,
+ ct->const_mask,
+ /* type */
+ ct->is_unsigned ? "u" : "",
+ etype_tostring(ct->type),
+ ct->is_reference,
+ ct->is_defined,
+ ct->is_null,
+ /* name */
+ ct->has_member_name,
+ /* call */
+ ct->calling_convention,
+ ct->has_var_arg,
+ /* var */
+ ct->is_variable_array,
+ ct->is_variable_struct,
+ ct->variable_size_known,
+ /* bit */
+ ct->is_bitfield,
+ ct->has_bitfield,
+ ct->bit_offset,
+ ct->bit_size,
+ /* jit */
+ ct->is_jitted);
+}
+
+static int ctype_tostring(lua_State* L)
+{
+ struct ctype ct;
+ assert(lua_type(L, 1) == LUA_TUSERDATA);
+ lua_settop(L, 1);
+ check_ctype(L, 1, &ct);
+ assert(lua_gettop(L) == 2);
+ push_type_name(L, -1, &ct);
+ lua_pushfstring(L, "ctype<%s>", lua_tostring(L, -1));
+
+ if (DEBUG_TOSTRING) {
+ print_type(L, &ct);
+ lua_concat(L, 2);
+ }
+
+ return 1;
+}
+
+static int cdata_tostring(lua_State* L)
+{
+ struct ctype ct;
+ char buf[64];
+ void* p;
+ int ret;
+
+ lua_settop(L, 1);
+ p = to_cdata(L, 1, &ct);
+
+ ret = call_user_op(L, "__tostring", 1, 2, &ct);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ if (ct.pointers > 0 || ct.is_reference || ct.type == STRUCT_TYPE || ct.type == UNION_TYPE) {
+ push_type_name(L, -1, &ct);
+ lua_pushfstring(L, "cdata<%s>: %p", lua_tostring(L, -1), p);
+
+ if (DEBUG_TOSTRING) {
+ print_type(L, &ct);
+ lua_concat(L, 2);
+ }
+
+ return 1;
+ }
+
+ switch (ct.type) {
+ case COMPLEX_DOUBLE_TYPE:
+ {
+ complex_double c = *(complex_double*) p;
+ lua_pushfstring(L, "%f+%fi", creal(c), cimag(c));
+ }
+ return 1;
+
+ case COMPLEX_FLOAT_TYPE:
+ {
+ complex_float c = *(complex_float*) p;
+ lua_pushfstring(L, "%f+%fi", crealf(c), cimagf(c));
+ }
+ return 1;
+
+ case FUNCTION_PTR_TYPE:
+ p = *(void**) p;
+ push_type_name(L, -1, &ct);
+ lua_pushfstring(L, "cdata<%s>: %p", lua_tostring(L, -1), *(void**) p);
+ return 1;
+
+ case INTPTR_TYPE:
+ lua_pushfstring(L, "%p", *(uintptr_t*) p);
+ return 1;
+
+ case INT64_TYPE:
+ sprintf(buf, ct.is_unsigned ? "%"PRIu64 : "%"PRId64, *(uint64_t*) p);
+ lua_pushstring(L, buf);
+ return 1;
+
+ default:
+ sprintf(buf, ct.is_unsigned ? "%"PRId64 : "%"PRId64, (int64_t) check_intptr(L, 1, p, &ct));
+ lua_pushstring(L, buf);
+ return 1;
+ }
+}
+
+static int ffi_errno(lua_State* L)
+{
+ struct jit* jit = get_jit(L);
+
+ if (!lua_isnoneornil(L, 1)) {
+ lua_pushinteger(L, jit->last_errno);
+ jit->last_errno = luaL_checknumber(L, 1);
+ } else {
+ lua_pushinteger(L, jit->last_errno);
+ }
+
+ return 1;
+}
+
+static int ffi_type(lua_State* L)
+{
+ if (lua_isuserdata(L, 1) && lua_getmetatable(L, 1)) {
+ if (equals_upval(L, -1, &cdata_mt_key) || equals_upval(L, -1, &ctype_mt_key)) {
+ lua_pushstring(L, "cdata");
+ return 1;
+ }
+ lua_pop(L, 1); /* mt */
+ }
+
+ /* call the old _G.type, we use an upvalue as _G.type is set
+ * to this function */
+ lua_pushvalue(L, lua_upvalueindex(1));
+ lua_insert(L, 1);
+ lua_call(L, lua_gettop(L)-1, LUA_MULTRET);
+ return lua_gettop(L);
+}
+
+static int ffi_number(lua_State* L)
+{
+ struct ctype ct;
+ void* data = to_cdata(L, 1, &ct);
+
+ if (ct.type != INVALID_TYPE) {
+ lua_pushinteger(L, check_intptr(L, 1, data, &ct));
+ return 1;
+ } else {
+ /* call the old _G.tonumber, we use an upvalue as _G.tonumber is set
+ * to this function */
+ lua_pushvalue(L, lua_upvalueindex(1));
+ lua_insert(L, 1);
+ lua_call(L, lua_gettop(L)-1, LUA_MULTRET);
+ return lua_gettop(L);
+ }
+}
+
+static int ffi_string(lua_State* L)
+{
+ struct ctype ct;
+ char* data;
+ lua_settop(L, 2);
+
+ data = (char*) check_cdata(L, 1, &ct);
+
+ if (is_void_ptr(&ct)) {
+ lua_pushlstring(L, data, (size_t) luaL_checknumber(L, 2));
+ return 1;
+
+ } else if (ct.type == INT8_TYPE && ct.pointers == 1) {
+ size_t sz;
+
+ if (lua_isuserdata(L, 2)) {
+ ptrdiff_t val;
+ if (!cdata_tointeger(L, 2, &val)) {
+ type_error(L, 2, "int", 0, NULL);
+ }
+ sz = (size_t) val;
+ } else if (!lua_isnil(L, 2)) {
+ sz = (size_t) luaL_checknumber(L, 2);
+
+ } else if (ct.is_array && !ct.is_variable_array) {
+ char* nul = memchr(data, '\0', ct.array_size);
+ sz = nul ? nul - data : ct.array_size;
+
+ } else {
+ sz = strlen(data);
+ }
+
+ lua_pushlstring(L, data, sz);
+ return 1;
+ }
+
+ return luaL_error(L, "unable to convert cdata to string");
+}
+
+static int ffi_copy(lua_State* L)
+{
+ struct ctype ft, tt;
+ char *to, *from;
+
+ setmintop(L, 3);
+ to = (char*) check_pointer(L, 1, &tt);
+ from = (char*) check_pointer(L, 2, &ft);
+
+ if (!lua_isnoneornil(L, 3)) {
+ memcpy(to, from, (size_t) luaL_checknumber(L, 3));
+
+ } else if (ft.type == INT8_TYPE && ft.pointers == 1) {
+ size_t sz = ft.is_array ? ft.array_size : strlen(from);
+ memcpy(to, from, sz);
+ to[sz] = '\0';
+ }
+
+ return 0;
+}
+
+static int ffi_fill(lua_State* L)
+{
+ struct ctype ct;
+ void* to;
+ size_t sz;
+ int val = 0;
+
+ setmintop(L, 3);
+ to = check_pointer(L, 1, &ct);
+ sz = (size_t) luaL_checknumber(L, 2);
+
+ if (!lua_isnoneornil(L, 3)) {
+ val = (int) luaL_checkinteger(L, 3);
+ }
+
+ memset(to, val, sz);
+ return 0;
+}
+
+static int ffi_abi(lua_State* L)
+{
+ luaL_checkstring(L, 1);
+ push_upval(L, &abi_key);
+ lua_pushvalue(L, 1);
+ lua_rawget(L, -2);
+ lua_pushboolean(L, lua_toboolean(L, -1));
+ return 1;
+}
+
+static int ffi_load(lua_State* L)
+{
+ const char* libname = luaL_checkstring(L, 1);
+ void** lib = (void**) lua_newuserdata(L, sizeof(void*));
+
+ *lib = LoadLibraryA(libname);
+
+#ifdef LIB_FORMAT_1
+ if (!*lib) {
+ libname = lua_pushfstring(L, LIB_FORMAT_1, lua_tostring(L, 1));
+ *lib = LoadLibraryA(libname);
+ lua_pop(L, 1);
+ }
+#endif
+
+#ifdef LIB_FORMAT_2
+ if (!*lib) {
+ libname = lua_pushfstring(L, LIB_FORMAT_2, lua_tostring(L, 1));
+ *lib = LoadLibraryA(libname);
+ lua_pop(L, 1);
+ }
+#endif
+
+ if (!*lib) {
+ return luaL_error(L, "could not load library %s", lua_tostring(L, 1));
+ }
+
+ lua_newtable(L);
+ lua_setuservalue(L, -2);
+
+ push_upval(L, &cmodule_mt_key);
+ lua_setmetatable(L, -2);
+ return 1;
+}
+
+static void* find_symbol(lua_State* L, int modidx, const char* asmname)
+{
+ size_t i;
+ void** libs;
+ size_t num;
+ void* sym = NULL;
+
+ libs = (void**) lua_touserdata(L, modidx);
+ num = lua_rawlen(L, modidx) / sizeof(void*);
+
+ for (i = 0; i < num && sym == NULL; i++) {
+ if (libs[i]) {
+ sym = GetProcAddressA(libs[i], asmname);
+ }
+ }
+
+ return sym;
+}
+
+/* pushes the user table */
+static void* lookup_global(lua_State* L, int modidx, int nameidx, const char** pname, struct ctype* ct)
+{
+ int top = lua_gettop(L);
+ void* sym;
+
+ modidx = lua_absindex(L, modidx);
+ nameidx = lua_absindex(L, nameidx);
+
+ *pname = luaL_checkstring(L, nameidx);
+
+ /* get the ctype */
+ push_upval(L, &functions_key);
+ lua_pushvalue(L, nameidx);
+ lua_rawget(L, -2);
+ if (lua_isnil(L, -1)) {
+ luaL_error(L, "missing declaration for function/global %s", *pname);
+ return NULL;
+ }
+
+ /* leave just the ct_usr on the stack */
+ *ct = *(const struct ctype*) lua_touserdata(L, -1);
+ lua_getuservalue(L, -1);
+ lua_replace(L, top + 1);
+ lua_pop(L, 1);
+
+ assert(lua_gettop(L) == top + 1);
+
+ /* get the assembly name */
+ push_upval(L, &asmname_key);
+ lua_pushvalue(L, nameidx);
+ lua_rawget(L, -2);
+ if (lua_isstring(L, -1)) {
+ *pname = lua_tostring(L, -1);
+ }
+ lua_pop(L, 2);
+
+ sym = find_symbol(L, modidx, *pname);
+
+ assert(lua_gettop(L) == top + 1);
+ return sym;
+}
+
+static int cmodule_index(lua_State* L)
+{
+ const char* asmname;
+ struct ctype ct;
+ void *sym;
+
+ lua_settop(L, 2);
+
+ /* see if we have already loaded the function */
+ lua_getuservalue(L, 1);
+ lua_pushvalue(L, 2);
+ lua_rawget(L, -2);
+ if (!lua_isnil(L, -1)) {
+ return 1;
+ }
+ lua_pop(L, 2);
+
+ /* check the constants table */
+ push_upval(L, &constants_key);
+ lua_pushvalue(L, 2);
+ lua_rawget(L, -2);
+ if (!lua_isnil(L, -1)) {
+ return 1;
+ }
+ lua_pop(L, 2);
+
+ /* lookup_global pushes the ct_usr */
+ sym = lookup_global(L, 1, 2, &asmname, &ct);
+
+#if defined _WIN32 && !defined _WIN64 && (defined __i386__ || defined _M_IX86)
+ if (!sym && ct.type == FUNCTION_TYPE) {
+ ct.calling_convention = STD_CALL;
+ lua_pushfstring(L, "_%s@%d", asmname, x86_return_size(L, -1, &ct));
+ sym = find_symbol(L, 1, lua_tostring(L, -1));
+ lua_pop(L, 1);
+ }
+
+ if (!sym && ct.type == FUNCTION_TYPE) {
+ ct.calling_convention = FAST_CALL;
+ lua_pushfstring(L, "@%s@%d", asmname, x86_return_size(L, -1, &ct));
+ sym = find_symbol(L, 1, lua_tostring(L, -1));
+ lua_pop(L, 1);
+ }
+#endif
+
+ if (!sym) {
+ return luaL_error(L, "failed to find function/global %s", asmname);
+ }
+
+ assert(lua_gettop(L) == 3); /* module, name, ct_usr */
+
+ if (ct.type == FUNCTION_TYPE) {
+ compile_function(L, (cfunction) sym, -1, &ct);
+ assert(lua_gettop(L) == 4); /* module, name, ct_usr, function */
+
+ /* set module usr value[luaname] = function to cache for next time */
+ lua_getuservalue(L, 1);
+ lua_pushvalue(L, 2);
+ lua_pushvalue(L, -3);
+ lua_rawset(L, -3);
+ lua_pop(L, 1); /* module uv */
+ return 1;
+ }
+
+ /* extern const char* foo; and extern const char foo[]; */
+ if (ct.pointers == 1 && ct.type == INT8_TYPE) {
+ char* str = (char*) sym;
+ if (!ct.is_array) {
+ str = *(char**) sym;
+ }
+ lua_pushstring(L, str);
+ return 1;
+ }
+
+ /* extern struct foo foo[], extern void* foo[]; and extern struct foo foo; */
+ if (ct.is_array || (!ct.pointers && (ct.type == UNION_TYPE || ct.type == STRUCT_TYPE))) {
+ void* p;
+ ct.is_reference = 1;
+ p = push_cdata(L, -1, &ct);
+ *(void**) p = sym;
+ return 1;
+ }
+
+ /* extern void* foo; and extern void (*foo)(); */
+ if (ct.pointers || ct.type == FUNCTION_PTR_TYPE) {
+ void* p = push_cdata(L, -1, &ct);
+ *(void**) p = *(void**) sym;
+ return 1;
+ }
+
+ switch (ct.type) {
+ case COMPLEX_DOUBLE_TYPE:
+ case COMPLEX_FLOAT_TYPE:
+ case INTPTR_TYPE:
+ case INT64_TYPE:
+ {
+ /* TODO: complex float/double need to be references if .re and
+ * .imag are setable */
+ void* p = push_cdata(L, -1, &ct);
+ memcpy(p, sym, ct.base_size);
+ return 1;
+ }
+
+ case DOUBLE_TYPE:
+ lua_pushnumber(L, *(double*) sym);
+ return 1;
+
+ case FLOAT_TYPE:
+ lua_pushnumber(L, *(float*) sym);
+ return 1;
+
+ case BOOL_TYPE:
+ lua_pushboolean(L, *(bool*) sym);
+ return 1;
+
+ case INT8_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint8_t*) sym : (lua_Integer) *(int8_t*) sym);
+ return 1;
+
+ case INT16_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint16_t*) sym : (lua_Integer) *(int16_t*) sym);
+ return 1;
+
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint32_t*) sym : (lua_Integer) *(int32_t*) sym);
+ return 1;
+ }
+
+ return luaL_error(L, "NYI - global value type");
+}
+
+static int cmodule_newindex(lua_State* L)
+{
+ const char* name;
+ void* sym;
+ struct ctype ct;
+
+ lua_settop(L, 3);
+
+ /* pushes the ct_usr */
+ sym = lookup_global(L, 1, 2, &name, &ct);
+ assert(lua_gettop(L) == 4); /* module, name, value, ct_usr */
+
+ if (sym == NULL) {
+ return luaL_error(L, "failed to find global %s", name);
+ }
+
+ if (ct.type == FUNCTION_TYPE || ct.is_array || (ct.const_mask & 1)) {
+ return luaL_error(L, "can not set global %s", name);
+ }
+
+ set_value(L, 3, sym, -1, &ct, 1);
+ return 0;
+}
+
+static int jit_gc(lua_State* L)
+{
+ size_t i;
+ struct jit* jit = get_jit(L);
+ dasm_free(jit);
+ for (i = 0; i < jit->pagenum; i++) {
+ FreePage(jit->pages[i], jit->pages[i]->size);
+ }
+ free(jit->pages);
+ free(jit->globals);
+ return 0;
+}
+
+static int ffi_debug(lua_State* L)
+{
+ lua_newtable(L);
+ push_upval(L, &ctype_mt_key);
+ lua_setfield(L, -2, "ctype_mt");
+ push_upval(L, &cdata_mt_key);
+ lua_setfield(L, -2, "cdata_mt");
+ push_upval(L, &cmodule_mt_key);
+ lua_setfield(L, -2, "cmodule_mt");
+ push_upval(L, &constants_key);
+ lua_setfield(L, -2, "constants");
+ push_upval(L, &types_key);
+ lua_setfield(L, -2, "types");
+ push_upval(L, &jit_key);
+ lua_setfield(L, -2, "jit");
+ push_upval(L, &gc_key);
+ lua_setfield(L, -2, "gc");
+ push_upval(L, &callbacks_key);
+ lua_setfield(L, -2, "callbacks");
+ push_upval(L, &functions_key);
+ lua_setfield(L, -2, "functions");
+ push_upval(L, &abi_key);
+ lua_setfield(L, -2, "abi");
+ push_upval(L, &next_unnamed_key);
+ lua_setfield(L, -2, "next_unnamed");
+ return 1;
+}
+
+static int do64(lua_State* L, int is_unsigned)
+{
+ lua_Number low, high;
+ struct ctype ct;
+ int64_t val;
+
+ lua_settop(L, 2);
+
+ if (!lua_isnil(L, 2)) {
+ high = luaL_checknumber(L, 1);
+ low = luaL_checknumber(L, 2);
+ } else {
+ high = 0;
+ low = luaL_checknumber(L, 1);
+ }
+
+ val = ((int64_t) (uint32_t) high << 32) | (int64_t) (uint32_t) low;
+
+ if (!is_unsigned && (high < 0 || low < 0)) {
+ val = -val;
+ }
+
+ memset(&ct, 0, sizeof(ct));
+ ct.type = INT64_TYPE;
+ ct.is_unsigned = is_unsigned;
+ ct.is_defined = 1;
+ ct.base_size = sizeof(int64_t);
+ push_number(L, (int64_t) val, 0, &ct);
+
+ return 1;
+}
+
+static int ffi_i64(lua_State* L)
+{ return do64(L, 0); }
+
+static int ffi_u64(lua_State* L)
+{ return do64(L, 1); }
+
+static const luaL_Reg cdata_mt[] = {
+ {"__gc", &cdata_gc},
+ {"__call", &cdata_call},
+ {"free", &cdata_free},
+ {"set", &cdata_set},
+ {"__index", &cdata_index},
+ {"__newindex", &cdata_newindex},
+ {"__add", &cdata_add},
+ {"__sub", &cdata_sub},
+ {"__mul", &cdata_mul},
+ {"__div", &cdata_div},
+ {"__mod", &cdata_mod},
+ {"__pow", &cdata_pow},
+ {"__unm", &cdata_unm},
+ {"__eq", &cdata_eq},
+ {"__lt", &cdata_lt},
+ {"__le", &cdata_le},
+ {"__tostring", &cdata_tostring},
+ {"__concat", &cdata_concat},
+ {"__len", &cdata_len},
+ {"__pairs", &cdata_pairs},
+ {"__ipairs", &cdata_ipairs},
+ {NULL, NULL}
+};
+
+static const luaL_Reg callback_mt[] = {
+ {"__gc", &callback_free},
+ {NULL, NULL}
+};
+
+static const luaL_Reg ctype_mt[] = {
+ {"__call", &ctype_call},
+ {"__new", &ctype_new},
+ {"__tostring", &ctype_tostring},
+ {NULL, NULL}
+};
+
+static const luaL_Reg cmodule_mt[] = {
+ {"__index", &cmodule_index},
+ {"__newindex", &cmodule_newindex},
+ {NULL, NULL}
+};
+
+static const luaL_Reg jit_mt[] = {
+ {"__gc", &jit_gc},
+ {NULL, NULL}
+};
+
+static const luaL_Reg ffi_reg[] = {
+ {"cdef", &ffi_cdef},
+ {"load", &ffi_load},
+ {"new", &ffi_new},
+ {"typeof", &ffi_typeof},
+ {"cast", &ffi_cast},
+ {"metatype", &ffi_metatype},
+ {"gc", &ffi_gc},
+ {"sizeof", &ffi_sizeof},
+ {"alignof", &ffi_alignof},
+ {"offsetof", &ffi_offsetof},
+ {"istype", &ffi_istype},
+ {"errno", &ffi_errno},
+ {"string", &ffi_string},
+ {"copy", &ffi_copy},
+ {"fill", &ffi_fill},
+ {"abi", &ffi_abi},
+ {"debug", &ffi_debug},
+ {"i64", &ffi_i64},
+ {"u64", &ffi_u64},
+ {NULL, NULL}
+};
+
+/* leaves the usr table on the stack */
+static void push_builtin(lua_State* L, struct ctype* ct, const char* name, int type, int size, int align, int is_unsigned)
+{
+ memset(ct, 0, sizeof(*ct));
+ ct->type = type;
+ ct->base_size = size;
+ ct->align_mask = align;
+ ct->is_defined = 1;
+ ct->is_unsigned = is_unsigned;
+
+ if (IS_COMPLEX(type)) {
+ lua_newtable(L);
+ } else {
+ lua_pushnil(L);
+ }
+
+ push_upval(L, &types_key);
+ push_ctype(L, -2, ct);
+ lua_setfield(L, -2, name);
+ lua_pop(L, 2); /* types, usr table */
+}
+
+static void push_builtin_undef(lua_State* L, struct ctype* ct, const char* name, int type)
+{
+ memset(ct, 0, sizeof(*ct));
+ ct->type = type;
+
+ push_upval(L, &types_key);
+ push_ctype(L, 0, ct);
+ lua_setfield(L, -2, name);
+ lua_pop(L, 1); /* types */
+}
+
+static void add_typedef(lua_State* L, const char* from, const char* to)
+{
+ struct ctype ct;
+ struct parser P;
+ P.line = 1;
+ P.align_mask = DEFAULT_ALIGN_MASK;
+ P.next = P.prev = from;
+
+ push_upval(L, &types_key);
+ parse_type(L, &P, &ct);
+ parse_argument(L, &P, -1, &ct, NULL, NULL);
+ push_ctype(L, -1, &ct);
+
+ /* stack is at +4: types, type usr, arg usr, ctype */
+
+ lua_setfield(L, -4, to);
+ lua_pop(L, 3); /* types, type usr, arg usr */
+}
+
+static int setup_upvals(lua_State* L)
+{
+ struct jit* jit = get_jit(L);
+
+ /* jit setup */
+ {
+ dasm_init(jit, 64);
+#ifdef _WIN32
+ {
+ SYSTEM_INFO si;
+ GetSystemInfo(&si);
+ jit->align_page_size = si.dwAllocationGranularity - 1;
+ }
+#else
+ jit->align_page_size = sysconf(_SC_PAGE_SIZE) - 1;
+#endif
+ jit->globals = (void**) malloc(64 * sizeof(void*));
+ dasm_setupglobal(jit, jit->globals, 64);
+ compile_globals(jit, L);
+ }
+
+ /* ffi.C */
+ {
+#ifdef _WIN32
+ size_t sz = sizeof(HMODULE) * 6;
+ HMODULE* libs = lua_newuserdata(L, sz);
+ memset(libs, 0, sz);
+
+ /* exe */
+ GetModuleHandle(NULL);
+ /* lua dll */
+#ifdef LUA_DLL_NAME
+#define STR2(tok) #tok
+#define STR(tok) STR2(tok)
+ libs[1] = LoadLibraryA(STR(LUA_DLL_NAME));
+#undef STR
+#undef STR2
+#endif
+
+ /* crt */
+#ifdef UNDER_CE
+ libs[2] = LoadLibraryA("coredll.dll");
+#else
+ GetModuleHandleExA(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, (char*) &_fmode, &libs[2]);
+ libs[3] = LoadLibraryA("kernel32.dll");
+ libs[4] = LoadLibraryA("user32.dll");
+ libs[5] = LoadLibraryA("gdi32.dll");
+#endif
+
+ jit->lua_dll = libs[1];
+ jit->kernel32_dll = libs[3];
+
+#else /* !_WIN32 */
+ size_t sz = sizeof(void*) * 5;
+ void** libs = lua_newuserdata(L, sz);
+ memset(libs, 0, sz);
+
+ libs[0] = LoadLibraryA(NULL); /* exe */
+ libs[1] = LoadLibraryA("libc.so");
+#ifdef __GNUC__
+ libs[2] = LoadLibraryA("libgcc.so");
+#endif
+ libs[3] = LoadLibraryA("libm.so");
+ libs[4] = LoadLibraryA("libdl.so");
+#endif
+
+ lua_newtable(L);
+ lua_setuservalue(L, -2);
+
+ push_upval(L, &cmodule_mt_key);
+ lua_setmetatable(L, -2);
+
+ lua_setfield(L, 1, "C");
+ }
+
+ /* setup builtin types */
+ {
+ complex_double* pc;
+ struct {char ch; uint16_t v;} a16;
+ struct {char ch; uint32_t v;} a32;
+ struct {char ch; uint64_t v;} a64;
+ struct {char ch; float v;} af;
+ struct {char ch; double v;} ad;
+#ifdef HAVE_LONG_DOUBLE
+ struct {char ch; long double v;} ald;
+#endif
+ struct {char ch; uintptr_t v;} aptr;
+ struct ctype ct;
+ struct {char ch; complex_float v;} cf;
+ struct {char ch; complex_double v;} cd;
+#if defined HAVE_LONG_DOUBLE && defined HAVE_COMPLEX
+ struct {char ch; complex long double v;} cld;
+#endif
+
+ push_builtin(L, &ct, "void", VOID_TYPE, 0, 0, 0);
+ push_builtin(L, &ct, "bool", BOOL_TYPE, sizeof(_Bool), sizeof(_Bool) -1, 1);
+ push_builtin(L, &ct, "uint8_t", INT8_TYPE, sizeof(uint8_t), 0, 1);
+ push_builtin(L, &ct, "int8_t", INT8_TYPE, sizeof(int8_t), 0, 0);
+ push_builtin(L, &ct, "uint16_t", INT16_TYPE, sizeof(uint16_t), ALIGNOF(a16), 1);
+ push_builtin(L, &ct, "int16_t", INT16_TYPE, sizeof(int16_t), ALIGNOF(a16), 0);
+ push_builtin(L, &ct, "uint32_t", INT32_TYPE, sizeof(uint32_t), ALIGNOF(a32), 1);
+ push_builtin(L, &ct, "int32_t", INT32_TYPE, sizeof(int32_t), ALIGNOF(a32), 0);
+ push_builtin(L, &ct, "uint64_t", INT64_TYPE, sizeof(uint64_t), ALIGNOF(a64), 1);
+ push_builtin(L, &ct, "int64_t", INT64_TYPE, sizeof(int64_t), ALIGNOF(a64), 0);
+ push_builtin(L, &ct, "float", FLOAT_TYPE, sizeof(float), ALIGNOF(af), 0);
+ push_builtin(L, &ct, "double", DOUBLE_TYPE, sizeof(double), ALIGNOF(ad), 0);
+#ifdef HAVE_LONG_DOUBLE
+ push_builtin(L, &ct, "long double", LONG_DOUBLE_TYPE, sizeof(long double), ALIGNOF(ald), 0);
+#else
+ push_builtin_undef(L, &ct, "long double", LONG_DOUBLE_TYPE);
+#endif
+ push_builtin(L, &ct, "uintptr_t", INTPTR_TYPE, sizeof(uintptr_t), ALIGNOF(aptr), 1);
+ push_builtin(L, &ct, "intptr_t", INTPTR_TYPE, sizeof(uintptr_t), ALIGNOF(aptr), 0);
+ push_builtin(L, &ct, "complex float", COMPLEX_FLOAT_TYPE, sizeof(complex_float), ALIGNOF(cf), 0);
+ push_builtin(L, &ct, "complex double", COMPLEX_DOUBLE_TYPE, sizeof(complex_double), ALIGNOF(cd), 0);
+#if defined HAVE_LONG_DOUBLE && defined HAVE_COMPLEX
+ push_builtin(L, &ct, "complex long double", COMPLEX_LONG_DOUBLE_TYPE, sizeof(complex long double), ALIGNOF(cld), 0);
+#else
+ push_builtin_undef(L, &ct, "complex long double", COMPLEX_LONG_DOUBLE_TYPE);
+#endif
+
+ /* add NULL and i constants */
+ push_upval(L, &constants_key);
+
+ memset(&ct, 0, sizeof(ct));
+ ct.type = VOID_TYPE;
+ ct.is_defined = 1;
+ ct.pointers = 1;
+ ct.is_null = 1;
+
+ /* add ffi.C.NULL */
+ push_cdata(L, 0, &ct);
+ lua_setfield(L, -2, "NULL");
+
+ /* add ffi.NULL */
+ push_cdata(L, 0, &ct);
+ lua_setfield(L, 1, "NULL");
+
+ memset(&ct, 0, sizeof(ct));
+ ct.type = COMPLEX_DOUBLE_TYPE;
+ ct.is_defined = 1;
+ ct.base_size = sizeof(complex_double);
+ pc = (complex_double*) push_cdata(L, 0, &ct);
+#ifdef HAVE_COMPLEX
+ *pc = 1i;
+#else
+ pc->real = 0;
+ pc->imag = 1;
+#endif
+ lua_setfield(L, -2, "i");
+
+ lua_pop(L, 1); /* constants */
+ }
+
+ assert(lua_gettop(L) == 1);
+
+ /* setup builtin typedefs */
+ {
+ add_typedef(L, "bool", "_Bool");
+
+ if (sizeof(uint32_t) == sizeof(size_t)) {
+ add_typedef(L, "uint32_t", "size_t");
+ add_typedef(L, "int32_t", "ssize_t");
+ } else if (sizeof(uint64_t) == sizeof(size_t)) {
+ add_typedef(L, "uint64_t", "size_t");
+ add_typedef(L, "int64_t", "ssize_t");
+ }
+
+ if (sizeof(int32_t) == sizeof(intptr_t)) {
+ add_typedef(L, "int32_t", "intptr_t");
+ add_typedef(L, "int32_t", "ptrdiff_t");
+ } else if (sizeof(int64_t) == sizeof(intptr_t)) {
+ add_typedef(L, "int64_t", "intptr_t");
+ add_typedef(L, "int64_t", "ptrdiff_t");
+ }
+
+ if (sizeof(uint8_t) == sizeof(wchar_t)) {
+ add_typedef(L, "uint8_t", "wchar_t");
+ } else if (sizeof(uint16_t) == sizeof(wchar_t)) {
+ add_typedef(L, "uint16_t", "wchar_t");
+ } else if (sizeof(uint32_t) == sizeof(wchar_t)) {
+ add_typedef(L, "uint32_t", "wchar_t");
+ }
+
+ if (sizeof(va_list) == sizeof(char*)) {
+ add_typedef(L, "char*", "va_list");
+ } else {
+ struct {char ch; va_list v;} av;
+ lua_pushfstring(L, "struct {char data[%d] __attribute__((align(%d)));}", (int) sizeof(va_list), (int) ALIGNOF(av) + 1);
+ add_typedef(L, lua_tostring(L, -1), "va_list");
+ lua_pop(L, 1);
+ }
+
+ add_typedef(L, "va_list", "__builtin_va_list");
+ add_typedef(L, "va_list", "__gnuc_va_list");
+ }
+
+ assert(lua_gettop(L) == 1);
+
+ /* setup ABI params table */
+ push_upval(L, &abi_key);
+
+#if defined ARCH_X86 || defined ARCH_ARM
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -2, "32bit");
+#elif defined ARCH_X64 || defined ARCH_PPC64
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -2, "64bit");
+#else
+#error
+#endif
+
+#if defined ARCH_X86 || defined ARCH_X64 || defined ARCH_ARM || defined ARCH_PPC64
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -2, "le");
+#else
+#error
+#endif
+
+#if defined ARCH_X86 || defined ARCH_X64 || defined ARCH_PPC64
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -2, "fpu");
+#elif defined ARCH_ARM
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -2, "softfp");
+#else
+#error
+#endif
+ lua_pop(L, 1); /* abi tbl */
+
+
+ /* GC table - shouldn't pin cdata values */
+ push_upval(L, &gc_key);
+ lua_newtable(L);
+ lua_pushliteral(L, "k");
+ lua_setfield(L, -2, "__mode");
+ lua_setmetatable(L, -2);
+ lua_pop(L, 1); /* gc table */
+
+
+ /* ffi.os */
+#if defined OS_CE
+ lua_pushliteral(L, "WindowsCE");
+#elif defined OS_WIN
+ lua_pushliteral(L, "Windows");
+#elif defined OS_OSX
+ lua_pushliteral(L, "OSX");
+#elif defined OS_LINUX
+ lua_pushliteral(L, "Linux");
+#elif defined OS_BSD
+ lua_pushliteral(L, "BSD");
+#elif defined OS_POSIX
+ lua_pushliteral(L, "POSIX");
+#else
+ lua_pushliteral(L, "Other");
+#endif
+ lua_setfield(L, 1, "os");
+
+
+ /* ffi.arch */
+#if defined ARCH_X86
+ lua_pushliteral(L, "x86");
+#elif defined ARCH_X64
+ lua_pushliteral(L, "x64");
+#elif defined ARCH_ARM
+ lua_pushliteral(L, "arm");
+#elif defined ARCH_PPC64
+ lua_pushliteral(L, "ppc64");
+#else
+# error
+#endif
+ lua_setfield(L, 1, "arch");
+
+ assert(lua_gettop(L) == 1);
+
+ return 0;
+}
+
+static void setup_mt(lua_State* L, const luaL_Reg* mt, int upvals)
+{
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -upvals-2, "__metatable");
+ luaL_setfuncs(L, mt, upvals);
+}
+
+
+#if defined FFI_ENABLE_LUATEX_INTERFACE
+int luaopen_ffi(lua_State* L)
+{
+ lua_settop(L, 0);
+
+ lua_newtable(L);
+ set_upval(L, &niluv_key);
+
+ lua_newtable(L);
+ setup_mt(L, ctype_mt, 0);
+ set_upval(L, &ctype_mt_key);
+
+ lua_newtable(L);
+ set_upval(L, &callbacks_key);
+
+ lua_newtable(L);
+ set_upval(L, &gc_key);
+
+ lua_newtable(L);
+ push_upval(L, &callbacks_key);
+ push_upval(L, &gc_key);
+ setup_mt(L, cdata_mt, 2);
+ set_upval(L, &cdata_mt_key);
+
+ lua_newtable(L);
+ setup_mt(L, callback_mt, 0);
+ set_upval(L, &callback_mt_key);
+
+ lua_newtable(L);
+ setup_mt(L, cmodule_mt, 0);
+ set_upval(L, &cmodule_mt_key);
+
+ memset(lua_newuserdata(L, sizeof(struct jit)), 0, sizeof(struct jit));
+ lua_newtable(L);
+ setup_mt(L, jit_mt, 0);
+ lua_setmetatable(L, -2);
+ set_upval(L, &jit_key);
+
+ lua_newtable(L);
+ set_upval(L, &constants_key);
+
+ lua_newtable(L);
+ set_upval(L, &types_key);
+
+ lua_newtable(L);
+ set_upval(L, &functions_key);
+
+ lua_newtable(L);
+ set_upval(L, &asmname_key);
+
+ lua_newtable(L);
+ set_upval(L, &abi_key);
+
+ lua_pushinteger(L, 1);
+ set_upval(L, &next_unnamed_key);
+
+ assert(lua_gettop(L) == 0);
+
+ /* ffi table */
+ lua_newtable(L);
+ luaL_setfuncs(L, ffi_reg, 0);
+
+ /* setup_upvals(ffi tbl) */
+ lua_pushcfunction(L, &setup_upvals);
+ lua_pushvalue(L, 1);
+ lua_call(L, 1, 0);
+
+ assert(lua_gettop(L) == 1);
+
+ lua_getglobal(L, "tonumber");
+ lua_pushcclosure(L, &ffi_number, 1);
+ lua_pushvalue(L, -1);
+ lua_setglobal(L, "tonumber");
+ lua_setfield(L, -2, "number"); /* ffi.number */
+
+ lua_getglobal(L, "type");
+ lua_pushcclosure(L, &ffi_type, 1);
+ lua_pushvalue(L, -1);
+ lua_setglobal(L, "type");
+ lua_setfield(L, -2, "type"); /* ffi.type */
+ return 1;
+}
+#else
+/* This is a stub for OS/ARCH that at this moment don't support ffi */
+int luaopen_ffi(lua_State *L)
+{
+ int k ;
+
+ k = luaL_dostring(L, "local info = [[\n"
+"The ffi module is available for:\n"
+"\n"
+" archictures : ARCH_X86 and ARCH_X64,\n"
+" operating systems : OS_CE, OS_WIN, OS_LINUX, OS BD and OS_POSIX\n"
+"\n"
+"The ARM processor is currently not supported. There are subtle\n"
+"differences between this module and the one in luajitTeX \n"
+"and we hope to be in sync around TeXLive 2018.\n"
+"Different OS can have different interfaces,\n"
+"for instance OS_WIN has not 'complex.h'. If you want portable\n"
+"code, stick to the most common concepts.\n"
+"]]\n"
+"\n"
+"local function stub()\n"
+" texio.write_nl(info)\n"
+"end\n"
+"\n"
+"return {\n"
+" fill = stub,\n"
+" cast = stub,\n"
+" offsetof = stub,\n"
+" copy = stub,\n"
+" string = stub,\n"
+" abi = stub,\n"
+" cdef = stub,\n"
+" typeof = stub,\n"
+" sizeof = stub,\n"
+" type = stub,\n"
+" number = stub,\n"
+" gc = stub,\n"
+" metatype = stub,\n"
+" errno = stub,\n"
+" debug = stub,\n"
+" os = '' ,\n"
+" arch = '' ,\n"
+" NULL = nil ,\n"
+" alignof = stub,\n"
+" new = stub,\n"
+" u64 = stub,\n"
+" i64 = stub,\n"
+" istype = stub,\n"
+" load = stub,\n"
+" C = nil ,\n"
+"}");
+
+ return k==0 ? 1 : k;
+}
+#endif
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/ffi.c.orig b/Build/source/texk/web2c/luatexdir/luaffi/ffi.c.orig
new file mode 100644
index 00000000000..988e764b2d7
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/ffi.c.orig
@@ -0,0 +1,3552 @@
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+#include "ffi.h"
+#include <math.h>
+#include <inttypes.h>
+
+/* Set to 1 to get extra debugging on print */
+#define DEBUG_TOSTRING 0
+
+int jit_key;
+int ctype_mt_key;
+int cdata_mt_key;
+int callback_mt_key;
+int cmodule_mt_key;
+int constants_key;
+int types_key;
+int gc_key;
+int callbacks_key;
+int functions_key;
+int abi_key;
+int next_unnamed_key;
+int niluv_key;
+int asmname_key;
+
+void push_upval(lua_State* L, int* key)
+{
+ lua_pushlightuserdata(L, key);
+ lua_rawget(L, LUA_REGISTRYINDEX);
+}
+
+void set_upval(lua_State* L, int* key)
+{
+ lua_pushlightuserdata(L, key);
+ lua_insert(L, -2);
+ lua_rawset(L, LUA_REGISTRYINDEX);
+}
+
+int equals_upval(lua_State* L, int idx, int* key)
+{
+ int ret;
+ lua_pushvalue(L, idx);
+ push_upval(L, key);
+ ret = lua_rawequal(L, -2, -1);
+ lua_pop(L, 2);
+ return ret;
+}
+
+struct jit* get_jit(lua_State* L)
+{
+ struct jit* jit;
+ push_upval(L, &jit_key);
+ jit = (struct jit*) lua_touserdata(L, -1);
+ jit->L = L;
+ lua_pop(L, 1); /* still in registry */
+ return jit;
+}
+
+static int type_error(lua_State* L, int idx, const char* to_type, int to_usr, const struct ctype* to_ct)
+{
+ luaL_Buffer B;
+ struct ctype ft;
+
+ assert(to_type || (to_usr && to_ct));
+ if (to_usr) {
+ to_usr = lua_absindex(L, to_usr);
+ }
+
+ idx = lua_absindex(L, idx);
+
+ luaL_buffinit(L, &B);
+ to_cdata(L, idx, &ft);
+
+ if (ft.type != INVALID_TYPE) {
+ push_type_name(L, -1, &ft);
+ lua_pushfstring(L, "unable to convert argument %d from cdata<%s> to cdata<", idx, lua_tostring(L, -1));
+ lua_remove(L, -2);
+ luaL_addvalue(&B);
+ } else {
+ lua_pushfstring(L, "unable to convert argument %d from lua<%s> to cdata<", idx, luaL_typename(L, idx));
+ luaL_addvalue(&B);
+ }
+
+ if (to_ct) {
+ push_type_name(L, to_usr, to_ct);
+ luaL_addvalue(&B);
+ } else {
+ luaL_addstring(&B, to_type);
+ }
+
+ luaL_addchar(&B, '>');
+
+ luaL_pushresult(&B);
+ return lua_error(L);
+}
+
+static void* userdata_toptr(lua_State* L, int idx)
+{
+ void* ptr = lua_touserdata(L, idx);
+
+ // check for FILE*
+ lua_getmetatable(L, idx);
+ luaL_getmetatable(L, LUA_FILEHANDLE);
+ int isfile = lua_rawequal(L, -1, -2);
+ lua_pop(L, 2);
+
+ if (isfile) {
+#if LUA_VERSION_NUM == 501
+ FILE** stream = (FILE**) ptr;
+ return *stream;
+#else
+ luaL_Stream* stream = (luaL_Stream*) ptr;
+ return stream->f;
+#endif
+ }
+
+ return ptr;
+}
+
+static int cdata_tointeger(lua_State* L, int idx, ptrdiff_t* val)
+{
+ struct ctype ct;
+ void* addr = to_cdata(L, idx, &ct);
+ lua_pop(L, 1);
+
+ if (ct.pointers) {
+ return 0;
+ }
+
+ switch (ct.type) {
+ case INT8_TYPE:
+ *val = *(int8_t*)addr;
+ return 1;
+ case INT16_TYPE:
+ *val = *(int16_t*)addr;
+ return 1;
+ case INT32_TYPE:
+ *val = *(int32_t*)addr;
+ return 1;
+ case INT64_TYPE:
+ *val = *(int64_t*)addr;
+ return 1;
+ default:
+ return 0;
+ }
+}
+
+static int64_t check_intptr(lua_State* L, int idx, void* p, struct ctype* ct)
+{
+ if (ct->type == INVALID_TYPE) {
+ int64_t ret;
+ memset(ct, 0, sizeof(*ct));
+ ct->base_size = 8;
+ ct->type = INT64_TYPE;
+ ct->is_defined = 1;
+ ret = luaL_checknumber(L, idx);
+ return ret;
+
+ } else if (ct->pointers) {
+ return (intptr_t) p;
+ }
+
+ switch (ct->type) {
+ case INTPTR_TYPE:
+ case FUNCTION_PTR_TYPE:
+ return *(intptr_t*) p;
+
+ case INT64_TYPE:
+ return *(int64_t*) p;
+
+ case INT32_TYPE:
+ return ct->is_unsigned ? (int64_t) *(uint32_t*) p : (int64_t) *(int32_t*) p;
+
+ case INT16_TYPE:
+ return ct->is_unsigned ? (int64_t) *(uint16_t*) p : (int64_t) *(int16_t*) p;
+
+ case INT8_TYPE:
+ return ct->is_unsigned ? (int64_t) *(uint8_t*) p : (int64_t) *(int8_t*) p;
+
+ default:
+ type_error(L, idx, "intptr_t", 0, NULL);
+ return 0;
+ }
+}
+
+static int get_cfunction_address(lua_State* L, int idx, cfunction* addr);
+
+#define TO_NUMBER(TYPE, ALLOW_POINTERS, LUA_TONUMBER) \
+ TYPE ret = 0; \
+ void* p; \
+ struct ctype ct; \
+ cfunction f; \
+ \
+ switch (lua_type(L, idx)) { \
+ case LUA_TBOOLEAN: \
+ ret = (TYPE) lua_toboolean(L, idx); \
+ break; \
+ \
+ case LUA_TNUMBER: \
+ ret = (TYPE) LUA_TONUMBER(L, idx); \
+ break; \
+ \
+ case LUA_TSTRING: \
+ if (!ALLOW_POINTERS) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ ret = (TYPE) (intptr_t) lua_tostring(L, idx); \
+ break; \
+ \
+ case LUA_TLIGHTUSERDATA: \
+ if (!ALLOW_POINTERS) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ ret = (TYPE) (intptr_t) lua_topointer(L, idx); \
+ break; \
+ \
+ case LUA_TFUNCTION: \
+ if (!ALLOW_POINTERS) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ if (!get_cfunction_address(L, idx, &f)) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ ret = (TYPE) (intptr_t) f; \
+ break; \
+ \
+ case LUA_TUSERDATA: \
+ p = to_cdata(L, idx, &ct); \
+ \
+ if (ct.type == INVALID_TYPE) { \
+ if (!ALLOW_POINTERS) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ ret = (TYPE) (intptr_t) userdata_toptr(L, idx); \
+ } else if (ct.pointers || ct.type == STRUCT_TYPE || ct.type == UNION_TYPE) {\
+ if (!ALLOW_POINTERS) { \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+ ret = (TYPE) (intptr_t) p; \
+ } else if (ct.type == COMPLEX_DOUBLE_TYPE) { \
+ ret = (TYPE) creal(*(complex_double*) p); \
+ } else if (ct.type == COMPLEX_FLOAT_TYPE) { \
+ ret = (TYPE) crealf(*(complex_float*) p); \
+ } else if (ct.type == DOUBLE_TYPE) { \
+ ret = (TYPE) *(double*) p; \
+ } else if (ct.type == FLOAT_TYPE) { \
+ ret = (TYPE) *(float*) p; \
+ } else { \
+ ret = check_intptr(L, idx, p, &ct); \
+ } \
+ lua_pop(L, 1); \
+ break; \
+ \
+ case LUA_TNIL: \
+ ret = (TYPE) 0; \
+ break; \
+ \
+ default: \
+ type_error(L, idx, #TYPE, 0, NULL); \
+ } \
+
+static int64_t cast_int64(lua_State* L, int idx, int is_cast)
+{ TO_NUMBER(int64_t, is_cast, lua_tointeger); return ret; }
+
+static uint64_t cast_uint64(lua_State* L, int idx, int is_cast)
+{ TO_NUMBER(uint64_t, is_cast, lua_tointeger); return ret; }
+
+int32_t check_int32(lua_State* L, int idx)
+{ return (int32_t) cast_int64(L, idx, 0); }
+
+uint32_t check_uint32(lua_State* L, int idx)
+{ return (uint32_t) cast_uint64(L, idx, 0); }
+
+int64_t check_int64(lua_State* L, int idx)
+{ return cast_int64(L, idx, 0); }
+
+uint64_t check_uint64(lua_State* L, int idx)
+{ return cast_uint64(L, idx, 0); }
+
+double check_double(lua_State* L, int idx)
+{ TO_NUMBER(double, 0, lua_tonumber); return ret; }
+
+float check_float(lua_State* L, int idx)
+{ TO_NUMBER(double, 0, lua_tonumber); return ret; }
+
+uintptr_t check_uintptr(lua_State* L, int idx)
+{ TO_NUMBER(uintptr_t, 1, lua_tointeger); return ret; }
+
+complex_double check_complex_double(lua_State* L, int idx)
+{
+ double real = 0, imag = 0;
+ void* p;
+ struct ctype ct;
+
+ switch (lua_type(L, idx)) {
+ case LUA_TNUMBER:
+ real = (double) lua_tonumber(L, idx);
+ break;
+ case LUA_TTABLE:
+ lua_rawgeti(L, idx, 1);
+ real = check_double(L, -1);
+ lua_pop(L, 1);
+
+ lua_rawgeti(L, idx, 2);
+ if (lua_isnil(L, -1)) {
+ imag = real;
+ } else {
+ imag = check_double(L, -1);
+ }
+ lua_pop(L, 1);
+ break;
+ case LUA_TUSERDATA:
+ p = to_cdata(L, idx, &ct);
+ if (ct.type == COMPLEX_DOUBLE_TYPE) {
+ real = creal(*(complex_double*) p);
+ imag = cimag(*(complex_double*) p);
+ } else if (ct.type == COMPLEX_FLOAT_TYPE) {
+ real = crealf(*(complex_float*) p);
+ imag = cimagf(*(complex_float*) p);
+ } else if (ct.type == DOUBLE_TYPE) {
+ real = *(double*) p;
+ } else if (ct.type == FLOAT_TYPE) {
+ real = *(float*) p;
+ } else {
+ real = check_intptr(L, idx, p, &ct);
+ }
+ lua_pop(L, 1);
+ break;
+
+ default:
+ type_error(L, idx, "complex", 0, NULL);
+ }
+
+ return mk_complex_double(real, imag);
+}
+
+complex_float check_complex_float(lua_State* L, int idx)
+{
+ complex_double d = check_complex_double(L, idx);
+ return mk_complex_float(creal(d), cimag(d));
+}
+
+static size_t unpack_vararg(lua_State* L, int i, char* to)
+{
+ void* p;
+ struct ctype ct;
+
+ switch (lua_type(L, i)) {
+ case LUA_TBOOLEAN:
+ *(int*) to = lua_toboolean(L, i);
+ return sizeof(int);
+
+ case LUA_TNUMBER:
+ *(double*) to = lua_tonumber(L, i); // TODO in Lua 5.3: lua_tointeger sometimes should be here
+ return sizeof(double);
+
+ case LUA_TSTRING:
+ *(const char**) to = lua_tostring(L, i);
+ return sizeof(const char*);
+
+ case LUA_TLIGHTUSERDATA:
+ *(void**) to = lua_touserdata(L, i);
+ return sizeof(void*);
+
+ case LUA_TUSERDATA:
+ p = to_cdata(L, i, &ct);
+ lua_pop(L, 1);
+
+ if (ct.type == INVALID_TYPE) {
+ *(void**) to = userdata_toptr(L, i);
+ return sizeof(void*);
+
+ } else if (ct.pointers || ct.type == INTPTR_TYPE) {
+ *(void**) to = p;
+ return sizeof(void*);
+
+ } else if (ct.type == INT32_TYPE) {
+ *(int32_t*) to = *(int32_t*) p;
+ return sizeof(int32_t);
+
+ } else if (ct.type == INT64_TYPE) {
+ *(int64_t*) to = *(int64_t*) p;
+ return sizeof(int64_t);
+ }
+ goto err;
+
+ case LUA_TNIL:
+ *(void**) to = NULL;
+ return sizeof(void*);
+
+ default:
+ goto err;
+ }
+
+err:
+ return type_error(L, i, "vararg", 0, NULL);
+}
+
+void unpack_varargs_stack(lua_State* L, int first, int last, char* to)
+{
+ int i;
+
+ for (i = first; i <= last; i++) {
+ to += unpack_vararg(L, i, to);
+ }
+}
+
+void unpack_varargs_stack_skip(lua_State* L, int first, int last, int ints_to_skip, int floats_to_skip, char* to)
+{
+ int i;
+
+ for (i = first; i <= last; i++) {
+ int type = lua_type(L, i);
+
+ if (type == LUA_TNUMBER && --floats_to_skip >= 0) {
+ continue;
+ } else if (type != LUA_TNUMBER && --ints_to_skip >= 0) {
+ continue;
+ }
+
+ to += unpack_vararg(L, i, to);
+ }
+}
+
+void unpack_varargs_float(lua_State* L, int first, int last, int max, char* to)
+{
+ int i;
+
+ for (i = first; i <= last && max > 0; i++) {
+ if (lua_type(L, i) == LUA_TNUMBER) {
+ unpack_vararg(L, i, to);
+ to += sizeof(double);
+ max--;
+ }
+ }
+}
+
+void unpack_varargs_int(lua_State* L, int first, int last, int max, char* to)
+{
+ int i;
+
+ for (i = first; i <= last && max > 0; i++) {
+ if (lua_type(L, i) != LUA_TNUMBER) {
+ unpack_vararg(L, i, to);
+ to += sizeof(void*);
+ max--;
+ }
+ }
+}
+
+void unpack_varargs_reg(lua_State* L, int first, int last, char* to)
+{
+ int i;
+
+ for (i = first; i <= last; i++) {
+ unpack_vararg(L, i, to);
+ to += sizeof(double);
+ }
+}
+
+/* to_enum tries to convert a value at idx to the enum type indicated by to_ct
+ * and uv to_usr. For strings this means it will do a string lookup for the
+ * enum type. It leaves the stack unchanged. Will throw an error if the type
+ * at idx can't be conerted.
+ */
+int32_t check_enum(lua_State* L, int idx, int to_usr, const struct ctype* to_ct)
+{
+ int32_t ret;
+
+ switch (lua_type(L, idx)) {
+ case LUA_TSTRING:
+ /* lookup string in to_usr to find value */
+ to_usr = lua_absindex(L, to_usr);
+ lua_pushvalue(L, idx);
+ lua_rawget(L, to_usr);
+
+ if (lua_isnil(L, -1)) {
+ goto err;
+ }
+
+ ret = (int32_t) lua_tointeger(L, -1);
+ lua_pop(L, 1);
+ return ret;
+
+ case LUA_TUSERDATA:
+ return check_int32(L, idx);
+
+ case LUA_TNIL:
+ return (int32_t) 0;
+
+ case LUA_TNUMBER:
+ return (int32_t) lua_tointeger(L, idx);
+
+ default:
+ goto err;
+ }
+
+err:
+ return type_error(L, idx, NULL, to_usr, to_ct);
+}
+
+/* to_pointer tries converts a value at idx to a pointer. It fills out ct and
+ * pushes the uv of the found type. It will throw a lua error if it can not
+ * convert the value to a pointer. */
+static void* check_pointer(lua_State* L, int idx, struct ctype* ct)
+{
+ void* p;
+ memset(ct, 0, sizeof(*ct));
+ idx = lua_absindex(L, idx);
+
+ switch (lua_type(L, idx)) {
+ case LUA_TNIL:
+ ct->type = VOID_TYPE;
+ ct->pointers = 1;
+ ct->is_null = 1;
+ lua_pushnil(L);
+ return NULL;
+
+ case LUA_TNUMBER:
+ ct->type = INTPTR_TYPE;
+ ct->is_unsigned = 1;
+ ct->pointers = 0;
+ lua_pushnil(L);
+ return (void*) (uintptr_t) lua_tonumber(L, idx); // TODO in Lua 5.3: maybe change to lua_tointeger
+
+ case LUA_TLIGHTUSERDATA:
+ ct->type = VOID_TYPE;
+ ct->pointers = 1;
+ lua_pushnil(L);
+ return lua_touserdata(L, idx);
+
+ case LUA_TSTRING:
+ ct->type = INT8_TYPE;
+ ct->pointers = 1;
+ ct->is_unsigned = IS_CHAR_UNSIGNED;
+ ct->is_array = 1;
+ ct->base_size = 1;
+ ct->const_mask = 2;
+ lua_pushnil(L);
+ return (void*) lua_tolstring(L, idx, &ct->array_size);
+
+ case LUA_TUSERDATA:
+ p = to_cdata(L, idx, ct);
+
+ if (ct->type == INVALID_TYPE) {
+ /* some other type of user data */
+ ct->type = VOID_TYPE;
+ ct->pointers = 1;
+ return userdata_toptr(L, idx);
+ } else if (ct->type == STRUCT_TYPE || ct->type == UNION_TYPE) {
+ return p;
+ } else {
+ return (void*) (intptr_t) check_intptr(L, idx, p, ct);
+ }
+ break;
+ }
+
+ type_error(L, idx, "pointer", 0, NULL);
+ return NULL;
+}
+
+static int is_void_ptr(const struct ctype* ct)
+{
+ return ct->type == VOID_TYPE
+ && ct->pointers == 1;
+}
+
+static int is_same_type(lua_State* L, int usr1, int usr2, const struct ctype* t1, const struct ctype* t2)
+{
+ if (t1->type != t2->type) {
+ return 0;
+ }
+
+#if LUA_VERSION_NUM == 501
+ if (lua_isnil(L, usr1) != lua_isnil(L, usr2)) {
+ int ret;
+ usr1 = lua_absindex(L, usr1);
+ usr2 = lua_absindex(L, usr2);
+ push_upval(L, &niluv_key);
+
+ ret = lua_rawequal(L, usr1, -1)
+ || lua_rawequal(L, usr2, -1);
+
+ lua_pop(L, 1);
+
+ if (ret) {
+ return 1;
+ }
+ }
+#endif
+
+ return lua_rawequal(L, usr1, usr2);
+}
+
+static void set_struct(lua_State* L, int idx, void* to, int to_usr, const struct ctype* tt, int check_pointers);
+
+/* to_typed_pointer converts a value at idx to a type tt with target uv to_usr
+ * checking all types. May push a temporary value so that it can create
+ * structs on the fly. */
+void* check_typed_pointer(lua_State* L, int idx, int to_usr, const struct ctype* tt)
+{
+ struct ctype ft;
+ void* p;
+
+ to_usr = lua_absindex(L, to_usr);
+ idx = lua_absindex(L, idx);
+
+ if (tt->pointers == 1 && (tt->type == STRUCT_TYPE || tt->type == UNION_TYPE) && lua_type(L, idx) == LUA_TTABLE) {
+ /* need to construct a struct of the target type */
+ struct ctype ct = *tt;
+ ct.pointers = ct.is_array = 0;
+ p = push_cdata(L, to_usr, &ct);
+ set_struct(L, idx, p, to_usr, &ct, 1);
+ return p;
+ }
+
+ p = check_pointer(L, idx, &ft);
+
+ if (tt->pointers == 1 && ft.pointers == 0 && (ft.type == STRUCT_TYPE || ft.type == UNION_TYPE)) {
+ /* auto dereference structs */
+ ft.pointers = 1;
+ ft.const_mask <<= 1;
+ }
+
+ if (is_void_ptr(tt)) {
+ /* any pointer can convert to void* */
+ goto suc;
+
+ } else if (is_void_ptr(&ft) && (ft.pointers || ft.is_reference)) {
+ /* void* can convert to any pointer */
+ goto suc;
+
+ } else if (ft.is_null) {
+ /* NULL can convert to any pointer */
+ goto suc;
+
+ } else if (!is_same_type(L, to_usr, -1, tt, &ft)) {
+ /* the base type is different */
+ goto err;
+
+ } else if (tt->pointers != ft.pointers) {
+ goto err;
+
+ } else if (ft.const_mask & ~tt->const_mask) {
+ /* for every const in from it must be in to, there are further rules
+ * for const casting (see the c++ spec), but they are hard to test
+ * quickly */
+ goto err;
+ }
+
+suc:
+ return p;
+
+err:
+ type_error(L, idx, NULL, to_usr, tt);
+ return NULL;
+}
+
+/**
+ * gets the address of the wrapped C function for the lua function value at idx
+ * and returns 1 if it exists; otherwise returns 0 and nothing is pushed */
+static int get_cfunction_address(lua_State* L, int idx, cfunction* addr)
+{
+ if (!lua_isfunction(L, idx)) return 0;
+
+ int top = lua_gettop(L);
+
+ // Get the last upvalue
+ int n = 2;
+ while (lua_getupvalue(L, idx, n)) {
+ lua_pop(L, 1);
+ n++;
+ }
+
+ if (!lua_getupvalue(L, idx, n - 1))
+ return 0;
+
+ if (!lua_isuserdata(L, -1) || !lua_getmetatable(L, -1)) {
+ lua_pop(L, 1);
+ return 0;
+ }
+
+ push_upval(L, &callback_mt_key);
+ if (!lua_rawequal(L, -1, -2)) {
+ lua_pop(L, 3);
+ return 0;
+ }
+
+ /* stack is:
+ * userdata upval
+ * metatable
+ * callback_mt
+ */
+
+ cfunction* f = lua_touserdata(L, -3);
+ *addr = f[1];
+ lua_pop(L, 3);
+ return 1;
+}
+
+/* to_cfunction converts a value at idx with usr table at to_usr and type tt
+ * into a function. Leaves the stack unchanged. */
+static cfunction check_cfunction(lua_State* L, int idx, int to_usr, const struct ctype* tt, int check_pointers)
+{
+ void* p;
+ struct ctype ft;
+ cfunction f;
+ int top = lua_gettop(L);
+
+ idx = lua_absindex(L, idx);
+ to_usr = lua_absindex(L, to_usr);
+
+ switch (lua_type(L, idx)) {
+ case LUA_TFUNCTION:
+ if (get_cfunction_address(L, idx, &f)) {
+ return f;
+ }
+
+ /* Function cdatas are pinned and must be manually cleaned up by
+ * calling func:free(). */
+ push_upval(L, &callbacks_key);
+ f = compile_callback(L, idx, to_usr, tt);
+ lua_pushboolean(L, 1);
+ lua_rawset(L, -3);
+ lua_pop(L, 1); /* callbacks tbl */
+ return f;
+
+ case LUA_TNIL:
+ return NULL;
+
+ case LUA_TLIGHTUSERDATA:
+ if (check_pointers) {
+ goto err;
+ } else {
+ return (cfunction) lua_touserdata(L, idx);
+ }
+
+ case LUA_TUSERDATA:
+ p = to_cdata(L, idx, &ft);
+ assert(lua_gettop(L) == top + 1);
+
+ if (ft.type == INVALID_TYPE) {
+ if (check_pointers) {
+ goto err;
+ } else {
+ lua_pop(L, 1);
+ return (cfunction) lua_touserdata(L, idx);
+ }
+
+ } else if (ft.is_null) {
+ lua_pop(L, 1);
+ return NULL;
+
+ } else if (!check_pointers && (ft.pointers || ft.type == INTPTR_TYPE)) {
+ lua_pop(L, 1);
+ return (cfunction) *(void**) p;
+
+ } else if (ft.type != FUNCTION_PTR_TYPE) {
+ goto err;
+
+ } else if (!check_pointers) {
+ lua_pop(L, 1);
+ return *(cfunction*) p;
+
+ } else if (ft.calling_convention != tt->calling_convention) {
+ goto err;
+
+ } else if (!is_same_type(L, -1, to_usr, &ft, tt)) {
+ goto err;
+
+ } else {
+ lua_pop(L, 1);
+ return *(cfunction*) p;
+ }
+
+ default:
+ goto err;
+ }
+
+err:
+ type_error(L, idx, NULL, to_usr, tt);
+ return NULL;
+}
+
+/* to_type_cfunction converts a value at idx with uv at to_usr and type tt to
+ * a cfunction. Leaves the stack unchanged. */
+cfunction check_typed_cfunction(lua_State* L, int idx, int to_usr, const struct ctype* tt)
+{ return check_cfunction(L, idx, to_usr, tt, 1); }
+
+static void set_value(lua_State* L, int idx, void* to, int to_usr, const struct ctype* tt, int check_pointers);
+
+static void set_array(lua_State* L, int idx, void* to, int to_usr, const struct ctype* tt, int check_pointers)
+{
+ size_t i, sz, esz;
+ struct ctype et;
+
+ idx = lua_absindex(L, idx);
+ to_usr = lua_absindex(L, to_usr);
+
+ switch (lua_type(L, idx)) {
+ case LUA_TSTRING:
+ if (tt->pointers == 1 && tt->type == INT8_TYPE) {
+ const char* str = lua_tolstring(L, idx, &sz);
+
+ if (!tt->is_variable_array && sz >= tt->array_size) {
+ memcpy(to, str, tt->array_size);
+ } else {
+ /* include nul terminator */
+ memcpy(to, str, sz+1);
+ }
+ } else {
+ goto err;
+ }
+ break;
+
+ case LUA_TTABLE:
+ et = *tt;
+ et.pointers--;
+ et.const_mask >>= 1;
+ et.is_array = 0;
+ esz = et.pointers ? sizeof(void*) : et.base_size;
+
+ lua_rawgeti(L, idx, 2);
+
+ if (tt->is_variable_array) {
+ /* we have no idea how big the array is, so set values based off
+ * how many items were given to us */
+ lua_pop(L, 1);
+ for (i = 0; i < lua_rawlen(L, idx); i++) {
+ lua_rawgeti(L, idx, (int) i + 1);
+ set_value(L, -1, (char*) to + esz * i, to_usr, &et, check_pointers);
+ lua_pop(L, 1);
+ }
+
+ } else if (lua_isnil(L, -1)) {
+ /* there is no second element, so we set the whole array to the
+ * first element (or nil - ie 0) if there is no first element) */
+ lua_pop(L, 1);
+ lua_rawgeti(L, idx, 1);
+
+ if (lua_isnil(L, -1)) {
+ memset(to, 0, ctype_size(L, tt));
+ } else {
+ /* if its still variable we have no idea how many values to set */
+ for (i = 0; i < tt->array_size; i++) {
+ set_value(L, -1, (char*) to + esz * i, to_usr, &et, check_pointers);
+ }
+ }
+
+ lua_pop(L, 1);
+
+ } else {
+ /* there is a second element, so we set each element using the
+ * equiv index in the table initializer */
+ lua_pop(L, 1);
+ for (i = 0; i < tt->array_size; i++) {
+ lua_rawgeti(L, idx, (int) (i+1));
+
+ if (lua_isnil(L, -1)) {
+ /* we've hit the end of the values provided in the
+ * initializer, so memset the rest to zero */
+ lua_pop(L, 1);
+ memset((char*) to + esz * i, 0, (tt->array_size - i) * esz);
+ break;
+
+ } else {
+ set_value(L, -1, (char*) to + esz * i, to_usr, &et, check_pointers);
+ lua_pop(L, 1);
+ }
+ }
+ }
+ break;
+
+ default:
+ goto err;
+ }
+
+ return;
+
+err:
+ type_error(L, idx, NULL, to_usr, tt);
+}
+
+/* pops the member key from the stack, leaves the member user value on the
+ * stack. Returns the member offset. Returns -ve if the member can not be
+ * found. */
+static ptrdiff_t get_member(lua_State* L, int usr, const struct ctype* ct, struct ctype* mt)
+{
+ ptrdiff_t off;
+ lua_rawget(L, usr);
+
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1);
+ return -1;
+ }
+
+ *mt = *(const struct ctype*) lua_touserdata(L, -1);
+ lua_getuservalue(L, -1);
+ lua_replace(L, -2);
+
+ if (mt->is_variable_array && ct->variable_size_known) {
+ /* eg char mbr[?] */
+ size_t sz = (mt->pointers > 1) ? sizeof(void*) : mt->base_size;
+ assert(ct->is_variable_struct && mt->is_array);
+ mt->array_size = ct->variable_increment / sz;
+ mt->is_variable_array = 0;
+
+ } else if (mt->is_variable_struct && ct->variable_size_known) {
+ /* eg struct {char a; char b[?]} mbr; */
+ assert(ct->is_variable_struct);
+ mt->variable_size_known = 1;
+ mt->variable_increment = ct->variable_increment;
+ }
+
+ off = mt->offset;
+ mt->offset = 0;
+ return off;
+}
+
+static void set_struct(lua_State* L, int idx, void* to, int to_usr, const struct ctype* tt, int check_pointers)
+{
+ int have_first = 0;
+ int have_other = 0;
+ struct ctype mt;
+ void* p;
+
+ to_usr = lua_absindex(L, to_usr);
+ idx = lua_absindex(L, idx);
+
+ switch (lua_type(L, idx)) {
+ case LUA_TTABLE:
+ /* match up to the members based off the table initializers key - this
+ * will match both numbered and named members in the user table
+ * we need a special case for when no entries in the initializer -
+ * zero initialize the c struct, and only one entry in the initializer
+ * - set all members to this value */
+ memset(to, 0, ctype_size(L, tt));
+ lua_pushnil(L);
+ while (lua_next(L, idx)) {
+ ptrdiff_t off;
+
+ if (!have_first && lua_tonumber(L, -2) == 1 && lua_tonumber(L, -1) != 0) {
+ have_first = 1;
+ } else if (!have_other && (lua_type(L, -2) != LUA_TNUMBER || lua_tonumber(L, -2) != 1)) {
+ have_other = 1;
+ }
+
+ lua_pushvalue(L, -2);
+ off = get_member(L, to_usr, tt, &mt);
+ assert(off >= 0);
+ set_value(L, -2, (char*) to + off, -1, &mt, check_pointers);
+
+ /* initializer value, mt usr */
+ lua_pop(L, 2);
+ }
+
+ /* if we only had a single non zero value then initialize all members to that value */
+ if (!have_other && have_first && tt->type != UNION_TYPE) {
+ size_t i, sz;
+ ptrdiff_t off;
+ lua_rawgeti(L, idx, 1);
+ sz = lua_rawlen(L, to_usr);
+
+ for (i = 2; i < sz; i++) {
+ lua_pushinteger(L, i);
+ off = get_member(L, to_usr, tt, &mt);
+ assert(off >= 0);
+ set_value(L, -2, (char*) to + off, -1, &mt, check_pointers);
+ lua_pop(L, 1); /* mt usr */
+ }
+
+ lua_pop(L, 1); /* initializer table */
+ }
+ break;
+
+ case LUA_TUSERDATA:
+ if (check_pointers) {
+ p = check_typed_pointer(L, idx, to_usr, tt);
+ } else {
+ struct ctype ct;
+ p = check_pointer(L, idx, &ct);
+ }
+ memcpy(to, p, tt->base_size);
+ lua_pop(L, 1);
+ break;
+
+ default:
+ goto err;
+ }
+
+ return;
+
+err:
+ type_error(L, idx, NULL, to_usr, tt);
+}
+
+static void set_value(lua_State* L, int idx, void* to, int to_usr, const struct ctype* tt, int check_pointers)
+{
+ int top = lua_gettop(L);
+
+ if (tt->is_array) {
+ set_array(L, idx, to, to_usr, tt, check_pointers);
+
+ } else if (tt->pointers || tt->is_reference) {
+ union {
+ uint8_t c[sizeof(void*)];
+ void* p;
+ } u;
+
+ if (lua_istable(L, idx)) {
+ luaL_error(L, "Can't set a pointer member to a struct that's about to be freed");
+ }
+
+ if (check_pointers) {
+ u.p = check_typed_pointer(L, idx, to_usr, tt);
+ } else {
+ struct ctype ct;
+ u.p = check_pointer(L, idx, &ct);
+ }
+
+#ifndef ALLOW_MISALIGNED_ACCESS
+ if ((uintptr_t) to & PTR_ALIGN_MASK) {
+ memcpy(to, u.c, sizeof(void*));
+ } else
+#endif
+ {
+ *(void**) to = u.p;
+ }
+
+ lua_pop(L, 1);
+
+ } else if (tt->is_bitfield) {
+
+ uint64_t hi_mask = UINT64_C(0) - (UINT64_C(1) << (tt->bit_offset + tt->bit_size));
+ uint64_t low_mask = (UINT64_C(1) << tt->bit_offset) - UINT64_C(1);
+ uint64_t val = check_uint64(L, idx);
+ val &= (UINT64_C(1) << tt->bit_size) - 1;
+ val <<= tt->bit_offset;
+ *(uint64_t*) to = val | (*(uint64_t*) to & (hi_mask | low_mask));
+
+ } else if (tt->type == STRUCT_TYPE || tt->type == UNION_TYPE) {
+ set_struct(L, idx, to, to_usr, tt, check_pointers);
+
+ } else {
+
+#ifndef ALLOW_MISALIGNED_ACCESS
+ union {
+ uint8_t c[8];
+ _Bool b;
+ uint64_t u64;
+ float f;
+ double d;
+ cfunction func;
+ } misalign;
+
+ void* origto = to;
+
+ if ((uintptr_t) origto & (tt->base_size - 1)) {
+ to = misalign.c;
+ }
+#endif
+
+ switch (tt->type) {
+ case BOOL_TYPE:
+ *(_Bool*) to = (cast_int64(L, idx, !check_pointers) != 0);
+ break;
+ case INT8_TYPE:
+ if (tt->is_unsigned) {
+ *(uint8_t*) to = (uint8_t) cast_uint64(L, idx, !check_pointers);
+ } else {
+ *(int8_t*) to = (int8_t) cast_int64(L, idx, !check_pointers);
+ }
+ break;
+ case INT16_TYPE:
+ if (tt->is_unsigned) {
+ *(uint16_t*) to = (uint16_t) cast_uint64(L, idx, !check_pointers);
+ } else {
+ *(int16_t*) to = (int16_t) cast_int64(L, idx, !check_pointers);
+ }
+ break;
+ case INT32_TYPE:
+ if (tt->is_unsigned) {
+ *(uint32_t*) to = (uint32_t) cast_uint64(L, idx, !check_pointers);
+ } else {
+ *(int32_t*) to = (int32_t) cast_int64(L, idx, !check_pointers);
+ }
+ break;
+ case INT64_TYPE:
+ if (tt->is_unsigned) {
+ *(uint64_t*) to = cast_uint64(L, idx, !check_pointers);
+ } else {
+ *(int64_t*) to = cast_int64(L, idx, !check_pointers);
+ }
+ break;
+ case FLOAT_TYPE:
+ *(float*) to = (float) check_double(L, idx);
+ break;
+ case DOUBLE_TYPE:
+ *(double*) to = check_double(L, idx);
+ break;
+ case COMPLEX_FLOAT_TYPE:
+ *(complex_float*) to = check_complex_float(L, idx);
+ break;
+ case COMPLEX_DOUBLE_TYPE:
+ *(complex_double*) to = check_complex_double(L, idx);
+ break;
+ case INTPTR_TYPE:
+ *(uintptr_t*) to = check_uintptr(L, idx);
+ break;
+ case ENUM_TYPE:
+ *(int32_t*) to = check_enum(L, idx, to_usr, tt);
+ break;
+ case FUNCTION_PTR_TYPE:
+ *(cfunction*) to = check_cfunction(L, idx, to_usr, tt, check_pointers);
+ break;
+ default:
+ goto err;
+ }
+
+#ifndef ALLOW_MISALIGNED_ACCESS
+ if ((uintptr_t) origto & (tt->base_size - 1)) {
+ memcpy(origto, misalign.c, tt->base_size);
+ }
+#endif
+ }
+
+ assert(lua_gettop(L) == top);
+ return;
+err:
+ type_error(L, idx, NULL, to_usr, tt);
+}
+
+static int ffi_typeof(lua_State* L)
+{
+ struct ctype ct;
+ check_ctype(L, 1, &ct);
+ push_ctype(L, -1, &ct);
+ return 1;
+}
+
+static void setmintop(lua_State* L, int idx)
+{
+ if (lua_gettop(L) < idx) {
+ lua_settop(L, idx);
+ }
+}
+
+/* warning: in the case that it finds an array size, it removes that index */
+static void get_variable_array_size(lua_State* L, int idx, struct ctype* ct)
+{
+ /* we only care about the variable buisness for the variable array
+ * directly ie ffi.new('char[?]') or the struct that contains the variable
+ * array ffi.new('struct {char v[?]}'). A pointer to the struct doesn't
+ * care about the variable size (it treats it as a zero sized array). */
+
+ if (ct->is_variable_array) {
+ assert(ct->is_array);
+ ct->array_size = (size_t) luaL_checknumber(L, idx);
+ ct->is_variable_array = 0;
+ lua_remove(L, idx);
+
+ } else if (ct->is_variable_struct && !ct->variable_size_known) {
+ assert(ct->type == STRUCT_TYPE && !ct->is_array);
+ ct->variable_increment *= (size_t) luaL_checknumber(L, idx);
+ ct->variable_size_known = 1;
+ lua_remove(L, idx);
+ }
+}
+
+static int is_scalar(struct ctype* ct)
+{
+ int type = ct->type;
+ if (ct->pointers || ct->is_reference) {
+ return !ct->is_array;
+ }
+ return type != STRUCT_TYPE && type != UNION_TYPE && !IS_COMPLEX(type);
+}
+
+static int should_pack(lua_State *L, int ct_usr, struct ctype* ct, int idx)
+{
+ struct ctype argt;
+ ct_usr = lua_absindex(L, ct_usr);
+
+ if (IS_COMPLEX(ct->type)) {
+ return 0;
+ }
+
+ switch (lua_type(L, idx)) {
+ case LUA_TTABLE:
+ return 0;
+ case LUA_TSTRING:
+ return ct->type == STRUCT_TYPE;
+ case LUA_TUSERDATA:
+ // don't pack if the argument is a cdata with the same type
+ to_cdata(L, idx, &argt);
+ int same = is_same_type(L, ct_usr, -1, ct, &argt);
+ lua_pop(L, 1);
+ return !same;
+ default:
+ return 1;
+ }
+}
+
+static int do_new(lua_State* L, int is_cast)
+{
+ int cargs, i;
+ void* p;
+ struct ctype ct;
+ int check_ptrs = !is_cast;
+
+ check_ctype(L, 1, &ct);
+
+ /* don't push a callback when we have a c function, as cb:set needs a
+ * compiled callback from a lua function to work */
+ if (!ct.pointers && ct.type == FUNCTION_PTR_TYPE && (lua_isnil(L, 2) || lua_isfunction(L, 2))) {
+ // Get the bound C function if this is a ffi lua function
+ cfunction func;
+ if (get_cfunction_address(L, 2, &func)) {
+ p = push_cdata(L, -1, &ct);
+ *(cfunction*) p = func;
+ return 1;
+ }
+
+ /* Function cdatas are pinned and must be manually cleaned up by
+ * calling func:free(). */
+ compile_callback(L, 2, -1, &ct);
+ push_upval(L, &callbacks_key);
+ lua_pushvalue(L, -2);
+ lua_pushboolean(L, 1);
+ lua_rawset(L, -3);
+ lua_pop(L, 1); /* callbacks tbl */
+ return 1;
+ }
+
+ /* this removes the vararg argument if its needed, and errors if its invalid */
+ if (!is_cast) {
+ get_variable_array_size(L, 2, &ct);
+ }
+
+ p = push_cdata(L, -1, &ct);
+
+ /* if the user mt has a __gc function then call ffi.gc on this value */
+ if (push_user_mt(L, -2, &ct)) {
+ push_upval(L, &gc_key);
+ lua_pushvalue(L, -3);
+
+ /* user_mt.__gc */
+ lua_pushliteral(L, "__gc");
+ lua_rawget(L, -4);
+
+ lua_rawset(L, -3); /* gc_upval[cdata] = user_mt.__gc */
+ lua_pop(L, 2); /* user_mt and gc_upval */
+ }
+
+ /* stack is:
+ * ctype arg
+ * ctor args ... 0+
+ * ctype usr
+ * cdata
+ */
+
+ cargs = lua_gettop(L) - 3;
+
+ if (cargs == 0) {
+ return 1;
+ }
+
+ int scalar = is_scalar(&ct);
+ if (scalar && cargs > 1) {
+ return luaL_error(L, "too many initializers");
+ }
+
+ if (cargs > 1 || (!scalar && should_pack(L, -2, &ct, 2))) {
+ lua_createtable(L, cargs, 0);
+ lua_replace(L, 1);
+ for (i = 1; i <= cargs; i++) {
+ lua_pushvalue(L, i + 1);
+ lua_rawseti(L, 1, i);
+ }
+ assert(lua_gettop(L) == cargs + 3);
+ set_value(L, 1, p, -2, &ct, check_ptrs);
+ return 1;
+ }
+
+ set_value(L, 2, p, -2, &ct, check_ptrs);
+ return 1;
+}
+
+static int ffi_new(lua_State* L)
+{ return do_new(L, 0); }
+
+static int ffi_cast(lua_State* L)
+{ return do_new(L, 1); }
+
+static int ctype_new(lua_State* L)
+{ return do_new(L, 0); }
+
+static int ctype_call(lua_State* L)
+{
+ struct ctype ct;
+ int top = lua_gettop(L);
+
+ check_ctype(L, 1, &ct);
+
+ if (push_user_mt(L, -1, &ct)) {
+ lua_pushstring(L, "__new");
+ lua_rawget(L, -2);
+ if (!lua_isnil(L, -1)) {
+ lua_insert(L, 1); // function at bottom of stack under args
+ lua_pop(L, 2);
+ lua_call(L, top, 1);
+ return 1;
+ }
+ lua_pop(L, 2);
+ }
+ lua_pop(L, 1);
+
+ assert(lua_gettop(L) == top);
+ return do_new(L, 0);
+}
+
+static int ffi_sizeof(lua_State* L)
+{
+ struct ctype ct;
+ check_ctype(L, 1, &ct);
+ get_variable_array_size(L, 2, &ct);
+ lua_pushinteger(L, ctype_size(L, &ct));
+ return 1;
+}
+
+static int ffi_alignof(lua_State* L)
+{
+ struct ctype ct, mt;
+ lua_settop(L, 2);
+ check_ctype(L, 1, &ct);
+
+ /* if no member is specified then we return the alignment of the type */
+ if (lua_isnil(L, 2)) {
+ lua_pushinteger(L, ct.align_mask + 1);
+ return 1;
+ }
+
+ /* get the alignment of the member */
+ lua_pushvalue(L, 2);
+ if (get_member(L, -2, &ct, &mt) < 0) {
+ push_type_name(L, 3, &ct);
+ return luaL_error(L, "type %s has no member %s", lua_tostring(L, -1), lua_tostring(L, 2));
+ }
+
+ lua_pushinteger(L, mt.align_mask + 1);
+ return 1;
+}
+
+static int ffi_offsetof(lua_State* L)
+{
+ ptrdiff_t off;
+ struct ctype ct, mt;
+ lua_settop(L, 2);
+ check_ctype(L, 1, &ct);
+
+ lua_pushvalue(L, 2);
+ off = get_member(L, -2, &ct, &mt); /* this replaces the member key at -1 with the mbr usr value */
+ if (off < 0) {
+ push_type_name(L, 3, &ct);
+ return luaL_error(L, "type %s has no member %s", lua_tostring(L, -1), lua_tostring(L, 2));
+ }
+
+ lua_pushinteger(L, off);
+
+ if (!mt.is_bitfield) {
+ return 1;
+ }
+
+ lua_pushinteger(L, mt.bit_offset);
+ lua_pushinteger(L, mt.bit_size);
+ return 3;
+}
+
+static int ffi_istype(lua_State* L)
+{
+ struct ctype tt, ft;
+ check_ctype(L, 1, &tt);
+ to_cdata(L, 2, &ft);
+
+ if (ft.type == INVALID_TYPE) {
+ goto fail;
+ }
+
+ if (!is_same_type(L, 3, 4, &tt, &ft)) {
+ goto fail;
+ }
+
+ if (tt.pointers != ft.pointers) {
+ goto fail;
+ }
+
+ if (tt.is_array != ft.is_array) {
+ goto fail;
+ }
+
+ if (tt.is_array && tt.array_size != ft.array_size) {
+ goto fail;
+ }
+
+ if (tt.calling_convention != ft.calling_convention) {
+ goto fail;
+ }
+
+ lua_pushboolean(L, 1);
+ return 1;
+
+fail:
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+static int cdata_gc(lua_State* L)
+{
+ struct ctype ct;
+ check_cdata(L, 1, &ct);
+ lua_settop(L, 1);
+
+ /* call the gc func if there is any registered */
+ lua_pushvalue(L, 1);
+ lua_rawget(L, lua_upvalueindex(2));
+ if (!lua_isnil(L, -1)) {
+ lua_pushvalue(L, 1);
+ lua_pcall(L, 1, 0, 0);
+ }
+
+ /* unset the closure */
+ lua_pushvalue(L, 1);
+ lua_pushnil(L);
+ lua_rawset(L, lua_upvalueindex(1));
+
+ return 0;
+}
+
+static int callback_free(lua_State* L)
+{
+ cfunction* p = (cfunction*) lua_touserdata(L, 1);
+ // FIXME: temporarily disabled to prevent SIGTRAP on exit
+ // free_code(get_jit(L), L, *p);
+ return 0;
+}
+
+static int cdata_free(lua_State* L)
+{
+ struct ctype ct;
+ cfunction* p = (cfunction*) check_cdata(L, 1, &ct);
+ lua_settop(L, 1);
+
+ /* unset the closure */
+ lua_pushvalue(L, 1);
+ lua_pushnil(L);
+ lua_rawset(L, lua_upvalueindex(1));
+
+ if (ct.is_jitted) {
+ free_code(get_jit(L), L, *p);
+ *p = NULL;
+ }
+
+ return 0;
+}
+
+static int cdata_set(lua_State* L)
+{
+ struct ctype ct;
+ cfunction* p = (cfunction*) check_cdata(L, 1, &ct);
+ luaL_checktype(L, 2, LUA_TFUNCTION);
+
+ if (!ct.is_jitted) {
+ luaL_error(L, "can't set the function for a non-lua callback");
+ }
+
+ if (*p == NULL) {
+ luaL_error(L, "can't set the function for a free'd callback");
+ }
+
+ push_func_ref(L, *p);
+ lua_pushvalue(L, 2);
+ lua_rawseti(L, -2, CALLBACK_FUNC_USR_IDX);
+
+ /* remove the closure for this callback as it embeds the function pointer
+ * value */
+ lua_pushvalue(L, 1);
+ lua_pushboolean(L, 1);
+ lua_rawset(L, lua_upvalueindex(1));
+
+ return 0;
+}
+
+static int cdata_call(lua_State* L)
+{
+ struct ctype ct;
+ int top = lua_gettop(L);
+ cfunction* p = (cfunction*) check_cdata(L, 1, &ct);
+
+ if (push_user_mt(L, -1, &ct)) {
+ lua_pushliteral(L, "__call");
+ lua_rawget(L, -2);
+
+ if (!lua_isnil(L, -1)) {
+ lua_insert(L, 1);
+ lua_pop(L, 2); /* ct_usr, user_mt */
+ lua_call(L, lua_gettop(L) - 1, LUA_MULTRET);
+ return lua_gettop(L);
+ }
+ }
+ if (ct.pointers || ct.type != FUNCTION_PTR_TYPE) {
+ return luaL_error(L, "only function callbacks are callable");
+ }
+
+ lua_pushvalue(L, 1);
+ lua_rawget(L, lua_upvalueindex(1));
+
+ if (!lua_isfunction(L, -1)) {
+ lua_pop(L, 1);
+ compile_function(L, *p, -1, &ct);
+
+ assert(lua_gettop(L) == top + 2); /* uv, closure */
+
+ /* closures[func] = closure */
+ lua_pushvalue(L, 1);
+ lua_pushvalue(L, -2);
+ lua_rawset(L, lua_upvalueindex(1));
+
+ lua_replace(L, 1);
+ } else {
+ lua_replace(L, 1);
+ }
+
+ lua_pop(L, 1); /* uv */
+ assert(lua_gettop(L) == top);
+
+ lua_call(L, lua_gettop(L) - 1, LUA_MULTRET);
+ return lua_gettop(L);
+}
+
+static int user_mt_key;
+
+static int ffi_metatype(lua_State* L)
+{
+ struct ctype ct;
+ lua_settop(L, 2);
+
+ check_ctype(L, 1, &ct);
+ if (lua_type(L, 2) != LUA_TTABLE && lua_type(L, 2) != LUA_TNIL) {
+ return luaL_argerror(L, 2, "metatable must be a table or nil");
+ }
+
+ lua_pushlightuserdata(L, &user_mt_key);
+ lua_pushvalue(L, 2);
+ lua_rawset(L, 3); /* user[user_mt_key] = mt */
+
+ /* return the passed in ctype */
+ push_ctype(L, 3, &ct);
+ return 1;
+}
+
+/* push_user_mt returns 1 if the type has a user metatable and pushes it onto
+ * the stack, otherwise it returns 0 and pushes nothing */
+int push_user_mt(lua_State* L, int ct_usr, const struct ctype* ct)
+{
+ if (ct->type != STRUCT_TYPE && ct->type != UNION_TYPE && !IS_COMPLEX(ct->type)) {
+ return 0;
+ }
+ if (!lua_istable(L, ct_usr)) {
+ return 0;
+ }
+
+ ct_usr = lua_absindex(L, ct_usr);
+ lua_pushlightuserdata(L, &user_mt_key);
+ lua_rawget(L, ct_usr);
+
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1);
+ return 0;
+ }
+ return 1;
+}
+
+static int ffi_gc(lua_State* L)
+{
+ struct ctype ct;
+ lua_settop(L, 2);
+ check_cdata(L, 1, &ct);
+
+ push_upval(L, &gc_key);
+ lua_pushvalue(L, 1);
+ lua_pushvalue(L, 2);
+ lua_rawset(L, -3);
+
+ /* return the cdata back */
+ lua_settop(L, 1);
+ return 1;
+}
+
+/* lookup_cdata_index returns the offset of the found type and user value on
+ * the stack if valid. Otherwise returns -ve and doesn't touch the stack.
+ */
+static ptrdiff_t lookup_cdata_index(lua_State* L, int idx, int ct_usr, struct ctype* ct)
+{
+ struct ctype mt;
+ ptrdiff_t off;
+
+ ct_usr = lua_absindex(L, ct_usr);
+ int type = lua_type(L, idx);
+
+ switch (type) {
+ case LUA_TNUMBER:
+ case LUA_TUSERDATA:
+ /* possibilities are array, pointer */
+
+ if (!ct->pointers || is_void_ptr(ct)) {
+ return -1;
+ }
+
+ // unbox cdata
+ if (type == LUA_TUSERDATA) {
+ if (!cdata_tointeger(L, idx, &off)) {
+ return -1;
+ }
+ } else {
+ off = lua_tointeger(L, idx);
+ }
+
+ ct->is_array = 0;
+ ct->pointers--;
+ ct->const_mask >>= 1;
+ ct->is_reference = 0;
+
+ lua_pushvalue(L, ct_usr);
+
+ return (ct->pointers ? sizeof(void*) : ct->base_size) * off;
+
+ case LUA_TSTRING:
+ /* possibilities are struct/union, pointer to struct/union */
+
+ if ((ct->type != STRUCT_TYPE && ct->type != UNION_TYPE) || ct->is_array || ct->pointers > 1) {
+ return -1;
+ }
+
+ lua_pushvalue(L, idx);
+ off = get_member(L, ct_usr, ct, &mt);
+ if (off < 0) {
+ return -1;
+ }
+
+ *ct = mt;
+ return off;
+
+ default:
+ return -1;
+ }
+}
+
+static int cdata_newindex(lua_State* L)
+{
+ struct ctype tt;
+ char* to;
+ ptrdiff_t off;
+
+ lua_settop(L, 3);
+
+ to = (char*) check_cdata(L, 1, &tt);
+ off = lookup_cdata_index(L, 2, -1, &tt);
+
+ if (off < 0) {
+ if (!push_user_mt(L, -1, &tt)) {
+ goto err;
+ }
+
+ lua_pushliteral(L, "__newindex");
+ lua_rawget(L, -2);
+
+ if (lua_isnil(L, -1)) {
+ goto err;
+ }
+
+ lua_insert(L, 1);
+ lua_settop(L, 4);
+ lua_call(L, 3, LUA_MULTRET);
+ return lua_gettop(L);
+ }
+
+ if (tt.const_mask & 1) {
+ return luaL_error(L, "can't set const data");
+ }
+
+ set_value(L, 3, to + off, -1, &tt, 1);
+ return 0;
+
+err:
+ push_type_name(L, 4, &tt);
+ return luaL_error(L, "type %s has no member %s", lua_tostring(L, -1), lua_tostring(L, 2));
+}
+
+static int cdata_index(lua_State* L)
+{
+ void* to;
+ struct ctype ct;
+ char* data;
+ ptrdiff_t off;
+
+ lua_settop(L, 2);
+ data = (char*) check_cdata(L, 1, &ct);
+ assert(lua_gettop(L) == 3);
+
+ if (!ct.pointers) {
+ switch (ct.type) {
+ case FUNCTION_PTR_TYPE:
+ /* Callbacks use the same metatable as standard cdata values, but have set
+ * and free members. So instead of mt.__index = mt, we do the equiv here. */
+ lua_getmetatable(L, 1);
+ lua_pushvalue(L, 2);
+ lua_rawget(L, -2);
+ return 1;
+
+ /* This provides the .re and .im virtual members */
+ case COMPLEX_DOUBLE_TYPE:
+ case COMPLEX_FLOAT_TYPE:
+ if (!lua_isstring(L, 2)) {
+ luaL_error(L, "invalid member for complex number");
+
+ } else if (strcmp(lua_tostring(L, 2), "re") == 0) {
+ lua_pushnumber(L, ct.type == COMPLEX_DOUBLE_TYPE ? creal(*(complex_double*) data) : crealf(*(complex_float*) data));
+
+ } else if (strcmp(lua_tostring(L, 2), "im") == 0) {
+ lua_pushnumber(L, ct.type == COMPLEX_DOUBLE_TYPE ? cimag(*(complex_double*) data) : cimagf(*(complex_float*) data));
+
+ } else {
+ luaL_error(L, "invalid member for complex number");
+ }
+ return 1;
+ }
+ }
+
+ off = lookup_cdata_index(L, 2, -1, &ct);
+
+ if (off < 0) {
+ assert(lua_gettop(L) == 3);
+ if (!push_user_mt(L, -1, &ct)) {
+ goto err;
+ }
+
+ lua_pushliteral(L, "__index");
+ lua_rawget(L, -2);
+
+ if (lua_isnil(L, -1)) {
+ goto err;
+ }
+
+ if (lua_istable(L, -1)) {
+ lua_pushvalue(L, 2);
+ lua_gettable(L, -2);
+ return 1;
+ }
+
+ lua_insert(L, 1);
+ lua_settop(L, 3);
+ lua_call(L, 2, LUA_MULTRET);
+ return lua_gettop(L);
+
+err:
+ push_type_name(L, 3, &ct);
+ return luaL_error(L, "type %s has no member %s", lua_tostring(L, -1), lua_tostring(L, 2));
+ }
+
+ assert(lua_gettop(L) == 4); /* ct, key, ct_usr, mbr_usr */
+ data += off;
+
+ if (ct.is_array) {
+ /* push a reference to the array */
+ ct.is_reference = 1;
+ to = push_cdata(L, -1, &ct);
+ *(void**) to = data;
+ return 1;
+
+ } else if (ct.is_bitfield) {
+
+ if (ct.type == INT64_TYPE) {
+ struct ctype rt;
+ uint64_t val = *(uint64_t*) data;
+ val >>= ct.bit_offset;
+ val &= (UINT64_C(1) << ct.bit_size) - 1;
+
+ memset(&rt, 0, sizeof(rt));
+ rt.base_size = 8;
+ rt.type = INT64_TYPE;
+ rt.is_unsigned = 1;
+ rt.is_defined = 1;
+
+ to = push_cdata(L, 0, &rt);
+ *(uint64_t*) to = val;
+
+ return 1;
+
+ } else if (ct.type == BOOL_TYPE) {
+ uint64_t val = *(uint64_t*) data;
+ lua_pushboolean(L, (int) (val & (UINT64_C(1) << ct.bit_offset)));
+ return 1;
+
+ } else {
+ uint64_t val = *(uint64_t*) data;
+ val >>= ct.bit_offset;
+ val &= (UINT64_C(1) << ct.bit_size) - 1;
+ lua_pushinteger(L, val);
+ return 1;
+ }
+
+ } else if (ct.pointers) {
+#ifndef ALLOW_MISALIGNED_ACCESS
+ union {
+ uint8_t c[8];
+ void* p;
+ } misalignbuf;
+
+ if ((uintptr_t) data & PTR_ALIGN_MASK) {
+ memcpy(misalignbuf.c, data, sizeof(void*));
+ data = misalignbuf.c;
+ }
+#endif
+ to = push_cdata(L, -1, &ct);
+ *(void**) to = *(void**) data;
+ return 1;
+
+ } else if (ct.type == STRUCT_TYPE || ct.type == UNION_TYPE) {
+ /* push a reference to the member */
+ ct.is_reference = 1;
+ to = push_cdata(L, -1, &ct);
+ *(void**) to = data;
+ return 1;
+
+ } else if (ct.type == FUNCTION_PTR_TYPE) {
+ cfunction* pf = (cfunction*) push_cdata(L, -1, &ct);
+ *pf = *(cfunction*) data;
+ return 1;
+
+ } else {
+#ifndef ALLOW_MISALIGNED_ACCESS
+ union {
+ uint8_t c[8];
+ double d;
+ float f;
+ uint64_t u64;
+ } misalignbuf;
+
+ assert(ct.base_size <= 8);
+
+ if ((uintptr_t) data & (ct.base_size - 1)) {
+ memcpy(misalignbuf.c, data, ct.base_size);
+ data = misalignbuf.c;
+ }
+#endif
+
+ switch (ct.type) {
+ case BOOL_TYPE:
+ lua_pushboolean(L, *(_Bool*) data);
+ break;
+ case INT8_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint8_t*) data : (lua_Integer) *(int8_t*) data);
+ break;
+ case INT16_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint16_t*) data : (lua_Integer) *(int16_t*) data);
+ break;
+ case ENUM_TYPE:
+ case INT32_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint32_t*) data : (lua_Integer) *(int32_t*) data);
+ break;
+ case INT64_TYPE:
+ to = push_cdata(L, -1, &ct);
+ *(int64_t*) to = *(int64_t*) data;
+ break;
+ case INTPTR_TYPE:
+ to = push_cdata(L, -1, &ct);
+ *(intptr_t*) to = *(intptr_t*) data;
+ break;
+ case FLOAT_TYPE:
+ lua_pushnumber(L, *(float*) data);
+ break;
+ case DOUBLE_TYPE:
+ lua_pushnumber(L, *(double*) data);
+ break;
+ case COMPLEX_DOUBLE_TYPE:
+ to = push_cdata(L, -1, &ct);
+ *(complex_double*) to = *(complex_double*) data;
+ break;
+ case COMPLEX_FLOAT_TYPE:
+ to = push_cdata(L, -1, &ct);
+ *(complex_float*) to = *(complex_float*) data;
+ break;
+ default:
+ luaL_error(L, "internal error: invalid member type");
+ }
+
+ return 1;
+ }
+}
+
+static complex_double check_complex(lua_State* L, int idx, void* p, struct ctype* ct)
+{
+ if (ct->type == INVALID_TYPE) {
+ double d = luaL_checknumber(L, idx);
+#ifdef HAVE_COMPLEX
+ return d;
+#else
+ complex_double c;
+ c.real = d;
+ c.imag = 0;
+ return c;
+#endif
+ } else if (ct->type == COMPLEX_DOUBLE_TYPE) {
+ return *(complex_double*) p;
+ } else if (ct->type == COMPLEX_FLOAT_TYPE) {
+ complex_float* f = (complex_float*) p;
+#ifdef HAVE_COMPLEX
+ return *f;
+#else
+ complex_double d;
+ d.real = f->real;
+ d.imag = f->imag;
+ return d;
+#endif
+ } else {
+ complex_double dummy;
+ type_error(L, idx, "complex", 0, NULL);
+ memset(&dummy, 0, sizeof(dummy));
+ return dummy;
+ }
+}
+
+static int rank(const struct ctype* ct)
+{
+ if (ct->pointers) {
+ return 5;
+ }
+
+ switch (ct->type) {
+ case COMPLEX_DOUBLE_TYPE:
+ return 7;
+ case COMPLEX_FLOAT_TYPE:
+ return 6;
+ case INTPTR_TYPE:
+ return sizeof(intptr_t) >= sizeof(int64_t) ? 4 : 1;
+ case INT64_TYPE:
+ return ct->is_unsigned ? 3 : 2;
+ case INT32_TYPE:
+ case INT16_TYPE:
+ case INT8_TYPE:
+ return 2;
+ default:
+ return 0;
+ }
+}
+
+static void push_complex(lua_State* L, complex_double res, int ct_usr, const struct ctype* ct)
+{
+ if (ct->type == COMPLEX_DOUBLE_TYPE) {
+ complex_double* p = (complex_double*) push_cdata(L, ct_usr, ct);
+ *p = res;
+ } else {
+ complex_float* p = (complex_float*) push_cdata(L, ct_usr, ct);
+#ifdef HAVE_COMPLEX
+ *p = (complex float) res;
+#else
+ p->real = (float) res.real;
+ p->imag = (float) res.imag;
+#endif
+ }
+}
+
+static void push_number(lua_State* L, int64_t val, int ct_usr, const struct ctype* ct)
+{
+ if ((ct->pointers || ct->type == INTPTR_TYPE) && sizeof(intptr_t) != sizeof(int64_t)) {
+ intptr_t* p = (intptr_t*) push_cdata(L, ct_usr, ct);
+ *p = val;
+ } else {
+ int64_t* p = (int64_t*) push_cdata(L, ct_usr, ct);
+ *p = val;
+ }
+}
+
+static int call_user_op(lua_State* L, const char* opfield, int idx, int ct_usr, const struct ctype* ct)
+{
+ idx = lua_absindex(L, idx);
+
+ if (push_user_mt(L, ct_usr, ct)) {
+ lua_pushstring(L, opfield);
+ lua_rawget(L, -2);
+ if (!lua_isnil(L, -1)) {
+ int top = lua_gettop(L);
+ lua_pushvalue(L, idx);
+ lua_call(L, 1, LUA_MULTRET);
+ return lua_gettop(L) - top + 1;
+ }
+ lua_pop(L, 2);
+ }
+ return -1;
+}
+
+static int cdata_unm(lua_State* L)
+{
+ struct ctype ct;
+ void* p;
+ int64_t val;
+ int ret;
+
+ lua_settop(L, 1);
+ p = to_cdata(L, 1, &ct);
+
+ ret = call_user_op(L, "__unm", 1, 2, &ct);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ val = check_intptr(L, 1, p, &ct);
+
+ if (ct.pointers) {
+ luaL_error(L, "can't negate a pointer value");
+ } else {
+ memset(&ct, 0, sizeof(ct));
+ ct.type = INT64_TYPE;
+ ct.base_size = 8;
+ ct.is_defined = 1;
+ push_number(L, -val, 0, &ct);
+ }
+
+ return 1;
+}
+
+/* returns -ve if no binop was called otherwise returns the number of return
+ * arguments */
+static int call_user_binop(lua_State* L, const char* opfield, int lidx, int lusr, const struct ctype* lt, int ridx, int rusr, const struct ctype* rt)
+{
+ lidx = lua_absindex(L, lidx);
+ ridx = lua_absindex(L, ridx);
+
+ if (push_user_mt(L, lusr, lt)) {
+ lua_pushstring(L, opfield);
+ lua_rawget(L, -2);
+
+ if (!lua_isnil(L, -1)) {
+ int top = lua_gettop(L);
+ lua_pushvalue(L, lidx);
+ lua_pushvalue(L, ridx);
+ lua_call(L, 2, LUA_MULTRET);
+ return lua_gettop(L) - top + 1;
+ }
+
+ lua_pop(L, 2); /* user_mt and user_mt.op */
+ }
+
+ if (push_user_mt(L, rusr, rt)) {
+ lua_pushstring(L, opfield);
+ lua_rawget(L, -2);
+
+ if (!lua_isnil(L, -1)) {
+ int top = lua_gettop(L);
+ lua_pushvalue(L, lidx);
+ lua_pushvalue(L, ridx);
+ lua_call(L, 2, LUA_MULTRET);
+ return lua_gettop(L) - top + 1;
+ }
+
+ lua_pop(L, 2); /* user_mt and user_mt.op */
+ }
+
+ return -1;
+}
+
+static int cdata_concat(lua_State* L)
+{
+ struct ctype lt, rt;
+ int ret;
+
+ lua_settop(L, 2);
+ to_cdata(L, 1, &lt);
+ to_cdata(L, 2, &rt);
+
+ ret = call_user_binop(L, "__concat", 1, 3, &lt, 2, 4, &rt);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ return luaL_error(L, "NYI");
+}
+
+static int cdata_len(lua_State* L)
+{
+ struct ctype ct;
+ int ret;
+
+ lua_settop(L, 1);
+ to_cdata(L, 1, &ct);
+
+ ret = call_user_op(L, "__len", 1, 2, &ct);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ push_type_name(L, 2, &ct);
+ return luaL_error(L, "type %s does not implement the __len metamethod", lua_tostring(L, -1));
+}
+
+static int cdata_pairs(lua_State* L)
+{
+ struct ctype ct;
+ int ret;
+
+ lua_settop(L, 1);
+ to_cdata(L, 1, &ct);
+
+ ret = call_user_op(L, "__pairs", 1, 2, &ct);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ push_type_name(L, 2, &ct);
+ return luaL_error(L, "type %s does not implement the __pairs metamethod", lua_tostring(L, -1));
+}
+
+static int cdata_ipairs(lua_State* L)
+{
+ struct ctype ct;
+ int ret;
+
+ lua_settop(L, 1);
+ to_cdata(L, 1, &ct);
+
+ ret = call_user_op(L, "__ipairs", 1, 2, &ct);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ push_type_name(L, 2, &ct);
+ return luaL_error(L, "type %s does not implement the __ipairs metamethod", lua_tostring(L, -1));
+}
+
+static int cdata_add(lua_State* L)
+{
+ struct ctype lt, rt, ct;
+ void *lp, *rp;
+ int ct_usr;
+ int ret;
+
+ lua_settop(L, 2);
+
+ lp = to_cdata(L, 1, &lt);
+ rp = to_cdata(L, 2, &rt);
+ assert(lua_gettop(L) == 4);
+
+ ret = call_user_binop(L, "__add", 1, 3, &lt, 2, 4, &rt);
+ if (ret >= 0) {
+ return ret;
+ }
+ assert(lua_gettop(L) == 4);
+
+ ct_usr = rank(&lt) > rank(&rt) ? 3 : 4;
+ ct = rank(&lt) > rank(&rt) ? lt : rt;
+
+ if (IS_COMPLEX(ct.type)) {
+ complex_double left, right, res;
+
+ left = check_complex(L, 1, lp, &lt);
+ right = check_complex(L, 2, rp, &rt);
+ assert(lua_gettop(L) == 4);
+
+#ifdef HAVE_COMPLEX
+ res = left + right;
+#else
+ res.real = left.real + right.real;
+ res.imag = left.imag + right.imag;
+#endif
+
+ push_complex(L, res, ct_usr, &ct);
+ return 1;
+
+ } else {
+ int64_t left = check_intptr(L, 1, lp, &lt);
+ int64_t right = check_intptr(L, 2, rp, &rt);
+ assert(lua_gettop(L) == 4);
+
+ /* note due to 2s complement it doesn't matter if we do the addition as int or uint,
+ * but the result needs to be uint64_t if either of the sources are */
+
+ if (lt.pointers && rt.pointers) {
+ luaL_error(L, "can't add two pointers");
+
+ } else if (lt.pointers) {
+ int64_t res = left + (lt.pointers > 1 ? sizeof(void*) : lt.base_size) * right;
+ lt.is_array = 0;
+ push_number(L, res, 3, &lt);
+
+ } else if (rt.pointers) {
+ int64_t res = right + (rt.pointers > 1 ? sizeof(void*) : rt.base_size) * left;
+ rt.is_array = 0;
+ push_number(L, res, 4, &rt);
+
+ } else {
+ push_number(L, left + right, ct_usr, &ct);
+ }
+
+ return 1;
+ }
+}
+
+static int cdata_sub(lua_State* L)
+{
+ struct ctype lt, rt, ct;
+ void *lp, *rp;
+ int ct_usr;
+ int ret;
+
+ lua_settop(L, 2);
+
+ lp = to_cdata(L, 1, &lt);
+ rp = to_cdata(L, 2, &rt);
+
+ ret = call_user_binop(L, "__sub", 1, 3, &lt, 2, 4, &rt);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ ct_usr = rank(&lt) > rank(&rt) ? 3 : 4;
+ ct = rank(&lt) > rank(&rt) ? lt : rt;
+
+ if (IS_COMPLEX(ct.type)) {
+ complex_double left, right, res;
+
+ left = check_complex(L, 1, lp, &lt);
+ right = check_complex(L, 2, rp, &rt);
+
+#ifdef HAVE_COMPLEX
+ res = left - right;
+#else
+ res.real = left.real - right.real;
+ res.imag = left.imag - right.imag;
+#endif
+
+ push_complex(L, res, ct_usr, &ct);
+ return 1;
+
+ } else {
+ int64_t left = check_intptr(L, 1, lp, &lt);
+ int64_t right = check_intptr(L, 2, rp, &rt);
+
+ if (rt.pointers) {
+ luaL_error(L, "NYI: can't subtract a pointer value");
+
+ } else if (lt.pointers) {
+ int64_t res = left - (lt.pointers > 1 ? sizeof(void*) : lt.base_size) * right;
+ lt.is_array = 0;
+ push_number(L, res, 3, &lt);
+
+ } else {
+ int64_t res = left - right;
+ push_number(L, res, ct_usr, &ct);
+ }
+
+ return 1;
+ }
+}
+
+/* TODO fix for unsigned */
+#define NUMBER_ONLY_BINOP(OPSTR, DO_NORMAL, DO_COMPLEX) \
+ struct ctype lt, rt, ct; \
+ void *lp, *rp; \
+ int ct_usr; \
+ int ret; \
+ \
+ lua_settop(L, 2); \
+ \
+ lp = to_cdata(L, 1, &lt); \
+ rp = to_cdata(L, 2, &rt); \
+ \
+ ret = call_user_binop(L, OPSTR, 1, 3, &lt, 2, 4, &rt); \
+ if (ret >= 0) { \
+ return ret; \
+ } \
+ \
+ ct_usr = rank(&lt) > rank(&rt) ? 3 : 4; \
+ ct = rank(&lt) > rank(&rt) ? lt : rt; \
+ \
+ if (IS_COMPLEX(ct.type)) { \
+ complex_double res; \
+ complex_double left = check_complex(L, 1, lp, &lt); \
+ complex_double right = check_complex(L, 2, rp, &rt); \
+ \
+ DO_COMPLEX(left, right, res); \
+ push_complex(L, res, ct_usr, &ct); \
+ \
+ } else if (lt.pointers || rt.pointers) { \
+ luaL_error(L, "can't operate on a pointer value"); \
+ \
+ } else { \
+ int64_t res; \
+ int64_t left = check_intptr(L, 1, lp, &lt); \
+ int64_t right = check_intptr(L, 2, rp, &rt); \
+ \
+ DO_NORMAL(left, right, res); \
+ push_number(L, res, ct_usr, &ct); \
+ } \
+ \
+ return 1
+
+#define MUL(l,r,s) s = l * r
+#define DIV(l,r,s) s = l / r
+#define MOD(l,r,s) s = l % r
+#define POW(l,r,s) s = pow(l, r)
+
+#ifdef HAVE_COMPLEX
+#define MULC(l,r,s) s = l * r
+#define DIVC(l,r,s) s = l / r
+#define MODC(l,r,s) (void) l, (void) r, memset(&s, 0, sizeof(s)), luaL_error(L, "NYI: complex mod")
+#define POWC(l,r,s) s = cpow(l, r)
+#else
+#define MULC(l,r,s) s.real = l.real * r.real - l.imag * r.imag, s.imag = l.real * r.imag + l.imag * r.real
+#define DIVC(l,r,s) s.real = (l.real * r.real + l.imag * r.imag) / (r.real * r.real + r.imag * r.imag), \
+ s.imag = (l.imag * r.real - l.real * r.imag) / (r.real * r.real + r.imag * r.imag)
+#define MODC(l,r,s) (void) l, (void) r, memset(&s, 0, sizeof(s)), luaL_error(L, "NYI: complex mod")
+#define POWC(l,r,s) (void) l, (void) r, memset(&s, 0, sizeof(s)), luaL_error(L, "NYI: complex pow")
+#endif
+
+static int cdata_mul(lua_State* L)
+{ NUMBER_ONLY_BINOP("__mul", MUL, MULC); }
+
+static int cdata_div(lua_State* L)
+{ NUMBER_ONLY_BINOP("__div", DIV, DIVC); }
+
+static int cdata_mod(lua_State* L)
+{ NUMBER_ONLY_BINOP("__mod", MOD, MODC); }
+
+static int cdata_pow(lua_State* L)
+{ NUMBER_ONLY_BINOP("__pow", POW, POWC); }
+
+#define COMPARE_BINOP(OPSTR, OP, OPC) \
+ struct ctype lt, rt; \
+ void *lp, *rp; \
+ int ret, res; \
+ \
+ lua_settop(L, 2); \
+ \
+ lp = to_cdata(L, 1, &lt); \
+ rp = to_cdata(L, 2, &rt); \
+ \
+ ret = call_user_binop(L, OPSTR, 1, 3, &lt, 2, 4, &rt); \
+ if (ret >= 0) { \
+ return ret; \
+ } \
+ \
+ if (IS_COMPLEX(lt.type) || IS_COMPLEX(rt.type)) { \
+ complex_double left = check_complex(L, 1, lp, &lt); \
+ complex_double right = check_complex(L, 2, rp, &rt); \
+ \
+ res = OPC(left, right); \
+ \
+ lua_pushboolean(L, res); \
+ \
+ } else { \
+ int64_t left = check_intptr(L, 1, lp, &lt); \
+ int64_t right = check_intptr(L, 2, rp, &rt); \
+ \
+ if (lt.pointers && rt.pointers) { \
+ if (is_void_ptr(&lt) || is_void_ptr(&rt) || is_same_type(L, 3, 4, &lt, &rt)) { \
+ res = OP((uint64_t) left, (uint64_t) right); \
+ } else { \
+ goto err; \
+ } \
+ \
+ } else if (lt.is_null && rt.type == FUNCTION_PTR_TYPE) { \
+ res = OP((uint64_t) left, (uint64_t) right); \
+ \
+ } else if (rt.is_null && lt.type == FUNCTION_PTR_TYPE) { \
+ res = OP((uint64_t) left, (uint64_t) right); \
+ \
+ } else if (lt.pointers && rt.type == INTPTR_TYPE && rt.is_unsigned) {\
+ res = OP((uint64_t) left, (uint64_t) right); \
+ \
+ } else if (rt.pointers && lt.type == INTPTR_TYPE && lt.is_unsigned) {\
+ res = OP((uint64_t) left, (uint64_t) right); \
+ \
+ } else if (rt.pointers || lt.pointers) { \
+ goto err; \
+ \
+ } else if (lt.is_unsigned && rt.is_unsigned) { \
+ res = OP((uint64_t) left, (uint64_t) right); \
+ \
+ } else if (lt.is_unsigned) { \
+ res = OP((int64_t) (uint64_t) left, right); \
+ \
+ } else if (rt.is_unsigned) { \
+ res = OP(left, (int64_t) (uint64_t) right); \
+ \
+ } else { \
+ res = OP(left, right); \
+ } \
+ \
+ lua_pushboolean(L, res); \
+ } \
+ return 1
+
+#define EQ(l, r) (l) == (r)
+#define LT(l, r) (l) < (r)
+#define LE(l, r) (l) <= (r)
+
+#ifdef HAVE_COMPLEX
+#define EQC(l, r) (l) == (r)
+#else
+#define EQC(l, r) (l).real == (r).real && (l).imag == (r).imag
+#endif
+
+#define LEC(l, r) EQC(l, r), luaL_error(L, "complex numbers are non-orderable")
+#define LTC(l, r) EQC(l, r), luaL_error(L, "complex numbers are non-orderable")
+
+static int cdata_eq(lua_State* L)
+{
+ COMPARE_BINOP("__eq", EQ, EQC);
+err:
+ lua_pushboolean(L, 0);
+ return 1;
+}
+
+static int cdata_lt(lua_State* L)
+{
+ COMPARE_BINOP("__lt", LT, LTC);
+err:
+ lua_getuservalue(L, 1);
+ lua_getuservalue(L, 2);
+ push_type_name(L, -2, &lt);
+ push_type_name(L, -2, &lt);
+ return luaL_error(L, "trying to compare incompatible types %s and %s", lua_tostring(L, -2), lua_tostring(L, -1));
+}
+
+static int cdata_le(lua_State* L)
+{
+ COMPARE_BINOP("__le", LE, LEC);
+err:
+ lua_getuservalue(L, 1);
+ lua_getuservalue(L, 2);
+ push_type_name(L, -2, &lt);
+ push_type_name(L, -2, &lt);
+ return luaL_error(L, "trying to compare incompatible types %s and %s", lua_tostring(L, -2), lua_tostring(L, -1));
+}
+
+static const char* etype_tostring(int type)
+{
+ switch (type) {
+ case VOID_TYPE: return "void";
+ case DOUBLE_TYPE: return "double";
+ case FLOAT_TYPE: return "float";
+ case COMPLEX_DOUBLE_TYPE: return "complex double";
+ case COMPLEX_FLOAT_TYPE: return "complex float";
+ case BOOL_TYPE: return "bool";
+ case INT8_TYPE: return "int8";
+ case INT16_TYPE: return "int16";
+ case INT32_TYPE: return "int32";
+ case INT64_TYPE: return "int64";
+ case INTPTR_TYPE: return "intptr";
+ case ENUM_TYPE: return "enum";
+ case UNION_TYPE: return "union";
+ case STRUCT_TYPE: return "struct";
+ case FUNCTION_PTR_TYPE: return "function ptr";
+ case FUNCTION_TYPE: return "function";
+ default: return "invalid";
+ }
+}
+
+static void print_type(lua_State* L, const struct ctype* ct)
+{
+ lua_pushfstring(L, " sz %d %d %d align %d ptr %d %d %d type %s%s %d %d %d name %d call %d %d var %d %d %d bit %d %d %d %d jit %d",
+ /* sz */
+ ct->base_size,
+ ct->array_size,
+ ct->offset,
+ /* align */
+ ct->align_mask,
+ /* ptr */
+ ct->is_array,
+ ct->pointers,
+ ct->const_mask,
+ /* type */
+ ct->is_unsigned ? "u" : "",
+ etype_tostring(ct->type),
+ ct->is_reference,
+ ct->is_defined,
+ ct->is_null,
+ /* name */
+ ct->has_member_name,
+ /* call */
+ ct->calling_convention,
+ ct->has_var_arg,
+ /* var */
+ ct->is_variable_array,
+ ct->is_variable_struct,
+ ct->variable_size_known,
+ /* bit */
+ ct->is_bitfield,
+ ct->has_bitfield,
+ ct->bit_offset,
+ ct->bit_size,
+ /* jit */
+ ct->is_jitted);
+}
+
+static int ctype_tostring(lua_State* L)
+{
+ struct ctype ct;
+ assert(lua_type(L, 1) == LUA_TUSERDATA);
+ lua_settop(L, 1);
+ check_ctype(L, 1, &ct);
+ assert(lua_gettop(L) == 2);
+ push_type_name(L, -1, &ct);
+ lua_pushfstring(L, "ctype<%s>", lua_tostring(L, -1));
+
+ if (DEBUG_TOSTRING) {
+ print_type(L, &ct);
+ lua_concat(L, 2);
+ }
+
+ return 1;
+}
+
+static int cdata_tostring(lua_State* L)
+{
+ struct ctype ct;
+ char buf[64];
+ void* p;
+ int ret;
+
+ lua_settop(L, 1);
+ p = to_cdata(L, 1, &ct);
+
+ ret = call_user_op(L, "__tostring", 1, 2, &ct);
+ if (ret >= 0) {
+ return ret;
+ }
+
+ if (ct.pointers > 0 || ct.is_reference || ct.type == STRUCT_TYPE || ct.type == UNION_TYPE) {
+ push_type_name(L, -1, &ct);
+ lua_pushfstring(L, "cdata<%s>: %p", lua_tostring(L, -1), p);
+
+ if (DEBUG_TOSTRING) {
+ print_type(L, &ct);
+ lua_concat(L, 2);
+ }
+
+ return 1;
+ }
+
+ switch (ct.type) {
+ case COMPLEX_DOUBLE_TYPE:
+ {
+ complex_double c = *(complex_double*) p;
+ lua_pushfstring(L, "%f+%fi", creal(c), cimag(c));
+ }
+ return 1;
+
+ case COMPLEX_FLOAT_TYPE:
+ {
+ complex_float c = *(complex_float*) p;
+ lua_pushfstring(L, "%f+%fi", crealf(c), cimagf(c));
+ }
+ return 1;
+
+ case FUNCTION_PTR_TYPE:
+ p = *(void**) p;
+ push_type_name(L, -1, &ct);
+ lua_pushfstring(L, "cdata<%s>: %p", lua_tostring(L, -1), *(void**) p);
+ return 1;
+
+ case INTPTR_TYPE:
+ lua_pushfstring(L, "%p", *(uintptr_t*) p);
+ return 1;
+
+ case INT64_TYPE:
+ sprintf(buf, ct.is_unsigned ? "%"PRIu64 : "%"PRId64, *(uint64_t*) p);
+ lua_pushstring(L, buf);
+ return 1;
+
+ default:
+ sprintf(buf, ct.is_unsigned ? "%"PRId64 : "%"PRId64, (int64_t) check_intptr(L, 1, p, &ct));
+ lua_pushstring(L, buf);
+ return 1;
+ }
+}
+
+static int ffi_errno(lua_State* L)
+{
+ struct jit* jit = get_jit(L);
+
+ if (!lua_isnoneornil(L, 1)) {
+ lua_pushinteger(L, jit->last_errno);
+ jit->last_errno = luaL_checknumber(L, 1);
+ } else {
+ lua_pushinteger(L, jit->last_errno);
+ }
+
+ return 1;
+}
+
+static int ffi_type(lua_State* L)
+{
+ if (lua_isuserdata(L, 1) && lua_getmetatable(L, 1)) {
+ if (equals_upval(L, -1, &cdata_mt_key) || equals_upval(L, -1, &ctype_mt_key)) {
+ lua_pushstring(L, "cdata");
+ return 1;
+ }
+ lua_pop(L, 1); /* mt */
+ }
+
+ /* call the old _G.type, we use an upvalue as _G.type is set
+ * to this function */
+ lua_pushvalue(L, lua_upvalueindex(1));
+ lua_insert(L, 1);
+ lua_call(L, lua_gettop(L)-1, LUA_MULTRET);
+ return lua_gettop(L);
+}
+
+static int ffi_number(lua_State* L)
+{
+ struct ctype ct;
+ void* data = to_cdata(L, 1, &ct);
+
+ if (ct.type != INVALID_TYPE) {
+ lua_pushinteger(L, check_intptr(L, 1, data, &ct));
+ return 1;
+ } else {
+ /* call the old _G.tonumber, we use an upvalue as _G.tonumber is set
+ * to this function */
+ lua_pushvalue(L, lua_upvalueindex(1));
+ lua_insert(L, 1);
+ lua_call(L, lua_gettop(L)-1, LUA_MULTRET);
+ return lua_gettop(L);
+ }
+}
+
+static int ffi_string(lua_State* L)
+{
+ struct ctype ct;
+ char* data;
+ lua_settop(L, 2);
+
+ data = (char*) check_cdata(L, 1, &ct);
+
+ if (is_void_ptr(&ct)) {
+ lua_pushlstring(L, data, (size_t) luaL_checknumber(L, 2));
+ return 1;
+
+ } else if (ct.type == INT8_TYPE && ct.pointers == 1) {
+ size_t sz;
+
+ if (lua_isuserdata(L, 2)) {
+ ptrdiff_t val;
+ if (!cdata_tointeger(L, 2, &val)) {
+ type_error(L, 2, "int", 0, NULL);
+ }
+ sz = (size_t) val;
+ } else if (!lua_isnil(L, 2)) {
+ sz = (size_t) luaL_checknumber(L, 2);
+
+ } else if (ct.is_array && !ct.is_variable_array) {
+ char* nul = memchr(data, '\0', ct.array_size);
+ sz = nul ? nul - data : ct.array_size;
+
+ } else {
+ sz = strlen(data);
+ }
+
+ lua_pushlstring(L, data, sz);
+ return 1;
+ }
+
+ return luaL_error(L, "unable to convert cdata to string");
+}
+
+static int ffi_copy(lua_State* L)
+{
+ struct ctype ft, tt;
+ char *to, *from;
+
+ setmintop(L, 3);
+ to = (char*) check_pointer(L, 1, &tt);
+ from = (char*) check_pointer(L, 2, &ft);
+
+ if (!lua_isnoneornil(L, 3)) {
+ memcpy(to, from, (size_t) luaL_checknumber(L, 3));
+
+ } else if (ft.type == INT8_TYPE && ft.pointers == 1) {
+ size_t sz = ft.is_array ? ft.array_size : strlen(from);
+ memcpy(to, from, sz);
+ to[sz] = '\0';
+ }
+
+ return 0;
+}
+
+static int ffi_fill(lua_State* L)
+{
+ struct ctype ct;
+ void* to;
+ size_t sz;
+ int val = 0;
+
+ setmintop(L, 3);
+ to = check_pointer(L, 1, &ct);
+ sz = (size_t) luaL_checknumber(L, 2);
+
+ if (!lua_isnoneornil(L, 3)) {
+ val = (int) luaL_checkinteger(L, 3);
+ }
+
+ memset(to, val, sz);
+ return 0;
+}
+
+static int ffi_abi(lua_State* L)
+{
+ luaL_checkstring(L, 1);
+ push_upval(L, &abi_key);
+ lua_pushvalue(L, 1);
+ lua_rawget(L, -2);
+ lua_pushboolean(L, lua_toboolean(L, -1));
+ return 1;
+}
+
+static int ffi_load(lua_State* L)
+{
+ const char* libname = luaL_checkstring(L, 1);
+ void** lib = (void**) lua_newuserdata(L, sizeof(void*));
+
+ *lib = LoadLibraryA(libname);
+
+#ifdef LIB_FORMAT_1
+ if (!*lib) {
+ libname = lua_pushfstring(L, LIB_FORMAT_1, lua_tostring(L, 1));
+ *lib = LoadLibraryA(libname);
+ lua_pop(L, 1);
+ }
+#endif
+
+#ifdef LIB_FORMAT_2
+ if (!*lib) {
+ libname = lua_pushfstring(L, LIB_FORMAT_2, lua_tostring(L, 1));
+ *lib = LoadLibraryA(libname);
+ lua_pop(L, 1);
+ }
+#endif
+
+ if (!*lib) {
+ return luaL_error(L, "could not load library %s", lua_tostring(L, 1));
+ }
+
+ lua_newtable(L);
+ lua_setuservalue(L, -2);
+
+ push_upval(L, &cmodule_mt_key);
+ lua_setmetatable(L, -2);
+ return 1;
+}
+
+static void* find_symbol(lua_State* L, int modidx, const char* asmname)
+{
+ size_t i;
+ void** libs;
+ size_t num;
+ void* sym = NULL;
+
+ libs = (void**) lua_touserdata(L, modidx);
+ num = lua_rawlen(L, modidx) / sizeof(void*);
+
+ for (i = 0; i < num && sym == NULL; i++) {
+ if (libs[i]) {
+ sym = GetProcAddressA(libs[i], asmname);
+ }
+ }
+
+ return sym;
+}
+
+/* pushes the user table */
+static void* lookup_global(lua_State* L, int modidx, int nameidx, const char** pname, struct ctype* ct)
+{
+ int top = lua_gettop(L);
+ void* sym;
+
+ modidx = lua_absindex(L, modidx);
+ nameidx = lua_absindex(L, nameidx);
+
+ *pname = luaL_checkstring(L, nameidx);
+
+ /* get the ctype */
+ push_upval(L, &functions_key);
+ lua_pushvalue(L, nameidx);
+ lua_rawget(L, -2);
+ if (lua_isnil(L, -1)) {
+ luaL_error(L, "missing declaration for function/global %s", *pname);
+ return NULL;
+ }
+
+ /* leave just the ct_usr on the stack */
+ *ct = *(const struct ctype*) lua_touserdata(L, -1);
+ lua_getuservalue(L, -1);
+ lua_replace(L, top + 1);
+ lua_pop(L, 1);
+
+ assert(lua_gettop(L) == top + 1);
+
+ /* get the assembly name */
+ push_upval(L, &asmname_key);
+ lua_pushvalue(L, nameidx);
+ lua_rawget(L, -2);
+ if (lua_isstring(L, -1)) {
+ *pname = lua_tostring(L, -1);
+ }
+ lua_pop(L, 2);
+
+ sym = find_symbol(L, modidx, *pname);
+
+ assert(lua_gettop(L) == top + 1);
+ return sym;
+}
+
+static int cmodule_index(lua_State* L)
+{
+ const char* asmname;
+ struct ctype ct;
+ void *sym;
+
+ lua_settop(L, 2);
+
+ /* see if we have already loaded the function */
+ lua_getuservalue(L, 1);
+ lua_pushvalue(L, 2);
+ lua_rawget(L, -2);
+ if (!lua_isnil(L, -1)) {
+ return 1;
+ }
+ lua_pop(L, 2);
+
+ /* check the constants table */
+ push_upval(L, &constants_key);
+ lua_pushvalue(L, 2);
+ lua_rawget(L, -2);
+ if (!lua_isnil(L, -1)) {
+ return 1;
+ }
+ lua_pop(L, 2);
+
+ /* lookup_global pushes the ct_usr */
+ sym = lookup_global(L, 1, 2, &asmname, &ct);
+
+#if defined _WIN32 && !defined _WIN64 && (defined __i386__ || defined _M_IX86)
+ if (!sym && ct.type == FUNCTION_TYPE) {
+ ct.calling_convention = STD_CALL;
+ lua_pushfstring(L, "_%s@%d", asmname, x86_return_size(L, -1, &ct));
+ sym = find_symbol(L, 1, lua_tostring(L, -1));
+ lua_pop(L, 1);
+ }
+
+ if (!sym && ct.type == FUNCTION_TYPE) {
+ ct.calling_convention = FAST_CALL;
+ lua_pushfstring(L, "@%s@%d", asmname, x86_return_size(L, -1, &ct));
+ sym = find_symbol(L, 1, lua_tostring(L, -1));
+ lua_pop(L, 1);
+ }
+#endif
+
+ if (!sym) {
+ return luaL_error(L, "failed to find function/global %s", asmname);
+ }
+
+ assert(lua_gettop(L) == 3); /* module, name, ct_usr */
+
+ if (ct.type == FUNCTION_TYPE) {
+ compile_function(L, (cfunction) sym, -1, &ct);
+ assert(lua_gettop(L) == 4); /* module, name, ct_usr, function */
+
+ /* set module usr value[luaname] = function to cache for next time */
+ lua_getuservalue(L, 1);
+ lua_pushvalue(L, 2);
+ lua_pushvalue(L, -3);
+ lua_rawset(L, -3);
+ lua_pop(L, 1); /* module uv */
+ return 1;
+ }
+
+ /* extern const char* foo; and extern const char foo[]; */
+ if (ct.pointers == 1 && ct.type == INT8_TYPE) {
+ char* str = (char*) sym;
+ if (!ct.is_array) {
+ str = *(char**) sym;
+ }
+ lua_pushstring(L, str);
+ return 1;
+ }
+
+ /* extern struct foo foo[], extern void* foo[]; and extern struct foo foo; */
+ if (ct.is_array || (!ct.pointers && (ct.type == UNION_TYPE || ct.type == STRUCT_TYPE))) {
+ void* p;
+ ct.is_reference = 1;
+ p = push_cdata(L, -1, &ct);
+ *(void**) p = sym;
+ return 1;
+ }
+
+ /* extern void* foo; and extern void (*foo)(); */
+ if (ct.pointers || ct.type == FUNCTION_PTR_TYPE) {
+ void* p = push_cdata(L, -1, &ct);
+ *(void**) p = *(void**) sym;
+ return 1;
+ }
+
+ switch (ct.type) {
+ case COMPLEX_DOUBLE_TYPE:
+ case COMPLEX_FLOAT_TYPE:
+ case INTPTR_TYPE:
+ case INT64_TYPE:
+ {
+ /* TODO: complex float/double need to be references if .re and
+ * .imag are setable */
+ void* p = push_cdata(L, -1, &ct);
+ memcpy(p, sym, ct.base_size);
+ return 1;
+ }
+
+ case DOUBLE_TYPE:
+ lua_pushnumber(L, *(double*) sym);
+ return 1;
+
+ case FLOAT_TYPE:
+ lua_pushnumber(L, *(float*) sym);
+ return 1;
+
+ case BOOL_TYPE:
+ lua_pushboolean(L, *(bool*) sym);
+ return 1;
+
+ case INT8_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint8_t*) sym : (lua_Integer) *(int8_t*) sym);
+ return 1;
+
+ case INT16_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint16_t*) sym : (lua_Integer) *(int16_t*) sym);
+ return 1;
+
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ lua_pushinteger(L, ct.is_unsigned ? (lua_Integer) *(uint32_t*) sym : (lua_Integer) *(int32_t*) sym);
+ return 1;
+ }
+
+ return luaL_error(L, "NYI - global value type");
+}
+
+static int cmodule_newindex(lua_State* L)
+{
+ const char* name;
+ void* sym;
+ struct ctype ct;
+
+ lua_settop(L, 3);
+
+ /* pushes the ct_usr */
+ sym = lookup_global(L, 1, 2, &name, &ct);
+ assert(lua_gettop(L) == 4); /* module, name, value, ct_usr */
+
+ if (sym == NULL) {
+ return luaL_error(L, "failed to find global %s", name);
+ }
+
+ if (ct.type == FUNCTION_TYPE || ct.is_array || (ct.const_mask & 1)) {
+ return luaL_error(L, "can not set global %s", name);
+ }
+
+ set_value(L, 3, sym, -1, &ct, 1);
+ return 0;
+}
+
+static int jit_gc(lua_State* L)
+{
+ size_t i;
+ struct jit* jit = get_jit(L);
+ dasm_free(jit);
+ for (i = 0; i < jit->pagenum; i++) {
+ FreePage(jit->pages[i], jit->pages[i]->size);
+ }
+ free(jit->pages);
+ free(jit->globals);
+ return 0;
+}
+
+static int ffi_debug(lua_State* L)
+{
+ lua_newtable(L);
+ push_upval(L, &ctype_mt_key);
+ lua_setfield(L, -2, "ctype_mt");
+ push_upval(L, &cdata_mt_key);
+ lua_setfield(L, -2, "cdata_mt");
+ push_upval(L, &cmodule_mt_key);
+ lua_setfield(L, -2, "cmodule_mt");
+ push_upval(L, &constants_key);
+ lua_setfield(L, -2, "constants");
+ push_upval(L, &types_key);
+ lua_setfield(L, -2, "types");
+ push_upval(L, &jit_key);
+ lua_setfield(L, -2, "jit");
+ push_upval(L, &gc_key);
+ lua_setfield(L, -2, "gc");
+ push_upval(L, &callbacks_key);
+ lua_setfield(L, -2, "callbacks");
+ push_upval(L, &functions_key);
+ lua_setfield(L, -2, "functions");
+ push_upval(L, &abi_key);
+ lua_setfield(L, -2, "abi");
+ push_upval(L, &next_unnamed_key);
+ lua_setfield(L, -2, "next_unnamed");
+ return 1;
+}
+
+static int do64(lua_State* L, int is_unsigned)
+{
+ lua_Number low, high;
+ struct ctype ct;
+ int64_t val;
+
+ lua_settop(L, 2);
+
+ if (!lua_isnil(L, 2)) {
+ high = luaL_checknumber(L, 1);
+ low = luaL_checknumber(L, 2);
+ } else {
+ high = 0;
+ low = luaL_checknumber(L, 1);
+ }
+
+ val = ((int64_t) (uint32_t) high << 32) | (int64_t) (uint32_t) low;
+
+ if (!is_unsigned && (high < 0 || low < 0)) {
+ val = -val;
+ }
+
+ memset(&ct, 0, sizeof(ct));
+ ct.type = INT64_TYPE;
+ ct.is_unsigned = is_unsigned;
+ ct.is_defined = 1;
+ ct.base_size = sizeof(int64_t);
+ push_number(L, (int64_t) val, 0, &ct);
+
+ return 1;
+}
+
+static int ffi_i64(lua_State* L)
+{ return do64(L, 0); }
+
+static int ffi_u64(lua_State* L)
+{ return do64(L, 1); }
+
+static const luaL_Reg cdata_mt[] = {
+ {"__gc", &cdata_gc},
+ {"__call", &cdata_call},
+ {"free", &cdata_free},
+ {"set", &cdata_set},
+ {"__index", &cdata_index},
+ {"__newindex", &cdata_newindex},
+ {"__add", &cdata_add},
+ {"__sub", &cdata_sub},
+ {"__mul", &cdata_mul},
+ {"__div", &cdata_div},
+ {"__mod", &cdata_mod},
+ {"__pow", &cdata_pow},
+ {"__unm", &cdata_unm},
+ {"__eq", &cdata_eq},
+ {"__lt", &cdata_lt},
+ {"__le", &cdata_le},
+ {"__tostring", &cdata_tostring},
+ {"__concat", &cdata_concat},
+ {"__len", &cdata_len},
+ {"__pairs", &cdata_pairs},
+ {"__ipairs", &cdata_ipairs},
+ {NULL, NULL}
+};
+
+static const luaL_Reg callback_mt[] = {
+ {"__gc", &callback_free},
+ {NULL, NULL}
+};
+
+static const luaL_Reg ctype_mt[] = {
+ {"__call", &ctype_call},
+ {"__new", &ctype_new},
+ {"__tostring", &ctype_tostring},
+ {NULL, NULL}
+};
+
+static const luaL_Reg cmodule_mt[] = {
+ {"__index", &cmodule_index},
+ {"__newindex", &cmodule_newindex},
+ {NULL, NULL}
+};
+
+static const luaL_Reg jit_mt[] = {
+ {"__gc", &jit_gc},
+ {NULL, NULL}
+};
+
+static const luaL_Reg ffi_reg[] = {
+ {"cdef", &ffi_cdef},
+ {"load", &ffi_load},
+ {"new", &ffi_new},
+ {"typeof", &ffi_typeof},
+ {"cast", &ffi_cast},
+ {"metatype", &ffi_metatype},
+ {"gc", &ffi_gc},
+ {"sizeof", &ffi_sizeof},
+ {"alignof", &ffi_alignof},
+ {"offsetof", &ffi_offsetof},
+ {"istype", &ffi_istype},
+ {"errno", &ffi_errno},
+ {"string", &ffi_string},
+ {"copy", &ffi_copy},
+ {"fill", &ffi_fill},
+ {"abi", &ffi_abi},
+ {"debug", &ffi_debug},
+ {"i64", &ffi_i64},
+ {"u64", &ffi_u64},
+ {NULL, NULL}
+};
+
+/* leaves the usr table on the stack */
+static void push_builtin(lua_State* L, struct ctype* ct, const char* name, int type, int size, int align, int is_unsigned)
+{
+ memset(ct, 0, sizeof(*ct));
+ ct->type = type;
+ ct->base_size = size;
+ ct->align_mask = align;
+ ct->is_defined = 1;
+ ct->is_unsigned = is_unsigned;
+
+ if (IS_COMPLEX(type)) {
+ lua_newtable(L);
+ } else {
+ lua_pushnil(L);
+ }
+
+ push_upval(L, &types_key);
+ push_ctype(L, -2, ct);
+ lua_setfield(L, -2, name);
+ lua_pop(L, 2); /* types, usr table */
+}
+
+static void push_builtin_undef(lua_State* L, struct ctype* ct, const char* name, int type)
+{
+ memset(ct, 0, sizeof(*ct));
+ ct->type = type;
+
+ push_upval(L, &types_key);
+ push_ctype(L, 0, ct);
+ lua_setfield(L, -2, name);
+ lua_pop(L, 1); /* types */
+}
+
+static void add_typedef(lua_State* L, const char* from, const char* to)
+{
+ struct ctype ct;
+ struct parser P;
+ P.line = 1;
+ P.align_mask = DEFAULT_ALIGN_MASK;
+ P.next = P.prev = from;
+
+ push_upval(L, &types_key);
+ parse_type(L, &P, &ct);
+ parse_argument(L, &P, -1, &ct, NULL, NULL);
+ push_ctype(L, -1, &ct);
+
+ /* stack is at +4: types, type usr, arg usr, ctype */
+
+ lua_setfield(L, -4, to);
+ lua_pop(L, 3); /* types, type usr, arg usr */
+}
+
+static int setup_upvals(lua_State* L)
+{
+ struct jit* jit = get_jit(L);
+
+ /* jit setup */
+ {
+ dasm_init(jit, 64);
+#ifdef _WIN32
+ {
+ SYSTEM_INFO si;
+ GetSystemInfo(&si);
+ jit->align_page_size = si.dwAllocationGranularity - 1;
+ }
+#else
+ jit->align_page_size = sysconf(_SC_PAGE_SIZE) - 1;
+#endif
+ jit->globals = (void**) malloc(64 * sizeof(void*));
+ dasm_setupglobal(jit, jit->globals, 64);
+ compile_globals(jit, L);
+ }
+
+ /* ffi.C */
+ {
+#ifdef _WIN32
+ size_t sz = sizeof(HMODULE) * 6;
+ HMODULE* libs = lua_newuserdata(L, sz);
+ memset(libs, 0, sz);
+
+ /* exe */
+ GetModuleHandle(NULL);
+ /* lua dll */
+#ifdef LUA_DLL_NAME
+#define STR2(tok) #tok
+#define STR(tok) STR2(tok)
+ libs[1] = LoadLibraryA(STR(LUA_DLL_NAME));
+#undef STR
+#undef STR2
+#endif
+
+ /* crt */
+#ifdef UNDER_CE
+ libs[2] = LoadLibraryA("coredll.dll");
+#else
+ GetModuleHandleExA(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, (char*) &_fmode, &libs[2]);
+ libs[3] = LoadLibraryA("kernel32.dll");
+ libs[4] = LoadLibraryA("user32.dll");
+ libs[5] = LoadLibraryA("gdi32.dll");
+#endif
+
+ jit->lua_dll = libs[1];
+ jit->kernel32_dll = libs[3];
+
+#else /* !_WIN32 */
+ size_t sz = sizeof(void*) * 5;
+ void** libs = lua_newuserdata(L, sz);
+ memset(libs, 0, sz);
+
+ libs[0] = LoadLibraryA(NULL); /* exe */
+ libs[1] = LoadLibraryA("libc.so");
+#ifdef __GNUC__
+ libs[2] = LoadLibraryA("libgcc.so");
+#endif
+ libs[3] = LoadLibraryA("libm.so");
+ libs[4] = LoadLibraryA("libdl.so");
+#endif
+
+ lua_newtable(L);
+ lua_setuservalue(L, -2);
+
+ push_upval(L, &cmodule_mt_key);
+ lua_setmetatable(L, -2);
+
+ lua_setfield(L, 1, "C");
+ }
+
+ /* setup builtin types */
+ {
+ complex_double* pc;
+ struct {char ch; uint16_t v;} a16;
+ struct {char ch; uint32_t v;} a32;
+ struct {char ch; uint64_t v;} a64;
+ struct {char ch; float v;} af;
+ struct {char ch; double v;} ad;
+#ifdef HAVE_LONG_DOUBLE
+ struct {char ch; long double v;} ald;
+#endif
+ struct {char ch; uintptr_t v;} aptr;
+ struct ctype ct;
+ struct {char ch; complex_float v;} cf;
+ struct {char ch; complex_double v;} cd;
+#if defined HAVE_LONG_DOUBLE && defined HAVE_COMPLEX
+ struct {char ch; complex long double v;} cld;
+#endif
+
+ push_builtin(L, &ct, "void", VOID_TYPE, 0, 0, 0);
+ push_builtin(L, &ct, "bool", BOOL_TYPE, sizeof(_Bool), sizeof(_Bool) -1, 1);
+ push_builtin(L, &ct, "uint8_t", INT8_TYPE, sizeof(uint8_t), 0, 1);
+ push_builtin(L, &ct, "int8_t", INT8_TYPE, sizeof(int8_t), 0, 0);
+ push_builtin(L, &ct, "uint16_t", INT16_TYPE, sizeof(uint16_t), ALIGNOF(a16), 1);
+ push_builtin(L, &ct, "int16_t", INT16_TYPE, sizeof(int16_t), ALIGNOF(a16), 0);
+ push_builtin(L, &ct, "uint32_t", INT32_TYPE, sizeof(uint32_t), ALIGNOF(a32), 1);
+ push_builtin(L, &ct, "int32_t", INT32_TYPE, sizeof(int32_t), ALIGNOF(a32), 0);
+ push_builtin(L, &ct, "uint64_t", INT64_TYPE, sizeof(uint64_t), ALIGNOF(a64), 1);
+ push_builtin(L, &ct, "int64_t", INT64_TYPE, sizeof(int64_t), ALIGNOF(a64), 0);
+ push_builtin(L, &ct, "float", FLOAT_TYPE, sizeof(float), ALIGNOF(af), 0);
+ push_builtin(L, &ct, "double", DOUBLE_TYPE, sizeof(double), ALIGNOF(ad), 0);
+#ifdef HAVE_LONG_DOUBLE
+ push_builtin(L, &ct, "long double", LONG_DOUBLE_TYPE, sizeof(long double), ALIGNOF(ald), 0);
+#else
+ push_builtin_undef(L, &ct, "long double", LONG_DOUBLE_TYPE);
+#endif
+ push_builtin(L, &ct, "uintptr_t", INTPTR_TYPE, sizeof(uintptr_t), ALIGNOF(aptr), 1);
+ push_builtin(L, &ct, "intptr_t", INTPTR_TYPE, sizeof(uintptr_t), ALIGNOF(aptr), 0);
+ push_builtin(L, &ct, "complex float", COMPLEX_FLOAT_TYPE, sizeof(complex_float), ALIGNOF(cf), 0);
+ push_builtin(L, &ct, "complex double", COMPLEX_DOUBLE_TYPE, sizeof(complex_double), ALIGNOF(cd), 0);
+#if defined HAVE_LONG_DOUBLE && defined HAVE_COMPLEX
+ push_builtin(L, &ct, "complex long double", COMPLEX_LONG_DOUBLE_TYPE, sizeof(complex long double), ALIGNOF(cld), 0);
+#else
+ push_builtin_undef(L, &ct, "complex long double", COMPLEX_LONG_DOUBLE_TYPE);
+#endif
+
+ /* add NULL and i constants */
+ push_upval(L, &constants_key);
+
+ memset(&ct, 0, sizeof(ct));
+ ct.type = VOID_TYPE;
+ ct.is_defined = 1;
+ ct.pointers = 1;
+ ct.is_null = 1;
+
+ /* add ffi.C.NULL */
+ push_cdata(L, 0, &ct);
+ lua_setfield(L, -2, "NULL");
+
+ /* add ffi.NULL */
+ push_cdata(L, 0, &ct);
+ lua_setfield(L, 1, "NULL");
+
+ memset(&ct, 0, sizeof(ct));
+ ct.type = COMPLEX_DOUBLE_TYPE;
+ ct.is_defined = 1;
+ ct.base_size = sizeof(complex_double);
+ pc = (complex_double*) push_cdata(L, 0, &ct);
+#ifdef HAVE_COMPLEX
+ *pc = 1i;
+#else
+ pc->real = 0;
+ pc->imag = 1;
+#endif
+ lua_setfield(L, -2, "i");
+
+ lua_pop(L, 1); /* constants */
+ }
+
+ assert(lua_gettop(L) == 1);
+
+ /* setup builtin typedefs */
+ {
+ add_typedef(L, "bool", "_Bool");
+
+ if (sizeof(uint32_t) == sizeof(size_t)) {
+ add_typedef(L, "uint32_t", "size_t");
+ add_typedef(L, "int32_t", "ssize_t");
+ } else if (sizeof(uint64_t) == sizeof(size_t)) {
+ add_typedef(L, "uint64_t", "size_t");
+ add_typedef(L, "int64_t", "ssize_t");
+ }
+
+ if (sizeof(int32_t) == sizeof(intptr_t)) {
+ add_typedef(L, "int32_t", "intptr_t");
+ add_typedef(L, "int32_t", "ptrdiff_t");
+ } else if (sizeof(int64_t) == sizeof(intptr_t)) {
+ add_typedef(L, "int64_t", "intptr_t");
+ add_typedef(L, "int64_t", "ptrdiff_t");
+ }
+
+ if (sizeof(uint8_t) == sizeof(wchar_t)) {
+ add_typedef(L, "uint8_t", "wchar_t");
+ } else if (sizeof(uint16_t) == sizeof(wchar_t)) {
+ add_typedef(L, "uint16_t", "wchar_t");
+ } else if (sizeof(uint32_t) == sizeof(wchar_t)) {
+ add_typedef(L, "uint32_t", "wchar_t");
+ }
+
+ if (sizeof(va_list) == sizeof(char*)) {
+ add_typedef(L, "char*", "va_list");
+ } else {
+ struct {char ch; va_list v;} av;
+ lua_pushfstring(L, "struct {char data[%d] __attribute__((align(%d)));}", (int) sizeof(va_list), (int) ALIGNOF(av) + 1);
+ add_typedef(L, lua_tostring(L, -1), "va_list");
+ lua_pop(L, 1);
+ }
+
+ add_typedef(L, "va_list", "__builtin_va_list");
+ add_typedef(L, "va_list", "__gnuc_va_list");
+ }
+
+ assert(lua_gettop(L) == 1);
+
+ /* setup ABI params table */
+ push_upval(L, &abi_key);
+
+#if defined ARCH_X86 || defined ARCH_ARM
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -2, "32bit");
+#elif defined ARCH_X64 || defined ARCH_PPC64
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -2, "64bit");
+#else
+#error
+#endif
+
+#if defined ARCH_X86 || defined ARCH_X64 || defined ARCH_ARM || defined ARCH_PPC64
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -2, "le");
+#else
+#error
+#endif
+
+#if defined ARCH_X86 || defined ARCH_X64 || defined ARCH_PPC64
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -2, "fpu");
+#elif defined ARCH_ARM
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -2, "softfp");
+#else
+#error
+#endif
+ lua_pop(L, 1); /* abi tbl */
+
+
+ /* GC table - shouldn't pin cdata values */
+ push_upval(L, &gc_key);
+ lua_newtable(L);
+ lua_pushliteral(L, "k");
+ lua_setfield(L, -2, "__mode");
+ lua_setmetatable(L, -2);
+ lua_pop(L, 1); /* gc table */
+
+
+ /* ffi.os */
+#if defined OS_CE
+ lua_pushliteral(L, "WindowsCE");
+#elif defined OS_WIN
+ lua_pushliteral(L, "Windows");
+#elif defined OS_OSX
+ lua_pushliteral(L, "OSX");
+#elif defined OS_LINUX
+ lua_pushliteral(L, "Linux");
+#elif defined OS_BSD
+ lua_pushliteral(L, "BSD");
+#elif defined OS_POSIX
+ lua_pushliteral(L, "POSIX");
+#else
+ lua_pushliteral(L, "Other");
+#endif
+ lua_setfield(L, 1, "os");
+
+
+ /* ffi.arch */
+#if defined ARCH_X86
+ lua_pushliteral(L, "x86");
+#elif defined ARCH_X64
+ lua_pushliteral(L, "x64");
+#elif defined ARCH_ARM
+ lua_pushliteral(L, "arm");
+#elif defined ARCH_PPC64
+ lua_pushliteral(L, "ppc64");
+#else
+# error
+#endif
+ lua_setfield(L, 1, "arch");
+
+ assert(lua_gettop(L) == 1);
+
+ return 0;
+}
+
+static void setup_mt(lua_State* L, const luaL_Reg* mt, int upvals)
+{
+ lua_pushboolean(L, 1);
+ lua_setfield(L, -upvals-2, "__metatable");
+ luaL_setfuncs(L, mt, upvals);
+}
+
+int luaopen_ffi(lua_State* L)
+{
+ lua_settop(L, 0);
+
+ lua_newtable(L);
+ set_upval(L, &niluv_key);
+
+ lua_newtable(L);
+ setup_mt(L, ctype_mt, 0);
+ set_upval(L, &ctype_mt_key);
+
+ lua_newtable(L);
+ set_upval(L, &callbacks_key);
+
+ lua_newtable(L);
+ set_upval(L, &gc_key);
+
+ lua_newtable(L);
+ push_upval(L, &callbacks_key);
+ push_upval(L, &gc_key);
+ setup_mt(L, cdata_mt, 2);
+ set_upval(L, &cdata_mt_key);
+
+ lua_newtable(L);
+ setup_mt(L, callback_mt, 0);
+ set_upval(L, &callback_mt_key);
+
+ lua_newtable(L);
+ setup_mt(L, cmodule_mt, 0);
+ set_upval(L, &cmodule_mt_key);
+
+ memset(lua_newuserdata(L, sizeof(struct jit)), 0, sizeof(struct jit));
+ lua_newtable(L);
+ setup_mt(L, jit_mt, 0);
+ lua_setmetatable(L, -2);
+ set_upval(L, &jit_key);
+
+ lua_newtable(L);
+ set_upval(L, &constants_key);
+
+ lua_newtable(L);
+ set_upval(L, &types_key);
+
+ lua_newtable(L);
+ set_upval(L, &functions_key);
+
+ lua_newtable(L);
+ set_upval(L, &asmname_key);
+
+ lua_newtable(L);
+ set_upval(L, &abi_key);
+
+ lua_pushinteger(L, 1);
+ set_upval(L, &next_unnamed_key);
+
+ assert(lua_gettop(L) == 0);
+
+ /* ffi table */
+ lua_newtable(L);
+ luaL_setfuncs(L, ffi_reg, 0);
+
+ /* setup_upvals(ffi tbl) */
+ lua_pushcfunction(L, &setup_upvals);
+ lua_pushvalue(L, 1);
+ lua_call(L, 1, 0);
+
+ assert(lua_gettop(L) == 1);
+
+ lua_getglobal(L, "tonumber");
+ lua_pushcclosure(L, &ffi_number, 1);
+ lua_pushvalue(L, -1);
+ lua_setglobal(L, "tonumber");
+ lua_setfield(L, -2, "number"); /* ffi.number */
+
+ lua_getglobal(L, "type");
+ lua_pushcclosure(L, &ffi_type, 1);
+ lua_pushvalue(L, -1);
+ lua_setglobal(L, "type");
+ lua_setfield(L, -2, "type"); /* ffi.type */
+ return 1;
+}
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/ffi.h b/Build/source/texk/web2c/luatexdir/luaffi/ffi.h
new file mode 100644
index 00000000000..35ab778332a
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/ffi.h
@@ -0,0 +1,466 @@
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+#pragma once
+
+#ifdef _MSC_VER
+#define _CRT_SECURE_NO_WARNINGS
+#endif
+
+#include <stdint.h>
+#include <stdbool.h>
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+
+#ifdef __cplusplus
+extern "C" {
+# include <lua.h>
+# include <lauxlib.h>
+# include <lualib.h>
+}
+# define EXTERN_C extern "C"
+#else
+# include <lua.h>
+# include <lauxlib.h>
+# include <lualib.h>
+# define EXTERN_C extern
+#endif
+
+#ifdef _WIN32
+#include <windows.h>
+#else
+#include <errno.h>
+#include <unistd.h>
+#include <dlfcn.h>
+#include <sys/mman.h>
+#endif
+
+#ifdef _WIN32
+/* We should include something equivalent to */
+/* complex.h */
+#else
+#include <complex.h>
+#define HAVE_COMPLEX
+#define HAVE_LONG_DOUBLE
+#endif
+
+#ifndef NDEBUG
+#define DASM_CHECKS
+#endif
+
+struct jit;
+#define Dst_DECL struct jit* Dst
+#define Dst_REF (Dst->ctx)
+#define DASM_EXTERN(a,b,c,d) get_extern(a,b,c,d)
+
+#include "dynasm/dasm_proto.h"
+
+#if defined LUA_FFI_BUILD_AS_DLL
+# define EXPORT __declspec(dllexport)
+#elif defined __GNUC__
+# define EXPORT __attribute__((visibility("default")))
+#else
+# define EXPORT
+#endif
+
+EXTERN_C EXPORT int luaopen_ffi(lua_State* L);
+
+static int lua_absindex2(lua_State* L, int idx) {
+ return (LUA_REGISTRYINDEX <= idx && idx < 0)
+ ? lua_gettop(L) + idx + 1
+ : idx;
+}
+/* use our own version of lua_absindex such that lua_absindex(L, 0) == 0 */
+#define lua_absindex(L, idx) lua_absindex2(L, idx)
+
+#if LUA_VERSION_NUM == 501
+static void lua_callk(lua_State *L, int nargs, int nresults, int ctx, lua_CFunction k)
+{
+ lua_call(L, nargs, nresults);
+}
+/*
+** set functions from list 'l' into table at top - 'nup'; each
+** function gets the 'nup' elements at the top as upvalues.
+** Returns with only the table at the stack.
+*/
+static void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup) {
+ luaL_checkstack(L, nup, "too many upvalues");
+ for (; l && l->name; l++) { /* fill the table with given functions */
+ int i;
+ for (i = 0; i < nup; i++) /* copy upvalues to the top */
+ lua_pushvalue(L, -nup);
+ lua_pushcclosure(L, l->func, nup); /* closure with those upvalues */
+ lua_setfield(L, -(nup + 2), l->name);
+ }
+ lua_pop(L, nup); /* remove upvalues */
+}
+#define lua_setuservalue lua_setfenv
+#define lua_getuservalue lua_getfenv
+#define lua_rawlen lua_objlen
+static char* luaL_prepbuffsize(luaL_Buffer* B, size_t sz) {
+ if (sz > LUAL_BUFFERSIZE) {
+ luaL_error(B->L, "string too long");
+ }
+ return luaL_prepbuffer(B);
+}
+#elif LUA_VERSION_NUM == 503
+static void (lua_remove)(lua_State *L, int idx) {
+ lua_remove(L, idx);
+}
+#endif
+
+/* architectures */
+#if defined _WIN32 && defined UNDER_CE
+# define OS_CE
+#elif defined _WIN32
+# define OS_WIN
+#elif defined __APPLE__ && defined __MACH__
+# define OS_OSX
+#elif defined __linux__
+# define OS_LINUX
+#elif defined __FreeBSD__ || defined __OpenBSD__ || defined __NetBSD__
+# define OS_BSD
+#elif defined unix || defined __unix__ || defined __unix || defined _POSIX_VERSION || defined _XOPEN_VERSION
+# define OS_POSIX
+#endif
+
+/* architecture */
+#if defined __i386__ || defined _M_IX86
+# define ARCH_X86
+#elif defined __amd64__ || defined _M_X64
+# define ARCH_X64
+#elif defined __arm__ || defined __ARM__ || defined ARM || defined __ARM || defined __arm || defined __aarch64__
+# define ARCH_ARM
+#elif defined __powerpc64__
+# define ARCH_PPC64
+#else
+# error
+#endif
+
+
+/* See ffi.c: replace luaopen_ffi with a stub */
+/* if FFI_ENABLE_LUATEX_INTERFACE is not defined */
+#if (defined ARCH_X86 || defined ARCH_X64) && (defined OS_CE || defined OS_WIN || defined OS_LINUX || defined OS_BSD || defined OS_POSIX)
+#define FFI_ENABLE_LUATEX_INTERFACE
+#endif
+
+#ifdef _WIN32
+
+# ifdef UNDER_CE
+ static void* DoLoadLibraryA(const char* name) {
+ wchar_t buf[MAX_PATH];
+ int sz = MultiByteToWideChar(CP_UTF8, 0, name, -1, buf, 512);
+ if (sz > 0) {
+ buf[sz] = 0;
+ return LoadLibraryW(buf);
+ } else {
+ return NULL;
+ }
+ }
+# define LoadLibraryA DoLoadLibraryA
+# else
+# define GetProcAddressA GetProcAddress
+# endif
+
+# define LIB_FORMAT_1 "%s.dll"
+# define AllocPage(size) VirtualAlloc(NULL, size, MEM_RESERVE|MEM_COMMIT, PAGE_READWRITE)
+# define FreePage(data, size) VirtualFree(data, 0, MEM_RELEASE)
+# define EnableExecute(data, size) do {DWORD old; VirtualProtect(data, size, PAGE_EXECUTE, &old); FlushInstructionCache(GetCurrentProcess(), data, size);} while (0)
+# define EnableWrite(data, size) do {DWORD old; VirtualProtect(data, size, PAGE_READWRITE, &old);} while (0)
+
+#else
+#ifdef OS_OSX
+# define LIB_FORMAT_1 "%s.dylib"
+# define LIB_FORMAT_2 "lib%s.dylib"
+#else
+# define LIB_FORMAT_1 "%s.so"
+# define LIB_FORMAT_2 "lib%s.so"
+#endif
+# define LoadLibraryA(name) dlopen(name, RTLD_LAZY | RTLD_GLOBAL)
+# define GetProcAddressA(lib, name) dlsym(lib, name)
+# define AllocPage(size) mmap(NULL, size, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANON, -1, 0)
+# define FreePage(data, size) munmap(data, size)
+# define EnableExecute(data, size) mprotect(data, size, PROT_READ|PROT_EXEC)
+# define EnableWrite(data, size) mprotect(data, size, PROT_READ|PROT_WRITE)
+#endif
+
+#if defined ARCH_X86 || defined ARCH_X64
+#define ALLOW_MISALIGNED_ACCESS
+#endif
+
+struct token;
+
+struct parser {
+ int line;
+ const char* next;
+ const char* prev;
+ unsigned align_mask;
+};
+
+struct page {
+ size_t size;
+ size_t off;
+ size_t freed;
+};
+
+struct jit {
+ lua_State* L;
+ int32_t last_errno;
+ dasm_State* ctx;
+ size_t pagenum;
+ struct page** pages;
+ size_t align_page_size;
+ void** globals;
+ int function_extern;
+ void* lua_dll;
+ void* kernel32_dll;
+};
+
+#define ALIGN_DOWN(PTR, MASK) \
+ (((uintptr_t) (PTR)) & (~ ((uintptr_t) (MASK)) ))
+#define ALIGN_UP(PTR, MASK) \
+ (( ((uintptr_t) (PTR)) + ((uintptr_t) (MASK)) ) & (~ ((uintptr_t) (MASK)) ))
+
+/* struct cdata/struct ctype */
+
+#define PTR_ALIGN_MASK (sizeof(void*) - 1)
+#define FUNCTION_ALIGN_MASK (sizeof(void (*)()) - 1)
+#define DEFAULT_ALIGN_MASK 7
+
+#ifdef OS_OSX
+/* TODO: figure out why the alignof trick doesn't work on OS X */
+#define ALIGNED_DEFAULT 7
+#elif defined __GNUC__
+#define ALIGNED_DEFAULT (__alignof__(void* __attribute__((aligned))) - 1)
+#else
+#define ALIGNED_DEFAULT PTR_ALIGN_MASK
+#endif
+
+extern int jit_key;
+extern int ctype_mt_key;
+extern int cdata_mt_key;
+extern int cmodule_mt_key;
+extern int callback_mt_key;
+extern int constants_key;
+extern int types_key;
+extern int gc_key;
+extern int callbacks_key;
+extern int functions_key;
+extern int abi_key;
+extern int next_unnamed_key;
+extern int niluv_key;
+extern int asmname_key;
+
+int equals_upval(lua_State* L, int idx, int* key);
+void push_upval(lua_State* L, int* key);
+void set_upval(lua_State* L, int* key);
+struct jit* get_jit(lua_State* L);
+
+/* both ctype and cdata are stored as userdatas
+ *
+ * usr value is a table shared between the related subtypes which has:
+ * name -> member ctype (for structs and unions)
+ * +ves -> member ctype - in memory order (for structs)
+ * +ves -> argument ctype (for function prototypes)
+ * 0 -> return ctype (for function prototypes)
+ * light userdata -> misc
+ */
+
+enum {
+ C_CALL,
+ STD_CALL,
+ FAST_CALL,
+};
+
+enum {
+ INVALID_TYPE,
+ VOID_TYPE,
+ FLOAT_TYPE,
+ DOUBLE_TYPE,
+ LONG_DOUBLE_TYPE,
+ COMPLEX_FLOAT_TYPE,
+ COMPLEX_DOUBLE_TYPE,
+ COMPLEX_LONG_DOUBLE_TYPE,
+ BOOL_TYPE,
+ INT8_TYPE,
+ INT16_TYPE,
+ INT32_TYPE,
+ INT64_TYPE,
+ INTPTR_TYPE,
+ ENUM_TYPE,
+ UNION_TYPE,
+ STRUCT_TYPE,
+ FUNCTION_TYPE,
+ FUNCTION_PTR_TYPE,
+};
+
+#define IS_CHAR_UNSIGNED (((char) -1) > 0)
+#define IS_COMPLEX(type) ((type) == COMPLEX_FLOAT_TYPE || (type) == COMPLEX_DOUBLE_TYPE)
+
+#define POINTER_BITS 2
+#define POINTER_MAX ((1 << POINTER_BITS) - 1)
+
+#define ALIGNOF(S) ((int) ((char*) &S.v - (char*) &S - 1))
+
+/* Note: if adding a new member that is associated with a struct/union
+ * definition then it needs to be copied over in ctype.c:set_defined for when
+ * we create types based off of the declaration alone.
+ *
+ * Since this is used as a header for every ctype and cdata, and we create a
+ * ton of them on the stack, we try and minimise its size.
+ */
+struct ctype {
+ size_t base_size; /* size of the base type in bytes */
+
+ union {
+ /* valid if is_bitfield */
+ struct {
+ /* size of bitfield in bits */
+ unsigned bit_size : 7;
+ /* offset within the current byte between 0-63 */
+ unsigned bit_offset : 6;
+ };
+ /* Valid if is_array */
+ size_t array_size;
+ /* Valid for is_variable_struct or is_variable_array. If
+ * variable_size_known (only used for is_variable_struct) then this is
+ * the total increment otherwise this is the per element increment.
+ */
+ size_t variable_increment;
+ };
+ size_t offset;
+ unsigned align_mask : 4; /* as (align bytes - 1) eg 7 gives 8 byte alignment */
+ unsigned pointers : POINTER_BITS; /* number of dereferences to get to the base type including +1 for arrays */
+ unsigned const_mask : POINTER_MAX + 1; /* const pointer mask, LSB is current pointer, +1 for the whether the base type is const */
+ unsigned type : 5; /* value given by type enum above */
+ unsigned is_reference : 1;
+ unsigned is_array : 1;
+ unsigned is_defined : 1;
+ unsigned is_null : 1;
+ unsigned has_member_name : 1;
+ unsigned calling_convention : 2;
+ unsigned has_var_arg : 1;
+ unsigned is_variable_array : 1; /* set for variable array types where we don't know the variable size yet */
+ unsigned is_variable_struct : 1;
+ unsigned variable_size_known : 1; /* used for variable structs after we know the variable size */
+ unsigned is_bitfield : 1;
+ unsigned has_bitfield : 1;
+ unsigned is_jitted : 1;
+ unsigned is_packed : 1;
+ unsigned is_unsigned : 1;
+};
+
+#ifdef _MSC_VER
+__declspec(align(16))
+#endif
+struct cdata {
+ const struct ctype type
+#ifdef __GNUC__
+ __attribute__ ((aligned(16)))
+#endif
+ ;
+};
+
+typedef void (*cfunction)(void);
+
+#ifdef HAVE_COMPLEX
+typedef double complex complex_double;
+typedef float complex complex_float;
+static complex_double mk_complex_double(double real, double imag) {
+ return real + imag * 1i;
+}
+static complex_double mk_complex_float(double real, double imag) {
+ return real + imag * 1i;
+}
+#else
+typedef struct {
+ double real, imag;
+} complex_double;
+
+typedef struct {
+ float real, imag;
+} complex_float;
+
+static complex_double mk_complex_double(double real, double imag) {
+ complex_double ret = { real, imag };
+ return ret;
+}
+static complex_float mk_complex_float(double real, double imag) {
+ complex_float ret = { real, imag };
+ return ret;
+}
+static double creal(complex_double c) {
+ return c.real;
+}
+static float crealf(complex_float c) {
+ return c.real;
+}
+
+static double cimag(complex_double c) {
+ return c.imag;
+}
+static float cimagf(complex_float c) {
+ return c.imag;
+}
+#endif
+
+#define CALLBACK_FUNC_USR_IDX 1
+
+void set_defined(lua_State* L, int ct_usr, struct ctype* ct);
+struct ctype* push_ctype(lua_State* L, int ct_usr, const struct ctype* ct);
+void* push_cdata(lua_State* L, int ct_usr, const struct ctype* ct); /* called from asm */
+void push_callback(lua_State* L, cfunction luafunc, cfunction cfunc);
+void check_ctype(lua_State* L, int idx, struct ctype* ct);
+void* to_cdata(lua_State* L, int idx, struct ctype* ct);
+void* check_cdata(lua_State* L, int idx, struct ctype* ct);
+size_t ctype_size(lua_State* L, const struct ctype* ct);
+
+int parse_type(lua_State* L, struct parser* P, struct ctype* type);
+void parse_argument(lua_State* L, struct parser* P, int ct_usr, struct ctype* type, struct token* name, struct parser* asmname);
+void push_type_name(lua_State* L, int usr, const struct ctype* ct);
+
+int push_user_mt(lua_State* L, int ct_usr, const struct ctype* ct);
+
+int ffi_cdef(lua_State* L);
+
+void push_func_ref(lua_State* L, cfunction func);
+void free_code(struct jit* jit, lua_State* L, cfunction func);
+int x86_return_size(lua_State* L, int usr, const struct ctype* ct);
+void compile_function(lua_State* L, cfunction f, int ct_usr, const struct ctype* ct);
+cfunction compile_callback(lua_State* L, int fidx, int ct_usr, const struct ctype* ct);
+void compile_globals(struct jit* jit, lua_State* L);
+int get_extern(struct jit* jit, uint8_t* addr, int idx, int type);
+
+/* WARNING: assembly needs to be updated for prototype changes of these functions */
+int check_bool(lua_State* L, int idx);
+double check_double(lua_State* L, int idx);
+double check_complex_imag(lua_State* L, int idx);
+float check_float(lua_State* L, int idx);
+uint64_t check_uint64(lua_State* L, int idx);
+int64_t check_int64(lua_State* L, int idx);
+int32_t check_int32(lua_State* L, int idx);
+uint32_t check_uint32(lua_State* L, int idx);
+uintptr_t check_uintptr(lua_State* L, int idx);
+int32_t check_enum(lua_State* L, int idx, int to_usr, const struct ctype* tt);
+/* these two will always push a value so that we can create structs/functions on the fly */
+void* check_typed_pointer(lua_State* L, int idx, int to_usr, const struct ctype* tt);
+cfunction check_typed_cfunction(lua_State* L, int idx, int to_usr, const struct ctype* tt);
+complex_double check_complex_double(lua_State* L, int idx);
+complex_float check_complex_float(lua_State* L, int idx);
+
+void unpack_varargs_stack(lua_State* L, int first, int last, char* to);
+void unpack_varargs_reg(lua_State* L, int first, int last, char* to);
+
+void unpack_varargs_stack_skip(lua_State* L, int first, int last, int ints_to_skip, int floats_to_skip, char* to);
+void unpack_varargs_float(lua_State* L, int first, int last, int max, char* to);
+void unpack_varargs_int(lua_State* L, int first, int last, int max, char* to);
+
+
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/ffi.h.orig b/Build/source/texk/web2c/luatexdir/luaffi/ffi.h.orig
new file mode 100644
index 00000000000..dabdc9b38bb
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/ffi.h.orig
@@ -0,0 +1,455 @@
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+
+#pragma once
+
+#ifdef _MSC_VER
+#define _CRT_SECURE_NO_WARNINGS
+#endif
+
+#include <stdint.h>
+#include <stdbool.h>
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+
+#ifdef __cplusplus
+extern "C" {
+# include <lua.h>
+# include <lauxlib.h>
+# include <lualib.h>
+}
+# define EXTERN_C extern "C"
+#else
+# include <lua.h>
+# include <lauxlib.h>
+# include <lualib.h>
+# define EXTERN_C extern
+#endif
+
+#ifdef _WIN32
+#include <windows.h>
+#else
+#include <errno.h>
+#include <unistd.h>
+#include <dlfcn.h>
+#include <sys/mman.h>
+#endif
+
+#include <complex.h>
+#define HAVE_COMPLEX
+#define HAVE_LONG_DOUBLE
+
+#ifndef NDEBUG
+#define DASM_CHECKS
+#endif
+
+struct jit;
+#define Dst_DECL struct jit* Dst
+#define Dst_REF (Dst->ctx)
+#define DASM_EXTERN(a,b,c,d) get_extern(a,b,c,d)
+
+#include "dynasm/dasm_proto.h"
+
+#if defined LUA_FFI_BUILD_AS_DLL
+# define EXPORT __declspec(dllexport)
+#elif defined __GNUC__
+# define EXPORT __attribute__((visibility("default")))
+#else
+# define EXPORT
+#endif
+
+EXTERN_C EXPORT int luaopen_ffi(lua_State* L);
+
+static int lua_absindex2(lua_State* L, int idx) {
+ return (LUA_REGISTRYINDEX <= idx && idx < 0)
+ ? lua_gettop(L) + idx + 1
+ : idx;
+}
+/* use our own version of lua_absindex such that lua_absindex(L, 0) == 0 */
+#define lua_absindex(L, idx) lua_absindex2(L, idx)
+
+#if LUA_VERSION_NUM == 501
+static void lua_callk(lua_State *L, int nargs, int nresults, int ctx, lua_CFunction k)
+{
+ lua_call(L, nargs, nresults);
+}
+/*
+** set functions from list 'l' into table at top - 'nup'; each
+** function gets the 'nup' elements at the top as upvalues.
+** Returns with only the table at the stack.
+*/
+static void luaL_setfuncs (lua_State *L, const luaL_Reg *l, int nup) {
+ luaL_checkstack(L, nup, "too many upvalues");
+ for (; l && l->name; l++) { /* fill the table with given functions */
+ int i;
+ for (i = 0; i < nup; i++) /* copy upvalues to the top */
+ lua_pushvalue(L, -nup);
+ lua_pushcclosure(L, l->func, nup); /* closure with those upvalues */
+ lua_setfield(L, -(nup + 2), l->name);
+ }
+ lua_pop(L, nup); /* remove upvalues */
+}
+#define lua_setuservalue lua_setfenv
+#define lua_getuservalue lua_getfenv
+#define lua_rawlen lua_objlen
+static char* luaL_prepbuffsize(luaL_Buffer* B, size_t sz) {
+ if (sz > LUAL_BUFFERSIZE) {
+ luaL_error(B->L, "string too long");
+ }
+ return luaL_prepbuffer(B);
+}
+#elif LUA_VERSION_NUM == 503
+static void (lua_remove)(lua_State *L, int idx) {
+ lua_remove(L, idx);
+}
+#endif
+
+/* architectures */
+#if defined _WIN32 && defined UNDER_CE
+# define OS_CE
+#elif defined _WIN32
+# define OS_WIN
+#elif defined __APPLE__ && defined __MACH__
+# define OS_OSX
+#elif defined __linux__
+# define OS_LINUX
+#elif defined __FreeBSD__ || defined __OpenBSD__ || defined __NetBSD__
+# define OS_BSD
+#elif defined unix || defined __unix__ || defined __unix || defined _POSIX_VERSION || defined _XOPEN_VERSION
+# define OS_POSIX
+#endif
+
+/* architecture */
+#if defined __i386__ || defined _M_IX86
+# define ARCH_X86
+#elif defined __amd64__ || defined _M_X64
+# define ARCH_X64
+#elif defined __arm__ || defined __ARM__ || defined ARM || defined __ARM || defined __arm || defined __aarch64__
+# define ARCH_ARM
+#elif defined __powerpc64__
+# define ARCH_PPC64
+#else
+# error
+#endif
+
+
+#ifdef _WIN32
+
+# ifdef UNDER_CE
+ static void* DoLoadLibraryA(const char* name) {
+ wchar_t buf[MAX_PATH];
+ int sz = MultiByteToWideChar(CP_UTF8, 0, name, -1, buf, 512);
+ if (sz > 0) {
+ buf[sz] = 0;
+ return LoadLibraryW(buf);
+ } else {
+ return NULL;
+ }
+ }
+# define LoadLibraryA DoLoadLibraryA
+# else
+# define GetProcAddressA GetProcAddress
+# endif
+
+# define LIB_FORMAT_1 "%s.dll"
+# define AllocPage(size) VirtualAlloc(NULL, size, MEM_RESERVE|MEM_COMMIT, PAGE_READWRITE)
+# define FreePage(data, size) VirtualFree(data, 0, MEM_RELEASE)
+# define EnableExecute(data, size) do {DWORD old; VirtualProtect(data, size, PAGE_EXECUTE, &old); FlushInstructionCache(GetCurrentProcess(), data, size);} while (0)
+# define EnableWrite(data, size) do {DWORD old; VirtualProtect(data, size, PAGE_READWRITE, &old);} while (0)
+
+#else
+#ifdef OS_OSX
+# define LIB_FORMAT_1 "%s.dylib"
+# define LIB_FORMAT_2 "lib%s.dylib"
+#else
+# define LIB_FORMAT_1 "%s.so"
+# define LIB_FORMAT_2 "lib%s.so"
+#endif
+# define LoadLibraryA(name) dlopen(name, RTLD_LAZY | RTLD_GLOBAL)
+# define GetProcAddressA(lib, name) dlsym(lib, name)
+# define AllocPage(size) mmap(NULL, size, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANON, -1, 0)
+# define FreePage(data, size) munmap(data, size)
+# define EnableExecute(data, size) mprotect(data, size, PROT_READ|PROT_EXEC)
+# define EnableWrite(data, size) mprotect(data, size, PROT_READ|PROT_WRITE)
+#endif
+
+#if defined ARCH_X86 || defined ARCH_X64
+#define ALLOW_MISALIGNED_ACCESS
+#endif
+
+struct token;
+
+struct parser {
+ int line;
+ const char* next;
+ const char* prev;
+ unsigned align_mask;
+};
+
+struct page {
+ size_t size;
+ size_t off;
+ size_t freed;
+};
+
+struct jit {
+ lua_State* L;
+ int32_t last_errno;
+ dasm_State* ctx;
+ size_t pagenum;
+ struct page** pages;
+ size_t align_page_size;
+ void** globals;
+ int function_extern;
+ void* lua_dll;
+ void* kernel32_dll;
+};
+
+#define ALIGN_DOWN(PTR, MASK) \
+ (((uintptr_t) (PTR)) & (~ ((uintptr_t) (MASK)) ))
+#define ALIGN_UP(PTR, MASK) \
+ (( ((uintptr_t) (PTR)) + ((uintptr_t) (MASK)) ) & (~ ((uintptr_t) (MASK)) ))
+
+/* struct cdata/struct ctype */
+
+#define PTR_ALIGN_MASK (sizeof(void*) - 1)
+#define FUNCTION_ALIGN_MASK (sizeof(void (*)()) - 1)
+#define DEFAULT_ALIGN_MASK 7
+
+#ifdef OS_OSX
+/* TODO: figure out why the alignof trick doesn't work on OS X */
+#define ALIGNED_DEFAULT 7
+#elif defined __GNUC__
+#define ALIGNED_DEFAULT (__alignof__(void* __attribute__((aligned))) - 1)
+#else
+#define ALIGNED_DEFAULT PTR_ALIGN_MASK
+#endif
+
+extern int jit_key;
+extern int ctype_mt_key;
+extern int cdata_mt_key;
+extern int cmodule_mt_key;
+extern int callback_mt_key;
+extern int constants_key;
+extern int types_key;
+extern int gc_key;
+extern int callbacks_key;
+extern int functions_key;
+extern int abi_key;
+extern int next_unnamed_key;
+extern int niluv_key;
+extern int asmname_key;
+
+int equals_upval(lua_State* L, int idx, int* key);
+void push_upval(lua_State* L, int* key);
+void set_upval(lua_State* L, int* key);
+struct jit* get_jit(lua_State* L);
+
+/* both ctype and cdata are stored as userdatas
+ *
+ * usr value is a table shared between the related subtypes which has:
+ * name -> member ctype (for structs and unions)
+ * +ves -> member ctype - in memory order (for structs)
+ * +ves -> argument ctype (for function prototypes)
+ * 0 -> return ctype (for function prototypes)
+ * light userdata -> misc
+ */
+
+enum {
+ C_CALL,
+ STD_CALL,
+ FAST_CALL,
+};
+
+enum {
+ INVALID_TYPE,
+ VOID_TYPE,
+ FLOAT_TYPE,
+ DOUBLE_TYPE,
+ LONG_DOUBLE_TYPE,
+ COMPLEX_FLOAT_TYPE,
+ COMPLEX_DOUBLE_TYPE,
+ COMPLEX_LONG_DOUBLE_TYPE,
+ BOOL_TYPE,
+ INT8_TYPE,
+ INT16_TYPE,
+ INT32_TYPE,
+ INT64_TYPE,
+ INTPTR_TYPE,
+ ENUM_TYPE,
+ UNION_TYPE,
+ STRUCT_TYPE,
+ FUNCTION_TYPE,
+ FUNCTION_PTR_TYPE,
+};
+
+#define IS_CHAR_UNSIGNED (((char) -1) > 0)
+#define IS_COMPLEX(type) ((type) == COMPLEX_FLOAT_TYPE || (type) == COMPLEX_DOUBLE_TYPE)
+
+#define POINTER_BITS 2
+#define POINTER_MAX ((1 << POINTER_BITS) - 1)
+
+#define ALIGNOF(S) ((int) ((char*) &S.v - (char*) &S - 1))
+
+/* Note: if adding a new member that is associated with a struct/union
+ * definition then it needs to be copied over in ctype.c:set_defined for when
+ * we create types based off of the declaration alone.
+ *
+ * Since this is used as a header for every ctype and cdata, and we create a
+ * ton of them on the stack, we try and minimise its size.
+ */
+struct ctype {
+ size_t base_size; /* size of the base type in bytes */
+
+ union {
+ /* valid if is_bitfield */
+ struct {
+ /* size of bitfield in bits */
+ unsigned bit_size : 7;
+ /* offset within the current byte between 0-63 */
+ unsigned bit_offset : 6;
+ };
+ /* Valid if is_array */
+ size_t array_size;
+ /* Valid for is_variable_struct or is_variable_array. If
+ * variable_size_known (only used for is_variable_struct) then this is
+ * the total increment otherwise this is the per element increment.
+ */
+ size_t variable_increment;
+ };
+ size_t offset;
+ unsigned align_mask : 4; /* as (align bytes - 1) eg 7 gives 8 byte alignment */
+ unsigned pointers : POINTER_BITS; /* number of dereferences to get to the base type including +1 for arrays */
+ unsigned const_mask : POINTER_MAX + 1; /* const pointer mask, LSB is current pointer, +1 for the whether the base type is const */
+ unsigned type : 5; /* value given by type enum above */
+ unsigned is_reference : 1;
+ unsigned is_array : 1;
+ unsigned is_defined : 1;
+ unsigned is_null : 1;
+ unsigned has_member_name : 1;
+ unsigned calling_convention : 2;
+ unsigned has_var_arg : 1;
+ unsigned is_variable_array : 1; /* set for variable array types where we don't know the variable size yet */
+ unsigned is_variable_struct : 1;
+ unsigned variable_size_known : 1; /* used for variable structs after we know the variable size */
+ unsigned is_bitfield : 1;
+ unsigned has_bitfield : 1;
+ unsigned is_jitted : 1;
+ unsigned is_packed : 1;
+ unsigned is_unsigned : 1;
+};
+
+#ifdef _MSC_VER
+__declspec(align(16))
+#endif
+struct cdata {
+ const struct ctype type
+#ifdef __GNUC__
+ __attribute__ ((aligned(16)))
+#endif
+ ;
+};
+
+typedef void (*cfunction)(void);
+
+#ifdef HAVE_COMPLEX
+typedef double complex complex_double;
+typedef float complex complex_float;
+static complex_double mk_complex_double(double real, double imag) {
+ return real + imag * 1i;
+}
+static complex_double mk_complex_float(double real, double imag) {
+ return real + imag * 1i;
+}
+#else
+typedef struct {
+ double real, imag;
+} complex_double;
+
+typedef struct {
+ float real, imag;
+} complex_float;
+
+static complex_double mk_complex_double(double real, double imag) {
+ complex_double ret = { real, imag };
+ return ret;
+}
+static complex_float mk_complex_float(double real, double imag) {
+ complex_float ret = { real, imag };
+ return ret;
+}
+static double creal(complex_double c) {
+ return c.real;
+}
+static float crealf(complex_float c) {
+ return c.real;
+}
+
+static double cimag(complex_double c) {
+ return c.imag;
+}
+static float cimagf(complex_float c) {
+ return c.imag;
+}
+#endif
+
+#define CALLBACK_FUNC_USR_IDX 1
+
+void set_defined(lua_State* L, int ct_usr, struct ctype* ct);
+struct ctype* push_ctype(lua_State* L, int ct_usr, const struct ctype* ct);
+void* push_cdata(lua_State* L, int ct_usr, const struct ctype* ct); /* called from asm */
+void push_callback(lua_State* L, cfunction luafunc, cfunction cfunc);
+void check_ctype(lua_State* L, int idx, struct ctype* ct);
+void* to_cdata(lua_State* L, int idx, struct ctype* ct);
+void* check_cdata(lua_State* L, int idx, struct ctype* ct);
+size_t ctype_size(lua_State* L, const struct ctype* ct);
+
+int parse_type(lua_State* L, struct parser* P, struct ctype* type);
+void parse_argument(lua_State* L, struct parser* P, int ct_usr, struct ctype* type, struct token* name, struct parser* asmname);
+void push_type_name(lua_State* L, int usr, const struct ctype* ct);
+
+int push_user_mt(lua_State* L, int ct_usr, const struct ctype* ct);
+
+int ffi_cdef(lua_State* L);
+
+void push_func_ref(lua_State* L, cfunction func);
+void free_code(struct jit* jit, lua_State* L, cfunction func);
+int x86_return_size(lua_State* L, int usr, const struct ctype* ct);
+void compile_function(lua_State* L, cfunction f, int ct_usr, const struct ctype* ct);
+cfunction compile_callback(lua_State* L, int fidx, int ct_usr, const struct ctype* ct);
+void compile_globals(struct jit* jit, lua_State* L);
+int get_extern(struct jit* jit, uint8_t* addr, int idx, int type);
+
+/* WARNING: assembly needs to be updated for prototype changes of these functions */
+int check_bool(lua_State* L, int idx);
+double check_double(lua_State* L, int idx);
+double check_complex_imag(lua_State* L, int idx);
+float check_float(lua_State* L, int idx);
+uint64_t check_uint64(lua_State* L, int idx);
+int64_t check_int64(lua_State* L, int idx);
+int32_t check_int32(lua_State* L, int idx);
+uint32_t check_uint32(lua_State* L, int idx);
+uintptr_t check_uintptr(lua_State* L, int idx);
+int32_t check_enum(lua_State* L, int idx, int to_usr, const struct ctype* tt);
+/* these two will always push a value so that we can create structs/functions on the fly */
+void* check_typed_pointer(lua_State* L, int idx, int to_usr, const struct ctype* tt);
+cfunction check_typed_cfunction(lua_State* L, int idx, int to_usr, const struct ctype* tt);
+complex_double check_complex_double(lua_State* L, int idx);
+complex_float check_complex_float(lua_State* L, int idx);
+
+void unpack_varargs_stack(lua_State* L, int first, int last, char* to);
+void unpack_varargs_reg(lua_State* L, int first, int last, char* to);
+
+void unpack_varargs_stack_skip(lua_State* L, int first, int last, int ints_to_skip, int floats_to_skip, char* to);
+void unpack_varargs_float(lua_State* L, int first, int last, int max, char* to);
+void unpack_varargs_int(lua_State* L, int first, int last, int max, char* to);
+
+
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/generate_call_h.bat b/Build/source/texk/web2c/luatexdir/luaffi/generate_call_h.bat
new file mode 100644
index 00000000000..bb8ce26188c
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/generate_call_h.bat
@@ -0,0 +1,4 @@
+lua.exe dynasm\dynasm.lua -LNE -D X32WIN -o call_x86.h call_x86.dasc
+lua.exe dynasm\dynasm.lua -LNE -D X64 -o call_x64.h call_x86.dasc
+lua.exe dynasm\dynasm.lua -LNE -D X64 -D X64WIN -o call_x64win.h call_x86.dasc
+lua.exe dynasm\dynasm.lua -LNE -o call_arm.h call_arm.dasc
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/luaffi-scm-1.rockspec b/Build/source/texk/web2c/luatexdir/luaffi/luaffi-scm-1.rockspec
new file mode 100644
index 00000000000..42cea90e6cb
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/luaffi-scm-1.rockspec
@@ -0,0 +1,34 @@
+package = "luaffi"
+version = "scm-1"
+
+source = {
+ url = "git://github.com/facebook/luaffifb.git",
+}
+
+description = {
+ summary = "FFI library for calling C functions from lua",
+ detailed = [[
+ ]],
+ homepage = "https://github.com/facebook/luaffifb",
+ license = "BSD"
+}
+
+dependencies = {
+ "lua >= 5.1",
+}
+
+build = {
+ type = "builtin",
+ modules = {
+ ['ffi'] = {
+ incdirs = {
+ "dynasm"
+ },
+ sources = {
+ "call.c", "ctype.c", "ffi.c", "parser.c",
+ }
+ },
+ ['ffi.libtest'] = 'test.c',
+ ['ffi.test'] = 'test.lua',
+ }
+}
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/msvc/inttypes.h b/Build/source/texk/web2c/luatexdir/luaffi/msvc/inttypes.h
new file mode 100644
index 00000000000..d137c703f41
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/msvc/inttypes.h
@@ -0,0 +1,31 @@
+#pragma once
+
+/* Signed integers */
+#define PRId8 "d"
+#define PRId16 "d"
+#define PRId32 "d"
+#define PRId64 "I64d"
+#define PRIi8 "i"
+#define PRIi16 "i"
+#define PRIi32 "i"
+#define PRIi64 "I64i"
+
+/* Unsigned integers */
+#define PRIo8 "o"
+#define PRIo16 "o"
+#define PRIo32 "o"
+#define PRIo64 "I64o"
+#define PRIu8 "u"
+#define PRIu16 "u"
+#define PRIu32 "u"
+#define PRIu64 "I64u"
+#define PRIx8 "x"
+#define PRIx16 "x"
+#define PRIx32 "x"
+#define PRIx64 "I64x"
+#define PRIX8 "X"
+#define PRIX16 "X"
+#define PRIX32 "X"
+#define PRIX64 "I64X"
+#define PRIxPTR PRIx32
+#define PRIXPTR PRIX32
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/msvc/stdbool.h b/Build/source/texk/web2c/luatexdir/luaffi/msvc/stdbool.h
new file mode 100644
index 00000000000..0bf760b0599
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/msvc/stdbool.h
@@ -0,0 +1,42 @@
+/* vim: ts=4 sw=4 sts=4 et
+ *
+ * Copyright (c) 2009 James R. McKaskill
+ *
+ * This software is licensed under the stock MIT license:
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+ * DEALINGS IN THE SOFTWARE.
+ *
+ * ----------------------------------------------------------------------------
+ */
+
+#pragma once
+
+
+#if defined __cplusplus
+typedef bool _Bool;
+
+#else
+#pragma warning(disable:4244) /* conversion from int to _Bool */
+typedef unsigned char _Bool;
+#define bool _Bool
+#define true 1
+#define false 0
+#define __bool_true_false_are_defined 1
+
+#endif
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/msvc/stdint.h b/Build/source/texk/web2c/luatexdir/luaffi/msvc/stdint.h
new file mode 100644
index 00000000000..627d30eb68b
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/msvc/stdint.h
@@ -0,0 +1,174 @@
+// boost cstdint.hpp header file ------------------------------------------//
+
+// (C) Copyright Beman Dawes 1999.
+// (C) Copyright Jens Mauer 2001
+// (C) Copyright John Maddock 2001
+// Distributed under the Boost
+// Software License, Version 1.0. (See accompanying file
+// LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+
+// See http://www.boost.org/libs/integer for documentation.
+
+// Revision History
+// 31 Oct 01 use BOOST_HAS_LONG_LONG to check for "long long" (Jens M.)
+// 16 Apr 01 check LONGLONG_MAX when looking for "long long" (Jens Maurer)
+// 23 Jan 01 prefer "long" over "int" for int32_t and intmax_t (Jens Maurer)
+// 12 Nov 00 Merged <boost/stdint.h> (Jens Maurer)
+// 23 Sep 00 Added INTXX_C macro support (John Maddock).
+// 22 Sep 00 Better 64-bit support (John Maddock)
+// 29 Jun 00 Reimplement to avoid including stdint.h within namespace boost
+// 8 Aug 99 Initial version (Beman Dawes)
+
+
+#ifndef STDINT_H
+#define STDINT_H
+
+#ifndef UNDER_CE
+#include <crtdefs.h>
+#endif
+
+#include <limits.h>
+
+// These are fairly safe guesses for some 16-bit, and most 32-bit and 64-bit
+// platforms. For other systems, they will have to be hand tailored.
+//
+// Because the fast types are assumed to be the same as the undecorated types,
+// it may be possible to hand tailor a more efficient implementation. Such
+// an optimization may be illusionary; on the Intel x86-family 386 on, for
+// example, byte arithmetic and load/stores are as fast as "int" sized ones.
+
+// 8-bit types ------------------------------------------------------------//
+
+# if UCHAR_MAX == 0xff
+ typedef signed char int8_t;
+ typedef signed char int_least8_t;
+ typedef signed char int_fast8_t;
+ typedef unsigned char uint8_t;
+ typedef unsigned char uint_least8_t;
+ typedef unsigned char uint_fast8_t;
+# else
+# error defaults not correct; you must hand modify boost/cstdint.hpp
+# endif
+
+// 16-bit types -----------------------------------------------------------//
+
+# if USHRT_MAX == 0xffff
+# if defined(__crayx1)
+ // The Cray X1 has a 16-bit short, however it is not recommend
+ // for use in performance critical code.
+ typedef short int16_t;
+ typedef short int_least16_t;
+ typedef int int_fast16_t;
+ typedef unsigned short uint16_t;
+ typedef unsigned short uint_least16_t;
+ typedef unsigned int uint_fast16_t;
+# else
+ typedef short int16_t;
+ typedef short int_least16_t;
+ typedef short int_fast16_t;
+ typedef unsigned short uint16_t;
+ typedef unsigned short uint_least16_t;
+ typedef unsigned short uint_fast16_t;
+# endif
+# elif (USHRT_MAX == 0xffffffff) && defined(CRAY)
+ // no 16-bit types on Cray:
+ typedef short int_least16_t;
+ typedef short int_fast16_t;
+ typedef unsigned short uint_least16_t;
+ typedef unsigned short uint_fast16_t;
+# else
+# error defaults not correct; you must hand modify boost/cstdint.hpp
+# endif
+
+// 32-bit types -----------------------------------------------------------//
+
+# if ULONG_MAX == 0xffffffff
+ typedef long int32_t;
+ typedef long int_least32_t;
+ typedef long int_fast32_t;
+ typedef unsigned long uint32_t;
+ typedef unsigned long uint_least32_t;
+ typedef unsigned long uint_fast32_t;
+# elif UINT_MAX == 0xffffffff
+ typedef int int32_t;
+ typedef int int_least32_t;
+ typedef int int_fast32_t;
+ typedef unsigned int uint32_t;
+ typedef unsigned int uint_least32_t;
+ typedef unsigned int uint_fast32_t;
+# else
+# error defaults not correct; you must hand modify boost/cstdint.hpp
+# endif
+
+// 64-bit types + intmax_t and uintmax_t ----------------------------------//
+
+ //
+ // we have Borland/Intel/Microsoft __int64:
+ //
+ typedef __int64 intmax_t;
+ typedef unsigned __int64 uintmax_t;
+ typedef __int64 int64_t;
+ typedef __int64 int_least64_t;
+ typedef __int64 int_fast64_t;
+ typedef unsigned __int64 uint64_t;
+ typedef unsigned __int64 uint_least64_t;
+ typedef unsigned __int64 uint_fast64_t;
+
+
+
+/****************************************************
+
+Macro definition section:
+
+Define various INTXX_C macros only if
+__STDC_CONSTANT_MACROS is defined.
+
+Undefine the macros if __STDC_CONSTANT_MACROS is
+not defined and the macros are (cf <cassert>).
+
+Added 23rd September 2000 (John Maddock).
+Modified 11th September 2001 to be excluded when
+BOOST_HAS_STDINT_H is defined (John Maddock).
+
+******************************************************/
+
+#if defined(__STDC_CONSTANT_MACROS) || !defined(__cplusplus)
+//
+// Borland/Intel/Microsoft compilers have width specific suffixes:
+//
+# define INT8_C(value) value##i8
+# define INT16_C(value) value##i16
+# define INT32_C(value) value##i32
+# define INT64_C(value) value##i64
+# define UINT8_C(value) value##ui8
+# define UINT16_C(value) value##ui16
+# define UINT32_C(value) value##ui32
+# define UINT64_C(value) value##ui64
+# define INTMAX_C(value) value##i64
+# define UINTMAX_C(value) value##ui64
+
+#endif // __STDC_CONSTANT_MACROS_DEFINED etc.
+
+#if defined(__STDC_LIMIT_MACROS) || !defined(__cplusplus)
+# define INT8_MIN INT8_C(-127)-1
+# define INT8_MAX INT8_C(127)
+# define INT16_MIN INT16_C(-32767)-1
+# define INT16_MAX INT16_C(32767)
+# define INT32_MIN INT32_C(-2147483647)-1
+# define INT32_MAX INT32_C(2147483647)
+# define INT64_MAX INT64_C(9223372036854775807)
+# define UINT8_MAX UINT8_C(255)
+# define UINT16_MAX UINT16_C(65535)
+# define UINT32_MAX UINT32_C(4294967295)
+# define UINT64_MAX UINT64_C(18446744073709551615)
+#endif
+
+#ifdef UNDER_CE
+typedef unsigned long uintptr_t;
+typedef long intptr_t;
+#endif
+
+
+
+#endif // BOOST_CSTDINT_HPP
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/msvcbuild.bat b/Build/source/texk/web2c/luatexdir/luaffi/msvcbuild.bat
new file mode 100644
index 00000000000..79c11eb19f2
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/msvcbuild.bat
@@ -0,0 +1,76 @@
+@if not defined INCLUDE goto :FAIL
+
+@setlocal
+
+@if "%1"=="debug-5.1" goto :DEBUG_5_1
+
+rem These should not have quotes
+@set LUA_INCLUDE=Z:\c\lua-5.2.0\src
+@set LUA_LIB=Z:\c\lua-5.2.0\lua5.2.lib
+@set LUA_EXE=Z:\c\lua-5.2.0\lua.exe
+rem This the name of the dll that can be handed to LoadLibrary. This should not have a path.
+@set LUA_DLL=lua5.2.dll
+@goto :DEBUG
+
+:DEBUG_5_1
+@set LUA_INCLUDE=Z:\c\lua-5.1.4\src
+@set LUA_LIB=Z:\c\lua-5.1.4\lua5.1.lib
+@set LUA_EXE=Z:\c\lua-5.1.4\lua.exe
+@set LUA_DLL=lua5.1.dll
+
+:DEBUG
+@set DO_CL=cl.exe /nologo /c /MDd /FC /Zi /Od /W3 /WX /D_CRT_SECURE_NO_DEPRECATE /DLUA_FFI_BUILD_AS_DLL /I"msvc"
+@set DO_LINK=link /nologo /debug
+@set DO_MT=mt /nologo
+
+@if "%1"=="debug" goto :COMPILE
+@if "%1"=="debug-5.1" goto :COMPILE
+@if "%1"=="test" goto :COMPILE
+@if "%1"=="clean" goto :CLEAN
+@if "%1"=="release" goto :RELEASE
+@if "%1"=="test-release" goto :RELEASE
+
+:RELEASE
+@set DO_CL=cl.exe /nologo /c /MD /Ox /W3 /Zi /WX /D_CRT_SECURE_NO_DEPRECATE /DLUA_FFI_BUILD_AS_DLL /I"msvc"
+@set DO_LINK=link.exe /nologo /debug
+@set DO_MT=mt.exe /nologo
+@goto :COMPILE
+
+:COMPILE
+"%LUA_EXE%" dynasm\dynasm.lua -LNE -D X32WIN -o call_x86.h call_x86.dasc
+"%LUA_EXE%" dynasm\dynasm.lua -LNE -D X64 -o call_x64.h call_x86.dasc
+"%LUA_EXE%" dynasm\dynasm.lua -LNE -D X64 -D X64WIN -o call_x64win.h call_x86.dasc
+"%LUA_EXE%" dynasm\dynasm.lua -LNE -o call_arm.h call_arm.dasc
+%DO_CL% /I"." /I"%LUA_INCLUDE%" /DLUA_DLL_NAME="%LUA_DLL%" call.c ctype.c ffi.c parser.c
+%DO_LINK% /DLL /OUT:ffi.dll "%LUA_LIB%" *.obj
+if exist ffi.dll.manifest^
+ %DO_MT% -manifest ffi.dll.manifest -outputresource:"ffi.dll;2"
+
+%DO_CL% /Gd test.c /Fo"test_cdecl.obj"
+%DO_CL% /Gz test.c /Fo"test_stdcall.obj"
+%DO_CL% /Gr test.c /Fo"test_fastcall.obj"
+%DO_LINK% /DLL /OUT:test_cdecl.dll test_cdecl.obj
+%DO_LINK% /DLL /OUT:test_stdcall.dll test_stdcall.obj
+%DO_LINK% /DLL /OUT:test_fastcall.dll test_fastcall.obj
+if exist test_cdecl.dll.manifest^
+ %DO_MT% -manifest test_cdecl.dll.manifest -outputresource:"test_cdecl.dll;2"
+if exist test_stdcall.dll.manifest^
+ %DO_MT% -manifest test_stdcall.dll.manifest -outputresource:"test_stdcall.dll;2"
+if exist test_fastcall.dll.manifest^
+ %DO_MT% -manifest test_fastcall.dll.manifest -outputresource:"test_fastcall.dll;2"
+
+@if "%1"=="test" "%LUA_EXE%" test.lua
+@if "%1"=="test-5.2" "%LUA_EXE%" test.lua
+@if "%1"=="test-release" "%LUA_EXE%" test.lua
+@goto :CLEAN_OBJ
+
+:CLEAN
+del *.dll
+:CLEAN_OBJ
+del *.obj *.manifest
+@goto :END
+
+:FAIL
+@echo You must open a "Visual Studio .NET Command Prompt" to run this script
+:END
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/parser.c b/Build/source/texk/web2c/luatexdir/luaffi/parser.c
new file mode 100644
index 00000000000..dceb84550b6
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/parser.c
@@ -0,0 +1,2618 @@
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+#include "ffi.h"
+
+#define IS_CONST(tok) (IS_LITERAL(tok, "const") || IS_LITERAL(tok, "__const") || IS_LITERAL(tok, "__const__"))
+#define IS_VOLATILE(tok) (IS_LITERAL(tok, "volatile") || IS_LITERAL(tok, "__volatile") || IS_LITERAL(tok, "__volatile__"))
+#define IS_RESTRICT(tok) (IS_LITERAL(tok, "restrict") || IS_LITERAL(tok, "__restrict") || IS_LITERAL(tok, "__restrict__"))
+#define IS_INLINE(tok) (IS_LITERAL(tok, "inline") || IS_LITERAL(tok, "__inline") || IS_LITERAL(tok, "__inline__"))
+
+enum etoken {
+ TOK_NIL,
+ TOK_NUMBER,
+ TOK_STRING,
+ TOK_TOKEN,
+
+ /* the order of these values must match the token strings in lex.c */
+
+ TOK_3_BEGIN,
+ TOK_VA_ARG,
+
+ TOK_2_BEGIN,
+ TOK_LEFT_SHIFT, TOK_RIGHT_SHIFT, TOK_LOGICAL_AND, TOK_LOGICAL_OR, TOK_LESS_EQUAL,
+ TOK_GREATER_EQUAL, TOK_EQUAL, TOK_NOT_EQUAL,
+
+ TOK_1_BEGIN,
+ TOK_OPEN_CURLY, TOK_CLOSE_CURLY, TOK_SEMICOLON, TOK_COMMA, TOK_COLON,
+ TOK_ASSIGN, TOK_OPEN_PAREN, TOK_CLOSE_PAREN, TOK_OPEN_SQUARE, TOK_CLOSE_SQUARE,
+ TOK_DOT, TOK_AMPERSAND, TOK_LOGICAL_NOT, TOK_BITWISE_NOT, TOK_MINUS,
+ TOK_PLUS, TOK_STAR, TOK_DIVIDE, TOK_MODULUS, TOK_LESS,
+ TOK_GREATER, TOK_BITWISE_XOR, TOK_BITWISE_OR, TOK_QUESTION, TOK_POUND,
+
+ TOK_REFERENCE = TOK_AMPERSAND,
+ TOK_MULTIPLY = TOK_STAR,
+ TOK_BITWISE_AND = TOK_AMPERSAND,
+};
+
+struct token {
+ enum etoken type;
+ int64_t integer;
+ const char* str;
+ size_t size;
+};
+
+#define IS_LITERAL(TOK, STR) \
+ (((TOK).size == sizeof(STR) - 1) && 0 == memcmp((TOK).str, STR, sizeof(STR) - 1))
+
+/* the order of tokens _must_ match the order of the enum etoken enum */
+
+static char tok3[][4] = {
+ "...", /* unused ">>=", "<<=", */
+};
+
+static char tok2[][3] = {
+ "<<", ">>", "&&", "||", "<=",
+ ">=", "==", "!=",
+ /* unused "+=", "-=", "*=", "/=", "%=", "&=", "^=", "|=", "++", "--", "->", "::", */
+};
+
+static char tok1[] = {
+ '{', '}', ';', ',', ':',
+ '=', '(', ')', '[', ']',
+ '.', '&', '!', '~', '-',
+ '+', '*', '/', '%', '<',
+ '>', '^', '|', '?', '#'
+};
+
+static int next_token(lua_State* L, struct parser* P, struct token* tok)
+{
+ size_t i;
+ const char* s = P->next;
+
+ /* UTF8 BOM */
+ if (s[0] == '\xEF' && s[1] == '\xBB' && s[2] == '\xBF') {
+ s += 3;
+ }
+
+ /* consume whitespace and comments */
+ for (;;) {
+ /* consume whitespace */
+ while(*s == '\t' || *s == '\n' || *s == ' ' || *s == '\v' || *s == '\r') {
+ if (*s == '\n') {
+ P->line++;
+ }
+ s++;
+ }
+
+ /* consume comments */
+ if (*s == '/' && *(s+1) == '/') {
+
+ s = strchr(s, '\n');
+ if (!s) {
+ luaL_error(L, "non-terminated comment");
+ }
+
+ } else if (*s == '/' && *(s+1) == '*') {
+ s += 2;
+
+ for (;;) {
+ if (s[0] == '\0') {
+ luaL_error(L, "non-terminated comment");
+ } else if (s[0] == '*' && s[1] == '/') {
+ s += 2;
+ break;
+ } else if (s[0] == '\n') {
+ P->line++;
+ }
+ s++;
+ }
+
+ } else if (*s == '\0') {
+ tok->type = TOK_NIL;
+ return 0;
+
+ } else {
+ break;
+ }
+ }
+
+ P->prev = s;
+
+ for (i = 0; i < sizeof(tok3) / sizeof(tok3[0]); i++) {
+ if (s[0] == tok3[i][0] && s[1] == tok3[i][1] && s[2] == tok3[i][2]) {
+ tok->type = (enum etoken) (TOK_3_BEGIN + 1 + i);
+ P->next = s + 3;
+ goto end;
+ }
+ }
+
+ for (i = 0; i < sizeof(tok2) / sizeof(tok2[0]); i++) {
+ if (s[0] == tok2[i][0] && s[1] == tok2[i][1]) {
+ tok->type = (enum etoken) (TOK_2_BEGIN + 1 + i);
+ P->next = s + 2;
+ goto end;
+ }
+ }
+
+ for (i = 0; i < sizeof(tok1) / sizeof(tok1[0]); i++) {
+ if (s[0] == tok1[i]) {
+ tok->type = (enum etoken) (TOK_1_BEGIN + 1 + i);
+ P->next = s + 1;
+ goto end;
+ }
+ }
+
+ if (*s == '.' || *s == '-' || ('0' <= *s && *s <= '9')) {
+ /* number */
+ tok->type = TOK_NUMBER;
+
+ /* split out the negative case so we get the full range of bits for
+ * unsigned (eg to support 0xFFFFFFFF where sizeof(long) == 4)
+ */
+ if (*s == '-') {
+ tok->integer = strtol(s, (char**) &s, 0);
+ } else {
+ tok->integer = strtoul(s, (char**) &s, 0);
+ }
+
+ while (*s == 'u' || *s == 'U' || *s == 'l' || *s == 'L') {
+ s++;
+ }
+
+ P->next = s;
+ goto end;
+
+ } else if (*s == '\'' || *s == '\"') {
+ /* "..." or '...' */
+ char quote = *s;
+ s++; /* jump over " */
+
+ tok->type = TOK_STRING;
+ tok->str = s;
+
+ while (*s != quote) {
+
+ if (*s == '\0' || (*s == '\\' && *(s+1) == '\0')) {
+ return luaL_error(L, "string not finished");
+ }
+
+ if (*s == '\\') {
+ s++;
+ }
+
+ s++;
+ }
+
+ tok->size = s - tok->str;
+ s++; /* jump over " */
+ P->next = s;
+ goto end;
+
+ } else if (('a' <= *s && *s <= 'z') || ('A' <= *s && *s <= 'Z') || *s == '_') {
+ /* tokens */
+ tok->type = TOK_TOKEN;
+ tok->str = s;
+
+ while (('a' <= *s && *s <= 'z') || ('A' <= *s && *s <= 'Z') || *s == '_' || ('0' <= *s && *s <= '9')) {
+ s++;
+ }
+
+ tok->size = s - tok->str;
+ P->next = s;
+ goto end;
+
+ } else {
+ return luaL_error(L, "invalid character %d", P->line);
+ }
+
+end:
+ /*fprintf(stderr, "token %d %d %.*s %.10s\n", tok->type, (int) tok->size, (tok->type == TOK_TOKEN || tok->type == TOK_STRING) ? (int) tok->size : 0, tok->str, P->next);*/
+ return 1;
+}
+
+#define require_token(L, P, tok) require_token_line(L, P, tok, __FILE__, __LINE__)
+
+static void require_token_line(lua_State* L, struct parser* P, struct token* tok, const char* file, int line)
+{
+ if (!next_token(L, P, tok)) {
+ luaL_error(L, "unexpected end on line %s:%d", file, line);
+ }
+}
+
+static void check_token(lua_State* L, struct parser* P, int type, const char* str, const char* err, ...)
+{
+ struct token tok;
+ if (!next_token(L, P, &tok) || tok.type != type || (tok.type == TOK_TOKEN && (tok.size != strlen(str) || memcmp(tok.str, str, tok.size) != 0))) {
+ va_list ap;
+ va_start(ap, err);
+ lua_pushvfstring(L, err, ap);
+ lua_error(L);
+ }
+}
+
+static void put_back(struct parser* P)
+{ P->next = P->prev; }
+
+
+int64_t calculate_constant(lua_State* L, struct parser* P);
+
+static int g_name_key;
+static int g_front_name_key;
+static int g_back_name_key;
+
+#ifndef max
+#define max(a,b) ((a) < (b) ? (b) : (a))
+#endif
+
+#ifndef min
+#define min(a,b) ((a) < (b) ? (a) : (b))
+#endif
+
+enum test {TEST};
+
+/* Parses an enum definition from after the open curly through to the close
+ * curly. Expects the user table to be on the top of the stack
+ */
+static int parse_enum(lua_State* L, struct parser* P, struct ctype* type)
+{
+ struct token tok;
+ int value = -1;
+ int ct_usr = lua_gettop(L);
+
+ for (;;) {
+ require_token(L, P, &tok);
+
+ assert(lua_gettop(L) == ct_usr);
+
+ if (tok.type == TOK_CLOSE_CURLY) {
+ break;
+ } else if (tok.type != TOK_TOKEN) {
+ return luaL_error(L, "unexpected token in enum at line %d", P->line);
+ }
+
+ lua_pushlstring(L, tok.str, tok.size);
+
+ require_token(L, P, &tok);
+
+ if (tok.type == TOK_COMMA || tok.type == TOK_CLOSE_CURLY) {
+ /* we have an auto calculated enum value */
+ value++;
+ } else if (tok.type == TOK_ASSIGN) {
+ /* we have an explicit enum value */
+ value = (int) calculate_constant(L, P);
+ require_token(L, P, &tok);
+ } else {
+ return luaL_error(L, "unexpected token in enum at line %d", P->line);
+ }
+
+ assert(lua_gettop(L) == ct_usr + 1);
+
+ /* add the enum value to the constants table */
+ push_upval(L, &constants_key);
+ lua_pushvalue(L, -2);
+ lua_pushinteger(L, value);
+ lua_rawset(L, -3);
+ lua_pop(L, 1);
+
+ assert(lua_gettop(L) == ct_usr + 1);
+
+ /* add the enum value to the enum usr value table */
+ lua_pushinteger(L, value);
+ lua_rawset(L, ct_usr);
+
+ if (tok.type == TOK_CLOSE_CURLY) {
+ break;
+ } else if (tok.type != TOK_COMMA) {
+ return luaL_error(L, "unexpected token in enum at line %d", P->line);
+ }
+ }
+
+ type->base_size = sizeof(enum test);
+ type->align_mask = sizeof(enum test) - 1;
+
+ assert(lua_gettop(L) == ct_usr);
+ return 0;
+}
+
+static void calculate_member_position(lua_State* L, struct parser* P, struct ctype* ct, struct ctype* mt, int* pbit_offset, int* pbitfield_type)
+{
+ int bit_offset = *pbit_offset;
+
+ if (ct->type == UNION_TYPE) {
+ size_t msize;
+
+ if (mt->is_variable_struct || mt->is_variable_array) {
+ luaL_error(L, "NYI: variable sized members in unions");
+ return;
+
+ } else if (mt->is_bitfield) {
+ msize = (mt->align_mask + 1);
+#ifdef _WIN32
+ /* MSVC has a bug where it doesn't update the alignment of
+ * a union for bitfield members. */
+ mt->align_mask = 0;
+#endif
+
+ } else if (mt->is_array) {
+ msize = mt->array_size * (mt->pointers > 1 ? sizeof(void*) : mt->base_size);
+
+ } else {
+ msize = mt->pointers ? sizeof(void*) : mt->base_size;
+ }
+
+ ct->base_size = max(ct->base_size, msize);
+
+ } else if (mt->is_bitfield) {
+ if (mt->has_member_name && mt->bit_size == 0) {
+ luaL_error(L, "zero length bitfields must be unnamed on line %d", P->line);
+ }
+
+#if defined _WIN32
+ /* MSVC uses a seperate storage unit for each size. This is aligned
+ * before the first bitfield. :0 finishes up the storage unit using
+ * the greater alignment of the storage unit or the type used with the
+ * :0. This is equivalent to the :0 always creating a new storage
+ * unit, but not necesserily using it yet.
+ */
+
+ if (*pbitfield_type == -1 && mt->bit_size == 0) {
+ /* :0 not after a bitfield are ignored */
+ return;
+ }
+
+ {
+ int different_storage = mt->align_mask != *pbitfield_type;
+ int no_room_left = bit_offset + mt->bit_size > (mt->align_mask + 1) * CHAR_BIT;
+
+ if (different_storage || no_room_left || !mt->bit_size) {
+ ct->base_size += (bit_offset + CHAR_BIT - 1) / CHAR_BIT;
+ bit_offset = 0;
+ if (*pbitfield_type >= 0) {
+ ct->base_size = ALIGN_UP(ct->base_size, *pbitfield_type);
+ }
+ ct->base_size = ALIGN_UP(ct->base_size, mt->align_mask);
+ }
+ }
+
+ mt->bit_offset = bit_offset;
+ mt->offset = ct->base_size;
+
+ *pbitfield_type = mt->align_mask;
+ bit_offset += mt->bit_size;
+
+// #elif defined OS_OSX
+// /* OSX doesn't use containers and bitfields are not aligned. So
+// * bitfields never add any padding, except for :0 which still forces
+// * an alignment based off the type used with the :0 */
+// if (mt->bit_size) {
+// mt->offset = ct->base_size;
+// mt->bit_offset = bit_offset;
+// bit_offset += mt->bit_size;
+// ct->base_size += bit_offset / CHAR_BIT;
+// bit_offset = bit_offset % CHAR_BIT;
+// } else {
+// ct->base_size += (bit_offset + CHAR_BIT - 1) / CHAR_BIT;
+// ct->base_size = ALIGN_UP(ct->base_size, mt->align_mask);
+// bit_offset = 0;
+// }
+
+// if (!mt->has_member_name) {
+// /* unnamed bitfields don't update the struct alignment */
+// mt->align_mask = 0;
+// }
+
+#elif defined __GNUC__
+ /* GCC tries to pack bitfields in as close as much as possible, but
+ * still making sure that they don't cross alignment boundaries.
+ * :0 forces an alignment based off the type used with the :0
+ */
+
+ int bits_used = (ct->base_size - ALIGN_DOWN(ct->base_size, mt->align_mask)) * CHAR_BIT + bit_offset;
+ int need_to_realign = bits_used + mt->bit_size > mt->base_size * CHAR_BIT;
+
+ if (!mt->is_packed && (!mt->bit_size || need_to_realign)) {
+ ct->base_size += (bit_offset + CHAR_BIT - 1) / CHAR_BIT;
+ ct->base_size = ALIGN_UP(ct->base_size, mt->align_mask);
+ bit_offset = 0;
+ }
+
+ mt->bit_offset = bit_offset;
+ mt->offset = ct->base_size;
+
+ bit_offset += mt->bit_size;
+ ct->base_size += bit_offset / CHAR_BIT;
+ bit_offset = bit_offset % CHAR_BIT;
+
+ /* unnamed bitfields don't update the struct alignment */
+ if (!mt->has_member_name) {
+ mt->align_mask = 0;
+ }
+#else
+#error
+#endif
+
+ } else {
+ /* finish up the current bitfield storage unit */
+ ct->base_size += (bit_offset + CHAR_BIT - 1) / CHAR_BIT;
+ bit_offset = 0;
+
+ if (*pbitfield_type >= 0) {
+ ct->base_size = ALIGN_UP(ct->base_size, *pbitfield_type);
+ }
+
+ *pbitfield_type = -1;
+
+ ct->base_size = ALIGN_UP(ct->base_size, mt->align_mask);
+ mt->offset = ct->base_size;
+
+ if (mt->is_variable_array) {
+ ct->is_variable_struct = 1;
+ ct->variable_increment = mt->pointers > 1 ? sizeof(void*) : mt->base_size;
+
+ } else if (mt->is_variable_struct) {
+ assert(!mt->variable_size_known && !mt->is_array && !mt->pointers);
+ ct->base_size += mt->base_size;
+ ct->is_variable_struct = 1;
+ ct->variable_increment = mt->variable_increment;
+
+ } else if (mt->is_array) {
+ ct->base_size += mt->array_size * (mt->pointers > 1 ? sizeof(void*) : mt->base_size);
+
+ } else {
+ ct->base_size += mt->pointers ? sizeof(void*) : mt->base_size;
+ }
+ }
+
+ /* increase the outer struct/union alignment if needed */
+ if (mt->align_mask > (int) ct->align_mask) {
+ ct->align_mask = mt->align_mask;
+ }
+
+ if (mt->has_bitfield || mt->is_bitfield) {
+ ct->has_bitfield = 1;
+ }
+
+ *pbit_offset = bit_offset;
+}
+
+static int copy_submembers(lua_State* L, int to_usr, int from_usr, const struct ctype* ft, int* midx)
+{
+ struct ctype ct;
+ int i, sublen;
+
+ from_usr = lua_absindex(L, from_usr);
+ to_usr = lua_absindex(L, to_usr);
+
+ /* integer keys */
+ sublen = (int) lua_rawlen(L, from_usr);
+ for (i = 1; i <= sublen; i++) {
+ lua_rawgeti(L, from_usr, i);
+
+ ct = *(const struct ctype*) lua_touserdata(L, -1);
+ ct.offset += ft->offset;
+ lua_getuservalue(L, -1);
+
+ push_ctype(L, -1, &ct);
+ lua_rawseti(L, to_usr, (*midx)++);
+
+ lua_pop(L, 2); /* ctype, user value */
+ }
+
+ /* string keys */
+ lua_pushnil(L);
+ while (lua_next(L, from_usr)) {
+ if (lua_type(L, -2) == LUA_TSTRING) {
+ struct ctype ct = *(const struct ctype*) lua_touserdata(L, -1);
+ ct.offset += ft->offset;
+ lua_getuservalue(L, -1);
+
+ /* uservalue[sub_mname] = new_sub_mtype */
+ lua_pushvalue(L, -3);
+ push_ctype(L, -2, &ct);
+ lua_rawset(L, to_usr);
+
+ lua_pop(L, 1); /* remove submember user value */
+ }
+ lua_pop(L, 1);
+ }
+
+ return 0;
+}
+
+static int add_member(lua_State* L, int ct_usr, int mname, int mbr_usr, const struct ctype* mt, int* midx)
+{
+ ct_usr = lua_absindex(L, ct_usr);
+ mname = lua_absindex(L, mname);
+
+ push_ctype(L, mbr_usr, mt);
+
+ /* usrvalue[mbr index] = pushed mtype */
+ lua_pushvalue(L, -1);
+ lua_rawseti(L, ct_usr, (*midx)++);
+
+ /* set usrvalue[mname] = pushed mtype */
+ lua_pushvalue(L, mname);
+ lua_pushvalue(L, -2);
+ lua_rawset(L, ct_usr);
+
+ /* set usrvalue[mtype] = mname */
+ lua_pushvalue(L, -1);
+ lua_pushvalue(L, mname);
+ lua_rawset(L, ct_usr);
+
+ lua_pop(L, 1);
+
+ return 0;
+}
+
+/* Parses a struct from after the open curly through to the close curly.
+ */
+static int parse_struct(lua_State* L, struct parser* P, int tmp_usr, const struct ctype* ct)
+{
+ struct token tok;
+ int midx = 1;
+ int top = lua_gettop(L);
+
+ tmp_usr = lua_absindex(L, tmp_usr);
+
+ /* parse members */
+ for (;;) {
+ struct ctype mbase;
+
+ assert(lua_gettop(L) == top);
+
+ /* see if we're at the end of the struct */
+ require_token(L, P, &tok);
+ if (tok.type == TOK_CLOSE_CURLY) {
+ break;
+ } else if (ct->is_variable_struct) {
+ return luaL_error(L, "can't have members after a variable sized member on line %d", P->line);
+ } else {
+ put_back(P);
+ }
+
+ /* members are of the form
+ * <base type> <arg>, <arg>, <arg>;
+ * eg struct foo bar, *bar2[2];
+ * mbase is 'struct foo'
+ * mtype is '' then '*[2]'
+ * mname is 'bar' then 'bar2'
+ */
+
+ parse_type(L, P, &mbase);
+
+ for (;;) {
+ struct token mname;
+ struct ctype mt = mbase;
+
+ memset(&mname, 0, sizeof(mname));
+
+ if (ct->is_variable_struct) {
+ return luaL_error(L, "can't have members after a variable sized member on line %d", P->line);
+ }
+
+ assert(lua_gettop(L) == top + 1);
+ parse_argument(L, P, -1, &mt, &mname, NULL);
+ assert(lua_gettop(L) == top + 2);
+
+ if (!mt.is_defined && (mt.pointers - mt.is_array) == 0) {
+ return luaL_error(L, "member type is undefined on line %d", P->line);
+ }
+
+ if (mt.type == VOID_TYPE && (mt.pointers - mt.is_array) == 0) {
+ return luaL_error(L, "member type can not be void on line %d", P->line);
+ }
+
+ mt.has_member_name = (mname.size > 0);
+ lua_pushlstring(L, mname.str, mname.size);
+
+ add_member(L, tmp_usr, -1, -2, &mt, &midx);
+
+ /* pop the usr value from push_argument and the member name */
+ lua_pop(L, 2);
+ assert(lua_gettop(L) == top + 1);
+
+ require_token(L, P, &tok);
+ if (tok.type == TOK_SEMICOLON) {
+ break;
+ } else if (tok.type != TOK_COMMA) {
+ luaL_error(L, "unexpected token in struct definition on line %d", P->line);
+ }
+ }
+
+ /* pop the usr value from push_type */
+ lua_pop(L, 1);
+ }
+
+ assert(lua_gettop(L) == top);
+ return 0;
+}
+
+static int calculate_struct_offsets(lua_State* L, struct parser* P, int ct_usr, struct ctype* ct, int tmp_usr)
+{
+ int i;
+ int midx = 1;
+ int sz = (int) lua_rawlen(L, tmp_usr);
+ int bit_offset = 0;
+ int bitfield_type = -1;
+
+ ct_usr = lua_absindex(L, ct_usr);
+ tmp_usr = lua_absindex(L, tmp_usr);
+
+ for (i = 1; i <= sz; i++) {
+ struct ctype mt;
+
+ /* get the member type */
+ lua_rawgeti(L, tmp_usr, i);
+ mt = *(const struct ctype*) lua_touserdata(L, -1);
+
+ /* get the member user table */
+ lua_getuservalue(L, -1);
+
+ /* get the member name */
+ lua_pushvalue(L, -2);
+ lua_rawget(L, tmp_usr);
+
+ calculate_member_position(L, P, ct, &mt, &bit_offset, &bitfield_type);
+
+ if (mt.has_member_name) {
+ assert(!lua_isnil(L, -1));
+ add_member(L, ct_usr, -1, -2, &mt, &midx);
+
+ } else if (mt.type == STRUCT_TYPE || mt.type == UNION_TYPE) {
+ /* With an unnamed member we copy all of the submembers into our
+ * usr value adjusting the offset as necessary. Note ctypes are
+ * immutable so need to push a new ctype to update the offset.
+ */
+ copy_submembers(L, ct_usr, -2, &mt, &midx);
+
+ } else {
+ /* We ignore unnamed members that aren't structs or unions. These
+ * are there just to change the padding */
+ }
+
+ lua_pop(L, 3);
+ }
+
+ /* finish up the current bitfield storage unit */
+ ct->base_size += (bit_offset + CHAR_BIT - 1) / CHAR_BIT;
+
+ /* only void is allowed 0 size */
+ if (ct->base_size == 0) {
+ ct->base_size = 1;
+ }
+
+ ct->base_size = ALIGN_UP(ct->base_size, ct->align_mask);
+ return 0;
+}
+
+/* copy over attributes that could be specified before the typedef eg
+ * __attribute__(packed) const type_t */
+static void instantiate_typedef(struct parser* P, struct ctype* tt, const struct ctype* ft)
+{
+ struct ctype pt = *tt;
+ *tt = *ft;
+
+ tt->const_mask |= pt.const_mask;
+ tt->is_packed = pt.is_packed;
+
+ if (tt->is_packed) {
+ tt->align_mask = 0;
+ } else {
+ /* Instantiate the typedef in the current packing. This may be
+ * further updated if a pointer is added or another alignment
+ * attribute is applied. If pt.align_mask is already non-zero than an
+ * increased alignment via __declspec(aligned(#)) has been set. */
+ tt->align_mask = max(min(P->align_mask, tt->align_mask), pt.align_mask);
+ }
+}
+
+/* this parses a struct or union starting with the optional
+ * name before the opening brace
+ * leaves the type usr value on the stack
+ */
+static int parse_record(lua_State* L, struct parser* P, struct ctype* ct)
+{
+ struct token tok;
+ int top = lua_gettop(L);
+
+ require_token(L, P, &tok);
+
+ /* name is optional */
+ if (tok.type == TOK_TOKEN) {
+ /* declaration */
+ lua_pushlstring(L, tok.str, tok.size);
+
+ assert(lua_gettop(L) == top+1);
+
+ /* lookup the name to see if we've seen this type before */
+ push_upval(L, &types_key);
+ lua_pushvalue(L, -2);
+ lua_rawget(L, top+2);
+
+ assert(lua_gettop(L) == top+3);
+
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1); /* pop the nil usr value */
+ lua_newtable(L); /* the new usr table */
+
+ /* stack layout is:
+ * top+1: record name
+ * top+2: types table
+ * top+3: new usr table
+ */
+
+ lua_pushlightuserdata(L, &g_name_key);
+ lua_pushvalue(L, top+1);
+ lua_rawset(L, top+3); /* usr[name_key] = name */
+
+ lua_pushvalue(L, top+1);
+ push_ctype(L, top+3, ct);
+ lua_rawset(L, top+2); /* types[name] = new_ctype */
+
+ } else {
+ /* get the exsting declared type */
+ const struct ctype* prevt = (const struct ctype*) lua_touserdata(L, top+3);
+
+ if (prevt->type != ct->type) {
+ lua_getuservalue(L, top+3);
+ push_type_name(L, -1, ct);
+ push_type_name(L, top+3, prevt);
+ luaL_error(L, "type '%s' previously declared as '%s'", lua_tostring(L, -2), lua_tostring(L, -1));
+ }
+
+ instantiate_typedef(P, ct, prevt);
+
+ /* replace the ctype with its usr value */
+ lua_getuservalue(L, -1);
+ lua_replace(L, -2);
+ }
+
+ /* remove the extra name and types table */
+ lua_replace(L, -3);
+ lua_pop(L, 1);
+
+ assert(lua_gettop(L) == top + 1 && lua_istable(L, -1));
+
+ /* if a name is given then we may be at the end of the string
+ * eg for ffi.new('struct foo')
+ */
+ if (!next_token(L, P, &tok)) {
+ return 0;
+ }
+
+ } else {
+ /* create a new unnamed record */
+ int num;
+
+ /* get the next unnamed number */
+ push_upval(L, &next_unnamed_key);
+ num = lua_tointeger(L, -1);
+ lua_pop(L, 1);
+
+ /* increment the unnamed upval */
+ lua_pushinteger(L, num + 1);
+ set_upval(L, &next_unnamed_key);
+
+ lua_newtable(L); /* the new usr table - leave on stack */
+
+ /* usr[name_key] = num */
+ lua_pushlightuserdata(L, &g_name_key);
+ lua_pushfstring(L, "%d", num);
+ lua_rawset(L, -3);
+ }
+
+ if (tok.type != TOK_OPEN_CURLY) {
+ /* this may just be a declaration or use of the type as an argument or
+ * member */
+ put_back(P);
+ return 0;
+ }
+
+ if (ct->is_defined) {
+ return luaL_error(L, "redefinition in line %d", P->line);
+ }
+
+ assert(lua_gettop(L) == top + 1 && lua_istable(L, -1));
+
+ if (ct->type == ENUM_TYPE) {
+ parse_enum(L, P, ct);
+ } else {
+ /* we do a two stage parse, where we parse the content first and build up
+ * the temp user table. We then iterate over that to calculate the offsets
+ * and fill out ct_usr. This is so we can handle out of order members
+ * (eg vtable) and attributes specified at the end of the struct.
+ */
+ lua_newtable(L);
+ parse_struct(L, P, -1, ct);
+ calculate_struct_offsets(L, P, -2, ct, -1);
+ assert(lua_gettop(L) == top + 2 && lua_istable(L, -1));
+ lua_pop(L, 1);
+ }
+
+ assert(lua_gettop(L) == top + 1 && lua_istable(L, -1));
+ set_defined(L, -1, ct);
+ assert(lua_gettop(L) == top + 1);
+ return 0;
+}
+
+/* parses single or multi work built in types, and pushes it onto the stack */
+static int parse_type_name(lua_State* L, struct parser* P)
+{
+ struct token tok;
+ int flags = 0;
+
+ enum {
+ UNSIGNED = 0x01,
+ SIGNED = 0x02,
+ LONG = 0x04,
+ SHORT = 0x08,
+ INT = 0x10,
+ CHAR = 0x20,
+ LONG_LONG = 0x40,
+ INT8 = 0x80,
+ INT16 = 0x100,
+ INT32 = 0x200,
+ INT64 = 0x400,
+ DOUBLE = 0x800,
+ FLOAT = 0x1000,
+ COMPLEX = 0x2000,
+ };
+
+ require_token(L, P, &tok);
+
+ /* we have to manually decode the builtin types since they can take up
+ * more then one token
+ */
+ for (;;) {
+ if (tok.type != TOK_TOKEN) {
+ break;
+ } else if (IS_LITERAL(tok, "unsigned")) {
+ flags |= UNSIGNED;
+ } else if (IS_LITERAL(tok, "signed")) {
+ flags |= SIGNED;
+ } else if (IS_LITERAL(tok, "short")) {
+ flags |= SHORT;
+ } else if (IS_LITERAL(tok, "char")) {
+ flags |= CHAR;
+ } else if (IS_LITERAL(tok, "long")) {
+ flags |= (flags & LONG) ? LONG_LONG : LONG;
+ } else if (IS_LITERAL(tok, "int")) {
+ flags |= INT;
+ } else if (IS_LITERAL(tok, "__int8")) {
+ flags |= INT8;
+ } else if (IS_LITERAL(tok, "__int16")) {
+ flags |= INT16;
+ } else if (IS_LITERAL(tok, "__int32")) {
+ flags |= INT32;
+ } else if (IS_LITERAL(tok, "__int64")) {
+ flags |= INT64;
+ } else if (IS_LITERAL(tok, "double")) {
+ flags |= DOUBLE;
+ } else if (IS_LITERAL(tok, "float")) {
+ flags |= FLOAT;
+ } else if (IS_LITERAL(tok, "complex") || IS_LITERAL(tok, "_Complex")) {
+ flags |= COMPLEX;
+ } else if (IS_LITERAL(tok, "register")) {
+ /* ignore */
+ } else {
+ break;
+ }
+
+ if (!next_token(L, P, &tok)) {
+ break;
+ }
+ }
+
+ if (flags) {
+ put_back(P);
+ }
+
+ if (flags & CHAR) {
+ if (flags & SIGNED) {
+ lua_pushliteral(L, "int8_t");
+ } else if (flags & UNSIGNED) {
+ lua_pushliteral(L, "uint8_t");
+ } else {
+ lua_pushstring(L, (((char) -1) > 0) ? "uint8_t" : "int8_t");
+ }
+
+ } else if (flags & INT8) {
+ lua_pushstring(L, (flags & UNSIGNED) ? "uint8_t" : "int8_t");
+ } else if (flags & INT16) {
+ lua_pushstring(L, (flags & UNSIGNED) ? "uint16_t" : "int16_t");
+ } else if (flags & INT32) {
+ lua_pushstring(L, (flags & UNSIGNED) ? "uint32_t" : "int32_t");
+ } else if (flags & (INT64 | LONG_LONG)) {
+ lua_pushstring(L, (flags & UNSIGNED) ? "uint64_t" : "int64_t");
+
+ } else if (flags & COMPLEX) {
+ if (flags & LONG) {
+ lua_pushliteral(L, "complex long double");
+ } else if (flags & FLOAT) {
+ lua_pushliteral(L, "complex float");
+ } else {
+ lua_pushliteral(L, "complex double");
+ }
+
+ } else if (flags & DOUBLE) {
+ if (flags & LONG) {
+ lua_pushliteral(L, "long double");
+ } else {
+ lua_pushliteral(L, "double");
+ }
+
+ } else if (flags & FLOAT) {
+ lua_pushliteral(L, "float");
+
+ } else if (flags & SHORT) {
+#define SHORT_TYPE(u) (sizeof(short) == sizeof(int64_t) ? u "int64_t" : sizeof(short) == sizeof(int32_t) ? u "int32_t" : u "int16_t")
+ if (flags & UNSIGNED) {
+ lua_pushstring(L, SHORT_TYPE("u"));
+ } else {
+ lua_pushstring(L, SHORT_TYPE(""));
+ }
+#undef SHORT_TYPE
+
+ } else if (flags & LONG) {
+#define LONG_TYPE(u) (sizeof(long) == sizeof(int64_t) ? u "int64_t" : u "int32_t")
+ if (flags & UNSIGNED) {
+ lua_pushstring(L, LONG_TYPE("u"));
+ } else {
+ lua_pushstring(L, LONG_TYPE(""));
+ }
+#undef LONG_TYPE
+
+ } else if (flags) {
+#define INT_TYPE(u) (sizeof(int) == sizeof(int64_t) ? u "int64_t" : sizeof(int) == sizeof(int32_t) ? u "int32_t" : u "int16_t")
+ if (flags & UNSIGNED) {
+ lua_pushstring(L, INT_TYPE("u"));
+ } else {
+ lua_pushstring(L, INT_TYPE(""));
+ }
+#undef INT_TYPE
+
+ } else {
+ lua_pushlstring(L, tok.str, tok.size);
+ }
+
+ return 0;
+}
+
+/* parse_attribute parses a token to see if it is an attribute. It may then
+ * parse some following tokens to decode the attribute setting the appropriate
+ * fields in ct. It will return 1 if the token was used (and possibly some
+ * more following it) or 0 if not. If the token was used, the next token must
+ * be retrieved using next_token/require_token.
+ */
+static int parse_attribute(lua_State* L, struct parser* P, struct token* tok, struct ctype* ct, struct parser* asmname)
+{
+ if (tok->type != TOK_TOKEN) {
+ return 0;
+
+ } else if (asmname && (IS_LITERAL(*tok, "__asm__") || IS_LITERAL(*tok, "__asm"))) {
+ check_token(L, P, TOK_OPEN_PAREN, NULL, "unexpected token after __asm__ on line %d", P->line);
+ *asmname = *P;
+
+ require_token(L, P, tok);
+ while (tok->type == TOK_STRING) {
+ require_token(L, P, tok);
+ }
+
+ if (tok->type != TOK_CLOSE_PAREN) {
+ luaL_error(L, "unexpected token after __asm__ on line %d", P->line);
+ }
+ return 1;
+
+ } else if (IS_LITERAL(*tok, "__attribute__") || IS_LITERAL(*tok, "__declspec")) {
+ int parens = 1;
+ check_token(L, P, TOK_OPEN_PAREN, NULL, "expected parenthesis after __attribute__ or __declspec on line %d", P->line);
+
+ for (;;) {
+ require_token(L, P, tok);
+ if (tok->type == TOK_OPEN_PAREN) {
+ parens++;
+ } else if (tok->type == TOK_CLOSE_PAREN) {
+ if (--parens == 0) {
+ break;
+ }
+
+ } else if (tok->type != TOK_TOKEN) {
+ /* ignore unknown symbols within parentheses */
+
+ } else if (IS_LITERAL(*tok, "align") || IS_LITERAL(*tok, "aligned") || IS_LITERAL(*tok, "__aligned__")) {
+ unsigned align = 0;
+ require_token(L, P, tok);
+
+ switch (tok->type) {
+ case TOK_CLOSE_PAREN:
+ align = ALIGNED_DEFAULT;
+ put_back(P);
+ break;
+
+ case TOK_OPEN_PAREN:
+ require_token(L, P, tok);
+
+ if (tok->type != TOK_NUMBER) {
+ luaL_error(L, "expected align(#) on line %d", P->line);
+ }
+
+ switch (tok->integer) {
+ case 1: align = 0; break;
+ case 2: align = 1; break;
+ case 4: align = 3; break;
+ case 8: align = 7; break;
+ case 16: align = 15; break;
+ default:
+ luaL_error(L, "unsupported align size on line %d", P->line);
+ }
+
+ check_token(L, P, TOK_CLOSE_PAREN, NULL, "expected align(#) on line %d", P->line);
+ break;
+
+ default:
+ luaL_error(L, "expected align(#) on line %d", P->line);
+ }
+
+ /* __attribute__(aligned(#)) is only supposed to increase alignment */
+ ct->align_mask = max(align, ct->align_mask);
+
+ } else if (IS_LITERAL(*tok, "packed") || IS_LITERAL(*tok, "__packed__")) {
+ ct->align_mask = 0;
+ ct->is_packed = 1;
+
+ } else if (IS_LITERAL(*tok, "mode") || IS_LITERAL(*tok, "__mode__")) {
+
+ check_token(L, P, TOK_OPEN_PAREN, NULL, "expected mode(MODE) on line %d", P->line);
+
+ require_token(L, P, tok);
+ if (tok->type != TOK_TOKEN) {
+ luaL_error(L, "expected mode(MODE) on line %d", P->line);
+ }
+
+ if (ct->type == FLOAT_TYPE || ct->type == DOUBLE_TYPE) {
+ struct {char ch; float v;} af;
+ struct {char ch; double v;} ad;
+
+ if (IS_LITERAL(*tok, "SF") || IS_LITERAL(*tok, "__SF__")) {
+ ct->type = FLOAT_TYPE;
+ ct->base_size = sizeof(float);
+ ct->align_mask = ALIGNOF(af);
+
+ } else if (IS_LITERAL(*tok, "DF") || IS_LITERAL(*tok, "__DF__")) {
+ ct->type = DOUBLE_TYPE;
+ ct->base_size = sizeof(double);
+ ct->align_mask = ALIGNOF(ad);
+
+ } else {
+ luaL_error(L, "unexpected mode on line %d", P->line);
+ }
+
+ } else {
+ struct {char ch; uint16_t v;} a16;
+ struct {char ch; uint32_t v;} a32;
+ struct {char ch; uint64_t v;} a64;
+
+ if (IS_LITERAL(*tok, "QI") || IS_LITERAL(*tok, "__QI__")
+ || IS_LITERAL(*tok, "byte") || IS_LITERAL(*tok, "__byte__")
+ ) {
+ ct->type = INT8_TYPE;
+ ct->base_size = sizeof(uint8_t);
+ ct->align_mask = 0;
+
+ } else if (IS_LITERAL(*tok, "HI") || IS_LITERAL(*tok, "__HI__")) {
+ ct->type = INT16_TYPE;
+ ct->base_size = sizeof(uint16_t);
+ ct->align_mask = ALIGNOF(a16);
+
+ } else if (IS_LITERAL(*tok, "SI") || IS_LITERAL(*tok, "__SI__")
+#if defined ARCH_X86 || defined ARCH_ARM
+ || IS_LITERAL(*tok, "word") || IS_LITERAL(*tok, "__word__")
+ || IS_LITERAL(*tok, "pointer") || IS_LITERAL(*tok, "__pointer__")
+#endif
+ ) {
+ ct->type = INT32_TYPE;
+ ct->base_size = sizeof(uint32_t);
+ ct->align_mask = ALIGNOF(a32);
+
+ } else if (IS_LITERAL(*tok, "DI") || IS_LITERAL(*tok, "__DI__")
+#if defined ARCH_X64 || defined ARCH_PPC64
+ || IS_LITERAL(*tok, "word") || IS_LITERAL(*tok, "__word__")
+ || IS_LITERAL(*tok, "pointer") || IS_LITERAL(*tok, "__pointer__")
+#endif
+ ) {
+ ct->type = INT64_TYPE;
+ ct->base_size = sizeof(uint64_t);
+ ct->align_mask = ALIGNOF(a64);
+
+ } else {
+ luaL_error(L, "unexpected mode on line %d", P->line);
+ }
+ }
+
+ check_token(L, P, TOK_CLOSE_PAREN, NULL, "expected mode(MODE) on line %d", P->line);
+
+ } else if (IS_LITERAL(*tok, "cdecl") || IS_LITERAL(*tok, "__cdecl__")) {
+ ct->calling_convention = C_CALL;
+
+ } else if (IS_LITERAL(*tok, "fastcall") || IS_LITERAL(*tok, "__fastcall__")) {
+ ct->calling_convention = FAST_CALL;
+
+ } else if (IS_LITERAL(*tok, "stdcall") || IS_LITERAL(*tok, "__stdcall__")) {
+ ct->calling_convention = STD_CALL;
+ }
+ /* ignore unknown tokens within parentheses */
+ }
+ return 1;
+
+ } else if (IS_LITERAL(*tok, "__cdecl")) {
+ ct->calling_convention = C_CALL;
+ return 1;
+
+ } else if (IS_LITERAL(*tok, "__fastcall")) {
+ ct->calling_convention = FAST_CALL;
+ return 1;
+
+ } else if (IS_LITERAL(*tok, "__stdcall")) {
+ ct->calling_convention = STD_CALL;
+ return 1;
+
+ } else if (IS_LITERAL(*tok, "__extension__") || IS_LITERAL(*tok, "extern")) {
+ /* ignore */
+ return 1;
+
+ } else {
+ return 0;
+ }
+}
+
+/* parses out the base type of a type expression in a function declaration,
+ * struct definition, typedef etc
+ *
+ * leaves the usr value of the type on the stack
+ */
+int parse_type(lua_State* L, struct parser* P, struct ctype* ct)
+{
+ struct token tok;
+ int top = lua_gettop(L);
+
+ memset(ct, 0, sizeof(*ct));
+
+ require_token(L, P, &tok);
+
+ /* get const/volatile before the base type */
+ for (;;) {
+ if (tok.type != TOK_TOKEN) {
+ return luaL_error(L, "unexpected value before type name on line %d", P->line);
+
+ } else if (IS_CONST(tok)) {
+ ct->const_mask = 1;
+ require_token(L, P, &tok);
+
+ } else if (IS_VOLATILE(tok) ||
+ IS_RESTRICT(tok) ||
+ IS_LITERAL(tok, "static") ||
+ IS_INLINE(tok)) {
+ /* ignored for now */
+ require_token(L, P, &tok);
+ } else if (parse_attribute(L, P, &tok, ct, NULL)) {
+ /* get function attributes before the return type */
+ require_token(L, P, &tok);
+
+ } else {
+ break;
+ }
+ }
+
+ /* get base type */
+ if (tok.type != TOK_TOKEN) {
+ return luaL_error(L, "unexpected value before type name on line %d", P->line);
+
+ } else if (IS_LITERAL(tok, "struct")) {
+ ct->type = STRUCT_TYPE;
+ parse_record(L, P, ct);
+
+ } else if (IS_LITERAL(tok, "union")) {
+ ct->type = UNION_TYPE;
+ parse_record(L, P, ct);
+
+ } else if (IS_LITERAL(tok, "enum")) {
+ ct->type = ENUM_TYPE;
+ parse_record(L, P, ct);
+
+ } else {
+ put_back(P);
+
+ /* lookup type */
+ push_upval(L, &types_key);
+ parse_type_name(L, P);
+ lua_rawget(L, -2);
+ lua_remove(L, -2);
+
+ if (lua_isnil(L, -1)) {
+ lua_pushlstring(L, tok.str, tok.size);
+ return luaL_error(L, "unknown type %s on line %d", lua_tostring(L, -1), P->line);
+ }
+
+ instantiate_typedef(P, ct, (const struct ctype*) lua_touserdata(L, -1));
+
+ /* we only want the usr tbl from the ctype in the types tbl */
+ lua_getuservalue(L, -1);
+ lua_replace(L, -2);
+ }
+
+ while (next_token(L, P, &tok)) {
+ if (tok.type != TOK_TOKEN) {
+ put_back(P);
+ break;
+
+ } else if (IS_CONST(tok) || IS_VOLATILE(tok)) {
+ /* ignore for now */
+
+ } else {
+ put_back(P);
+ break;
+ }
+ }
+
+ assert(lua_gettop(L) == top + 1 && (lua_istable(L, -1) || lua_isnil(L, -1)));
+ return 0;
+}
+
+enum name_type {
+ BOTH,
+ FRONT,
+ BACK,
+};
+
+static void append_type_name(luaL_Buffer* B, int usr, const struct ctype* ct, enum name_type type)
+{
+ size_t i;
+ lua_State* L = B->L;
+
+ usr = lua_absindex(L, usr);
+
+ if (type == FRONT || type == BOTH) {
+ if (ct->type != FUNCTION_PTR_TYPE && (ct->const_mask & (1 << ct->pointers))) {
+ luaL_addstring(B, "const ");
+ }
+
+ if (ct->is_unsigned) {
+ luaL_addstring(B, "unsigned ");
+ }
+
+ switch (ct->type) {
+ case ENUM_TYPE:
+ luaL_addstring(B, "enum ");
+ goto get_name;
+
+ case STRUCT_TYPE:
+ luaL_addstring(B, "struct ");
+ goto get_name;
+
+ case UNION_TYPE:
+ luaL_addstring(B, "union ");
+ goto get_name;
+
+ get_name:
+ lua_pushlightuserdata(L, &g_name_key);
+ lua_rawget(L, usr);
+ luaL_addvalue(B);
+ break;
+
+ case FUNCTION_TYPE:
+ case FUNCTION_PTR_TYPE:
+ lua_pushlightuserdata(L, &g_front_name_key);
+ lua_rawget(L, usr);
+ luaL_addvalue(B);
+ break;
+
+ case VOID_TYPE:
+ luaL_addstring(B, "void");
+ break;
+ case BOOL_TYPE:
+ luaL_addstring(B, "bool");
+ break;
+ case DOUBLE_TYPE:
+ luaL_addstring(B, "double");
+ break;
+ case LONG_DOUBLE_TYPE:
+ luaL_addstring(B, "long double");
+ break;
+ case FLOAT_TYPE:
+ luaL_addstring(B, "float");
+ break;
+ case COMPLEX_LONG_DOUBLE_TYPE:
+ luaL_addstring(B, "long complex double");
+ break;
+ case COMPLEX_DOUBLE_TYPE:
+ luaL_addstring(B, "complex double");
+ break;
+ case COMPLEX_FLOAT_TYPE:
+ luaL_addstring(B, "complex float");
+ break;
+ case INT8_TYPE:
+ luaL_addstring(B, "char");
+ break;
+ case INT16_TYPE:
+ luaL_addstring(B, "short");
+ break;
+ case INT32_TYPE:
+ luaL_addstring(B, "int");
+ break;
+ case INT64_TYPE:
+ luaL_addstring(B, "long long");
+ break;
+
+ case INTPTR_TYPE:
+ if (sizeof(intptr_t) == sizeof(int32_t)) {
+ luaL_addstring(B, "long");
+ } else if (sizeof(intptr_t) == sizeof(int64_t)) {
+ luaL_addstring(B, "long long");
+ } else {
+ luaL_error(L, "internal error - bad type");
+ }
+ break;
+
+ default:
+ luaL_error(L, "internal error - bad type %d", ct->type);
+ }
+
+ for (i = 0; i < ct->pointers - ct->is_array; i++) {
+ luaL_addchar(B, '*');
+ if (ct->const_mask & (1 << (ct->pointers - i - 1))) {
+ luaL_addstring(B, " const");
+ }
+ }
+ }
+
+ if (type == BOTH || type == BACK) {
+ if (ct->is_reference) {
+ luaL_addstring(B, " &");
+ }
+
+ if (ct->is_variable_array && !ct->variable_size_known) {
+ luaL_addstring(B, "[?]");
+ } else if (ct->is_array) {
+ lua_pushfstring(L, "[%d]", (int) ct->array_size);
+ luaL_addvalue(B);
+ }
+
+ if (ct->type == FUNCTION_PTR_TYPE || ct->type == FUNCTION_TYPE) {
+ lua_pushlightuserdata(L, &g_back_name_key);
+ lua_rawget(L, usr);
+ luaL_addvalue(B);
+ }
+
+ if (ct->is_bitfield) {
+ lua_pushfstring(L, " : %d", (int) ct->bit_size);
+ luaL_addvalue(B);
+ }
+ }
+}
+
+void push_type_name(lua_State* L, int usr, const struct ctype* ct)
+{
+ luaL_Buffer B;
+ usr = lua_absindex(L, usr);
+ luaL_buffinit(L, &B);
+ append_type_name(&B, usr, ct, BOTH);
+ luaL_pushresult(&B);
+}
+
+static void push_function_type_strings(lua_State* L, int usr, const struct ctype* ct)
+{
+ size_t i, args;
+ luaL_Buffer B;
+ int top = lua_gettop(L);
+ const struct ctype* ret_ct;
+
+ int arg_ct = top+3;
+ int arg_usr = top+4;
+ int ret_usr = top+6;
+
+ usr = lua_absindex(L, usr);
+
+ /* return type */
+ lua_settop(L, top+4); /* room for two returns and two temp positions */
+ lua_rawgeti(L, usr, 0);
+ lua_getuservalue(L, -1);
+ ret_ct = (const struct ctype*) lua_touserdata(L, -2);
+
+ luaL_buffinit(L, &B);
+ append_type_name(&B, ret_usr, ret_ct, FRONT);
+
+ if (ret_ct->type != FUNCTION_TYPE && ret_ct->type != FUNCTION_PTR_TYPE) {
+ luaL_addchar(&B, ' ');
+ }
+
+ switch (ct->calling_convention) {
+ case STD_CALL:
+ luaL_addstring(&B, "(__stdcall *");
+ break;
+ case FAST_CALL:
+ luaL_addstring(&B, "(__fastcall *");
+ break;
+ case C_CALL:
+ luaL_addstring(&B, "(*");
+ break;
+ default:
+ luaL_error(L, "internal error - unknown calling convention");
+ }
+
+ luaL_pushresult(&B);
+ lua_replace(L, top+1);
+
+ luaL_buffinit(L, &B);
+ luaL_addstring(&B, ")(");
+
+ /* arguments */
+ args = lua_rawlen(L, usr);
+ for (i = 1; i <= args; i++) {
+ if (i > 1) {
+ luaL_addstring(&B, ", ");
+ }
+
+ /* note push the arg and user value below the indexes used by the buffer
+ * and use indexes relative to top to avoid problems due to the buffer
+ * system pushing a variable number of arguments onto the stack */
+ lua_rawgeti(L, usr, (int) i);
+ lua_replace(L, arg_ct);
+ lua_getuservalue(L, arg_ct);
+ lua_replace(L, arg_usr);
+ append_type_name(&B, arg_usr, (const struct ctype*) lua_touserdata(L, arg_ct), BOTH);
+ }
+
+ luaL_addstring(&B, ")");
+ append_type_name(&B, ret_usr, ret_ct, BACK);
+ luaL_pushresult(&B);
+ lua_replace(L, top+2);
+
+ lua_settop(L, top+2);
+ assert(lua_isstring(L, top+1) && lua_isstring(L, top+2));
+}
+
+/* parses from after the opening paranthesis to after the closing parenthesis */
+static void parse_function_arguments(lua_State* L, struct parser* P, int ct_usr, struct ctype* ct)
+{
+ struct token tok;
+ int args = 0;
+ int top = lua_gettop(L);
+
+ ct_usr = lua_absindex(L, ct_usr);
+
+ for (;;) {
+ require_token(L, P, &tok);
+
+ if (tok.type == TOK_CLOSE_PAREN) {
+ break;
+ }
+
+ if (args) {
+ if (tok.type != TOK_COMMA) {
+ luaL_error(L, "unexpected token in function argument %d on line %d", args, P->line);
+ }
+
+ require_token(L, P, &tok);
+ }
+
+ if (tok.type == TOK_VA_ARG) {
+ ct->has_var_arg = true;
+ check_token(L, P, TOK_CLOSE_PAREN, "", "unexpected token after ... in function on line %d", P->line);
+ break;
+
+ } else if (tok.type == TOK_TOKEN) {
+ struct ctype at;
+
+ put_back(P);
+ parse_type(L, P, &at);
+ parse_argument(L, P, -1, &at, NULL, NULL);
+
+ assert(lua_gettop(L) == top + 2);
+
+ /* array arguments are just treated as their base pointer type */
+ at.is_array = 0;
+
+ /* check for the c style int func(void) and error on other uses of arguments of type void */
+ if (at.type == VOID_TYPE && at.pointers == 0) {
+ if (args) {
+ luaL_error(L, "can't have argument of type void on line %d", P->line);
+ }
+
+ check_token(L, P, TOK_CLOSE_PAREN, "", "unexpected void in function on line %d", P->line);
+ lua_pop(L, 2);
+ break;
+ }
+
+ push_ctype(L, -1, &at);
+ lua_rawseti(L, ct_usr, ++args);
+
+ lua_pop(L, 2); /* parse_type and parse_argument at_usr */
+
+ } else {
+ luaL_error(L, "unexpected token in function argument %d on line %d", args+1, P->line);
+ }
+ }
+
+ assert(lua_gettop(L) == top);
+}
+
+static int max_bitfield_size(int type)
+{
+ switch (type) {
+ case BOOL_TYPE:
+ return 1;
+ case INT8_TYPE:
+ return 8;
+ case INT16_TYPE:
+ return 16;
+ case INT32_TYPE:
+ case ENUM_TYPE:
+ return 32;
+ case INT64_TYPE:
+ return 64;
+ default:
+ return -1;
+ }
+}
+
+static struct ctype* parse_argument2(lua_State* L, struct parser* P, int ct_usr, struct ctype* ct, struct token* name, struct parser* asmname);
+
+/* parses from after the first ( in a function declaration or function pointer
+ * can be one of:
+ * void foo(...) before ...
+ * void (foo)(...) before foo
+ * void (* <>)(...) before <> which is the inner type
+ */
+static struct ctype* parse_function(lua_State* L, struct parser* P, int ct_usr, struct ctype* ct, struct token* name, struct parser* asmname)
+{
+ /* We have a function pointer or a function. The usr table will
+ * get replaced by the canonical one (if there is one) in
+ * find_canonical_usr after all the arguments and returns have
+ * been parsed. */
+ struct token tok;
+ int top = lua_gettop(L);
+ struct ctype* ret;
+
+ lua_newtable(L);
+ ret = push_ctype(L, ct_usr, ct);
+ lua_rawseti(L, -2, 0);
+ ct_usr = lua_gettop(L);
+
+ memset(ct, 0, sizeof(*ct));
+ ct->base_size = sizeof(void (*)());
+ ct->align_mask = min(FUNCTION_ALIGN_MASK, P->align_mask);
+ ct->type = FUNCTION_TYPE;
+ ct->is_defined = 1;
+
+ if (name->type == TOK_NIL) {
+ for (;;) {
+ require_token(L, P, &tok);
+
+ if (tok.type == TOK_STAR) {
+
+ if (ct->type == FUNCTION_TYPE) {
+ ct->type = FUNCTION_PTR_TYPE;
+ } else if (ct->pointers == POINTER_MAX) {
+ luaL_error(L, "maximum number of pointer derefs reached - use a struct to break up the pointers on line %d", P->line);
+ } else {
+ ct->pointers++;
+ ct->const_mask <<= 1;
+ }
+
+ } else if (parse_attribute(L, P, &tok, ct, asmname)) {
+ /* parse_attribute sets the appropriate fields */
+
+ } else {
+ /* call parse_argument to handle the inner contents
+ * e.g. the <> in "void (* <>) (...)". Note that the
+ * inner contents can itself be a function, a function
+ * ptr, array, etc (e.g. "void (*signal(int sig, void
+ * (*func)(int)))(int)" ).
+ */
+ put_back(P);
+ ct = parse_argument2(L, P, ct_usr, ct, name, asmname);
+ break;
+ }
+ }
+
+ check_token(L, P, TOK_CLOSE_PAREN, NULL, "unexpected token in function on line %d", P->line);
+ check_token(L, P, TOK_OPEN_PAREN, NULL, "unexpected token in function on line %d", P->line);
+ }
+
+ parse_function_arguments(L, P, ct_usr, ct);
+
+ /* if we have an inner function then set the outer function ptr as its
+ * return type and return the inner function
+ * e.g. for void (* <signal(int, void (*)(int))> )(int) inner is
+ * surrounded by <>, return type is void (*)(int)
+ */
+ if (lua_gettop(L) == ct_usr+1) {
+ lua_replace(L, ct_usr);
+ }
+
+ assert(lua_gettop(L) == top + 1 && lua_istable(L, -1));
+ return ret;
+}
+
+static struct ctype* parse_argument2(lua_State* L, struct parser* P, int ct_usr, struct ctype* ct, struct token* name, struct parser* asmname)
+{
+ struct token tok;
+ int top = lua_gettop(L);
+ int ft_usr = 0;
+
+ luaL_checkstack(L, 10, "function too complex");
+ ct_usr = lua_absindex(L, ct_usr);
+
+ for (;;) {
+ if (!next_token(L, P, &tok)) {
+ /* we've reached the end of the string */
+ break;
+
+ } else if (tok.type == TOK_STAR) {
+ if (ct->pointers == POINTER_MAX) {
+ luaL_error(L, "maximum number of pointer derefs reached - use a struct to break up the pointers on line %d", P->line);
+ }
+
+ ct->pointers++;
+ ct->const_mask <<= 1;
+
+ /* __declspec(align(#)) may come before the type in a member */
+ if (!ct->is_packed) {
+ ct->align_mask = max(min(PTR_ALIGN_MASK, P->align_mask), ct->align_mask);
+ }
+
+ } else if (tok.type == TOK_REFERENCE) {
+ ct->is_reference = 1;
+
+ } else if (parse_attribute(L, P, &tok, ct, asmname)) {
+ /* parse attribute has filled out appropriate fields in type */
+
+ } else if (tok.type == TOK_OPEN_PAREN) {
+ ct = parse_function(L, P, ct_usr, ct, name, asmname);
+ ft_usr = lua_gettop(L);
+
+ } else if (tok.type == TOK_OPEN_SQUARE) {
+ /* array */
+ if (ct->pointers == POINTER_MAX) {
+ luaL_error(L, "maximum number of pointer derefs reached - use a struct to break up the pointers");
+ }
+ ct->is_array = 1;
+ ct->pointers++;
+ ct->const_mask <<= 1;
+ require_token(L, P, &tok);
+
+ if (ct->pointers == 1 && !ct->is_defined) {
+ luaL_error(L, "array of undefined type on line %d", P->line);
+ }
+
+ if (ct->is_variable_struct || ct->is_variable_array) {
+ luaL_error(L, "can't have an array of a variably sized type on line %d", P->line);
+ }
+
+ if (tok.type == TOK_QUESTION) {
+ ct->is_variable_array = 1;
+ ct->variable_increment = (ct->pointers > 1) ? sizeof(void*) : ct->base_size;
+ check_token(L, P, TOK_CLOSE_SQUARE, "", "invalid character in array on line %d", P->line);
+
+ } else if (tok.type == TOK_CLOSE_SQUARE) {
+ ct->array_size = 0;
+
+ } else if (tok.type == TOK_TOKEN && IS_RESTRICT(tok)) {
+ /* odd gcc extension foo[__restrict] for arguments */
+ ct->array_size = 0;
+ check_token(L, P, TOK_CLOSE_SQUARE, "", "invalid character in array on line %d", P->line);
+
+ } else {
+ int64_t asize;
+ put_back(P);
+ asize = calculate_constant(L, P);
+ if (asize < 0) {
+ luaL_error(L, "array size can not be negative on line %d", P->line);
+ }
+ ct->array_size = (size_t) asize;
+ check_token(L, P, TOK_CLOSE_SQUARE, "", "invalid character in array on line %d", P->line);
+ }
+
+ } else if (tok.type == TOK_COLON) {
+ int64_t bsize = calculate_constant(L, P);
+
+ if (ct->pointers || bsize < 0 || bsize > max_bitfield_size(ct->type)) {
+ luaL_error(L, "invalid bitfield on line %d", P->line);
+ }
+
+ ct->is_bitfield = 1;
+ ct->bit_size = (unsigned) bsize;
+
+ } else if (tok.type != TOK_TOKEN) {
+ /* we've reached the end of the declaration */
+ put_back(P);
+ break;
+
+ } else if (IS_CONST(tok)) {
+ ct->const_mask |= 1;
+
+ } else if (IS_VOLATILE(tok) || IS_RESTRICT(tok)) {
+ /* ignored for now */
+
+ } else {
+ *name = tok;
+ }
+ }
+
+ assert((ft_usr == 0 && lua_gettop(L) == top) || (lua_gettop(L) == top + 1 && ft_usr == top + 1 && (lua_istable(L, -1) || lua_isnil(L, -1))));
+ return ct;
+}
+
+static void find_canonical_usr(lua_State* L, int ct_usr, const struct ctype *ct)
+{
+ struct ctype rt;
+ int top = lua_gettop(L);
+ int types;
+
+ if (ct->type != FUNCTION_PTR_TYPE && ct->type != FUNCTION_TYPE) {
+ return;
+ }
+
+ luaL_checkstack(L, 10, "function too complex");
+ ct_usr = lua_absindex(L, ct_usr);
+
+ /* check to see if we already have the canonical usr table */
+ lua_pushlightuserdata(L, &g_name_key);
+ lua_rawget(L, ct_usr);
+ if (!lua_isnil(L, -1)) {
+ lua_pop(L, 1);
+ assert(top == lua_gettop(L));
+ return;
+ }
+ lua_pop(L, 1);
+
+ assert(top == lua_gettop(L));
+
+ /* first canonize the return type */
+ lua_rawgeti(L, ct_usr, 0);
+ rt = *(struct ctype*) lua_touserdata(L, -1);
+ lua_getuservalue(L, -1);
+ find_canonical_usr(L, -1, &rt);
+ push_ctype(L, -1, &rt);
+ lua_rawseti(L, ct_usr, 0);
+ lua_pop(L, 2); /* return ctype and usr */
+
+ assert(top == lua_gettop(L));
+
+ /* look up the type string in the types table */
+ push_upval(L, &types_key);
+ types = lua_gettop(L);
+
+ push_function_type_strings(L, ct_usr, ct);
+ lua_pushvalue(L, -2);
+ lua_pushvalue(L, -2);
+ lua_concat(L, 2);
+
+ lua_pushvalue(L, -1);
+ lua_rawget(L, types);
+
+ assert(lua_gettop(L) == types + 4 && types == top + 1);
+ /* stack: types, front, back, both, looked up value */
+
+ if (lua_isnil(L, -1)) {
+ lua_pop(L, 1);
+
+ lua_pushlightuserdata(L, &g_front_name_key);
+ lua_pushvalue(L, -4);
+ lua_rawset(L, ct_usr);
+
+ lua_pushlightuserdata(L, &g_back_name_key);
+ lua_pushvalue(L, -3);
+ lua_rawset(L, ct_usr);
+
+ lua_pushlightuserdata(L, &g_name_key);
+ lua_pushvalue(L, -2);
+ lua_rawset(L, ct_usr);
+
+ lua_pushvalue(L, -1);
+ push_ctype(L, ct_usr, ct);
+ lua_rawset(L, types);
+ } else {
+ lua_getuservalue(L, -1);
+ lua_replace(L, ct_usr);
+ lua_pop(L, 1);
+ }
+
+ lua_pop(L, 4);
+ assert(top == lua_gettop(L) && types == top + 1);
+}
+
+
+/* parses after the main base type of a typedef, function argument or
+ * struct/union member
+ * eg for const void* bar[3] the base type is void with the subtype so far of
+ * const, this parses the "* bar[3]" and updates the type argument
+ *
+ * ct_usr and type must be as filled out by parse_type
+ *
+ * pushes the updated user value on the top of the stack
+ */
+void parse_argument(lua_State* L, struct parser* P, int ct_usr, struct ctype* ct, struct token* pname, struct parser* asmname)
+{
+ struct token tok, name;
+ int top = lua_gettop(L);
+
+ memset(&name, 0, sizeof(name));
+ parse_argument2(L, P, ct_usr, ct, &name, asmname);
+
+ for (;;) {
+ if (!next_token(L, P, &tok)) {
+ break;
+ } else if (parse_attribute(L, P, &tok, ct, asmname)) {
+ /* parse_attribute sets the appropriate fields */
+ } else {
+ put_back(P);
+ break;
+ }
+ }
+
+ if (lua_gettop(L) == top) {
+ lua_pushvalue(L, ct_usr);
+ }
+
+ find_canonical_usr(L, -1, ct);
+
+ if (pname) {
+ *pname = name;
+ }
+}
+
+static void parse_typedef(lua_State* L, struct parser* P)
+{
+ struct token tok;
+ struct ctype base_type;
+ int top = lua_gettop(L);
+
+ parse_type(L, P, &base_type);
+
+ for (;;) {
+ struct ctype arg_type = base_type;
+ struct token name;
+
+ memset(&name, 0, sizeof(name));
+
+ assert(lua_gettop(L) == top + 1);
+ parse_argument(L, P, -1, &arg_type, &name, NULL);
+ assert(lua_gettop(L) == top + 2);
+
+ if (!name.size) {
+ luaL_error(L, "Can't have a typedef without a name on line %d", P->line);
+ } else if (arg_type.is_variable_array) {
+ luaL_error(L, "Can't typedef a variable length array on line %d", P->line);
+ }
+
+ push_upval(L, &types_key);
+ lua_pushlstring(L, name.str, name.size);
+ push_ctype(L, -3, &arg_type);
+ lua_rawset(L, -3);
+ lua_pop(L, 2); /* types and parse_argument usr tbl */
+
+ require_token(L, P, &tok);
+
+ if (tok.type == TOK_SEMICOLON) {
+ break;
+ } else if (tok.type != TOK_COMMA) {
+ luaL_error(L, "Unexpected character in typedef on line %d", P->line);
+ }
+ }
+
+ lua_pop(L, 1); /* parse_type usr tbl */
+ assert(lua_gettop(L) == top);
+}
+
+static bool is_hex(char ch)
+{ return ('0' <= ch && ch <= '9') || ('a' <= ch && ch <= 'f') || ('A' <= ch && ch <= 'F'); }
+
+static bool is_digit(char ch)
+{ return '0' <= ch && ch <= '9'; }
+
+static int from_hex(char ch)
+{
+ if (ch >= 'a') {
+ return ch - 'a' + 10;
+ } else if (ch >= 'A') {
+ return ch - 'A' + 10;
+ } else {
+ return ch - '0';
+ }
+}
+
+static void push_strings(lua_State* L, struct parser* P)
+{
+ luaL_Buffer B;
+ luaL_buffinit(L, &B);
+
+ for (;;) {
+ const char *p, *e;
+ char *t, *s;
+ struct token tok;
+
+ require_token(L, P, &tok);
+ if (tok.type != TOK_STRING) {
+ break;
+ }
+
+ p = tok.str;
+ e = p + tok.size;
+
+ t = luaL_prepbuffsize(&B, tok.size);
+ s = t;
+
+ while (p < e) {
+ if (*p == '\\') {
+ if (++p == e) {
+ luaL_error(L, "parse error in string");
+ }
+ switch (*p) {
+ case '\\': *(t++) = '\\'; p++; break;
+ case '\"': *(t++) = '\"'; p++; break;
+ case '\'': *(t++) = '\''; p++; break;
+ case 'n': *(t++) = '\n'; p++; break;
+ case 'r': *(t++) = '\r'; p++; break;
+ case 'b': *(t++) = '\b'; p++; break;
+ case 't': *(t++) = '\t'; p++; break;
+ case 'f': *(t++) = '\f'; p++; break;
+ case 'a': *(t++) = '\a'; p++; break;
+ case 'v': *(t++) = '\v'; p++; break;
+ case 'e': *(t++) = 0x1B; p++; break;
+ case 'x':
+ {
+ uint8_t u;
+ p++;
+ if (p + 2 > e || !is_hex(p[0]) || !is_hex(p[1])) {
+ luaL_error(L, "parse error in string");
+ }
+ u = (from_hex(p[0]) << 4) | from_hex(p[1]);
+ *(t++) = *(char*) &u;
+ p += 2;
+ break;
+ }
+ default:
+ {
+ uint8_t u;
+ const char* e2 = min(p + 3, e);
+ if (!is_digit(*p)) {
+ luaL_error(L, "parse error in string");
+ }
+ u = *p - '0';
+ p++;
+ while (is_digit(*p) && p < e2) {
+ u = 10*u + *p-'0';
+ p++;
+ }
+ *(t++) = *(char*) &u;
+ break;
+ }
+ }
+ } else {
+ *(t++) = *(p++);
+ }
+ }
+
+ luaL_addsize(&B, t-s);
+ }
+
+ luaL_pushresult(&B);
+}
+
+static void parse_constant_assignemnt(lua_State* L,
+ struct parser* P,
+ const struct ctype* type,
+ const struct token* name)
+{
+ int64_t val = calculate_constant(L, P);
+
+ check_token(L, P, TOK_SEMICOLON, "", "expected ; after constant definition on line %d", P->line);
+
+ push_upval(L, &constants_key);
+ lua_pushlstring(L, name->str, name->size);
+
+ switch (type->type) {
+ case INT8_TYPE:
+ case INT16_TYPE:
+ case INT32_TYPE:
+ if (type->is_unsigned)
+ lua_pushinteger(L, (unsigned int) val);
+ else
+ lua_pushinteger(L, (int) val);
+ break;
+
+ default:
+ luaL_error(L, "expected a valid 8-, 16-, or 32-bit signed or unsigned integer type after 'static const' on line %d", P->line);
+ }
+
+ lua_rawset(L, -3);
+ lua_pop(L, 2); /*constants and type*/
+}
+
+#define END 0
+#define PRAGMA_POP 1
+
+static int parse_root(lua_State* L, struct parser* P)
+{
+ int top = lua_gettop(L);
+ struct token tok;
+
+ while (next_token(L, P, &tok)) {
+ /* we can have:
+ * struct definition
+ * enum definition
+ * union definition
+ * struct/enum/union declaration
+ * typedef
+ * function declaration
+ * pragma pack
+ */
+
+ assert(lua_gettop(L) == top);
+
+ if (tok.type == TOK_SEMICOLON) {
+ /* empty semicolon in root continue on */
+
+ } else if (tok.type == TOK_POUND) {
+
+ check_token(L, P, TOK_TOKEN, "pragma", "unexpected pre processor directive on line %d", P->line);
+ check_token(L, P, TOK_TOKEN, "pack", "unexpected pre processor directive on line %d", P->line);
+ check_token(L, P, TOK_OPEN_PAREN, "", "invalid pack directive on line %d", P->line);
+
+ require_token(L, P, &tok);
+
+ if (tok.type == TOK_NUMBER) {
+ if (tok.integer != 1 && tok.integer != 2 && tok.integer != 4 && tok.integer != 8 && tok.integer != 16) {
+ luaL_error(L, "pack directive with invalid pack size on line %d", P->line);
+ }
+
+ P->align_mask = (unsigned) (tok.integer - 1);
+ check_token(L, P, TOK_CLOSE_PAREN, "", "invalid pack directive on line %d", P->line);
+
+ } else if (tok.type == TOK_TOKEN && IS_LITERAL(tok, "push")) {
+ int line = P->line;
+ unsigned previous_alignment = P->align_mask;
+
+ check_token(L, P, TOK_CLOSE_PAREN, "", "invalid pack directive on line %d", P->line);
+
+ if (parse_root(L, P) != PRAGMA_POP) {
+ luaL_error(L, "reached end of string without a pragma pop to match the push on line %d", line);
+ }
+
+ P->align_mask = previous_alignment;
+
+ } else if (tok.type == TOK_TOKEN && IS_LITERAL(tok, "pop")) {
+ check_token(L, P, TOK_CLOSE_PAREN, "", "invalid pack directive on line %d", P->line);
+ return PRAGMA_POP;
+
+ } else {
+ luaL_error(L, "invalid pack directive on line %d", P->line);
+ }
+
+
+ } else if (tok.type != TOK_TOKEN) {
+ return luaL_error(L, "unexpected character on line %d", P->line);
+
+ } else if (IS_LITERAL(tok, "__extension__")) {
+ /* ignore */
+ continue;
+
+ } else if (IS_LITERAL(tok, "extern")) {
+ /* ignore extern as data and functions can only be extern */
+ continue;
+
+ } else if (IS_LITERAL(tok, "typedef")) {
+ parse_typedef(L, P);
+
+ } else {
+ /* type declaration, type definition, or function declaration */
+ struct ctype type;
+ struct token name;
+ struct parser asmname;
+
+ memset(&name, 0, sizeof(name));
+ memset(&asmname, 0, sizeof(asmname));
+
+ put_back(P);
+ parse_type(L, P, &type);
+
+ for (;;) {
+ parse_argument(L, P, -1, &type, &name, &asmname);
+
+ if (name.size) {
+ /* global/function declaration */
+
+ /* set asmname_tbl[name] = asmname */
+ if (asmname.next) {
+ push_upval(L, &asmname_key);
+ lua_pushlstring(L, name.str, name.size);
+ push_strings(L, &asmname);
+ lua_rawset(L, -3);
+ lua_pop(L, 1); /* asmname upval */
+ }
+
+ push_upval(L, &functions_key);
+ lua_pushlstring(L, name.str, name.size);
+ push_ctype(L, -3, &type);
+ lua_rawset(L, -3);
+ lua_pop(L, 1); /* functions upval */
+ } else {
+ /* type declaration/definition - already been processed */
+ }
+
+ lua_pop(L, 1);
+
+ if (!next_token(L, P, &tok)) {
+ break;
+ }
+
+ if (tok.type == TOK_COMMA) {
+ continue;
+ }
+
+ if (tok.type == TOK_OPEN_CURLY) {
+ int line = P->line;
+ int remaining = 1;
+ while (remaining > 0 && next_token(L, P, &tok)) {
+ if (tok.type == TOK_CLOSE_CURLY) {
+ remaining--;
+ } else if (tok.type == TOK_OPEN_CURLY) {
+ remaining++;
+ }
+ }
+ if (remaining > 0) {
+ luaL_error(L, "missing closing bracket for line %d", line);
+ }
+ } else if (tok.type == TOK_ASSIGN) {
+ parse_constant_assignemnt(L, P, &type, &name);
+ } else if (tok.type != TOK_SEMICOLON) {
+ luaL_error(L, "missing semicolon on line %d", P->line);
+ }
+ break;
+ }
+
+ lua_pop(L, 1);
+ }
+ }
+
+ return END;
+}
+
+int ffi_cdef(lua_State* L)
+{
+ struct parser P;
+
+ P.line = 1;
+ P.prev = P.next = luaL_checkstring(L, 1);
+ P.align_mask = DEFAULT_ALIGN_MASK;
+
+ if (parse_root(L, &P) == PRAGMA_POP) {
+ luaL_error(L, "pragma pop without an associated push on line %d", P.line);
+ }
+
+ return 0;
+}
+
+/* calculate_constant handles operator precedence by having a number of
+ * recursive commands each of which computes the result at that level of
+ * precedence and above. calculate_constant1 is the highest precedence
+ */
+
+static int64_t string_to_int(const char* str, size_t size)
+{
+ const char* end = str + size;
+ char c = *str++;
+ if (str < end)
+ {
+ if (c == '\\') {
+ c = *str++;
+ switch (c) {
+ case '\'': c = '\''; break;
+ case '\"': c = '\"'; break;
+ case '\?': c = '\?'; break;
+ case '\\': c = '\\'; break;
+ case 'a': c = '\a'; break;
+ case 'b': c = '\b'; break;
+ case 'f': c = '\f'; break;
+ case 'n': c = '\n'; break;
+ case 'r': c = '\r'; break;
+ case 't': c = '\t'; break;
+ case 'v': c = '\v'; break;
+ case 'e': c = 27; break;
+ case 'x':
+ c = 0;
+ while (str < end) {
+ char d = *str++;
+ c *= 16;
+ if (d >= '0' && d <= '9') c += (d - '0');
+ else c += (d - 'a' + 10);
+ }
+ break;
+ default:
+ c = c - '0';
+ while (str < end) {
+ char d = *str++;
+ c = c*8 + (d - '0');
+ }
+ break;
+ }
+ }
+ }
+ return c;
+}
+
+static int try_cast(lua_State* L)
+{
+ struct parser* P = (struct parser*) lua_touserdata(L, 1);
+ struct ctype ct;
+ struct token name, tok;
+ memset(&name, 0, sizeof(name));
+
+ parse_type(L, P, &ct);
+ parse_argument(L, P, -1, &ct, &name, NULL);
+
+ require_token(L, P, &tok);
+ if (tok.type != TOK_CLOSE_PAREN || name.size) {
+ return luaL_error(L, "invalid cast");
+ }
+
+ if (ct.pointers/* || ct.type != INT32_TYPE*/) {
+ return luaL_error(L, "unsupported cast on line %d", P->line);
+ }
+
+ return 0;
+}
+
+static int64_t calculate_constant2(lua_State* L, struct parser* P, struct token* tok);
+
+/* () */
+static int64_t calculate_constant1(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t ret;
+
+ if (tok->type == TOK_NUMBER) {
+ ret = tok->integer;
+ next_token(L, P, tok);
+ return ret;
+
+ } else if (tok->type == TOK_TOKEN) {
+ /* look up name in constants table */
+ push_upval(L, &constants_key);
+ lua_pushlstring(L, tok->str, tok->size);
+ lua_rawget(L, -2);
+ lua_remove(L, -2); /* constants table */
+
+ if (!lua_isnumber(L, -1)) {
+ lua_pushlstring(L, tok->str, tok->size);
+ luaL_error(L, "use of undefined constant %s on line %d", lua_tostring(L, -1), P->line);
+ }
+
+ ret = (int64_t) lua_tonumber(L, -1);
+ lua_pop(L, 1);
+ next_token(L, P, tok);
+ return ret;
+
+ } else if (tok->type == TOK_OPEN_PAREN) {
+ struct parser before_cast = *P;
+ int top = lua_gettop(L);
+
+ /* see if this is a numeric cast, which we ignore */
+ lua_pushcfunction(L, &try_cast);
+ lua_pushlightuserdata(L, P);
+ if (!lua_pcall(L, 1, 0, 0)) {
+ next_token(L, P, tok);
+ return calculate_constant2(L, P, tok);
+ }
+ lua_settop(L, top);
+
+ *P = before_cast;
+ ret = calculate_constant(L, P);
+
+ require_token(L, P, tok);
+ if (tok->type != TOK_CLOSE_PAREN) {
+ luaL_error(L, "error whilst parsing constant at line %d", P->line);
+ }
+
+ next_token(L, P, tok);
+ return ret;
+
+ } else if (tok->type == TOK_STRING) {
+ ret = string_to_int(tok->str, tok->size);
+
+ next_token(L, P, tok);
+ return ret;
+
+ } else {
+ return luaL_error(L, "unexpected token whilst parsing constant at line %d", P->line);
+ }
+}
+
+/* ! and ~, unary + and -, and sizeof */
+static int64_t calculate_constant2(lua_State* L, struct parser* P, struct token* tok)
+{
+ if (tok->type == TOK_LOGICAL_NOT) {
+ require_token(L, P, tok);
+ return !calculate_constant2(L, P, tok);
+
+ } else if (tok->type == TOK_BITWISE_NOT) {
+ require_token(L, P, tok);
+ return ~calculate_constant2(L, P, tok);
+
+ } else if (tok->type == TOK_PLUS) {
+ require_token(L, P, tok);
+ return calculate_constant2(L, P, tok);
+
+ } else if (tok->type == TOK_MINUS) {
+ require_token(L, P, tok);
+ return -calculate_constant2(L, P, tok);
+
+ } else if (tok->type == TOK_TOKEN &&
+ (IS_LITERAL(*tok, "sizeof")
+ || IS_LITERAL(*tok, "alignof")
+ || IS_LITERAL(*tok, "__alignof__")
+ || IS_LITERAL(*tok, "__alignof"))) {
+
+ bool issize = IS_LITERAL(*tok, "sizeof");
+ struct ctype type;
+
+ require_token(L, P, tok);
+ if (tok->type != TOK_OPEN_PAREN) {
+ luaL_error(L, "invalid sizeof at line %d", P->line);
+ }
+
+ parse_type(L, P, &type);
+ parse_argument(L, P, -1, &type, NULL, NULL);
+ lua_pop(L, 2);
+
+ require_token(L, P, tok);
+ if (tok->type != TOK_CLOSE_PAREN) {
+ luaL_error(L, "invalid sizeof at line %d", P->line);
+ }
+
+ next_token(L, P, tok);
+
+ return issize ? ctype_size(L, &type) : type.align_mask + 1;
+
+ } else {
+ return calculate_constant1(L, P, tok);
+ }
+}
+
+/* binary * / and % (left associative) */
+static int64_t calculate_constant3(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t left = calculate_constant2(L, P, tok);
+
+ for (;;) {
+ if (tok->type == TOK_MULTIPLY) {
+ require_token(L, P, tok);
+ left *= calculate_constant2(L, P, tok);
+
+ } else if (tok->type == TOK_DIVIDE) {
+ require_token(L, P, tok);
+ left /= calculate_constant2(L, P, tok);
+
+ } else if (tok->type == TOK_MODULUS) {
+ require_token(L, P, tok);
+ left %= calculate_constant2(L, P, tok);
+
+ } else {
+ return left;
+ }
+ }
+}
+
+/* binary + and - (left associative) */
+static int64_t calculate_constant4(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t left = calculate_constant3(L, P, tok);
+
+ for (;;) {
+ if (tok->type == TOK_PLUS) {
+ require_token(L, P, tok);
+ left += calculate_constant3(L, P, tok);
+
+ } else if (tok->type == TOK_MINUS) {
+ require_token(L, P, tok);
+ left -= calculate_constant3(L, P, tok);
+
+ } else {
+ return left;
+ }
+ }
+}
+
+/* binary << and >> (left associative) */
+static int64_t calculate_constant5(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t left = calculate_constant4(L, P, tok);
+
+ for (;;) {
+ if (tok->type == TOK_LEFT_SHIFT) {
+ require_token(L, P, tok);
+ left <<= calculate_constant4(L, P, tok);
+
+ } else if (tok->type == TOK_RIGHT_SHIFT) {
+ require_token(L, P, tok);
+ left >>= calculate_constant4(L, P, tok);
+
+ } else {
+ return left;
+ }
+ }
+}
+
+/* binary <, <=, >, and >= (left associative) */
+static int64_t calculate_constant6(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t left = calculate_constant5(L, P, tok);
+
+ for (;;) {
+ if (tok->type == TOK_LESS) {
+ require_token(L, P, tok);
+ left = (left < calculate_constant5(L, P, tok));
+
+ } else if (tok->type == TOK_LESS_EQUAL) {
+ require_token(L, P, tok);
+ left = (left <= calculate_constant5(L, P, tok));
+
+ } else if (tok->type == TOK_GREATER) {
+ require_token(L, P, tok);
+ left = (left > calculate_constant5(L, P, tok));
+
+ } else if (tok->type == TOK_GREATER_EQUAL) {
+ require_token(L, P, tok);
+ left = (left >= calculate_constant5(L, P, tok));
+
+ } else {
+ return left;
+ }
+ }
+}
+
+/* binary ==, != (left associative) */
+static int64_t calculate_constant7(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t left = calculate_constant6(L, P, tok);
+
+ for (;;) {
+ if (tok->type == TOK_EQUAL) {
+ require_token(L, P, tok);
+ left = (left == calculate_constant6(L, P, tok));
+
+ } else if (tok->type == TOK_NOT_EQUAL) {
+ require_token(L, P, tok);
+ left = (left != calculate_constant6(L, P, tok));
+
+ } else {
+ return left;
+ }
+ }
+}
+
+/* binary & (left associative) */
+static int64_t calculate_constant8(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t left = calculate_constant7(L, P, tok);
+
+ for (;;) {
+ if (tok->type == TOK_BITWISE_AND) {
+ require_token(L, P, tok);
+ left = (left & calculate_constant7(L, P, tok));
+
+ } else {
+ return left;
+ }
+ }
+}
+
+/* binary ^ (left associative) */
+static int64_t calculate_constant9(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t left = calculate_constant8(L, P, tok);
+
+ for (;;) {
+ if (tok->type == TOK_BITWISE_XOR) {
+ require_token(L, P, tok);
+ left = (left ^ calculate_constant8(L, P, tok));
+
+ } else {
+ return left;
+ }
+ }
+}
+
+/* binary | (left associative) */
+static int64_t calculate_constant10(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t left = calculate_constant9(L, P, tok);
+
+ for (;;) {
+ if (tok->type == TOK_BITWISE_OR) {
+ require_token(L, P, tok);
+ left = (left | calculate_constant9(L, P, tok));
+
+ } else {
+ return left;
+ }
+ }
+}
+
+/* binary && (left associative) */
+static int64_t calculate_constant11(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t left = calculate_constant10(L, P, tok);
+
+ for (;;) {
+ if (tok->type == TOK_LOGICAL_AND) {
+ require_token(L, P, tok);
+ left = (left && calculate_constant10(L, P, tok));
+
+ } else {
+ return left;
+ }
+ }
+}
+
+/* binary || (left associative) */
+static int64_t calculate_constant12(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t left = calculate_constant11(L, P, tok);
+
+ for (;;) {
+ if (tok->type == TOK_LOGICAL_OR) {
+ require_token(L, P, tok);
+ left = (left || calculate_constant11(L, P, tok));
+
+ } else {
+ return left;
+ }
+ }
+}
+
+/* ternary ?: (right associative) */
+static int64_t calculate_constant13(lua_State* L, struct parser* P, struct token* tok)
+{
+ int64_t left = calculate_constant12(L, P, tok);
+
+ if (tok->type == TOK_QUESTION) {
+ int64_t middle, right;
+ require_token(L, P, tok);
+ middle = calculate_constant13(L, P, tok);
+ if (tok->type != TOK_COLON) {
+ luaL_error(L, "invalid ternery (? :) in constant on line %d", P->line);
+ }
+ require_token(L, P, tok);
+ right = calculate_constant13(L, P, tok);
+ return left ? middle : right;
+
+ } else {
+ return left;
+ }
+}
+
+int64_t calculate_constant(lua_State* L, struct parser* P)
+{
+ struct token tok;
+ int64_t ret;
+ require_token(L, P, &tok);
+ ret = calculate_constant13(L, P, &tok);
+
+ if (tok.type != TOK_NIL) {
+ put_back(P);
+ }
+
+ return ret;
+}
+
+
+
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/test.c b/Build/source/texk/web2c/luatexdir/luaffi/test.c
new file mode 100644
index 00000000000..20f5d136f20
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/test.c
@@ -0,0 +1,720 @@
+/* vim: ts=4 sw=4 sts=4 et tw=78
+ * Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+ * Portions copyright (c) 2011 James R. McKaskill.
+ *
+ * This source code is licensed under the BSD-style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ */
+#include <stdio.h>
+#include <stdint.h>
+#include <inttypes.h>
+#include <stddef.h>
+#include <stdbool.h>
+#include <stdarg.h>
+
+#ifdef _WIN32
+#include <windows.h>
+#else
+#include <errno.h>
+#endif
+
+#include <complex.h>
+#define HAVE_COMPLEX
+
+#ifdef __cplusplus
+# define EXTERN_C extern "C"
+#else
+# define EXTERN_C extern
+#endif
+
+#ifdef _WIN32
+#define EXPORT EXTERN_C __declspec(dllexport)
+#elif defined __GNUC__
+#define EXPORT EXTERN_C __attribute__((visibility("default")))
+#else
+#define EXPORT EXTERN_C
+#endif
+
+enum e8 {
+ FOO8,
+ BAR8,
+};
+enum e16 {
+ FOO16 = 1 << 8,
+ BAR16,
+ BIG16 = 1 << 14,
+};
+enum e32 {
+ FOO32 = 1 << 16,
+ BAR32,
+ BIG32 = 1 << 30,
+};
+
+EXPORT bool have_complex();
+
+bool have_complex()
+{
+#ifdef HAVE_COMPLEX
+ return 1;
+#else
+ return 0;
+#endif
+}
+
+EXPORT bool is_msvc;
+
+bool is_msvc =
+#ifdef _MSC_VER
+ 1;
+#else
+ 0;
+#endif
+
+EXPORT int test_pow(int v);
+int test_pow(int v)
+{ return v * v; }
+
+#define ADD(TYPE, NAME) \
+ EXPORT TYPE NAME(TYPE a, TYPE b); \
+ TYPE NAME(TYPE a, TYPE b) { return a + b; }
+
+ADD(int8_t, add_i8)
+ADD(uint8_t, add_u8)
+ADD(int16_t, add_i16)
+ADD(uint16_t, add_u16)
+ADD(int32_t, add_i32)
+ADD(uint32_t, add_u32)
+ADD(int64_t, add_i64)
+ADD(uint64_t, add_u64)
+ADD(double, add_d)
+ADD(float, add_f)
+#ifdef HAVE_COMPLEX
+ADD(double complex, add_dc)
+ADD(float complex, add_fc)
+#endif
+
+EXPORT enum e8 inc_e8(enum e8 v);
+EXPORT enum e16 inc_e16(enum e16 v);
+EXPORT enum e32 inc_e32(enum e32 v);
+enum e8 inc_e8(enum e8 v) {return v+1;}
+enum e16 inc_e16(enum e16 v) {return v+1;}
+enum e32 inc_e32(enum e32 v) {return v+1;}
+
+EXPORT _Bool not_b(_Bool v);
+EXPORT _Bool not_b2(_Bool v);
+
+_Bool not_b(_Bool v) {return !v;}
+_Bool not_b2(_Bool v) {return !v;}
+
+#define PRINT(TYPE, NAME, FORMAT) \
+ EXPORT int NAME(char* buf, TYPE val); \
+ int NAME(char* buf, TYPE val) {return sprintf(buf, "%" FORMAT, val);}
+
+PRINT(int8_t, print_i8, PRId8)
+PRINT(uint8_t, print_u8, PRIu8)
+PRINT(int16_t, print_i16, PRId16)
+PRINT(uint16_t, print_u16, PRIu16)
+PRINT(int32_t, print_i32, PRId32)
+PRINT(uint32_t, print_u32, PRIu32)
+PRINT(int64_t, print_i64, PRId64)
+PRINT(uint64_t, print_u64, PRIu64)
+PRINT(double, print_d, "g")
+PRINT(float, print_f, "g")
+PRINT(const char*, print_s, "s")
+PRINT(void*, print_p, "p")
+PRINT(enum e8, print_e8, "d")
+PRINT(enum e16, print_e16, "d")
+PRINT(enum e32, print_e32, "d")
+
+#ifdef HAVE_COMPLEX
+EXPORT int print_dc(char* buf, double complex val);
+EXPORT int print_fc(char* buf, float complex val);
+int print_dc(char* buf, double complex val) {return sprintf(buf, "%g+%gi", creal(val), cimag(val));}
+int print_fc(char* buf, float complex val) {return sprintf(buf, "%g+%gi", creal(val), cimag(val));}
+#endif
+
+EXPORT int print_b(char* buf, _Bool val);
+EXPORT int print_b2(char* buf, _Bool val);
+int print_b(char* buf, _Bool val) {return sprintf(buf, "%s", val ? "true" : "false");}
+int print_b2(char* buf, _Bool val) {return sprintf(buf, "%s", val ? "true" : "false");}
+
+EXPORT bool (*ret_fp(bool (*val)(bool)))(bool);
+bool (*ret_fp(bool (*val)(bool)))(bool)
+{return val;}
+
+#define OFFSETOF(STRUCT, MEMBER) ((int) ((char*) &STRUCT.MEMBER - (char*) &S - 1))
+
+#define ALIGN_UP(VALUE, ALIGNMENT, SUFFIX) \
+ struct align_##ALIGNMENT##_##SUFFIX { \
+ char pad; \
+ VALUE; \
+ }; \
+ EXPORT int print_align_##ALIGNMENT##_##SUFFIX(char* buf, struct align_##ALIGNMENT##_##SUFFIX* p); \
+ int print_align_##ALIGNMENT##_##SUFFIX(char* buf, struct align_##ALIGNMENT##_##SUFFIX* p) { \
+ struct {char ch; struct align_##ALIGNMENT##_##SUFFIX v;} s; \
+ int off = sprintf(buf, "size %d offset %d align %d value ", \
+ (int) sizeof(s.v), \
+ (int) (((char*) &p->v) - (char*) p), \
+ (int) (((char*) &s.v) - (char*) &s)); \
+ return print_##SUFFIX(buf+off, p->v); \
+ }
+
+#ifdef HAVE_COMPLEX
+#define COMPLEX_ALIGN(ALIGNMENT, ATTR) \
+ ALIGN_UP(ATTR(double complex), ALIGNMENT, dc) \
+ ALIGN_UP(ATTR(float complex), ALIGNMENT, fc)
+#else
+#define COMPLEX_ALIGN(ALIGNMENT, ATTR)
+#endif
+
+/* MSVC doesn't support __declspec(aligned(#)) on enums see C4329 */
+#define ENUM_ALIGN2(ALIGNMENT, ATTR) \
+ ALIGN_UP(ATTR(enum e8), ALIGNMENT, e8) \
+ ALIGN_UP(ATTR(enum e16), ALIGNMENT, e16) \
+ ALIGN_UP(ATTR(enum e32), ALIGNMENT, e32) \
+
+#ifdef _MSC_VER
+#define ENUM_ALIGN(ALIGNMENT, ATTR)
+#else
+#define ENUM_ALIGN(ALIGNMENT, ATTR) ENUM_ALIGN2(ALIGNMENT, ATTR)
+#endif
+
+#define ALIGN2(ALIGNMENT, ATTR) \
+ ALIGN_UP(ATTR(uint16_t), ALIGNMENT, u16) \
+ ALIGN_UP(ATTR(uint32_t), ALIGNMENT, u32) \
+ ALIGN_UP(ATTR(uint64_t), ALIGNMENT, u64) \
+ ALIGN_UP(ATTR(float), ALIGNMENT, f) \
+ ALIGN_UP(ATTR(double), ALIGNMENT, d) \
+ ALIGN_UP(ATTR(const char*), ALIGNMENT, s) \
+ ALIGN_UP(ATTR(void*), ALIGNMENT, p) \
+ ALIGN_UP(ATTR(_Bool), ALIGNMENT, b) \
+ ALIGN_UP(ATTR(_Bool), ALIGNMENT, b2) \
+ ENUM_ALIGN(ALIGNMENT, ATTR) \
+ COMPLEX_ALIGN(ALIGNMENT, ATTR)
+
+#define NO_ATTR(TYPE) TYPE v
+
+#ifdef _MSC_VER
+#define ALIGN_NO_ATTR(ALIGNMENT) \
+ ALIGN2(ALIGNMENT, NO_ATTR) \
+ ENUM_ALIGN2(ALIGNMENT, NO_ATTR)
+#else
+#define ALIGN_NO_ATTR(ALIGNMENT) \
+ ALIGN2(ALIGNMENT, NO_ATTR)
+#endif
+
+ALIGN_NO_ATTR(0)
+
+#pragma pack(push)
+#pragma pack(1)
+ALIGN_NO_ATTR(1)
+#pragma pack(2)
+ALIGN_NO_ATTR(2)
+#pragma pack(4)
+ALIGN_NO_ATTR(4)
+#pragma pack(8)
+ALIGN_NO_ATTR(8)
+#pragma pack(16)
+ALIGN_NO_ATTR(16)
+#pragma pack(pop)
+
+#ifdef _MSC_VER
+#define ATTR_(TYPE, ALIGN) __declspec(align(ALIGN)) TYPE v
+#else
+#define ATTR_(TYPE, ALIGN) TYPE v __attribute__((aligned(ALIGN)))
+#endif
+
+#define ATTR1(TYPE) ATTR_(TYPE, 1)
+#define ATTR2(TYPE) ATTR_(TYPE, 2)
+#define ATTR4(TYPE) ATTR_(TYPE, 4)
+#define ATTR8(TYPE) ATTR_(TYPE, 8)
+#define ATTR16(TYPE) ATTR_(TYPE, 16)
+
+#define ATTR_DEF(TYPE) TYPE v __attribute__((aligned))
+
+ALIGN2(attr_1, ATTR1)
+ALIGN2(attr_2, ATTR2)
+ALIGN2(attr_4, ATTR4)
+ALIGN2(attr_8, ATTR8)
+ALIGN2(attr_16, ATTR16)
+
+#ifndef _MSC_VER
+ALIGN2(attr_def, ATTR_DEF)
+#endif
+
+#ifdef _MSC_VER
+#define alignof(type) __alignof(type)
+#else
+#define alignof(type) __alignof__(type)
+#endif
+
+EXPORT int max_alignment();
+
+int max_alignment()
+{ return alignof(struct align_attr_16_p); }
+
+/* bit_fields1.cpp */
+/* compile with: /LD */
+struct Date {
+ unsigned short nWeekDay : 3; /* 0..7 (3 bits) */
+ unsigned short nMonthDay : 6; /* 0..31 (6 bits) */
+ unsigned short nMonth : 5; /* 0..12 (5 bits) */
+ unsigned short nYear : 8; /* 0..100 (8 bits) */
+};
+
+EXPORT int print_date(size_t* sz, size_t* align, char* buf, struct Date* d);
+
+int print_date(size_t* sz, size_t* align, char* buf, struct Date* d) {
+ *sz = sizeof(struct Date);
+ *align = alignof(struct Date);
+ return sprintf(buf, "%d %d %d %d", d->nWeekDay, d->nMonthDay, d->nMonth, d->nYear);
+}
+
+/* bit_fields2.cpp */
+/* compile with: /LD */
+struct Date2 {
+ unsigned nWeekDay : 3; /* 0..7 (3 bits) */
+ unsigned nMonthDay : 6; /* 0..31 (6 bits) */
+ unsigned : 0; /* Force alignment to next boundary. */
+ unsigned nMonth : 5; /* 0..12 (5 bits) */
+ unsigned nYear : 8; /* 0..100 (8 bits) */
+};
+
+EXPORT int print_date2(size_t* sz, size_t* align, char* buf, struct Date2* d);
+
+int print_date2(size_t* sz, size_t* align, char* buf, struct Date2* d) {
+ *sz = sizeof(struct Date2);
+ *align = alignof(struct Date2);
+ return sprintf(buf, "%d %d %d %d", d->nWeekDay, d->nMonthDay, d->nMonth, d->nYear);
+}
+
+// Examples from SysV X86 ABI
+struct sysv1 {
+ int j:5;
+ int k:6;
+ int m:7;
+};
+
+EXPORT int print_sysv1(size_t* sz, size_t* align, char* buf, struct sysv1* s);
+
+int print_sysv1(size_t* sz, size_t* align, char* buf, struct sysv1* s) {
+ *sz = sizeof(struct sysv1);
+ *align = alignof(struct sysv1);
+ return sprintf(buf, "%d %d %d", s->j, s->k, s->m);
+}
+
+struct sysv2 {
+ short s:9;
+ int j:9;
+ char c;
+ short t:9;
+ short u:9;
+ char d;
+};
+
+EXPORT int print_sysv2(size_t* sz, size_t* align, char* buf, struct sysv2* s);
+
+int print_sysv2(size_t* sz, size_t* align, char* buf, struct sysv2* s) {
+ *sz = sizeof(struct sysv2);
+ *align = alignof(struct sysv2);
+ return sprintf(buf, "%d %d %d %d %d %d", s->s, s->j, s->c, s->t, s->u, s->d);
+}
+
+struct sysv3 {
+ char c;
+ short s:8;
+};
+
+EXPORT int print_sysv3(size_t* sz, size_t* align, char* buf, struct sysv3* s);
+
+int print_sysv3(size_t* sz, size_t* align, char* buf, struct sysv3* s) {
+ *sz = sizeof(struct sysv3);
+ *align = alignof(struct sysv3);
+ return sprintf(buf, "%d %d", s->c, s->s);
+}
+
+union sysv4 {
+ char c;
+ short s:8;
+};
+
+EXPORT int print_sysv4(size_t* sz, size_t* align, char* buf, union sysv4* s);
+
+int print_sysv4(size_t* sz, size_t* align, char* buf, union sysv4* s) {
+ *sz = sizeof(union sysv4);
+ *align = alignof(union sysv4);
+ return sprintf(buf, "%d", s->s);
+}
+
+struct sysv5 {
+ char c;
+ int :0;
+ char d;
+ short :9;
+ char e;
+ char :0;
+};
+
+EXPORT int print_sysv5(size_t* sz, size_t* align, char* buf, struct sysv5* s);
+
+int print_sysv5(size_t* sz, size_t* align, char* buf, struct sysv5* s) {
+ *sz = sizeof(struct sysv5);
+ *align = alignof(struct sysv5);
+ return sprintf(buf, "%d %d %d", s->c, s->d, s->e);
+}
+
+struct sysv6 {
+ char c;
+ int :0;
+ char d;
+ int :9;
+ char e;
+};
+
+EXPORT int print_sysv6(size_t* sz, size_t* align, char* buf, struct sysv6* s);
+
+int print_sysv6(size_t* sz, size_t* align, char* buf, struct sysv6* s) {
+ *sz = sizeof(struct sysv6);
+ *align = alignof(struct sysv6);
+ return sprintf(buf, "%d %d %d", s->c, s->d, s->e);
+}
+
+struct sysv7 {
+ int j:9;
+ short s:9;
+ char c;
+ short t:9;
+ short u:9;
+};
+
+EXPORT int print_sysv7(size_t* sz, size_t* align, char* buf, struct sysv7* s);
+
+int print_sysv7(size_t* sz, size_t* align, char* buf, struct sysv7* s) {
+ *sz = sizeof(struct sysv7);
+ *align = alignof(struct sysv7);
+ return sprintf(buf, "%d %d %d %d %d", s->j, s->s, s->c, s->t, s->u);
+}
+
+/* Now some targeting bitfield tests */
+
+/* Bitfield alignment */
+#define BITALIGN(TNUM,BNUM) \
+ struct ba_##TNUM##_##BNUM { \
+ char a; \
+ uint##TNUM##_t b : BNUM; \
+ }; \
+ EXPORT int print_ba_##TNUM##_##BNUM(size_t* sz, size_t* align, char* buf, struct ba_##TNUM##_##BNUM* s); \
+ int print_ba_##TNUM##_##BNUM(size_t* sz, size_t* align, char* buf, struct ba_##TNUM##_##BNUM* s) { \
+ *sz = sizeof(struct ba_##TNUM##_##BNUM); \
+ *align = alignof(struct ba_##TNUM##_##BNUM); \
+ return sprintf(buf, "%d %d", (int) s->a, (int) s->b); \
+ }
+
+BITALIGN(8,7)
+BITALIGN(16,7)
+BITALIGN(16,15)
+BITALIGN(32,7)
+BITALIGN(32,15)
+BITALIGN(32,31)
+BITALIGN(64,7)
+BITALIGN(64,15)
+BITALIGN(64,31)
+BITALIGN(64,63)
+
+/* Do unsigned and signed coallesce */
+#define BITCOALESCE(NUM) \
+ struct bc##NUM { \
+ uint##NUM##_t a : 3; \
+ int##NUM##_t b : 3; \
+ }; \
+ EXPORT int print_bc##NUM(size_t* sz, size_t* align, char* buf, struct bc##NUM* s); \
+ int print_bc##NUM(size_t* sz, size_t* align, char* buf, struct bc##NUM* s) { \
+ *sz = sizeof(struct bc##NUM); \
+ *align = alignof(struct bc##NUM); \
+ return sprintf(buf, "%d %d", (int) s->a, (int) s->b); \
+ }
+
+BITCOALESCE(8)
+BITCOALESCE(16)
+BITCOALESCE(32)
+BITCOALESCE(64)
+
+// Do different sizes coallesce
+struct bdsz {
+ uint8_t a : 3;
+ uint16_t b : 3;
+ uint32_t c : 3;
+ uint64_t d : 3;
+};
+
+EXPORT int print_bdsz(size_t* sz, size_t* align, char* buf, struct bdsz* s);
+int print_bdsz(size_t* sz, size_t* align, char* buf, struct bdsz* s) {
+ *sz = sizeof(struct bdsz);
+ *align = alignof(struct bdsz);
+ return sprintf(buf, "%d %d %d %d", (int) s->a, (int) s->b, (int) s->c, (int) s->d);
+}
+
+// Does coallesence upgrade the storage unit
+struct bcup {
+ uint8_t a : 7;
+ uint16_t b : 9;
+ uint32_t c : 17;
+ uint64_t d : 33;
+};
+
+EXPORT int print_bcup(size_t* sz, size_t* align, char* buf, struct bcup* s);
+int print_bcup(size_t* sz, size_t* align, char* buf, struct bcup* s) {
+ *sz = sizeof(struct bcup);
+ *align = alignof(struct bcup);
+ return sprintf(buf, "%d %d %d %"PRIu64, (int) s->a, (int) s->b, (int) s->c, (uint64_t) s->d);
+}
+
+// Is unaligned access allowed
+struct buna {
+ uint32_t a : 31;
+ uint32_t b : 31;
+};
+
+EXPORT int print_buna(size_t* sz, size_t* align, char* buf, struct buna* s);
+int print_buna(size_t* sz, size_t* align, char* buf, struct buna* s) {
+ *sz = sizeof(struct buna);
+ *align = alignof(struct buna);
+ return sprintf(buf, "%d %d", (int) s->a, (int) s->b);
+}
+
+/* What does a lone :0 do */
+#define BITLONEZERO(NUM) \
+ struct blz##NUM { \
+ uint##NUM##_t a; \
+ uint##NUM##_t :0; \
+ uint##NUM##_t b; \
+ }; \
+ EXPORT int print_##blz##NUM(size_t* sz, size_t* align, char* buf, struct blz##NUM* s); \
+ int print_blz##NUM(size_t* sz, size_t* align, char* buf, struct blz##NUM* s) { \
+ *sz = sizeof(struct blz##NUM); \
+ *align = alignof(struct blz##NUM); \
+ return sprintf(buf, "%d %d", (int) s->a, (int) s->b); \
+ }
+
+BITLONEZERO(8)
+BITLONEZERO(16)
+BITLONEZERO(32)
+BITLONEZERO(64)
+
+/* What does a :0 or unnamed :# of the same or different type do */
+#define BITZERO(NUM, ZNUM, BNUM) \
+ struct bz_##NUM##_##ZNUM##_##BNUM { \
+ uint8_t a; \
+ uint##NUM##_t b : 3; \
+ uint##ZNUM##_t :BNUM; \
+ uint##NUM##_t c : 3; \
+ }; \
+ EXPORT int print_bz_##NUM##_##ZNUM##_##BNUM(size_t* sz, size_t* align, char* buf, struct bz_##NUM##_##ZNUM##_##BNUM* s); \
+ int print_bz_##NUM##_##ZNUM##_##BNUM(size_t* sz, size_t* align, char* buf, struct bz_##NUM##_##ZNUM##_##BNUM* s) { \
+ *sz = sizeof(struct bz_##NUM##_##ZNUM##_##BNUM); \
+ *align = alignof(struct bz_##NUM##_##ZNUM##_##BNUM); \
+ return sprintf(buf, "%d %d %d", (int) s->a, (int) s->b, (int) s->c); \
+ }
+
+BITZERO(8,8,0)
+BITZERO(8,8,7)
+BITZERO(8,16,0)
+BITZERO(8,16,7)
+BITZERO(8,16,15)
+BITZERO(8,32,0)
+BITZERO(8,32,7)
+BITZERO(8,32,15)
+BITZERO(8,32,31)
+BITZERO(8,64,0)
+BITZERO(8,64,7)
+BITZERO(8,64,15)
+BITZERO(8,64,31)
+BITZERO(8,64,63)
+BITZERO(16,8,0)
+BITZERO(16,8,7)
+BITZERO(16,16,0)
+BITZERO(16,16,7)
+BITZERO(16,16,15)
+BITZERO(16,32,0)
+BITZERO(16,32,7)
+BITZERO(16,32,15)
+BITZERO(16,32,31)
+BITZERO(16,64,0)
+BITZERO(16,64,7)
+BITZERO(16,64,15)
+BITZERO(16,64,31)
+BITZERO(16,64,63)
+BITZERO(32,8,0)
+BITZERO(32,8,7)
+BITZERO(32,16,0)
+BITZERO(32,16,7)
+BITZERO(32,16,15)
+BITZERO(32,32,0)
+BITZERO(32,32,7)
+BITZERO(32,32,15)
+BITZERO(32,32,31)
+BITZERO(32,64,0)
+BITZERO(32,64,7)
+BITZERO(32,64,15)
+BITZERO(32,64,31)
+BITZERO(32,64,63)
+BITZERO(64,8,0)
+BITZERO(64,8,7)
+BITZERO(64,16,0)
+BITZERO(64,16,7)
+BITZERO(64,16,15)
+BITZERO(64,32,0)
+BITZERO(64,32,7)
+BITZERO(64,32,15)
+BITZERO(64,32,31)
+BITZERO(64,64,0)
+BITZERO(64,64,7)
+BITZERO(64,64,15)
+BITZERO(64,64,31)
+BITZERO(64,64,63)
+
+#define CALL(TYPE, SUFFIX) \
+ EXPORT TYPE call_##SUFFIX(TYPE (*func)(TYPE), TYPE arg); \
+ TYPE call_##SUFFIX(TYPE (*func)(TYPE), TYPE arg) { \
+ return func(arg); \
+ }
+
+CALL(int, i)
+CALL(float, f)
+CALL(double, d)
+CALL(const char*, s)
+CALL(_Bool, b)
+CALL(enum e8, e8)
+CALL(enum e16, e16)
+CALL(enum e32, e32)
+#ifdef HAVE_COMPLEX
+CALL(double complex, dc)
+CALL(float complex, fc)
+#endif
+
+struct fptr {
+#ifdef _MSC_VER
+ int (__cdecl *p)(int);
+#else
+ int (*p)(int);
+#endif
+};
+
+EXPORT int call_fptr(struct fptr* s, int val);
+
+int call_fptr(struct fptr* s, int val) {
+ return (s->p)(val);
+}
+
+EXPORT bool g_b;
+EXPORT int8_t g_i8;
+EXPORT int16_t g_i16;
+EXPORT int32_t g_i32;
+EXPORT int64_t g_i64;
+EXPORT uint8_t g_u8;
+EXPORT uint16_t g_u16;
+EXPORT uint32_t g_u32;
+EXPORT uint64_t g_u64;
+EXPORT float g_f;
+EXPORT double g_d;
+#ifdef HAVE_COMPLEX
+EXPORT double complex g_dc;
+EXPORT float complex g_fc;
+#endif
+EXPORT bool (*g_fp)(bool);
+EXPORT const char g_s[];
+EXPORT const char* g_sp;
+EXPORT void* g_p;
+EXPORT enum e8 g_e8;
+EXPORT enum e16 g_e16;
+EXPORT enum e32 g_e32;
+EXPORT struct Date g_date;
+
+bool g_b = true;
+int8_t g_i8 = -8;
+int16_t g_i16 = -16;
+int32_t g_i32 = -32;
+int64_t g_i64 = -64;
+uint8_t g_u8 = 8;
+uint16_t g_u16 = 16;
+uint32_t g_u32 = 32;
+uint64_t g_u64 = 64;
+float g_f = 3;
+double g_d = 5;
+#ifdef HAVE_COMPLEX
+double complex g_dc = 7+8i;
+float complex g_fc = 6+9i;
+#endif
+bool (*g_fp)(bool) = &not_b;
+void* g_p = (void*) &not_b;
+const char g_s[] = "g_s";
+const char* g_sp = "g_sp";
+enum e8 g_e8 = FOO8;
+enum e16 g_e16 = FOO16;
+enum e32 g_e32 = FOO32;
+struct Date g_date = {1,2,3,4};
+
+EXPORT void set_errno(int val);
+EXPORT int get_errno(void);
+
+void set_errno(int val) {
+#ifdef _WIN32
+ SetLastError(val);
+#else
+ errno = val;
+#endif
+}
+
+int get_errno(void) {
+#ifdef _WIN32
+ return GetLastError();
+#else
+ return errno;
+#endif
+}
+
+EXPORT int va_list_size, va_list_align;
+int va_list_size = sizeof(va_list);
+int va_list_align = alignof(va_list);
+
+
+EXPORT char buf[512];
+char buf[512];
+
+EXPORT void test_call_echo(char* c);
+void test_call_echo(char* c)
+{
+ sprintf(buf, "%s", c);
+}
+
+EXPORT void test_call_pppppii(void* a, void* b, void* c, void* d, void* e, int f, int g);
+void test_call_pppppii(void* a, void* b, void* c, void* d, void* e, int f, int g)
+{
+ sprintf(buf, "%p %p %p %p %p %d %d", a, b, c, d, e, f, g);
+}
+
+EXPORT void test_call_pppppiiiiii(void* p1, void* p2, void* p3, void* p4, void* p5, int i1, int i2, int i3, int i4, int i5, int i6);
+void test_call_pppppiiiiii(void* p1, void* p2, void* p3, void* p4, void* p5, int i1, int i2, int i3, int i4, int i5, int i6)
+{
+ sprintf(buf, "%p %p %p %p %p %d %d %d %d %d %d", p1, p2, p3, p4, p5, i1, i2, i3, i4, i5, i6);
+}
+
+EXPORT void test_call_pppppffffff(void* p1, void* p2, void* p3, void* p4, void* p5, float f1, float f2, float f3, float f4, float f5, float f6);
+void test_call_pppppffffff(void* p1, void* p2, void* p3, void* p4, void* p5, float f1, float f2, float f3, float f4, float f5, float f6)
+{
+ sprintf(buf, "%p %p %p %p %p %0.1f %0.1f %0.1f %0.1f %0.1f %0.1f", p1, p2, p3, p4, p5, f1, f2, f3, f4, f5, f6);
+}
+
+EXPORT void test_call_pppppiifiii(void* p1, void* p2, void* p3, void* p4, void* p5, int i1, int i2, float f3, int i4, int i5, int i6);
+void test_call_pppppiifiii(void* p1, void* p2, void* p3, void* p4, void* p5, int i1, int i2, float f3, int i4, int i5, int i6)
+{
+ sprintf(buf, "%p %p %p %p %p %d %d %0.1f %d %d %d", p1, p2, p3, p4, p5, i1, i2, f3, i4, i5, i6);
+}
+
+EXPORT void test_call_pppppiiifii(void* p1, void* p2, void* p3, void* p4, void* p5, int i1, int i2, int i3, float f4, int i5, int i6);
+void test_call_pppppiiifii(void* p1, void* p2, void* p3, void* p4, void* p5, int i1, int i2, int i3, float f4, int i5, int i6)
+{
+ sprintf(buf, "%p %p %p %p %p %d %d %d %0.1f %d %d", p1, p2, p3, p4, p5, i1, i2, i3, f4, i5, i6);
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/luaffi/test.lua b/Build/source/texk/web2c/luatexdir/luaffi/test.lua
new file mode 100644
index 00000000000..8a9b7189f04
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luaffi/test.lua
@@ -0,0 +1,1003 @@
+-- vim: ts=4 sw=4 sts=4 et tw=78
+-- Portions copyright (c) 2015-present, Facebook, Inc. All rights reserved.
+-- Portions copyright (c) 2011 James R. McKaskill.
+--
+-- This source code is licensed under the BSD-style license found in the
+-- LICENSE file in the root directory of this source tree. An additional grant
+-- of patent rights can be found in the PATENTS file in the same directory.
+--
+io.stdout:setvbuf('no')
+local ffi = require 'ffi'
+local dlls = {}
+
+local function loadlib(lib)
+ for pattern in package.cpath:gmatch('[^;]+') do
+ local path = pattern:gsub('?', lib)
+ local ok, lib = pcall(ffi.load, path)
+ if ok then
+ return lib
+ end
+ end
+ error("Unable to load", lib)
+end
+
+if _VERSION == 'Lua 5.1' then
+ dlls.__cdecl = loadlib('ffi/libtest')
+else
+ dlls.__cdecl = ffi.load(package.searchpath('ffi.libtest', package.cpath))
+end
+
+if ffi.arch == 'x86' and ffi.os == 'Windows' then
+ dlls.__stdcall = ffi.load('test_stdcall')
+ dlls.__fastcall = ffi.load('test_fastcall')
+end
+
+local function check(a, b, msg)
+ if a ~= b then
+ print('check', a, b)
+ end
+ return _G.assert(a == b, msg)
+end
+
+print('Running test')
+
+ffi.cdef [[
+enum e8 {
+ FOO8,
+ BAR8,
+};
+enum e16 {
+ FOO16 = 1 << 8,
+ BAR16,
+ BIG16 = 1 << 14,
+};
+enum e32 {
+ FOO32 = 1 << 16,
+ BAR32,
+ BIG32 = 1 << 30,
+};
+int max_alignment();
+bool is_msvc, is_msvc2 __asm__("is_msvc");
+bool have_complex(void);
+bool have_complex2() __asm__("have" /*foo*/ "\x5F" "complex"); // 5F is _
+
+int8_t add_i8(int8_t a, int8_t b);
+uint8_t add_u8(uint8_t a, uint8_t b);
+int16_t add_i16(int16_t a, int16_t b);
+uint16_t add_i16(uint16_t a, uint16_t b);
+int32_t add_i32(int32_t a, int32_t b);
+uint32_t add_u32(uint32_t a, uint32_t b);
+int64_t add_i64(int64_t a, int64_t b);
+uint64_t add_u64(uint64_t a, uint64_t b);
+double add_d(double a, double b);
+float add_f(float a, float b);
+double complex add_dc(double complex a, double complex b);
+float complex add_fc(float complex a, float complex b);
+enum e8 inc_e8(enum e8);
+enum e16 inc_e16(enum e16);
+enum e32 inc_e32(enum e32);
+bool not_b(bool v);
+_Bool not_b2(_Bool v);
+typedef bool (*fp)(bool);
+fp ret_fp(fp v);
+bool (*ret_fp2(bool (*)(bool)))(bool) __asm("ret_fp");
+
+int print_i8(char* buf, int8_t val);
+int print_u8(char* buf, uint8_t val);
+int print_i16(char* buf, int16_t val);
+int print_u16(char* buf, uint16_t val);
+int print_i32(char* buf, int32_t val);
+int print_u32(char* buf, uint32_t val);
+int print_i64(char* buf, int64_t val);
+int print_u64(char* buf, uint64_t val);
+int print_s(char* buf, const char* val);
+int print_b(char* buf, bool val);
+int print_b2(char* buf, _Bool val);
+int print_d(char* buf, double val);
+int print_f(char* buf, float val);
+int print_p(char* buf, void* val);
+int print_dc(char* buf, double complex val);
+int print_fc(char* buf, float complex val);
+int print_e8(char* buf, enum e8 val);
+int print_e16(char* buf, enum e16 val);
+int print_e32(char* buf, enum e32 val);
+int sprintf(char* buf, const char* format, ...);
+
+// Examples from MSDN
+
+// bit_fields1.cpp
+// compile with: /LD
+struct Date {
+ unsigned short nWeekDay : 3; // 0..7 (3 bits)
+ unsigned short nMonthDay : 6; // 0..31 (6 bits)
+ unsigned short nMonth : 5; // 0..12 (5 bits)
+ unsigned short nYear : 8; // 0..100 (8 bits)
+};
+
+// bit_fields2.cpp
+// compile with: /LD
+struct Date2 {
+ unsigned nWeekDay : 3; // 0..7 (3 bits)
+ unsigned nMonthDay : 6; // 0..31 (6 bits)
+ unsigned : 0; // Force alignment to next boundary.
+ unsigned nMonth : 5; // 0..12 (5 bits)
+ unsigned nYear : 8; // 0..100 (8 bits)
+};
+
+// For checking the alignment of short bitfields
+struct Date3 {
+ char pad;
+ unsigned short nWeekDay : 3; // 0..7 (3 bits)
+ unsigned short nMonthDay : 6; // 0..31 (6 bits)
+ unsigned short nMonth : 5; // 0..12 (5 bits)
+ unsigned short nYear : 8; // 0..100 (8 bits)
+};
+
+// For checking the alignment and container of int64 bitfields
+struct bit64 {
+ char pad;
+ uint64_t a : 15;
+ uint64_t b : 14;
+ uint64_t c : 13;
+ uint64_t d : 12;
+};
+
+// Examples from SysV X86 ABI
+struct sysv1 {
+ int j:5;
+ int k:6;
+ int m:7;
+};
+
+struct sysv2 {
+ short s:9;
+ int j:9;
+ char c;
+ short t:9;
+ short u:9;
+ char d;
+};
+
+struct sysv3 {
+ char c;
+ short s:8;
+};
+
+union sysv4 {
+ char c;
+ short s:8;
+};
+
+struct sysv5 {
+ char c;
+ int :0;
+ char d;
+ short :9;
+ char e;
+ char :0;
+};
+
+struct sysv6 {
+ char c;
+ int :0;
+ char d;
+ int :9;
+ char e;
+};
+
+struct sysv7 {
+ int j:9;
+ short s:9;
+ char c;
+ short t:9;
+ short u:9;
+};
+
+int print_date(size_t* sz, size_t* align, char* buf, struct Date* s);
+int print_date2(size_t* sz, size_t* align, char* buf, struct Date2* s);
+int print_date3(size_t* sz, size_t* align, char* buf, struct Date3* d);
+int print_bit64(size_t* sz, size_t* align, char* buf, struct bit64* d);
+int print_sysv1(size_t* sz, size_t* align, char* buf, struct sysv1* s);
+int print_sysv2(size_t* sz, size_t* align, char* buf, struct sysv2* s);
+int print_sysv3(size_t* sz, size_t* align, char* buf, struct sysv3* s);
+int print_sysv4(size_t* sz, size_t* align, char* buf, union sysv4* s);
+int print_sysv5(size_t* sz, size_t* align, char* buf, struct sysv5* s);
+int print_sysv6(size_t* sz, size_t* align, char* buf, struct sysv6* s);
+int print_sysv7(size_t* sz, size_t* align, char* buf, struct sysv7* s);
+
+struct fptr {
+ int (__cdecl *p)(int);
+};
+int call_fptr(struct fptr* s, int val);
+
+bool g_b;
+int8_t g_i8;
+int16_t g_i16;
+int32_t g_i32;
+int64_t g_i64;
+uint8_t g_u8;
+uint16_t g_u16;
+uint32_t g_u32;
+uint64_t g_u64;
+float g_f;
+double g_d;
+double complex g_dc;
+float complex g_fc;
+bool (*g_fp)(bool);
+const char g_s[];
+const char* g_sp;
+void* g_p;
+enum e8 g_e8;
+enum e16 g_e16;
+enum e32 g_e32;
+struct Date g_date;
+
+void set_errno(int val);
+int get_errno(void);
+]]
+
+local align = [[
+struct align_ALIGN_SUFFIX {
+ char pad;
+ TYPE v;
+};
+
+int print_align_ALIGN_SUFFIX(char* buf, struct align_ALIGN_SUFFIX* p);
+]]
+
+local palign = [[
+#pragma pack(push)
+#pragma pack(ALIGN)
+]] .. align .. [[
+#pragma pack(pop)
+]]
+
+local bitfields = [[
+struct bcTNUM {
+ uintTNUM_t a : 3;
+ intTNUM_t b : 3;
+};
+struct blzTNUM {
+ uintTNUM_t a;
+ uintTNUM_t :0;
+ uintTNUM_t b;
+};
+int print_bcTNUM(size_t* sz, size_t* align, char* buf, struct bcTNUM* s);
+int print_blzTNUM(size_t* sz, size_t* align, char* buf, struct blzTNUM* s);
+]]
+
+local bitalign = [[
+struct ba_TNUM_BNUM {
+ char a;
+ uintTNUM_t b : BNUM;
+};
+struct bu_TNUM_BNUM {
+ char a;
+ uintTNUM_t :BNUM;
+ char b;
+};
+int print_ba_TNUM_BNUM(size_t* sz, size_t* align, char* buf, struct ba_TNUM_BNUM* s);
+]]
+
+local bitzero = [[
+struct bz_TNUM_ZNUM_BNUM {
+ uint8_t a;
+ uintTNUM_t b : 3;
+ uintZNUM_t :BNUM;
+ uintTNUM_t c : 3;
+};
+int print_bz_TNUM_ZNUM_BNUM(size_t* sz, size_t* align, char* buf, struct bz_TNUM_ZNUM_BNUM* s);
+]]
+
+local i = ffi.C.i
+local test_values = {
+ ['void*'] = ffi.new('char[3]'),
+ ['const char*'] = 'foo',
+ float = 3.4,
+ double = 5.6,
+ uint16_t = 65000,
+ uint32_t = ffi.new('uint32_t', 700000056),
+ uint64_t = 12345678901234,
+ bool = true,
+ _Bool = false,
+ ['float complex'] = 3.1+4.2*i,
+ ['double complex'] = 5.1+6.2*i,
+ ['enum e8'] = ffi.C.FOO8,
+ ['enum e16'] = ffi.C.FOO16,
+ ['enum e32'] = ffi.C.FOO32,
+}
+
+local types = {
+ b = 'bool',
+ b2 = '_Bool',
+ d = 'double',
+ f = 'float',
+ u64 = 'uint64_t',
+ u32 = 'uint32_t',
+ u16 = 'uint16_t',
+ s = 'const char*',
+ p = 'void*',
+ e8 = 'enum e8',
+ e16 = 'enum e16',
+ e32 = 'enum e32',
+}
+
+local buf = ffi.new('char[256]')
+
+local function checkbuf(type, ret, msg)
+ local str = tostring(test_values[type]):gsub('^cdata%b<>: ', '')
+ check(ffi.string(buf), str, msg)
+ check(ret, #str, msg)
+end
+
+local function checkalign(type, v, ret)
+ --print(v)
+ local str = tostring(test_values[type]):gsub('^cdata%b<>: ', '')
+ check(ffi.string(buf), ('size %d offset %d align %d value %s'):format(ffi.sizeof(v), ffi.offsetof(v, 'v'), ffi.alignof(v, 'v'), str))
+ check(ret, #str)
+end
+
+local u64 = ffi.typeof('uint64_t')
+local i64 = ffi.typeof('int64_t')
+
+local first = true
+
+for convention,c in pairs(dlls) do
+ check(c.add_i8(1,1), 2)
+ check(c.add_i8(256,1), 1)
+ check(c.add_i8(127,1), -128)
+ check(c.add_i8(-120,120), 0)
+ check(c.add_u8(255,1), 0)
+ check(c.add_u8(120,120), 240)
+ check(c.add_i16(2000,4000), 6000)
+ check(c.add_d(20, 12), 32)
+ check(c.add_f(40, 32), 72)
+ check(c.not_b(true), false)
+ check(c.not_b2(false), true)
+ check(c.inc_e8(c.FOO8), c.BAR8)
+ check(c.inc_e8('FOO8'), c.BAR8)
+ check(c.inc_e16(c.FOO16), c.BAR16)
+ check(c.inc_e32(c.FOO32), c.BAR32)
+ check(c.ret_fp(c.g_fp), c.g_fp)
+ check(c.ret_fp2(c.g_fp), c.g_fp)
+
+ if c.have_complex() then
+ check(c.add_dc(3+4*i, 4+5*i), 7+9*i)
+ check(c.add_fc(2+4*i, 6+8*i), 8+12*i)
+ types.dc = 'double complex'
+ types.fc = 'float complex'
+ else
+ types.dc = nil
+ types.fc = nil
+ end
+ check((3+4*i).re, 3)
+ check((3+4*i).im, 4)
+ check(ffi.new('complex float', 2+8*i).re, 2)
+ check(ffi.new('complex float', 5+6*i).im, 6)
+
+ check(c.have_complex(), c.have_complex2())
+ check(c.is_msvc, c.is_msvc2)
+
+ check(c.g_b, true)
+ check(c.g_i8, -8)
+ check(c.g_i16, -16)
+ check(c.g_i32, -32)
+ check(c.g_i64, i64(-64))
+ check(c.g_u8, 8)
+ check(c.g_u16, 16)
+ check(c.g_u32, 32)
+ check(c.g_u64, u64(64))
+ check(c.g_f, 3)
+ check(c.g_d, 5)
+ if c.have_complex() then
+ check(c.g_dc, 7 + 8*i)
+ check(c.g_fc, 6 + 9*i)
+ end
+ check(ffi.cast('void*', c.g_fp), c.g_p)
+ check(c.g_s, 'g_s')
+ check(c.g_sp, 'g_sp')
+ check(c.g_e8, c.FOO8)
+ check(c.g_e16, c.FOO16)
+ check(c.g_e32, c.FOO32)
+ check(c.g_date.nWeekDay, 1)
+ check(c.g_date.nMonthDay, 2)
+ check(c.g_date.nMonth, 3)
+ check(c.g_date.nYear, 4)
+
+ c.g_b = false; check(c.g_b, false)
+ c.g_i8 = -108; check(c.g_i8, -108)
+ c.g_i16 = -1016; check(c.g_i16, -1016)
+ c.g_i32 = -1032; check(c.g_i32, -1032)
+ c.g_i64 = -1064; check(c.g_i64, i64(-1064))
+ c.g_u8 = 208; check(c.g_u8, 208)
+ c.g_u16 = 2016; check(c.g_u16, 2016)
+ c.g_u32 = 2032; check(c.g_u32, 2032)
+ c.g_u64 = 2064; check(c.g_u64, u64(2064))
+ c.g_f = 13; check(c.g_f, 13)
+ c.g_d = 15; check(c.g_d, 15)
+ if c.have_complex() then
+ c.g_dc = 17+18*i; check(c.g_dc, 17+18*i)
+ c.g_fc = 16+19*i; check(c.g_fc, 16+19*i)
+ end
+ c.g_sp = 'foo'; check(c.g_sp, 'foo')
+ c.g_e8 = c.BAR8; check(c.g_e8, c.BAR8)
+ c.g_e16 = c.BAR16; check(c.g_e16, c.BAR16)
+ c.g_e32 = c.BAR32; check(c.g_e32, c.BAR32)
+ c.g_date.nWeekDay = 3; check(c.g_date.nWeekDay, 3)
+
+ local align_attr = c.is_msvc and [[
+ struct align_attr_ALIGN_SUFFIX {
+ char pad;
+ __declspec(align(ALIGN)) TYPE v;
+ };
+
+ int print_align_attr_ALIGN_SUFFIX(char* buf, struct align_attr_ALIGN_SUFFIX* p);
+ ]] or [[
+ struct align_attr_ALIGN_SUFFIX {
+ char pad;
+ TYPE v __attribute__(aligned(ALIGN));
+ };
+
+ int print_align_attr_ALIGN_SUFFIX(char* buf, struct align_attr_ALIGN_SUFFIX* p);
+ ]]
+
+ for suffix, type in pairs(types) do
+ local test = test_values[type]
+ --print('checkbuf', suffix, type, buf, test)
+ checkbuf(type, c['print_' .. suffix](buf, test), suffix)
+
+ if first then
+ ffi.cdef(align:gsub('SUFFIX', suffix):gsub('TYPE', type):gsub('ALIGN', 0))
+ end
+
+ local v = ffi.new('struct align_0_' .. suffix, {0, test})
+ checkalign(type, v, c['print_align_0_' .. suffix](buf, v))
+
+ for _,align in ipairs{1,2,4,8,16} do
+ if align > c.max_alignment() then
+ break
+ end
+
+ if first then
+ ffi.cdef(palign:gsub('SUFFIX', suffix):gsub('TYPE', type):gsub('ALIGN', align))
+ ffi.cdef(align_attr:gsub('SUFFIX', suffix):gsub('TYPE', type):gsub('ALIGN', align))
+ end
+
+ local v = ffi.new('struct align_' .. align .. '_' .. suffix, {0, test})
+ checkalign(type, v, c['print_align_' .. align .. '_' .. suffix](buf, v))
+
+ -- MSVC doesn't support aligned attributes on enums
+ if not type:match('^enum e[0-9]*$') or not c.is_msvc then
+ local v2 = ffi.new('struct align_attr_' .. align .. '_' .. suffix, {0, test})
+ checkalign(type, v2, c['print_align_attr_' .. align .. '_' .. suffix](buf, v2))
+ end
+ end
+
+ if not c.is_msvc then
+ if first then
+ local h = [[
+ struct align_attr_def_SUFFIX {
+ char pad;
+ TYPE v __attribute__(aligned);
+ };
+ int print_align_attr_def_SUFFIX(char* buf, struct align_attr_def_SUFFIX* p);
+ ]]
+ ffi.cdef(h:gsub('SUFFIX', suffix):gsub('TYPE', type))
+ end
+
+ local v = ffi.new('struct align_attr_def_' .. suffix, {0, test})
+ -- print(type)
+ -- print("Align " .. c['print_align_attr_def_' .. suffix](buf, v))
+ -- print(ffi.string(buf))
+ -- checkalign(type, v, c['print_align_attr_def_' .. suffix](buf, v))
+ end
+ end
+
+ local psz = ffi.new('size_t[1]')
+ local palign = ffi.new('size_t[1]')
+ local function check_align(type, test, ret)
+ --print('check_align', type, test, ret, ffi.string(buf), psz[0], palign[0])
+ check(tonumber(palign[0]), ffi.alignof(type))
+ check(tonumber(psz[0]), ffi.sizeof(type))
+ check(ret, #test)
+ check(test, ffi.string(buf))
+ end
+
+ for _, tnum in ipairs{8, 16, 32, 64} do
+ if first then
+ ffi.cdef(bitfields:gsub('TNUM',tnum))
+ end
+
+ check_align('struct bc'..tnum, '1 2', c['print_bc'..tnum](psz, palign, buf, {1,2}))
+ check_align('struct blz'..tnum, '1 2', c['print_blz'..tnum](psz, palign, buf, {1,2}))
+
+ for _, znum in ipairs{8, 16, 32, 64} do
+ for _, bnum in ipairs{7, 15, 31, 63} do
+ if bnum > znum then
+ break
+ end
+ if first then
+ ffi.cdef(bitzero:gsub('TNUM',tnum):gsub('ZNUM',znum):gsub('BNUM', bnum))
+ end
+ check_align('struct bz_'..tnum..'_'..znum..'_'..bnum, '1 2 3', c['print_bz_'..tnum..'_'..znum..'_'..bnum](psz, palign, buf, {1,2,3}))
+ end
+ end
+
+ for _, bnum in ipairs{7, 15, 31, 63} do
+ if bnum > tnum then
+ break
+ end
+ if first then
+ ffi.cdef(bitalign:gsub('TNUM',tnum):gsub('BNUM',bnum))
+ end
+ check_align('struct ba_'..tnum..'_'..bnum, '1 2', c['print_ba_'..tnum..'_'..bnum](psz, palign, buf, {1,2}))
+ end
+ end
+
+ check_align('struct Date', '1 2 3 4', c.print_date(psz, palign, buf, {1,2,3,4}))
+ check_align('struct Date2', '1 2 3 4', c.print_date2(psz, palign, buf, {1,2,3,4}))
+ check_align('struct sysv1', '1 2 3', c.print_sysv1(psz, palign, buf, {1,2,3}))
+ check_align('struct sysv2', '1 2 3 4 5 6', c.print_sysv2(psz, palign, buf, {1,2,3,4,5,6}))
+ check_align('struct sysv3', '1 2', c.print_sysv3(psz, palign, buf, {1,2}))
+ check_align('union sysv4', '1', c.print_sysv4(psz, palign, buf, {1}))
+ check_align('struct sysv5', '1 2 3', c.print_sysv5(psz, palign, buf, {1,2,3}))
+ check_align('struct sysv6', '1 2 3', c.print_sysv6(psz, palign, buf, {1,2,3}))
+ check_align('struct sysv7', '1 2 3 4 5', c.print_sysv7(psz, palign, buf, {1,2,3,4,5}))
+
+ local cbs = [[
+ typedef const char* (*__cdecl sfunc)(const char*);
+ int call_i(int (*__cdecl func)(int), int arg);
+ float call_f(float (*__cdecl func)(float), float arg);
+ double call_d(double (*__cdecl func)(double), double arg);
+ const char* call_s(sfunc func, const char* arg);
+ _Bool call_b(_Bool (*__cdecl func)(_Bool), _Bool arg);
+ double complex call_dc(double complex (*__cdecl func)(double complex), double complex arg);
+ float complex call_fc(float complex (*__cdecl func)(float complex), float complex arg);
+ enum e8 call_e8(enum e8 (*__cdecl func)(enum e8), enum e8 arg);
+ enum e16 call_e16(enum e16 (*__cdecl func)(enum e16), enum e16 arg);
+ enum e32 call_e32(enum e32 (*__cdecl func)(enum e32), enum e32 arg);
+ ]]
+
+ ffi.cdef(cbs:gsub('__cdecl', convention))
+
+ local u3 = ffi.new('uint64_t', 3)
+ check(c.call_i(function(a) return 2*a end, 3), 6)
+ assert(math.abs(c.call_d(function(a) return 2*a end, 3.2) - 6.4) < 0.0000000001)
+ assert(math.abs(c.call_f(function(a) return 2*a end, 3.2) - 6.4) < 0.000001)
+ check(ffi.string(c.call_s(function(s) return s + u3 end, 'foobar')), 'bar')
+ check(c.call_b(function(v) return not v end, true), false)
+ check(c.call_e8(function(v) return v + 1 end, c.FOO8), c.BAR8)
+ check(c.call_e16(function(v) return v + 1 end, c.FOO16), c.BAR16)
+ check(c.call_e32(function(v) return v + 1 end, c.FOO32), c.BAR32)
+
+ if c.have_complex() then
+ check(c.call_dc(function(v) return v + 2+3*i end, 4+6*i), 6+9*i)
+ check(c.call_fc(function(v) return v + 1+2*i end, 7+4*i), 8+6*i)
+ end
+
+ local u2 = ffi.new('uint64_t', 2)
+ local cb = ffi.new('sfunc', function(s) return s + u3 end)
+ check(ffi.string(cb('foobar')), 'bar')
+ check(ffi.string(c.call_s(cb, 'foobar')), 'bar')
+ cb:set(function(s) return s + u2 end)
+ check(ffi.string(c.call_s(cb, 'foobar')), 'obar')
+
+ local fp = ffi.new('struct fptr')
+ assert(fp.p == ffi.C.NULL)
+ fp.p = function(a) return 2*a end
+ assert(fp.p ~= ffi.C.NULL)
+ check(c.call_fptr(fp, 4), 8)
+ local suc, err = pcall(function() fp.p:set(function() end) end)
+ assert(not suc)
+ check(err:gsub('^.*: ',''), "can't set the function for a non-lua callback")
+
+ check(c.call_fptr({function(a) return 3*a end}, 5), 15)
+
+ local suc, err = pcall(c.call_s, function(s) error(ffi.string(s), 0) end, 'my error')
+ check(suc, false)
+ check(err, 'my error')
+
+ check(ffi.errno(), c.get_errno())
+ c.set_errno(3)
+ check(ffi.errno(), 3)
+ check(c.get_errno(), 3)
+ check(ffi.errno(4), 3)
+ check(ffi.errno(), 4)
+ check(c.get_errno(), 4)
+
+ local gccattr = {
+ __cdecl = 'int test_pow(int v) __attribute__((cdecl));',
+ __stdcall = 'int test_pow(int v) __attribute__(stdcall);',
+ __fastcall = '__attribute__(fastcall) int test_pow(int v);',
+ }
+
+ ffi.cdef(gccattr[convention])
+ check(c.test_pow(5), 25)
+
+ ffi.cdef [[
+ int va_list_size, va_list_align;
+ int vsnprintf(char* buf, size_t sz, const char* fmt, va_list ap);
+ ]]
+ ffi.new('va_list')
+ assert(ffi.debug().functions.vsnprintf ~= nil)
+ assert(ffi.istype('va_list', ffi.new('__builtin_va_list')))
+ assert(ffi.istype('va_list', ffi.new('__gnuc_va_list')))
+ check(ffi.sizeof('va_list'), c.va_list_size)
+ check(ffi.alignof('va_list'), c.va_list_align)
+
+ first = false
+end
+
+local c = ffi.C
+
+assert(c.sprintf(buf, "%g", 5.3) == 3 and ffi.string(buf) == '5.3')
+assert(c.sprintf(buf, "%d", false) == 1 and ffi.string(buf) == '0')
+assert(c.sprintf(buf, "%d%g", false, 6.7) == 4 and ffi.string(buf) == '06.7')
+
+assert(ffi.sizeof('uint32_t[?]', 32) == 32 * 4)
+assert(ffi.sizeof(ffi.new('uint32_t[?]', 32)) == 32 * 4)
+
+ffi.cdef [[
+struct vls {
+ struct {
+ char a;
+ struct {
+ char b;
+ char v[?];
+ } c;
+ } d;
+};
+struct vls2 {
+ char pad;
+ union {
+ uint8_t a;
+ uint16_t b;
+ };
+};
+]]
+
+assert(ffi.sizeof('struct vls', 3) == 5)
+assert(ffi.sizeof(ffi.new('struct vls', 4).d.c) == 5)
+assert(ffi.offsetof('struct vls2', 'a') == 2)
+assert(ffi.sizeof('struct vls2') == 4)
+
+ffi.cdef [[ static const int DUMMY = 8 << 2; ]]
+assert(ffi.C.DUMMY == 32)
+
+ffi.new('struct {const char* foo;}', {'foo'})
+
+assert(not pcall(function()
+ ffi.new('struct {char* foo;}', {'ff'})
+end))
+
+local mt = {}
+local vls = ffi.new(ffi.metatype('struct vls', mt), 1)
+
+assert(not pcall(function() return vls.key end))
+
+mt.__index = function(vls, key)
+ return function(vls, a, b)
+ return 'in index ' .. key .. ' ' .. vls.d.a .. ' ' .. a .. ' ' .. b
+ end
+end
+
+vls.d.a = 3
+check(vls:key('a', 'b'), 'in index key 3 a b')
+
+assert(not pcall(function() vls.k = 3 end))
+
+mt.__newindex = function(vls, key, val)
+ error('in newindex ' .. key .. ' ' .. vls.d.a .. ' ' .. val, 0)
+end
+
+vls.d.a = 4
+local suc, err = pcall(function() vls.key = 'val' end)
+assert(not suc)
+check(err, 'in newindex key 4 val')
+
+mt.__add = function(vls, a) return vls.d.a + a end
+mt.__sub = function(vls, a) return vls.d.a - a end
+mt.__mul = function(vls, a) return vls.d.a * a end
+mt.__div = function(vls, a) return vls.d.a / a end
+mt.__mod = function(vls, a) return vls.d.a % a end
+mt.__pow = function(vls, a) return vls.d.a ^ a end
+mt.__eq = function(vls, a) return u64(vls.d.a) == a end
+mt.__lt = function(vls, a) return u64(vls.d.a) < a end
+mt.__le = function(vls, a) return u64(vls.d.a) <= a end
+mt.__call = function(vls, a, b) return '__call', vls.d.a .. a .. (b or 'nil') end
+mt.__unm = function(vls) return -vls.d.a end
+mt.__concat = function(vls, a) return vls.d.a .. a end
+mt.__len = function(vls) return vls.d.a end
+mt.__tostring = function(vls) return 'string ' .. vls.d.a end
+
+vls.d.a = 5
+check(vls + 5, 10)
+check(vls - 5, 0)
+check(vls * 5, 25)
+check(vls / 5, 1)
+check(vls % 3, 2)
+check(vls ^ 3, 125)
+check(vls == u64(4), false)
+check(vls == u64(5), true)
+check(vls == u64(6), false)
+check(vls < u64(4), false)
+check(vls < u64(5), false)
+check(vls < u64(6), true)
+check(vls <= u64(4), false)
+check(vls <= u64(5), true)
+check(vls <= u64(6), true)
+check(-vls, -5)
+local a,b = vls('6')
+check(a, '__call')
+check(b, '56nil')
+check(tostring(vls), 'string 5')
+
+if _VERSION ~= 'Lua 5.1' then
+ check(vls .. 'str', '5str')
+ check(#vls, 5)
+end
+
+check(tostring(1.1+3.2*i), '1.1+3.2i')
+check((1+3*i)*(2+4*i), -10+10*i)
+check((3+2*i)*(3-2*i), 13+0*i)
+
+-- Should ignore unknown attributes
+ffi.cdef [[
+typedef int ALenum;
+__attribute__((dllimport)) void __attribute__((__cdecl__)) alEnable( ALenum capability );
+]]
+
+check(ffi.sizeof('struct {char foo[alignof(uint64_t)];}'), ffi.alignof('uint64_t'))
+
+-- Check native number type for int64_t/uint64_t function args/returns in Lua 5.3
+if _VERSION == "Lua 5.3" then
+ local native_7F = 0x7FFFFFFFFFFFFFFF
+ local cdata_long_7F = ffi.new("int64_t", 0x7FFFFFFFFFFFFFFF)
+ local cdata_ulong_7F = ffi.new("uint64_t", 0x7FFFFFFFFFFFFFFF)
+
+ local native_80 = 0x8000000000000000
+
+ for _, func in ipairs{ffi.C.add_i64, ffi.C.add_u64} do
+ -- 0x7FFFFFFFFFFFFFFF (native) + 1 == 0x8000000000000000 (native)
+ local res = func(native_7F, 1)
+ assert(type(res) == "number", "native_7F: returned value not a number")
+ assert(res == native_80, "native_7F: math error")
+
+ -- 0x7FFFFFFFFFFFFFFF (cdata int64_t) + 1 == 0x8000000000000000 (native)
+ local res = func(cdata_long_7F, 1)
+ assert(type(res) == "number", "cdata_long_7F: returned value not a number")
+ assert(res == native_80, "cdata_long_7F: math error")
+
+ -- 0x7FFFFFFFFFFFFFFF (cdata uint64_t) + 1 == 0x8000000000000000 (native)
+ local res = func(cdata_ulong_7F, 1)
+ assert(type(res) == "number", "cdata_ulong_7F: returned value not a number")
+ assert(res == native_80, "cdata_ulong_7F: math error")
+ end
+end
+
+-- Long double is not supported yet but it should be parsed
+ffi.cdef('long double foo(long double val);')
+check(tostring(ffi.debug().functions.foo):match('ctype(%b<>)'), '<long double (*)(long double)>')
+
+ffi.cdef [[
+typedef int byte1 __attribute__(mode(QI));
+typedef int byte2 __attribute__(mode(HI));
+typedef int byte4 __attribute__(mode(SI));
+typedef int byte8 __attribute__(mode(DI));
+typedef unsigned ubyte8 __attribute__(mode(DI));
+typedef int word __attribute__(mode(word));
+typedef int pointer __attribute__(mode(pointer));
+typedef int byte __attribute__(mode(byte));
+typedef float float4 __attribute__(mode(SF));
+typedef float float8 __attribute__(mode(DF));
+]]
+assert(ffi.istype('int8_t', ffi.new('byte1')))
+assert(ffi.istype('int16_t', ffi.new('byte2')))
+assert(ffi.istype('int32_t', ffi.new('byte4')))
+assert(ffi.istype('int64_t', ffi.new('byte8')))
+assert(ffi.istype('uint64_t', ffi.new('ubyte8')))
+check(ffi.sizeof('void*'), ffi.sizeof('pointer'))
+check(ffi.alignof('void*'), ffi.alignof('pointer'))
+check(ffi.sizeof('void*'), ffi.sizeof('word'))
+check(ffi.alignof('void*'), ffi.alignof('word'))
+assert(ffi.istype('int8_t', ffi.new('byte')))
+assert(ffi.istype('float', ffi.new('float4')))
+assert(ffi.istype('double', ffi.new('float8')))
+
+ffi.cdef('void register_foo(register int val);')
+check(tostring(ffi.debug().functions.register_foo):match('%b<>'), '<void (*)(int)>')
+
+ffi.cdef [[
+ typedef struct __sFILE FILE;
+]]
+
+assert(not ffi.istype('int', ffi.new('int*')))
+assert(not ffi.istype('int[]', ffi.new('int*')))
+assert(not ffi.istype('int[3]', ffi.new('int*')))
+assert(not ffi.istype('int[3]', ffi.new('int[2]')))
+assert(ffi.istype('const int[3]', ffi.new('const int[3]')))
+assert(ffi.istype('int[3]', ffi.new('const int[3]')))
+
+-- Crazy function pointer that takes an int and a function pointer and returns
+-- a function pointer. Type of &signal.
+check(tostring(ffi.typeof('void (*foo(int, void(*)(int)))(int)')):match('%b<>'), '<void (*(*)(int, void (*)(int)))(int)>')
+
+-- Make sure we pass all arguments to tonumber
+check(tonumber('FE', 16), 0xFE)
+
+-- Allow casts from pointer to numeric types
+ffi.cast('long', ffi.C.NULL)
+ffi.cast('int8_t', ffi.C.NULL)
+assert(not pcall(function() ffi.new('long', ffi.C.NULL) end))
+
+-- ffi.new and ffi.cast allow unpacked struct/arrays
+assert(ffi.new('int[3]', 1)[0] == 1)
+assert(ffi.new('int[3]', {1})[0] == 1)
+assert(ffi.new('int[3]', 1, 2)[1] == 2)
+assert(ffi.new('int[3]', {1, 2})[1] == 2)
+
+ffi.cdef[[
+struct var {
+ char ch[?];
+};
+]]
+local d = ffi.new('char[4]')
+local v = ffi.cast('struct var*', d)
+v.ch = {1,2,3,4}
+assert(v.ch[3] == 4)
+v.ch = "bar"
+assert(v.ch[3] == 0)
+assert(v.ch[2] == string.byte('r'))
+assert(d[1] == string.byte('a'))
+
+ffi.cast('char*', 1)
+
+-- 2 arg form of ffi.copy
+ffi.copy(d, 'bar')
+
+-- unsigned should be ignored for pointer rules
+ffi.cdef[[
+int strncmp(const signed char *s1, const unsigned char *s2, size_t n);
+]]
+assert(ffi.C.strncmp("two", "three", 3) ~= 0)
+
+ffi.fill(d, 3, 1)
+assert(d[2] == 1)
+ffi.fill(d, 3)
+assert(d[2] == 0)
+
+-- tests for __new
+ffi.cdef[[
+struct newtest {
+ int a;
+ int b;
+ int c;
+};
+]]
+
+local tp = ffi.metatype("struct newtest", {__new =
+ function(tp, x, y, z)
+ tp = ffi.new(tp)
+ tp.a, tp.b, tp.c = x, y, z
+ return tp
+ end})
+local v = tp(1, 2, 3)
+assert(v.a == 1 and v.b == 2 and v.c == 3)
+
+local tp = ffi.metatype("struct newtest", {__new =
+ function(tp, x, y, z)
+ tp = ffi.new(tp, {a = x, b = y, c = z})
+ return tp
+ end})
+local v = tp(1, 2, 3)
+assert(v.a == 1 and v.b == 2 and v.c == 3)
+
+-- tests for __pairs and __ipairs; not iterating just testing what is returned
+local tp = ffi.metatype("struct newtest",
+ {__pairs = function(tp) return tp.a, tp.b end, __ipairs = function(tp) return tp.b, tp.c end}
+)
+if _VERSION ~= 'Lua 5.1' then
+ local v = tp(1, 2, 3)
+ x, y = pairs(v)
+ assert(x == 1 and y == 2)
+ x, y = ipairs(v)
+ assert(x == 2 and y == 3)
+end
+
+-- test for pointer to struct having same metamethods
+local st = ffi.cdef "struct ptest {int a, b;};"
+local tp = ffi.metatype("struct ptest", {__index = function(s, k) return k end, __len = function(s) return 3 end})
+
+local a = tp(1, 2)
+assert(a.banana == "banana")
+assert(#a == 3)
+local b = ffi.new("int[2]")
+local c = ffi.cast("struct ptest *", b)
+assert(c.banana == "banana") -- should have same methods
+assert(#c == 3)
+
+
+ffi.cdef [[
+char buf[512];
+void test_call_echo(const char* c);
+void test_call_pppppii(void* a, void* b, void* c, void* d, void* e, int f, int g);
+void test_call_pppppiiiiii(void* p1, void* p2, void* p3, void* p4, void* p5, int i1, int i2, int i3, int i4, int i5, int i6);
+void test_call_pppppffffff(void* p1, void* p2, void* p3, void* p4, void* p5, float f1, float f2, float f3, float f4, float f5, float f6);
+void test_call_pppppiifiii(void* p1, void* p2, void* p3, void* p4, void* p5, int i1, int i2, float f3, int i4, int i5, int i6);
+void test_call_pppppiiifii(void* p1, void* p2, void* p3, void* p4, void* p5, int i1, int i2, int i3, float i4, int i5, int i6);
+]]
+
+ffi.C.test_call_echo("input")
+assert(ffi.C.buf == "input")
+
+local function ptr(x) return ffi.new('void*', x) end
+
+ffi.C.test_call_pppppii(ptr(1), ptr(2), ptr(3), ptr(4), ptr(5), 6, 7)
+assert(ffi.C.buf == "0x1 0x2 0x3 0x4 0x5 6 7")
+
+ffi.C.test_call_pppppiiiiii(ptr(1), ptr(2), ptr(3), ptr(4), ptr(5), 6, 7, 8, 9, 10, 11)
+assert(ffi.C.buf == "0x1 0x2 0x3 0x4 0x5 6 7 8 9 10 11")
+
+ffi.C.test_call_pppppffffff(ptr(1), ptr(2), ptr(3), ptr(4), ptr(5), 6.5, 7.5, 8.5, 9.5, 10.5, 11.5)
+assert(ffi.C.buf == "0x1 0x2 0x3 0x4 0x5 6.5 7.5 8.5 9.5 10.5 11.5")
+
+ffi.C.test_call_pppppiifiii(ptr(1), ptr(2), ptr(3), ptr(4), ptr(5), 6, 7, 8.5, 9, 10, 11)
+assert(ffi.C.buf == "0x1 0x2 0x3 0x4 0x5 6 7 8.5 9 10 11")
+
+ffi.C.test_call_pppppiiifii(ptr(1), ptr(2), ptr(3), ptr(4), ptr(5), 6, 7, 8, 9.5, 10, 11)
+assert(ffi.C.buf == "0x1 0x2 0x3 0x4 0x5 6 7 8 9.5 10 11")
+
+local sum = ffi.C.add_dc(ffi.new('complex', 1, 2), ffi.new('complex', 3, 5))
+assert(ffi.istype('complex', sum))
+
+sum = ffi.C.add_fc(ffi.new('complex float', 1, 2), ffi.new('complex float', 3, 5))
+assert(ffi.istype('complex float', sum))
+
+ffi.cdef [[
+struct Arrays {
+ int ints[3];
+ unsigned int uints[3];
+};
+struct ArrayOfArrays {
+ struct Arrays arrays[3];
+};
+]]
+
+local struct = ffi.new('struct Arrays')
+local structOfStructs = ffi.new('struct ArrayOfArrays')
+for i=0,2 do
+ struct.ints[i] = i
+ struct.uints[i] = i
+ structOfStructs.arrays[0].ints[i] = i
+end
+for i=0,2 do
+ assert(struct.ints[i] == i)
+ assert(struct.uints[i] == i)
+ assert(structOfStructs.arrays[0].ints[i] == i)
+end
+
+-- Test ffi.string
+local buf = ffi.new('char[5]')
+ffi.fill(buf, 4, 97)
+buf[4] = 0
+
+assert(ffi.string(buf) == 'aaaa')
+assert(ffi.string(buf, 4) == 'aaaa')
+assert(ffi.string(buf, 2) == 'aa')
+assert(ffi.string(buf, 0) == '')
+assert(ffi.string(buf, ffi.new('long long', 2)) == 'aa')
+assert(ffi.string(buf, ffi.new('int', 2)) == 'aa')
+
+-- Test io.tmpfile()
+ffi.cdef [[
+ int fprintf ( FILE * stream, const char * format, ... );
+]]
+local f = io.tmpfile()
+ffi.C.fprintf(f, "test: %s\n", "foo")
+
+f:seek("set", 0)
+local str = f:read('*l')
+assert(str == 'test: foo', str)
+f:close()
+
+print('Test PASSED')
diff --git a/Build/source/texk/web2c/luatexdir/tex/commands.w b/Build/source/texk/web2c/luatexdir/tex/commands.w
index 04eba945b1c..c267904f0d9 100644
--- a/Build/source/texk/web2c/luatexdir/tex/commands.w
+++ b/Build/source/texk/web2c/luatexdir/tex/commands.w
@@ -1,878 +1,879 @@
-% commands.w
-%
-% Copyright 2009-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\eTeX{e-\TeX}
-
-@ @c
-
-
-#include "ptexlib.h"
-
-@ The symbolic names for glue parameters are put into \TeX's hash table
-by using the routine called |primitive|, defined below. Let us enter them
-now, so that we don't have to list all those parameter names anywhere else.
-
-@c
-void initialize_commands(void)
-{
-
- primitive_tex("lineskip", assign_glue_cmd, glue_base + line_skip_code, glue_base);
- primitive_tex("baselineskip", assign_glue_cmd, glue_base + baseline_skip_code, glue_base);
- primitive_tex("parskip", assign_glue_cmd, glue_base + par_skip_code, glue_base);
- primitive_tex("abovedisplayskip", assign_glue_cmd, glue_base + above_display_skip_code, glue_base);
- primitive_tex("belowdisplayskip", assign_glue_cmd, glue_base + below_display_skip_code, glue_base);
- primitive_tex("abovedisplayshortskip", assign_glue_cmd, glue_base + above_display_short_skip_code, glue_base);
- primitive_tex("belowdisplayshortskip", assign_glue_cmd, glue_base + below_display_short_skip_code, glue_base);
- primitive_tex("leftskip", assign_glue_cmd, glue_base + left_skip_code, glue_base);
- primitive_tex("rightskip", assign_glue_cmd, glue_base + right_skip_code, glue_base);
- primitive_tex("topskip", assign_glue_cmd, glue_base + top_skip_code, glue_base);
- primitive_tex("splittopskip", assign_glue_cmd, glue_base + split_top_skip_code, glue_base);
- primitive_tex("tabskip", assign_glue_cmd, glue_base + tab_skip_code, glue_base);
- primitive_tex("spaceskip", assign_glue_cmd, glue_base + space_skip_code, glue_base);
- primitive_tex("xspaceskip", assign_glue_cmd, glue_base + xspace_skip_code, glue_base);
- primitive_tex("parfillskip", assign_glue_cmd, glue_base + par_fill_skip_code, glue_base);
- primitive_tex("thinmuskip", assign_mu_glue_cmd, glue_base + thin_mu_skip_code, glue_base + thin_mu_skip_code);
- primitive_tex("medmuskip", assign_mu_glue_cmd, glue_base + med_mu_skip_code, glue_base + thin_mu_skip_code);
- primitive_tex("thickmuskip", assign_mu_glue_cmd, glue_base + thick_mu_skip_code, glue_base + thin_mu_skip_code);
- primitive_luatex("mathsurroundskip", assign_glue_cmd, glue_base + math_skip_code, glue_base);
- primitive_luatex("mathsurroundmode", assign_int_cmd, int_base + math_skip_mode_code, int_base);
- primitive_tex("output", assign_toks_cmd, output_routine_loc, local_base);
- primitive_tex("everypar", assign_toks_cmd, every_par_loc, local_base);
- primitive_tex("everymath", assign_toks_cmd, every_math_loc, local_base);
- primitive_tex("everydisplay", assign_toks_cmd, every_display_loc, local_base);
- primitive_tex("everyhbox", assign_toks_cmd, every_hbox_loc, local_base);
- primitive_tex("everyvbox", assign_toks_cmd, every_vbox_loc, local_base);
- primitive_tex("everyjob", assign_toks_cmd, every_job_loc, local_base);
- primitive_tex("everycr", assign_toks_cmd, every_cr_loc, local_base);
- primitive_tex("errhelp", assign_toks_cmd, err_help_loc, local_base);
-
- /* The integer parameter names must be entered into the hash table */
-
- primitive_tex("pretolerance", assign_int_cmd, int_base + pretolerance_code, int_base);
- primitive_tex("tolerance", assign_int_cmd, int_base + tolerance_code, int_base);
- primitive_tex("linepenalty", assign_int_cmd, int_base + line_penalty_code, int_base);
- primitive_tex("hyphenpenalty", assign_int_cmd, int_base + hyphen_penalty_code, int_base);
- primitive_tex("exhyphenpenalty", assign_int_cmd, int_base + ex_hyphen_penalty_code, int_base);
- primitive_tex("clubpenalty", assign_int_cmd, int_base + club_penalty_code, int_base);
- primitive_tex("widowpenalty", assign_int_cmd, int_base + widow_penalty_code, int_base);
- primitive_tex("displaywidowpenalty", assign_int_cmd, int_base + display_widow_penalty_code, int_base);
- primitive_tex("brokenpenalty", assign_int_cmd, int_base + broken_penalty_code, int_base);
- primitive_tex("binoppenalty", assign_int_cmd, int_base + bin_op_penalty_code, int_base);
- primitive_tex("relpenalty", assign_int_cmd, int_base + rel_penalty_code, int_base);
- primitive_tex("predisplaypenalty", assign_int_cmd, int_base + pre_display_penalty_code, int_base);
- primitive_tex("postdisplaypenalty", assign_int_cmd, int_base + post_display_penalty_code, int_base);
- primitive_tex("interlinepenalty", assign_int_cmd, int_base + inter_line_penalty_code, int_base);
- primitive_tex("doublehyphendemerits", assign_int_cmd, int_base + double_hyphen_demerits_code, int_base);
- primitive_tex("finalhyphendemerits", assign_int_cmd, int_base + final_hyphen_demerits_code, int_base);
- primitive_tex("adjdemerits", assign_int_cmd, int_base + adj_demerits_code, int_base);
- primitive_tex("mag", assign_int_cmd, int_base + mag_code, int_base);
- primitive_tex("delimiterfactor", assign_int_cmd, int_base + delimiter_factor_code, int_base);
- primitive_tex("looseness", assign_int_cmd, int_base + looseness_code, int_base);
- primitive_tex("time", assign_int_cmd, int_base + time_code, int_base);
- primitive_tex("day", assign_int_cmd, int_base + day_code, int_base);
- primitive_tex("month", assign_int_cmd, int_base + month_code, int_base);
- primitive_tex("year", assign_int_cmd, int_base + year_code, int_base);
- primitive_tex("showboxbreadth", assign_int_cmd, int_base + show_box_breadth_code, int_base);
- primitive_tex("showboxdepth", assign_int_cmd, int_base + show_box_depth_code, int_base);
- primitive_tex("hbadness", assign_int_cmd, int_base + hbadness_code, int_base);
- primitive_tex("vbadness", assign_int_cmd, int_base + vbadness_code, int_base);
- primitive_tex("pausing", assign_int_cmd, int_base + pausing_code, int_base);
- primitive_tex("tracingonline", assign_int_cmd, int_base + tracing_online_code, int_base);
- primitive_tex("tracingmacros", assign_int_cmd, int_base + tracing_macros_code, int_base);
- primitive_tex("tracingstats", assign_int_cmd, int_base + tracing_stats_code, int_base);
- primitive_tex("tracingparagraphs", assign_int_cmd, int_base + tracing_paragraphs_code, int_base);
- primitive_tex("tracingpages", assign_int_cmd, int_base + tracing_pages_code, int_base);
- primitive_tex("tracingoutput", assign_int_cmd, int_base + tracing_output_code, int_base);
- primitive_tex("tracinglostchars", assign_int_cmd, int_base + tracing_lost_chars_code, int_base);
- primitive_tex("tracingcommands", assign_int_cmd, int_base + tracing_commands_code, int_base);
- primitive_tex("tracingrestores", assign_int_cmd, int_base + tracing_restores_code, int_base);
- primitive_tex("uchyph", assign_int_cmd, int_base + uc_hyph_code, int_base);
- primitive_tex("outputpenalty", assign_int_cmd, int_base + output_penalty_code, int_base);
- primitive_tex("maxdeadcycles", assign_int_cmd, int_base + max_dead_cycles_code, int_base);
- primitive_tex("hangafter", assign_int_cmd, int_base + hang_after_code, int_base);
- primitive_tex("floatingpenalty", assign_int_cmd, int_base + floating_penalty_code, int_base);
- primitive_tex("globaldefs", assign_int_cmd, int_base + global_defs_code, int_base);
- primitive_tex("fam", assign_int_cmd, int_base + cur_fam_code, int_base);
- primitive_tex("escapechar", assign_int_cmd, int_base + escape_char_code, int_base);
- primitive_tex("defaulthyphenchar", assign_int_cmd, int_base + default_hyphen_char_code, int_base);
- primitive_tex("defaultskewchar", assign_int_cmd, int_base + default_skew_char_code, int_base);
- primitive_tex("endlinechar", assign_int_cmd, int_base + end_line_char_code, int_base);
- primitive_tex("newlinechar", assign_int_cmd, int_base + new_line_char_code, int_base);
- primitive_tex("language", assign_int_cmd, int_base + language_code, int_base);
- primitive_tex("setlanguage", assign_int_cmd, int_base + cur_lang_code, int_base);
- primitive_tex("firstvalidlanguage", assign_int_cmd, int_base + first_valid_language_code, int_base);
- primitive_tex("exhyphenchar", assign_int_cmd, int_base + ex_hyphen_char_code, int_base);
- primitive_tex("lefthyphenmin", assign_int_cmd, int_base + left_hyphen_min_code, int_base);
- primitive_tex("righthyphenmin", assign_int_cmd, int_base + right_hyphen_min_code, int_base);
- primitive_tex("holdinginserts", assign_int_cmd, int_base + holding_inserts_code, int_base);
- primitive_tex("errorcontextlines", assign_int_cmd, int_base + error_context_lines_code, int_base);
- primitive_luatex("nokerns", assign_int_cmd, int_base + disable_kern_code, int_base);
- primitive_luatex("noligs", assign_int_cmd, int_base + disable_lig_code, int_base);
- primitive_luatex("nospaces", assign_int_cmd, int_base + disable_space_code, int_base);
- primitive_luatex("catcodetable", assign_int_cmd, int_base + cat_code_table_code, int_base);
- primitive_luatex("outputbox", assign_int_cmd, int_base + output_box_code, int_base);
- primitive_luatex("outputmode", assign_int_cmd, int_base + output_mode_code, int_base);
- primitive_luatex("adjustspacing", assign_int_cmd, int_base + adjust_spacing_code, int_base);
- primitive_luatex("protrudechars", assign_int_cmd, int_base + protrude_chars_code, int_base);
- primitive_luatex("tracingfonts", assign_int_cmd, int_base + tracing_fonts_code, int_base);
- primitive_luatex("draftmode", assign_int_cmd, int_base + draft_mode_code, int_base);
- primitive_tex("parindent", assign_dimen_cmd, dimen_base + par_indent_code, dimen_base);
- primitive_tex("mathsurround", assign_dimen_cmd, dimen_base + math_surround_code, dimen_base);
- primitive_tex("lineskiplimit", assign_dimen_cmd, dimen_base + line_skip_limit_code, dimen_base);
- primitive_tex("hsize", assign_dimen_cmd, dimen_base + hsize_code, dimen_base);
- primitive_tex("vsize", assign_dimen_cmd, dimen_base + vsize_code, dimen_base);
- primitive_tex("maxdepth", assign_dimen_cmd, dimen_base + max_depth_code, dimen_base);
- primitive_tex("splitmaxdepth", assign_dimen_cmd, dimen_base + split_max_depth_code, dimen_base);
- primitive_tex("boxmaxdepth", assign_dimen_cmd, dimen_base + box_max_depth_code, dimen_base);
- primitive_tex("hfuzz", assign_dimen_cmd, dimen_base + hfuzz_code, dimen_base);
- primitive_tex("vfuzz", assign_dimen_cmd, dimen_base + vfuzz_code, dimen_base);
- primitive_tex("delimitershortfall", assign_dimen_cmd, dimen_base + delimiter_shortfall_code, dimen_base);
- primitive_tex("nulldelimiterspace", assign_dimen_cmd, dimen_base + null_delimiter_space_code, dimen_base);
- primitive_tex("scriptspace", assign_dimen_cmd, dimen_base + script_space_code, dimen_base);
- primitive_tex("predisplaysize", assign_dimen_cmd, dimen_base + pre_display_size_code, dimen_base);
- primitive_tex("displaywidth", assign_dimen_cmd, dimen_base + display_width_code, dimen_base);
- primitive_tex("displayindent", assign_dimen_cmd, dimen_base + display_indent_code, dimen_base);
- primitive_tex("overfullrule", assign_dimen_cmd, dimen_base + overfull_rule_code, dimen_base);
- primitive_tex("hangindent", assign_dimen_cmd, dimen_base + hang_indent_code, dimen_base);
- primitive_tex("hoffset", assign_dimen_cmd, dimen_base + h_offset_code, dimen_base);
- primitive_tex("voffset", assign_dimen_cmd, dimen_base + v_offset_code, dimen_base);
- primitive_tex("emergencystretch", assign_dimen_cmd, dimen_base + emergency_stretch_code, dimen_base);
- primitive_luatex("pagewidth", assign_dimen_cmd, dimen_base + page_width_code, dimen_base);
- primitive_luatex("pageheight", assign_dimen_cmd, dimen_base + page_height_code, dimen_base);
- primitive_luatex("pxdimen", assign_dimen_cmd, dimen_base + px_dimen_code, dimen_base);
-
- /* Many of \TeX's primitives need no |equiv|, since they are identifiable
- by their |eq_type| alone. These primitives are loaded into the hash table
- as follows: */
-
- primitive_tex(" ", ex_space_cmd, 0, 0);
- primitive_tex("/", ital_corr_cmd, 0, 0);
- primitive_tex("accent", accent_cmd, 0, 0);
- primitive_tex("advance", advance_cmd, 0, 0);
- primitive_tex("afterassignment", after_assignment_cmd, 0, 0);
- primitive_tex("aftergroup", after_group_cmd, 0, 0);
- primitive_tex("begingroup", begin_group_cmd, 0, 0);
- primitive_tex("char", char_num_cmd, 0, 0);
- primitive_tex("csname", cs_name_cmd, 0, 0);
- primitive_luatex("lastnamedcs", cs_name_cmd, 1, 0);
- primitive_luatex("begincsname", cs_name_cmd, 2, 0);
- primitive_tex("delimiter", delim_num_cmd, 0, 0);
- primitive_luatex("Udelimiter", delim_num_cmd, 1, 0);
- primitive_tex("divide", divide_cmd, 0, 0);
- primitive_tex("endcsname", end_cs_name_cmd, 0, 0);
- primitive_tex("endgroup", end_group_cmd, 0, 0);
- cs_text(frozen_end_group) = maketexstring("endgroup");
- eqtb[frozen_end_group] = eqtb[cur_val];
- primitive_tex("expandafter", expand_after_cmd, 0, 0);
- primitive_tex("font", def_font_cmd, 0, 0);
- primitive_luatex("letterspacefont", letterspace_font_cmd, 0, 0);
- primitive_luatex("expandglyphsinfont", normal_cmd, expand_font_code, 0);
- primitive_luatex("copyfont", copy_font_cmd, 0, 0);
- primitive_luatex("setfontid", set_font_id_cmd, 0, 0);
- primitive_tex("fontdimen", assign_font_dimen_cmd, 0, 0);
- primitive_tex("halign", halign_cmd, 0, 0);
- primitive_tex("hrule", hrule_cmd, 0, 0);
- primitive_luatex("nohrule", no_hrule_cmd, 0, 0);
- primitive_tex("ignorespaces", ignore_spaces_cmd, 0, 0);
- primitive_tex("insert", insert_cmd, 0, 0);
- primitive_luatex("leftghost", char_ghost_cmd, 0, 0);
- primitive_tex("mark", mark_cmd, 0, 0);
- primitive_tex("mathaccent", math_accent_cmd, 0, 0);
- primitive_luatex("Umathaccent", math_accent_cmd, 1, 0);
- primitive_tex("mathchar", math_char_num_cmd, 0, 0);
- primitive_luatex("Umathchar", math_char_num_cmd, 1, 0);
- primitive_luatex("Umathcharnum", math_char_num_cmd, 2, 0);
- primitive_tex("mathchoice", math_choice_cmd, 0, 0);
- primitive_luatex("Ustack", math_choice_cmd, 1, 0);
- primitive_tex("multiply", multiply_cmd, 0, 0);
- primitive_tex("noalign", no_align_cmd, 0, 0);
- primitive_tex("noboundary", boundary_cmd, 0, 0);
- primitive_tex("boundary", boundary_cmd, 1, 0);
- primitive_tex("protrusionboundary", boundary_cmd, 2, 0);
- primitive_tex("wordboundary", boundary_cmd, 3, 0);
- primitive_tex("noexpand", no_expand_cmd, 0, 0);
- primitive_luatex("primitive", no_expand_cmd, 1, 0);
- primitive_tex("nonscript", non_script_cmd, 0, 0);
- primitive_tex("omit", omit_cmd, 0, 0);
- primitive_tex("parshape", set_tex_shape_cmd, par_shape_loc, par_shape_loc);
- primitive_tex("penalty", break_penalty_cmd, 0, 0);
- primitive_tex("prevgraf", set_prev_graf_cmd, 0, 0);
- primitive_tex("radical", radical_cmd, 0, 0);
- primitive_luatex("Uradical", radical_cmd, 1, 0);
- primitive_luatex("Uroot", radical_cmd, 2, 0);
- primitive_luatex("Uunderdelimiter", radical_cmd, 3, 0);
- primitive_luatex("Uoverdelimiter", radical_cmd, 4, 0);
- primitive_luatex("Udelimiterunder", radical_cmd, 5, 0);
- primitive_luatex("Udelimiterover", radical_cmd, 6, 0);
- primitive_luatex("Uhextensible", radical_cmd, 7, 0);
- primitive_tex("read", read_to_cs_cmd, 0, 0);
- primitive_tex("relax", relax_cmd, too_big_char, too_big_char);
- cs_text(frozen_relax) = maketexstring("relax");
- eqtb[frozen_relax] = eqtb[cur_val];
- primitive_luatex("rightghost", char_ghost_cmd, 1, 0);
- primitive_tex("setbox", set_box_cmd, 0, 0);
- primitive_tex("the", the_cmd, 0, 0);
- primitive_luatex("toksapp", combine_toks_cmd, 0, 0);
- primitive_luatex("tokspre", combine_toks_cmd, 1, 0);
- primitive_luatex("etoksapp", combine_toks_cmd, 2, 0);
- primitive_luatex("etokspre", combine_toks_cmd, 3, 0);
- primitive_tex("toks", toks_register_cmd, 0, 0);
- primitive_tex("vadjust", vadjust_cmd, 0, 0);
- primitive_tex("valign", valign_cmd, 0, 0);
- primitive_tex("vcenter", vcenter_cmd, 0, 0);
- primitive_tex("vrule", vrule_cmd, 0, 0);
- primitive_luatex("novrule", no_vrule_cmd, 0, 0);
- primitive_tex("par", par_end_cmd, too_big_char, too_big_char); /* cf.\ |scan_file_name| */
- par_loc = cur_val;
- par_token = cs_token_flag + par_loc;
- @<Create a bunch of primitives@>;
- @<Create the math param primitives@>;
- @<Create another bunch of primitives@>;
-}
-
-
-@ These are in a separate module due to a CWEAVE limitation.
-
-@<Create a bunch of primitives@>=
-
- /*
- The processing of \.{\\input} involves the |start_input| subroutine,
- which will be declared later; the processing of \.{\\endinput} is trivial.
- */
-
- primitive_tex("input", input_cmd, 0, 0);
- primitive_tex("endinput", input_cmd, 1, 0);
- primitive_tex("topmark", top_bot_mark_cmd, top_mark_code, 0);
- primitive_tex("firstmark", top_bot_mark_cmd, first_mark_code, 0);
- primitive_tex("botmark", top_bot_mark_cmd, bot_mark_code, 0);
- primitive_tex("splitfirstmark", top_bot_mark_cmd, split_first_mark_code, 0);
- primitive_tex("splitbotmark", top_bot_mark_cmd, split_bot_mark_code, 0);
- primitive_luatex("clearmarks", mark_cmd, clear_marks_code, 0);
- primitive_etex("marks", mark_cmd, marks_code, 0);
- primitive_etex("topmarks", top_bot_mark_cmd, top_mark_code + marks_code, 0);
- primitive_etex("firstmarks", top_bot_mark_cmd, first_mark_code + marks_code, 0);
- primitive_etex("botmarks", top_bot_mark_cmd, bot_mark_code + marks_code, 0);
- primitive_etex("splitfirstmarks", top_bot_mark_cmd, split_first_mark_code + marks_code, 0);
- primitive_etex("splitbotmarks", top_bot_mark_cmd, split_bot_mark_code + marks_code, 0);
-
- /*
- The hash table is initialized with `\.{\\count}', `\.{\\attribute}',
- `\.{\\dimen}', `\.{\\skip}', and `\.{\\muskip}' all having |register|
- as their command code; they are distinguished by the |chr_code|, which
- is either |int_val|, |attr_val|, |dimen_val|, |glue_val|, or |mu_val|.
- */
-
- primitive_tex("count", register_cmd, int_val_level, 0);
- primitive_luatex("attribute", register_cmd, attr_val_level, 0);
- primitive_tex("dimen", register_cmd, dimen_val_level, 0);
- primitive_tex("skip", register_cmd, glue_val_level, 0);
- primitive_tex("muskip", register_cmd, mu_val_level, 0);
-
- primitive_tex("spacefactor", set_aux_cmd, hmode, 0);
- primitive_tex("prevdepth", set_aux_cmd, vmode, 0);
- primitive_tex("deadcycles", set_page_int_cmd, 0, 0);
- primitive_tex("insertpenalties", set_page_int_cmd, 1, 0);
- primitive_tex("wd", set_box_dimen_cmd, width_offset, 0);
- primitive_tex("ht", set_box_dimen_cmd, height_offset, 0);
- primitive_tex("dp", set_box_dimen_cmd, depth_offset, 0);
- primitive_tex("lastpenalty", last_item_cmd, lastpenalty_code, 0);
- primitive_tex("lastkern", last_item_cmd, lastkern_code, 0);
- primitive_tex("lastskip", last_item_cmd, lastskip_code, 0);
- primitive_tex("inputlineno", last_item_cmd, input_line_no_code, 0);
- primitive_tex("badness", last_item_cmd, badness_code, 0);
- primitive_luatex("luatexversion", last_item_cmd, luatex_version_code, 0);
- primitive_luatex("lastsavedboxresourceindex", last_item_cmd, last_saved_box_resource_index_code, 0);
- primitive_luatex("lastsavedimageresourceindex", last_item_cmd, last_saved_image_resource_index_code, 0);
- primitive_luatex("lastsavedimageresourcepages", last_item_cmd, last_saved_image_resource_pages_code, 0);
- primitive_luatex("lastxpos", last_item_cmd, last_x_pos_code, 0);
- primitive_luatex("lastypos", last_item_cmd, last_y_pos_code, 0);
- primitive_luatex("randomseed", last_item_cmd, random_seed_code, 0);
-
- primitive_tex("number", convert_cmd, number_code, 0);
- primitive_tex("romannumeral", convert_cmd, roman_numeral_code, 0);
- primitive_tex("string", convert_cmd, string_code, 0);
- primitive_tex("csstring", convert_cmd, cs_string_code, 0);
- primitive_tex("meaning", convert_cmd, meaning_code, 0);
- primitive_etex("eTeXVersion", convert_cmd, etex_code, 0);
- primitive_tex("fontname", convert_cmd, font_name_code, 0);
- primitive_luatex("fontid", convert_cmd, font_id_code, 0);
- primitive_luatex("luatexrevision", convert_cmd, luatex_revision_code, 0);
- primitive_luatex("luatexdatestamp", convert_cmd, luatex_date_code, 0);
- primitive_luatex("luatexbanner", convert_cmd, luatex_banner_code, 0);
- primitive_luatex("leftmarginkern", convert_cmd, left_margin_kern_code, 0);
- primitive_luatex("rightmarginkern", convert_cmd, right_margin_kern_code, 0);
- primitive_luatex("uniformdeviate", convert_cmd, uniform_deviate_code, 0);
- primitive_luatex("normaldeviate", convert_cmd, normal_deviate_code, 0);
- primitive_core("directlua", convert_cmd, lua_code, 0);
- primitive_luatex("luafunction", convert_cmd, lua_function_code, 0);
- primitive_luatex("luaescapestring", convert_cmd, lua_escape_string_code, 0);
- primitive_luatex("mathstyle", convert_cmd, math_style_code, 0);
- primitive_luatex("expanded", convert_cmd, expanded_code, 0);
- primitive_tex("jobname", convert_cmd, job_name_code, 0);
- primitive_luatex("formatname", convert_cmd, format_name_code, 0);
- primitive_luatex("Uchar", convert_cmd, uchar_code, 0);
-
- primitive_luatex("Umathcharclass", convert_cmd, math_char_class_code, 0);
- primitive_luatex("Umathcharfam", convert_cmd, math_char_fam_code, 0);
- primitive_luatex("Umathcharslot", convert_cmd, math_char_slot_code, 0);
-
- primitive_tex("if", if_test_cmd, if_char_code, 0);
- primitive_tex("ifcat", if_test_cmd, if_cat_code, 0);
- primitive_tex("ifnum", if_test_cmd, if_int_code, 0);
- primitive_tex("ifdim", if_test_cmd, if_dim_code, 0);
- primitive_tex("ifodd", if_test_cmd, if_odd_code, 0);
- primitive_tex("ifvmode", if_test_cmd, if_vmode_code, 0);
- primitive_tex("ifhmode", if_test_cmd, if_hmode_code, 0);
- primitive_tex("ifmmode", if_test_cmd, if_mmode_code, 0);
- primitive_tex("ifinner", if_test_cmd, if_inner_code, 0);
- primitive_tex("ifvoid", if_test_cmd, if_void_code, 0);
-
- primitive_tex("ifhbox", if_test_cmd, if_hbox_code, 0);
- primitive_tex("ifvbox", if_test_cmd, if_vbox_code, 0);
- primitive_tex("ifx", if_test_cmd, ifx_code, 0);
- primitive_tex("ifeof", if_test_cmd, if_eof_code, 0);
- primitive_tex("iftrue", if_test_cmd, if_true_code, 0);
- primitive_tex("iffalse", if_test_cmd, if_false_code, 0);
- primitive_tex("ifcase", if_test_cmd, if_case_code, 0);
- primitive_luatex("ifprimitive", if_test_cmd, if_primitive_code, 0);
- primitive_tex("fi", fi_or_else_cmd, fi_code, 0);
- cs_text(frozen_fi) = maketexstring("fi");
- eqtb[frozen_fi] = eqtb[cur_val];
- primitive_tex("or", fi_or_else_cmd, or_code, 0);
- primitive_tex("else", fi_or_else_cmd, else_code, 0);
-
- /*
- \TeX\ always knows at least one font, namely the null font. It has no
- characters, and its seven parameters are all equal to zero.
- */
-
- primitive_tex("nullfont", set_font_cmd, null_font, 0);
- cs_text(frozen_null_font) = maketexstring("nullfont");
- eqtb[frozen_null_font] = eqtb[cur_val];
-
- primitive_tex("span", tab_mark_cmd, span_code, tab_mark_cmd_code);
- primitive_luatex("aligntab", tab_mark_cmd, tab_mark_cmd_code, tab_mark_cmd_code);
- primitive_luatex("alignmark", mac_param_cmd, tab_mark_cmd_code, tab_mark_cmd_code);
- primitive_tex("cr", car_ret_cmd, cr_code, cr_code);
- cs_text(frozen_cr) = maketexstring("cr");
- eqtb[frozen_cr] = eqtb[cur_val];
- primitive_tex("crcr", car_ret_cmd, cr_cr_code, cr_code);
- cs_text(frozen_end_template) = maketexstring("endtemplate");
- cs_text(frozen_endv) = maketexstring("endtemplate");
- set_eq_type(frozen_endv, endv_cmd);
- set_equiv(frozen_endv, null_list);
- set_eq_level(frozen_endv, level_one);
- eqtb[frozen_end_template] = eqtb[frozen_endv];
- set_eq_type(frozen_end_template, end_template_cmd);
-
- primitive_tex("pagegoal", set_page_dimen_cmd, 0, 0);
- primitive_tex("pagetotal", set_page_dimen_cmd, 1, 0);
- primitive_tex("pagestretch", set_page_dimen_cmd, 2, 0);
- primitive_tex("pagefilstretch", set_page_dimen_cmd, 3, 0);
- primitive_tex("pagefillstretch", set_page_dimen_cmd, 4, 0);
- primitive_tex("pagefilllstretch", set_page_dimen_cmd, 5, 0);
- primitive_tex("pageshrink", set_page_dimen_cmd, 6, 0);
- primitive_tex("pagedepth", set_page_dimen_cmd, 7, 0);
-
- /*
- Either \.{\\dump} or \.{\\end} will cause |main_control| to enter the
- endgame, since both of them have `|stop|' as their command code.
- */
-
- primitive_tex("end", stop_cmd, 0, 0);
- primitive_tex("dump", stop_cmd, 1, 0);
-
- primitive_tex("hskip", hskip_cmd, skip_code, 0);
- primitive_tex("hfil", hskip_cmd, fil_code, 0);
- primitive_tex("hfill", hskip_cmd, fill_code, 0);
- primitive_tex("hss", hskip_cmd, ss_code, 0);
- primitive_tex("hfilneg", hskip_cmd, fil_neg_code, 0);
- primitive_tex("vskip", vskip_cmd, skip_code, 0);
- primitive_tex("vfil", vskip_cmd, fil_code, 0);
- primitive_tex("vfill", vskip_cmd, fill_code, 0);
- primitive_tex("vss", vskip_cmd, ss_code, 0);
- primitive_tex("vfilneg", vskip_cmd, fil_neg_code, 0);
- primitive_tex("mskip", mskip_cmd, mskip_code, 0);
- primitive_tex("kern", kern_cmd, explicit_kern, 0);
- primitive_tex("mkern", mkern_cmd, mu_glue, 0);
- primitive_tex("moveleft", hmove_cmd, 1, 0);
- primitive_tex("moveright", hmove_cmd, 0, 0);
- primitive_tex("raise", vmove_cmd, 1, 0);
- primitive_tex("lower", vmove_cmd, 0, 0);
- primitive_tex("box", make_box_cmd, box_code, 0);
- primitive_tex("copy", make_box_cmd, copy_code, 0);
- primitive_tex("lastbox", make_box_cmd, last_box_code, 0);
- primitive_tex("vsplit", make_box_cmd, vsplit_code, 0);
- primitive_tex("tpack", make_box_cmd, tpack_code, 0);
- primitive_tex("vpack", make_box_cmd, vpack_code, 0);
- primitive_tex("hpack", make_box_cmd, hpack_code, 0);
- primitive_tex("vtop", make_box_cmd, vtop_code, 0);
- primitive_tex("vbox", make_box_cmd, vtop_code + vmode, 0);
- primitive_tex("hbox", make_box_cmd, vtop_code + hmode, 0);
- primitive_tex("shipout", leader_ship_cmd, a_leaders - 1, 0); /* |ship_out_flag=leader_flag-1| */
- primitive_tex("leaders", leader_ship_cmd, a_leaders, 0);
- primitive_tex("cleaders", leader_ship_cmd, c_leaders, 0);
- primitive_tex("xleaders", leader_ship_cmd, x_leaders, 0);
- primitive_luatex("gleaders", leader_ship_cmd, g_leaders, 0);
- primitive_luatex("boxdir", assign_box_dir_cmd, 0, 0);
- primitive_tex("indent", start_par_cmd, 1, 0);
- primitive_tex("noindent", start_par_cmd, 0, 0);
- primitive_luatex("quitvmode", start_par_cmd, 2, 0);
- primitive_tex("unpenalty", remove_item_cmd, penalty_node, 0);
- primitive_tex("unkern", remove_item_cmd, kern_node, 0);
- primitive_tex("unskip", remove_item_cmd, glue_node, 0);
- primitive_tex("unhbox", un_hbox_cmd, box_code, 0);
- primitive_tex("unhcopy", un_hbox_cmd, copy_code, 0);
- primitive_tex("unvbox", un_vbox_cmd, box_code, 0);
- primitive_tex("unvcopy", un_vbox_cmd, copy_code, 0);
- primitive_tex("-", discretionary_cmd, explicit_disc, 0);
- primitive_tex("discretionary", discretionary_cmd, discretionary_disc, 0);
- primitive_luatex("localleftbox", assign_local_box_cmd, 0, 0);
- primitive_luatex("localrightbox", assign_local_box_cmd, 1, 0);
-
- primitive_luatex("Ustartmath", math_shift_cs_cmd, text_style, 0);
- primitive_luatex("Ustopmath", math_shift_cs_cmd, cramped_text_style, 0);
- primitive_luatex("Ustartdisplaymath", math_shift_cs_cmd, display_style, 0);
- primitive_luatex("Ustopdisplaymath", math_shift_cs_cmd, cramped_display_style, 0);
- primitive_tex("eqno", eq_no_cmd, 0, 0);
- primitive_tex("leqno", eq_no_cmd, 1, 0);
- primitive_tex("mathord", math_comp_cmd, ord_noad_type, 0);
- primitive_tex("mathop", math_comp_cmd, op_noad_type_normal, 0);
- primitive_tex("mathbin", math_comp_cmd, bin_noad_type, 0);
- primitive_tex("mathrel", math_comp_cmd, rel_noad_type, 0);
- primitive_tex("mathopen", math_comp_cmd, open_noad_type, 0);
- primitive_tex("mathclose", math_comp_cmd, close_noad_type, 0);
- primitive_tex("mathpunct", math_comp_cmd, punct_noad_type, 0);
- primitive_tex("mathinner", math_comp_cmd, inner_noad_type, 0);
- primitive_tex("underline", math_comp_cmd, under_noad_type, 0);
- primitive_tex("overline", math_comp_cmd, over_noad_type, 0);
- primitive_tex("displaylimits", limit_switch_cmd, op_noad_type_normal, 0);
- primitive_tex("limits", limit_switch_cmd, op_noad_type_limits, 0);
- primitive_tex("nolimits", limit_switch_cmd, op_noad_type_no_limits, 0);
- primitive_tex("displaystyle", math_style_cmd, display_style, 0);
- primitive_tex("textstyle", math_style_cmd, text_style, 0);
- primitive_tex("scriptstyle", math_style_cmd, script_style, 0);
- primitive_tex("scriptscriptstyle", math_style_cmd, script_script_style, 0);
- primitive_luatex("crampeddisplaystyle", math_style_cmd, cramped_display_style, 0);
- primitive_luatex("crampedtextstyle", math_style_cmd, cramped_text_style, 0);
- primitive_luatex("crampedscriptstyle", math_style_cmd, cramped_script_style, 0);
- primitive_luatex("crampedscriptscriptstyle", math_style_cmd, cramped_script_script_style, 0);
- primitive_luatex("Usuperscript", super_sub_script_cmd, sup_mark_cmd, sup_mark_cmd);
- primitive_luatex("Usubscript", super_sub_script_cmd, sub_mark_cmd, sup_mark_cmd);
- primitive_tex("above", above_cmd, above_code, 0);
- primitive_tex("over", above_cmd, over_code, 0);
- primitive_tex("atop", above_cmd, atop_code, 0);
- primitive_luatex("Uskewed", above_cmd, skewed_code, 0);
- primitive_tex("abovewithdelims", above_cmd, delimited_code + above_code, 0);
- primitive_tex("overwithdelims", above_cmd, delimited_code + over_code, 0);
- primitive_tex("atopwithdelims", above_cmd, delimited_code + atop_code, 0);
- primitive_luatex("Uskewedwithdelims", above_cmd, delimited_code + skewed_code, 0);
- primitive_tex("left", left_right_cmd, left_noad_side, 0);
- primitive_tex("right", left_right_cmd, right_noad_side, 0);
- primitive_tex("middle", left_right_cmd, middle_noad_side, 0);
- primitive_tex("Uleft", left_right_cmd, 10+left_noad_side, 0);
- primitive_tex("Uright", left_right_cmd, 10+right_noad_side, 0);
- primitive_tex("Umiddle", left_right_cmd, 10+middle_noad_side, 0);
- primitive_luatex("Uvextensible", left_right_cmd, 10+no_noad_side, 0);
- cs_text(frozen_right) = maketexstring("right");
- eqtb[frozen_right] = eqtb[cur_val];
-
- primitive_tex("long", prefix_cmd, 1, 0);
- primitive_tex("outer", prefix_cmd, 2, 0);
- primitive_tex("global", prefix_cmd, 4, 0);
- primitive_tex("def", def_cmd, 0, 0);
- primitive_tex("gdef", def_cmd, 1, 0);
- primitive_tex("edef", def_cmd, 2, 0);
- primitive_tex("xdef", def_cmd, 3, 0);
- primitive_tex("let", let_cmd, normal, 0);
- primitive_tex("futurelet", let_cmd, normal + 1, 0);
- primitive_luatex("letcharcode", let_cmd, normal + 2, 0);
- primitive_tex("chardef", shorthand_def_cmd, char_def_code, 0);
- primitive_tex("mathchardef", shorthand_def_cmd, math_char_def_code, 0);
- primitive_luatex("Umathchardef", shorthand_def_cmd, xmath_char_def_code, 0);
- primitive_luatex("Umathcharnumdef", shorthand_def_cmd, umath_char_def_code, 0);
- primitive_tex("countdef", shorthand_def_cmd, count_def_code, 0);
- primitive_luatex("attributedef", shorthand_def_cmd, attribute_def_code, 0);
- primitive_tex("dimendef", shorthand_def_cmd, dimen_def_code, 0);
- primitive_tex("skipdef", shorthand_def_cmd, skip_def_code, 0);
- primitive_tex("muskipdef", shorthand_def_cmd, mu_skip_def_code, 0);
- primitive_tex("toksdef", shorthand_def_cmd, toks_def_code, 0);
- primitive_tex("catcode", def_char_code_cmd, cat_code_base, cat_code_base);
- primitive_tex("mathcode", def_char_code_cmd, math_code_base, cat_code_base);
- primitive_tex("lccode", def_char_code_cmd, lc_code_base, cat_code_base);
- primitive_tex("uccode", def_char_code_cmd, uc_code_base, cat_code_base);
- primitive_tex("sfcode", def_char_code_cmd, sf_code_base, cat_code_base);
- primitive_tex("delcode", def_del_code_cmd, del_code_base, del_code_base);
- primitive_tex("textfont", def_family_cmd, text_size, 0);
- primitive_tex("scriptfont", def_family_cmd, script_size, 0);
- primitive_tex("scriptscriptfont", def_family_cmd, script_script_size, 0);
- primitive_luatex("Umathquad", set_math_param_cmd, math_param_quad, 0);
- primitive_luatex("Umathaxis", set_math_param_cmd, math_param_axis, 0);
-
-@ These are in a separate module due to a CWEAVE limitation.
-
-@<Create the math param primitives@>=
- primitive_luatex("Umathoperatorsize", set_math_param_cmd, math_param_operator_size, 0);
- primitive_luatex("Umathoverbarkern", set_math_param_cmd, math_param_overbar_kern, 0);
- primitive_luatex("Umathoverbarrule", set_math_param_cmd, math_param_overbar_rule, 0);
- primitive_luatex("Umathoverbarvgap", set_math_param_cmd, math_param_overbar_vgap, 0);
- primitive_luatex("Umathunderbarkern", set_math_param_cmd, math_param_underbar_kern, 0);
- primitive_luatex("Umathunderbarrule", set_math_param_cmd, math_param_underbar_rule, 0);
- primitive_luatex("Umathunderbarvgap", set_math_param_cmd, math_param_underbar_vgap, 0);
- primitive_luatex("Umathradicalkern", set_math_param_cmd, math_param_radical_kern, 0);
- primitive_luatex("Umathradicalrule", set_math_param_cmd, math_param_radical_rule, 0);
- primitive_luatex("Umathradicalvgap", set_math_param_cmd, math_param_radical_vgap, 0);
- primitive_luatex("Umathradicaldegreebefore", set_math_param_cmd, math_param_radical_degree_before, 0);
- primitive_luatex("Umathradicaldegreeafter", set_math_param_cmd, math_param_radical_degree_after, 0);
- primitive_luatex("Umathradicaldegreeraise", set_math_param_cmd, math_param_radical_degree_raise, 0);
- primitive_luatex("Umathstackvgap", set_math_param_cmd, math_param_stack_vgap, 0);
- primitive_luatex("Umathstacknumup", set_math_param_cmd, math_param_stack_num_up, 0);
- primitive_luatex("Umathstackdenomdown", set_math_param_cmd, math_param_stack_denom_down, 0);
- primitive_luatex("Umathfractionrule", set_math_param_cmd, math_param_fraction_rule, 0);
- primitive_luatex("Umathfractionnumvgap", set_math_param_cmd, math_param_fraction_num_vgap, 0);
- primitive_luatex("Umathfractionnumup", set_math_param_cmd, math_param_fraction_num_up, 0);
- primitive_luatex("Umathfractiondenomvgap", set_math_param_cmd, math_param_fraction_denom_vgap, 0);
- primitive_luatex("Umathfractiondenomdown", set_math_param_cmd, math_param_fraction_denom_down, 0);
- primitive_luatex("Umathfractiondelsize", set_math_param_cmd, math_param_fraction_del_size, 0);
- primitive_luatex("Umathskewedfractionvgap", set_math_param_cmd, math_param_skewed_fraction_vgap, 0);
- primitive_luatex("Umathskewedfractionhgap", set_math_param_cmd, math_param_skewed_fraction_hgap, 0);
- primitive_luatex("Umathlimitabovevgap", set_math_param_cmd, math_param_limit_above_vgap, 0);
- primitive_luatex("Umathlimitabovebgap", set_math_param_cmd, math_param_limit_above_bgap, 0);
- primitive_luatex("Umathlimitabovekern", set_math_param_cmd, math_param_limit_above_kern, 0);
- primitive_luatex("Umathlimitbelowvgap", set_math_param_cmd, math_param_limit_below_vgap, 0);
- primitive_luatex("Umathlimitbelowbgap", set_math_param_cmd, math_param_limit_below_bgap, 0);
- primitive_luatex("Umathlimitbelowkern", set_math_param_cmd, math_param_limit_below_kern, 0);
- primitive_luatex("Umathnolimitsubfactor", set_math_param_cmd, math_param_nolimit_sub_factor, 0); /* bonus */
- primitive_luatex("Umathnolimitsupfactor", set_math_param_cmd, math_param_nolimit_sup_factor, 0); /* bonus */
- primitive_luatex("Umathunderdelimitervgap", set_math_param_cmd, math_param_under_delimiter_vgap, 0);
- primitive_luatex("Umathunderdelimiterbgap", set_math_param_cmd, math_param_under_delimiter_bgap, 0);
- primitive_luatex("Umathoverdelimitervgap", set_math_param_cmd, math_param_over_delimiter_vgap, 0);
- primitive_luatex("Umathoverdelimiterbgap", set_math_param_cmd, math_param_over_delimiter_bgap, 0);
- primitive_luatex("Umathsubshiftdrop", set_math_param_cmd, math_param_sub_shift_drop, 0);
- primitive_luatex("Umathsupshiftdrop", set_math_param_cmd, math_param_sup_shift_drop, 0);
- primitive_luatex("Umathsubshiftdown", set_math_param_cmd, math_param_sub_shift_down, 0);
- primitive_luatex("Umathsubsupshiftdown", set_math_param_cmd, math_param_sub_sup_shift_down, 0);
- primitive_luatex("Umathsubtopmax", set_math_param_cmd, math_param_sub_top_max, 0);
- primitive_luatex("Umathsupshiftup", set_math_param_cmd, math_param_sup_shift_up, 0);
- primitive_luatex("Umathsupbottommin", set_math_param_cmd, math_param_sup_bottom_min, 0);
- primitive_luatex("Umathsupsubbottommax", set_math_param_cmd, math_param_sup_sub_bottom_max, 0);
- primitive_luatex("Umathsubsupvgap", set_math_param_cmd, math_param_subsup_vgap, 0);
- primitive_luatex("Umathspaceafterscript", set_math_param_cmd, math_param_space_after_script, 0);
- primitive_luatex("Umathconnectoroverlapmin", set_math_param_cmd, math_param_connector_overlap_min, 0);
- primitive_luatex("Umathordordspacing", set_math_param_cmd, math_param_ord_ord_spacing, 0);
- primitive_luatex("Umathordopspacing", set_math_param_cmd, math_param_ord_op_spacing, 0);
- primitive_luatex("Umathordbinspacing", set_math_param_cmd, math_param_ord_bin_spacing, 0);
- primitive_luatex("Umathordrelspacing", set_math_param_cmd, math_param_ord_rel_spacing, 0);
- primitive_luatex("Umathordopenspacing", set_math_param_cmd, math_param_ord_open_spacing, 0);
- primitive_luatex("Umathordclosespacing", set_math_param_cmd, math_param_ord_close_spacing, 0);
- primitive_luatex("Umathordpunctspacing", set_math_param_cmd, math_param_ord_punct_spacing, 0);
- primitive_luatex("Umathordinnerspacing", set_math_param_cmd, math_param_ord_inner_spacing, 0);
- primitive_luatex("Umathopordspacing", set_math_param_cmd, math_param_op_ord_spacing, 0);
- primitive_luatex("Umathopopspacing", set_math_param_cmd, math_param_op_op_spacing, 0);
- primitive_luatex("Umathopbinspacing", set_math_param_cmd, math_param_op_bin_spacing, 0);
- primitive_luatex("Umathoprelspacing", set_math_param_cmd, math_param_op_rel_spacing, 0);
- primitive_luatex("Umathopopenspacing", set_math_param_cmd, math_param_op_open_spacing, 0);
- primitive_luatex("Umathopclosespacing", set_math_param_cmd, math_param_op_close_spacing, 0);
- primitive_luatex("Umathoppunctspacing", set_math_param_cmd, math_param_op_punct_spacing, 0);
- primitive_luatex("Umathopinnerspacing", set_math_param_cmd, math_param_op_inner_spacing, 0);
- primitive_luatex("Umathbinordspacing", set_math_param_cmd, math_param_bin_ord_spacing, 0);
- primitive_luatex("Umathbinopspacing", set_math_param_cmd, math_param_bin_op_spacing, 0);
- primitive_luatex("Umathbinbinspacing", set_math_param_cmd, math_param_bin_bin_spacing, 0);
- primitive_luatex("Umathbinrelspacing", set_math_param_cmd, math_param_bin_rel_spacing, 0);
- primitive_luatex("Umathbinopenspacing", set_math_param_cmd, math_param_bin_open_spacing, 0);
- primitive_luatex("Umathbinclosespacing", set_math_param_cmd, math_param_bin_close_spacing, 0);
- primitive_luatex("Umathbinpunctspacing", set_math_param_cmd, math_param_bin_punct_spacing, 0);
- primitive_luatex("Umathbininnerspacing", set_math_param_cmd, math_param_bin_inner_spacing, 0);
- primitive_luatex("Umathrelordspacing", set_math_param_cmd, math_param_rel_ord_spacing, 0);
- primitive_luatex("Umathrelopspacing", set_math_param_cmd, math_param_rel_op_spacing, 0);
- primitive_luatex("Umathrelbinspacing", set_math_param_cmd, math_param_rel_bin_spacing, 0);
- primitive_luatex("Umathrelrelspacing", set_math_param_cmd, math_param_rel_rel_spacing, 0);
- primitive_luatex("Umathrelopenspacing", set_math_param_cmd, math_param_rel_open_spacing, 0);
- primitive_luatex("Umathrelclosespacing", set_math_param_cmd, math_param_rel_close_spacing, 0);
- primitive_luatex("Umathrelpunctspacing", set_math_param_cmd, math_param_rel_punct_spacing, 0);
- primitive_luatex("Umathrelinnerspacing", set_math_param_cmd, math_param_rel_inner_spacing, 0);
- primitive_luatex("Umathopenordspacing", set_math_param_cmd, math_param_open_ord_spacing, 0);
- primitive_luatex("Umathopenopspacing", set_math_param_cmd, math_param_open_op_spacing, 0);
- primitive_luatex("Umathopenbinspacing", set_math_param_cmd, math_param_open_bin_spacing, 0);
- primitive_luatex("Umathopenrelspacing", set_math_param_cmd, math_param_open_rel_spacing, 0);
- primitive_luatex("Umathopenopenspacing", set_math_param_cmd, math_param_open_open_spacing, 0);
- primitive_luatex("Umathopenclosespacing", set_math_param_cmd, math_param_open_close_spacing, 0);
- primitive_luatex("Umathopenpunctspacing", set_math_param_cmd, math_param_open_punct_spacing, 0);
- primitive_luatex("Umathopeninnerspacing", set_math_param_cmd, math_param_open_inner_spacing, 0);
- primitive_luatex("Umathcloseordspacing", set_math_param_cmd, math_param_close_ord_spacing, 0);
- primitive_luatex("Umathcloseopspacing", set_math_param_cmd, math_param_close_op_spacing, 0);
- primitive_luatex("Umathclosebinspacing", set_math_param_cmd, math_param_close_bin_spacing, 0);
- primitive_luatex("Umathcloserelspacing", set_math_param_cmd, math_param_close_rel_spacing, 0);
- primitive_luatex("Umathcloseopenspacing", set_math_param_cmd, math_param_close_open_spacing, 0);
- primitive_luatex("Umathcloseclosespacing", set_math_param_cmd, math_param_close_close_spacing, 0);
- primitive_luatex("Umathclosepunctspacing", set_math_param_cmd, math_param_close_punct_spacing, 0);
- primitive_luatex("Umathcloseinnerspacing", set_math_param_cmd, math_param_close_inner_spacing, 0);
- primitive_luatex("Umathpunctordspacing", set_math_param_cmd, math_param_punct_ord_spacing, 0);
- primitive_luatex("Umathpunctopspacing", set_math_param_cmd, math_param_punct_op_spacing, 0);
- primitive_luatex("Umathpunctbinspacing", set_math_param_cmd, math_param_punct_bin_spacing, 0);
- primitive_luatex("Umathpunctrelspacing", set_math_param_cmd, math_param_punct_rel_spacing, 0);
- primitive_luatex("Umathpunctopenspacing", set_math_param_cmd, math_param_punct_open_spacing, 0);
- primitive_luatex("Umathpunctclosespacing", set_math_param_cmd, math_param_punct_close_spacing, 0);
- primitive_luatex("Umathpunctpunctspacing", set_math_param_cmd, math_param_punct_punct_spacing, 0);
- primitive_luatex("Umathpunctinnerspacing", set_math_param_cmd, math_param_punct_inner_spacing, 0);
- primitive_luatex("Umathinnerordspacing", set_math_param_cmd, math_param_inner_ord_spacing, 0);
- primitive_luatex("Umathinneropspacing", set_math_param_cmd, math_param_inner_op_spacing, 0);
- primitive_luatex("Umathinnerbinspacing", set_math_param_cmd, math_param_inner_bin_spacing, 0);
- primitive_luatex("Umathinnerrelspacing", set_math_param_cmd, math_param_inner_rel_spacing, 0);
- primitive_luatex("Umathinneropenspacing", set_math_param_cmd, math_param_inner_open_spacing, 0);
- primitive_luatex("Umathinnerclosespacing", set_math_param_cmd, math_param_inner_close_spacing, 0);
- primitive_luatex("Umathinnerpunctspacing", set_math_param_cmd, math_param_inner_punct_spacing, 0);
- primitive_luatex("Umathinnerinnerspacing", set_math_param_cmd, math_param_inner_inner_spacing, 0);
-
-@ These are in a separate module due to a CWEAVE limitation.
-
-@<Create another bunch of primitives@>=
- primitive_luatex("Umathcode", extdef_math_code_cmd, math_code_base, math_code_base);
- primitive_luatex("Udelcode", extdef_del_code_cmd, del_code_base, del_code_base);
- primitive_luatex("Umathcodenum", extdef_math_code_cmd, math_code_base + 1, math_code_base);
- primitive_luatex("Udelcodenum", extdef_del_code_cmd, del_code_base + 1, del_code_base);
- primitive_tex("hyphenation", hyph_data_cmd, 0, 0);
- primitive_tex("patterns", hyph_data_cmd, 1, 0);
- primitive_luatex("prehyphenchar", hyph_data_cmd, 2, 0);
- primitive_luatex("posthyphenchar", hyph_data_cmd, 3, 0);
- primitive_luatex("preexhyphenchar", hyph_data_cmd, 4, 0);
- primitive_luatex("postexhyphenchar", hyph_data_cmd, 5, 0);
- primitive_luatex("hyphenationmin", hyph_data_cmd, 6, 0);
- primitive_luatex("hjcode", hyph_data_cmd, 7, 0);
- primitive_tex("hyphenchar", assign_font_int_cmd, 0, 0);
- primitive_tex("skewchar", assign_font_int_cmd, 1, 0);
- primitive_luatex("lpcode", assign_font_int_cmd, lp_code_base, 0);
- primitive_luatex("rpcode", assign_font_int_cmd, rp_code_base, 0);
- primitive_luatex("efcode", assign_font_int_cmd, ef_code_base, 0);
- primitive_luatex("tagcode", assign_font_int_cmd, tag_code, 0);
- primitive_luatex("ignoreligaturesinfont", assign_font_int_cmd, no_lig_code, 0);
- primitive_tex("batchmode", set_interaction_cmd, batch_mode, 0);
- primitive_tex("nonstopmode", set_interaction_cmd, nonstop_mode, 0);
- primitive_tex("scrollmode", set_interaction_cmd, scroll_mode, 0);
- primitive_tex("errorstopmode", set_interaction_cmd, error_stop_mode, 0);
- primitive_tex("openin", in_stream_cmd, 1, 0);
- primitive_tex("closein", in_stream_cmd, 0, 0);
- primitive_tex("message", message_cmd, 0, 0);
- primitive_tex("errmessage", message_cmd, 1, 0);
- primitive_tex("lowercase", case_shift_cmd, lc_code_base, lc_code_base);
- primitive_tex("uppercase", case_shift_cmd, uc_code_base, lc_code_base);
- primitive_tex("show", xray_cmd, show_code, 0);
- primitive_tex("showbox", xray_cmd, show_box_code, 0);
- primitive_tex("showthe", xray_cmd, show_the_code, 0);
- primitive_tex("showlists", xray_cmd, show_lists, 0);
-
- primitive_tex("openout", extension_cmd, open_code, 0);
- primitive_tex("write", extension_cmd, write_code, 0);
- write_loc = cur_val;
- primitive_tex("closeout", extension_cmd, close_code, 0);
- primitive_tex("special", extension_cmd, special_code, 0);
- cs_text(frozen_special) = maketexstring("special");
- eqtb[frozen_special] = eqtb[cur_val];
- primitive_tex("immediate", extension_cmd, immediate_code, 0);
- primitive_luatex("localinterlinepenalty", assign_int_cmd, int_base + local_inter_line_penalty_code, int_base);
- primitive_luatex("localbrokenpenalty", assign_int_cmd, int_base + local_broken_penalty_code, int_base);
- primitive_luatex("pagedir", assign_dir_cmd, int_base + page_direction_code, dir_base);
- primitive_luatex("bodydir", assign_dir_cmd, int_base + body_direction_code, dir_base);
- primitive_luatex("pardir", assign_dir_cmd, int_base + par_direction_code, dir_base);
- primitive_luatex("textdir", assign_dir_cmd, int_base + text_direction_code, dir_base);
- primitive_luatex("mathdir", assign_dir_cmd, int_base + math_direction_code, dir_base);
- primitive_luatex("linedir", assign_dir_cmd, int_base + line_direction_code, dir_base);
- primitive_luatex("pageleftoffset", assign_dimen_cmd, dimen_base + page_left_offset_code, dimen_base);
- primitive_luatex("pagetopoffset", assign_dimen_cmd, dimen_base + page_top_offset_code, dimen_base);
- primitive_luatex("pagerightoffset", assign_dimen_cmd, dimen_base + page_right_offset_code, dimen_base);
- primitive_luatex("pagebottomoffset", assign_dimen_cmd, dimen_base + page_bottom_offset_code, dimen_base);
- primitive_luatex("saveboxresource", extension_cmd, save_box_resource_code, 0);
- primitive_luatex("useboxresource", extension_cmd, use_box_resource_code, 0);
- primitive_luatex("saveimageresource", extension_cmd, save_image_resource_code, 0);
- primitive_luatex("useimageresource", extension_cmd, use_image_resource_code, 0);
- primitive_luatex("savepos", normal_cmd, save_pos_code, 0);
- primitive_luatex("savecatcodetable", normal_cmd, save_cat_code_table_code, 0);
- primitive_luatex("initcatcodetable", normal_cmd, init_cat_code_table_code, 0);
- primitive_luatex("setrandomseed", normal_cmd, set_random_seed_code, 0);
- primitive_luatex("latelua", normal_cmd, late_lua_code, 0);
- primitive_luatex("insertht", convert_cmd, insert_ht_code, 0);
- primitive_luatex("dviextension", extension_cmd, dvi_extension_code, 0);
- primitive_luatex("dvifeedback", feedback_cmd, dvi_feedback_code, 0);
- primitive_luatex("dvivariable", variable_cmd, dvi_variable_code, 0);
- primitive_luatex("pdfextension", extension_cmd, pdf_extension_code, 0);
- primitive_luatex("pdffeedback", feedback_cmd, pdf_feedback_code, 0);
- primitive_luatex("pdfvariable", variable_cmd, pdf_variable_code, 0);
- primitive_luatex("mathoption", option_cmd, math_option_code, 0);
-
- /*
- some of the internal integer parameters are not associated with actual
- primitives at all.
- */
-
- primitive_no("nolocalwhatsits", assign_int_cmd, int_base + no_local_whatsits_code, int_base);
- primitive_no("nolocaldirs", assign_int_cmd, int_base + no_local_dirs_code, int_base);
-
-
-@ @c
-void initialize_etex_commands(void)
-{
- primitive_etex("lastnodetype", last_item_cmd, last_node_type_code, 0);
- primitive_etex("eTeXversion", last_item_cmd, eTeX_version_code, 0);
- primitive_etex("eTeXminorversion", last_item_cmd, eTeX_minor_version_code, 0);
- primitive_etex("eTeXrevision", convert_cmd, eTeX_revision_code, 0);
-
- /*
- First we implement the additional \eTeX\ parameters in the table of equivalents.
- */
-
- primitive_etex("everyeof", assign_toks_cmd, every_eof_loc, local_base);
- primitive_etex("tracingassigns", assign_int_cmd, int_base + tracing_assigns_code, int_base);
- primitive_etex("tracinggroups", assign_int_cmd, int_base + tracing_groups_code, int_base);
- primitive_etex("tracingifs", assign_int_cmd, int_base + tracing_ifs_code, int_base);
- primitive_etex("tracingscantokens", assign_int_cmd, int_base + tracing_scan_tokens_code, int_base);
- primitive_etex("tracingnesting", assign_int_cmd, int_base + tracing_nesting_code, int_base);
- primitive_etex("predisplaydirection", assign_int_cmd, int_base + pre_display_direction_code, int_base);
- primitive_etex("lastlinefit", assign_int_cmd, int_base + last_line_fit_code, int_base);
- primitive_etex("savingvdiscards", assign_int_cmd, int_base + saving_vdiscards_code, int_base);
- primitive_etex("savinghyphcodes", assign_int_cmd, int_base + saving_hyph_codes_code, int_base);
- primitive_luatex("suppressfontnotfounderror", assign_int_cmd, int_base + suppress_fontnotfound_error_code, int_base);
- primitive_luatex("suppresslongerror", assign_int_cmd, int_base + suppress_long_error_code, int_base);
- primitive_luatex("suppressmathparerror", assign_int_cmd, int_base + suppress_mathpar_error_code, int_base);
- primitive_luatex("suppressifcsnameerror", assign_int_cmd, int_base + suppress_ifcsname_error_code, int_base);
- primitive_luatex("suppressoutererror", assign_int_cmd, int_base + suppress_outer_error_code, int_base);
- primitive_luatex("matheqnogapstep", assign_int_cmd, int_base + math_eqno_gap_step_code, int_base);
- primitive_luatex("mathdisplayskipmode", assign_int_cmd, int_base + math_display_skip_mode_code, int_base);
- primitive_luatex("mathscriptsmode", assign_int_cmd, int_base + math_scripts_mode_code, int_base);
- primitive_luatex("mathnolimitsmode", assign_int_cmd, int_base + math_nolimits_mode_code, int_base);
- primitive_luatex("mathrulesmode", assign_int_cmd, int_base + math_rules_mode_code, int_base);
- primitive_luatex("mathrulesfam", assign_int_cmd, int_base + math_rules_fam_code, int_base);
- primitive_luatex("synctex", assign_int_cmd, int_base + synctex_code, int_base);
-
- primitive_etex("currentgrouplevel", last_item_cmd, current_group_level_code, 0);
- primitive_etex("currentgrouptype", last_item_cmd, current_group_type_code, 0);
-
- primitive_etex("currentiflevel", last_item_cmd, current_if_level_code, 0);
- primitive_etex("currentiftype", last_item_cmd, current_if_type_code, 0);
- primitive_etex("currentifbranch", last_item_cmd, current_if_branch_code, 0);
- primitive_etex("fontcharwd", last_item_cmd, font_char_wd_code, 0);
- primitive_etex("fontcharht", last_item_cmd, font_char_ht_code, 0);
- primitive_etex("fontchardp", last_item_cmd, font_char_dp_code, 0);
- primitive_etex("fontcharic", last_item_cmd, font_char_ic_code, 0);
-
- primitive_etex("parshapelength", last_item_cmd, par_shape_length_code, 0);
- primitive_etex("parshapeindent", last_item_cmd, par_shape_indent_code, 0);
- primitive_etex("parshapedimen", last_item_cmd, par_shape_dimen_code, 0);
-
- primitive_luatex("shapemode", assign_int_cmd, int_base + shape_mode_code, int_base);
- primitive_luatex("hyphenationbounds", assign_int_cmd, int_base + hyphenation_bounds_code, int_base);
-
- primitive_etex("showgroups", xray_cmd, show_groups, 0);
-
- /*
- The \.{\\showtokens} command displays a token list.
- */
-
- primitive_etex("showtokens", xray_cmd, show_tokens, 0);
-
- /*
- The \.{\\unexpanded} primitive prevents expansion of tokens much as
- the result from \.{\\the} applied to a token variable. The
- \.{\\detokenize} primitive converts a token list into a list of
- character tokens much as if the token list were written to a file. We
- use the fact that the command modifiers for \.{\\unexpanded} and
- \.{\\detokenize} are odd whereas those for \.{\\the} and \.{\\showthe}
- are even.
- */
-
- primitive_etex("unexpanded", the_cmd, 1, 0);
- primitive_etex("detokenize", the_cmd, show_tokens, 0);
-
- /*
- The \.{\\showifs} command displays all currently active conditionals.
- */
-
- primitive_etex("showifs", xray_cmd, show_ifs, 0);
-
- /*
- The \.{\\interactionmode} primitive allows to query and set the interaction mode.
- */
-
- primitive_etex("interactionmode", set_page_int_cmd, 2, 0);
-
- /*
- The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens} primitive.
- */
-
- primitive_etex("scantokens", input_cmd, 2, 0);
- primitive_luatex("scantextokens", input_cmd, 3, 0);
-
- primitive_etex("readline", read_to_cs_cmd, 1, 0);
-
- primitive_etex("unless", expand_after_cmd, 1, 0);
- primitive_etex("ifdefined", if_test_cmd, if_def_code, 0);
- primitive_etex("ifcsname", if_test_cmd, if_cs_code, 0);
- primitive_etex("iffontchar", if_test_cmd, if_font_char_code, 0);
- primitive_luatex("ifincsname", if_test_cmd, if_in_csname_code, 0);
- primitive_luatex("ifabsnum", if_test_cmd, if_abs_num_code, 0);
- primitive_luatex("ifabsdim", if_test_cmd, if_abs_dim_code, 0);
-
- /*
- The |protected| feature of \eTeX\ defines the \.{\\protected} prefix
- command for macro definitions. Such macros are protected against
- expansions when lists of expanded tokens are built, e.g., for \.{\\edef}
- or during \.{\\write}.
- */
-
- primitive_etex("protected", prefix_cmd, 8, 0);
-
- /*
- Here are the additional \eTeX\ primitives for expressions.
- */
-
- primitive_etex("numexpr", last_item_cmd, eTeX_expr - int_val_level + int_val_level, 0);
- primitive_etex("dimexpr", last_item_cmd, eTeX_expr - int_val_level + dimen_val_level, 0);
- primitive_etex("glueexpr", last_item_cmd, eTeX_expr - int_val_level + glue_val_level, 0);
- primitive_etex("muexpr", last_item_cmd, eTeX_expr - int_val_level + mu_val_level, 0);
-
- primitive_etex("gluestretchorder", last_item_cmd, glue_stretch_order_code, 0);
- primitive_etex("glueshrinkorder", last_item_cmd, glue_shrink_order_code, 0);
- primitive_etex("gluestretch", last_item_cmd, glue_stretch_code, 0);
- primitive_etex("glueshrink", last_item_cmd, glue_shrink_code, 0);
-
- primitive_etex("mutoglue", last_item_cmd, mu_to_glue_code, 0);
- primitive_etex("gluetomu", last_item_cmd, glue_to_mu_code, 0);
-
- /*
- The \.{\\pagediscards} and \.{\\splitdiscards} commands share the
- command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are
- distinguished by their |chr_code| values |last_box_code| and
- |vsplit_code|. These |chr_code| values are larger than |box_code| and
- |copy_code|.
- */
-
- primitive_etex("pagediscards", un_vbox_cmd, last_box_code, 0);
- primitive_etex("splitdiscards", un_vbox_cmd, vsplit_code, 0);
-
- /*
- The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties},
- and \.{\\displaywidowpenalties} commands allow to define arrays of
- penalty values to be used instead of the corresponding single values.
- */
-
- primitive_etex("interlinepenalties", set_etex_shape_cmd, inter_line_penalties_loc, etex_pen_base);
- primitive_etex("clubpenalties", set_etex_shape_cmd, club_penalties_loc, etex_pen_base);
- primitive_etex("widowpenalties", set_etex_shape_cmd, widow_penalties_loc, etex_pen_base);
- primitive_etex("displaywidowpenalties", set_etex_shape_cmd, display_widow_penalties_loc, etex_pen_base);
-
-}
+% commands.w
+%
+% Copyright 2009-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\eTeX{e-\TeX}
+
+@ @c
+
+
+#include "ptexlib.h"
+
+@ The symbolic names for glue parameters are put into \TeX's hash table
+by using the routine called |primitive|, defined below. Let us enter them
+now, so that we don't have to list all those parameter names anywhere else.
+
+@c
+void initialize_commands(void)
+{
+
+ primitive_tex("lineskip", assign_glue_cmd, glue_base + line_skip_code, glue_base);
+ primitive_tex("baselineskip", assign_glue_cmd, glue_base + baseline_skip_code, glue_base);
+ primitive_tex("parskip", assign_glue_cmd, glue_base + par_skip_code, glue_base);
+ primitive_tex("abovedisplayskip", assign_glue_cmd, glue_base + above_display_skip_code, glue_base);
+ primitive_tex("belowdisplayskip", assign_glue_cmd, glue_base + below_display_skip_code, glue_base);
+ primitive_tex("abovedisplayshortskip", assign_glue_cmd, glue_base + above_display_short_skip_code, glue_base);
+ primitive_tex("belowdisplayshortskip", assign_glue_cmd, glue_base + below_display_short_skip_code, glue_base);
+ primitive_tex("leftskip", assign_glue_cmd, glue_base + left_skip_code, glue_base);
+ primitive_tex("rightskip", assign_glue_cmd, glue_base + right_skip_code, glue_base);
+ primitive_tex("topskip", assign_glue_cmd, glue_base + top_skip_code, glue_base);
+ primitive_tex("splittopskip", assign_glue_cmd, glue_base + split_top_skip_code, glue_base);
+ primitive_tex("tabskip", assign_glue_cmd, glue_base + tab_skip_code, glue_base);
+ primitive_tex("spaceskip", assign_glue_cmd, glue_base + space_skip_code, glue_base);
+ primitive_tex("xspaceskip", assign_glue_cmd, glue_base + xspace_skip_code, glue_base);
+ primitive_tex("parfillskip", assign_glue_cmd, glue_base + par_fill_skip_code, glue_base);
+ primitive_tex("thinmuskip", assign_mu_glue_cmd, glue_base + thin_mu_skip_code, glue_base + thin_mu_skip_code);
+ primitive_tex("medmuskip", assign_mu_glue_cmd, glue_base + med_mu_skip_code, glue_base + thin_mu_skip_code);
+ primitive_tex("thickmuskip", assign_mu_glue_cmd, glue_base + thick_mu_skip_code, glue_base + thin_mu_skip_code);
+ primitive_luatex("mathsurroundskip", assign_glue_cmd, glue_base + math_skip_code, glue_base);
+ primitive_luatex("mathsurroundmode", assign_int_cmd, int_base + math_skip_mode_code, int_base);
+ primitive_tex("output", assign_toks_cmd, output_routine_loc, local_base);
+ primitive_tex("everypar", assign_toks_cmd, every_par_loc, local_base);
+ primitive_tex("everymath", assign_toks_cmd, every_math_loc, local_base);
+ primitive_tex("everydisplay", assign_toks_cmd, every_display_loc, local_base);
+ primitive_tex("everyhbox", assign_toks_cmd, every_hbox_loc, local_base);
+ primitive_tex("everyvbox", assign_toks_cmd, every_vbox_loc, local_base);
+ primitive_tex("everyjob", assign_toks_cmd, every_job_loc, local_base);
+ primitive_tex("everycr", assign_toks_cmd, every_cr_loc, local_base);
+ primitive_tex("errhelp", assign_toks_cmd, err_help_loc, local_base);
+
+ /* The integer parameter names must be entered into the hash table */
+
+ primitive_tex("pretolerance", assign_int_cmd, int_base + pretolerance_code, int_base);
+ primitive_tex("tolerance", assign_int_cmd, int_base + tolerance_code, int_base);
+ primitive_tex("linepenalty", assign_int_cmd, int_base + line_penalty_code, int_base);
+ primitive_tex("hyphenpenalty", assign_int_cmd, int_base + hyphen_penalty_code, int_base);
+ primitive_tex("exhyphenpenalty", assign_int_cmd, int_base + ex_hyphen_penalty_code, int_base);
+ primitive_tex("clubpenalty", assign_int_cmd, int_base + club_penalty_code, int_base);
+ primitive_tex("widowpenalty", assign_int_cmd, int_base + widow_penalty_code, int_base);
+ primitive_tex("displaywidowpenalty", assign_int_cmd, int_base + display_widow_penalty_code, int_base);
+ primitive_tex("brokenpenalty", assign_int_cmd, int_base + broken_penalty_code, int_base);
+ primitive_tex("binoppenalty", assign_int_cmd, int_base + bin_op_penalty_code, int_base);
+ primitive_tex("relpenalty", assign_int_cmd, int_base + rel_penalty_code, int_base);
+ primitive_tex("predisplaypenalty", assign_int_cmd, int_base + pre_display_penalty_code, int_base);
+ primitive_tex("postdisplaypenalty", assign_int_cmd, int_base + post_display_penalty_code, int_base);
+ primitive_tex("interlinepenalty", assign_int_cmd, int_base + inter_line_penalty_code, int_base);
+ primitive_tex("doublehyphendemerits", assign_int_cmd, int_base + double_hyphen_demerits_code, int_base);
+ primitive_tex("finalhyphendemerits", assign_int_cmd, int_base + final_hyphen_demerits_code, int_base);
+ primitive_tex("adjdemerits", assign_int_cmd, int_base + adj_demerits_code, int_base);
+ primitive_tex("mag", assign_int_cmd, int_base + mag_code, int_base);
+ primitive_tex("delimiterfactor", assign_int_cmd, int_base + delimiter_factor_code, int_base);
+ primitive_tex("looseness", assign_int_cmd, int_base + looseness_code, int_base);
+ primitive_tex("time", assign_int_cmd, int_base + time_code, int_base);
+ primitive_tex("day", assign_int_cmd, int_base + day_code, int_base);
+ primitive_tex("month", assign_int_cmd, int_base + month_code, int_base);
+ primitive_tex("year", assign_int_cmd, int_base + year_code, int_base);
+ primitive_tex("showboxbreadth", assign_int_cmd, int_base + show_box_breadth_code, int_base);
+ primitive_tex("showboxdepth", assign_int_cmd, int_base + show_box_depth_code, int_base);
+ primitive_tex("hbadness", assign_int_cmd, int_base + hbadness_code, int_base);
+ primitive_tex("vbadness", assign_int_cmd, int_base + vbadness_code, int_base);
+ primitive_tex("pausing", assign_int_cmd, int_base + pausing_code, int_base);
+ primitive_tex("tracingonline", assign_int_cmd, int_base + tracing_online_code, int_base);
+ primitive_tex("tracingmacros", assign_int_cmd, int_base + tracing_macros_code, int_base);
+ primitive_tex("tracingstats", assign_int_cmd, int_base + tracing_stats_code, int_base);
+ primitive_tex("tracingparagraphs", assign_int_cmd, int_base + tracing_paragraphs_code, int_base);
+ primitive_tex("tracingpages", assign_int_cmd, int_base + tracing_pages_code, int_base);
+ primitive_tex("tracingoutput", assign_int_cmd, int_base + tracing_output_code, int_base);
+ primitive_tex("tracinglostchars", assign_int_cmd, int_base + tracing_lost_chars_code, int_base);
+ primitive_tex("tracingcommands", assign_int_cmd, int_base + tracing_commands_code, int_base);
+ primitive_tex("tracingrestores", assign_int_cmd, int_base + tracing_restores_code, int_base);
+ primitive_tex("uchyph", assign_int_cmd, int_base + uc_hyph_code, int_base);
+ primitive_tex("outputpenalty", assign_int_cmd, int_base + output_penalty_code, int_base);
+ primitive_tex("maxdeadcycles", assign_int_cmd, int_base + max_dead_cycles_code, int_base);
+ primitive_tex("hangafter", assign_int_cmd, int_base + hang_after_code, int_base);
+ primitive_tex("floatingpenalty", assign_int_cmd, int_base + floating_penalty_code, int_base);
+ primitive_tex("globaldefs", assign_int_cmd, int_base + global_defs_code, int_base);
+ primitive_tex("fam", assign_int_cmd, int_base + cur_fam_code, int_base);
+ primitive_tex("escapechar", assign_int_cmd, int_base + escape_char_code, int_base);
+ primitive_tex("defaulthyphenchar", assign_int_cmd, int_base + default_hyphen_char_code, int_base);
+ primitive_tex("defaultskewchar", assign_int_cmd, int_base + default_skew_char_code, int_base);
+ primitive_tex("endlinechar", assign_int_cmd, int_base + end_line_char_code, int_base);
+ primitive_tex("newlinechar", assign_int_cmd, int_base + new_line_char_code, int_base);
+ primitive_tex("language", assign_int_cmd, int_base + language_code, int_base);
+ primitive_tex("setlanguage", assign_int_cmd, int_base + cur_lang_code, int_base);
+ primitive_tex("firstvalidlanguage", assign_int_cmd, int_base + first_valid_language_code, int_base);
+ primitive_tex("exhyphenchar", assign_int_cmd, int_base + ex_hyphen_char_code, int_base);
+ primitive_tex("lefthyphenmin", assign_int_cmd, int_base + left_hyphen_min_code, int_base);
+ primitive_tex("righthyphenmin", assign_int_cmd, int_base + right_hyphen_min_code, int_base);
+ primitive_tex("holdinginserts", assign_int_cmd, int_base + holding_inserts_code, int_base);
+ primitive_tex("errorcontextlines", assign_int_cmd, int_base + error_context_lines_code, int_base);
+ primitive_luatex("nokerns", assign_int_cmd, int_base + disable_kern_code, int_base);
+ primitive_luatex("noligs", assign_int_cmd, int_base + disable_lig_code, int_base);
+ primitive_luatex("nospaces", assign_int_cmd, int_base + disable_space_code, int_base);
+ primitive_luatex("catcodetable", assign_int_cmd, int_base + cat_code_table_code, int_base);
+ primitive_luatex("outputbox", assign_int_cmd, int_base + output_box_code, int_base);
+ primitive_luatex("outputmode", assign_int_cmd, int_base + output_mode_code, int_base);
+ primitive_luatex("adjustspacing", assign_int_cmd, int_base + adjust_spacing_code, int_base);
+ primitive_luatex("protrudechars", assign_int_cmd, int_base + protrude_chars_code, int_base);
+ primitive_luatex("tracingfonts", assign_int_cmd, int_base + tracing_fonts_code, int_base);
+ primitive_luatex("draftmode", assign_int_cmd, int_base + draft_mode_code, int_base);
+ primitive_tex("parindent", assign_dimen_cmd, dimen_base + par_indent_code, dimen_base);
+ primitive_tex("mathsurround", assign_dimen_cmd, dimen_base + math_surround_code, dimen_base);
+ primitive_tex("lineskiplimit", assign_dimen_cmd, dimen_base + line_skip_limit_code, dimen_base);
+ primitive_tex("hsize", assign_dimen_cmd, dimen_base + hsize_code, dimen_base);
+ primitive_tex("vsize", assign_dimen_cmd, dimen_base + vsize_code, dimen_base);
+ primitive_tex("maxdepth", assign_dimen_cmd, dimen_base + max_depth_code, dimen_base);
+ primitive_tex("splitmaxdepth", assign_dimen_cmd, dimen_base + split_max_depth_code, dimen_base);
+ primitive_tex("boxmaxdepth", assign_dimen_cmd, dimen_base + box_max_depth_code, dimen_base);
+ primitive_tex("hfuzz", assign_dimen_cmd, dimen_base + hfuzz_code, dimen_base);
+ primitive_tex("vfuzz", assign_dimen_cmd, dimen_base + vfuzz_code, dimen_base);
+ primitive_tex("delimitershortfall", assign_dimen_cmd, dimen_base + delimiter_shortfall_code, dimen_base);
+ primitive_tex("nulldelimiterspace", assign_dimen_cmd, dimen_base + null_delimiter_space_code, dimen_base);
+ primitive_tex("scriptspace", assign_dimen_cmd, dimen_base + script_space_code, dimen_base);
+ primitive_tex("predisplaysize", assign_dimen_cmd, dimen_base + pre_display_size_code, dimen_base);
+ primitive_tex("displaywidth", assign_dimen_cmd, dimen_base + display_width_code, dimen_base);
+ primitive_tex("displayindent", assign_dimen_cmd, dimen_base + display_indent_code, dimen_base);
+ primitive_tex("overfullrule", assign_dimen_cmd, dimen_base + overfull_rule_code, dimen_base);
+ primitive_tex("hangindent", assign_dimen_cmd, dimen_base + hang_indent_code, dimen_base);
+ primitive_tex("hoffset", assign_dimen_cmd, dimen_base + h_offset_code, dimen_base);
+ primitive_tex("voffset", assign_dimen_cmd, dimen_base + v_offset_code, dimen_base);
+ primitive_tex("emergencystretch", assign_dimen_cmd, dimen_base + emergency_stretch_code, dimen_base);
+ primitive_luatex("pagewidth", assign_dimen_cmd, dimen_base + page_width_code, dimen_base);
+ primitive_luatex("pageheight", assign_dimen_cmd, dimen_base + page_height_code, dimen_base);
+ primitive_luatex("pxdimen", assign_dimen_cmd, dimen_base + px_dimen_code, dimen_base);
+ primitive_luatex("predisplaygapfactor", assign_int_cmd, int_base + math_pre_display_gap_factor_code, int_base);
+
+ /* Many of \TeX's primitives need no |equiv|, since they are identifiable
+ by their |eq_type| alone. These primitives are loaded into the hash table
+ as follows: */
+
+ primitive_tex(" ", ex_space_cmd, 0, 0);
+ primitive_tex("/", ital_corr_cmd, 0, 0);
+ primitive_tex("accent", accent_cmd, 0, 0);
+ primitive_tex("advance", advance_cmd, 0, 0);
+ primitive_tex("afterassignment", after_assignment_cmd, 0, 0);
+ primitive_tex("aftergroup", after_group_cmd, 0, 0);
+ primitive_tex("begingroup", begin_group_cmd, 0, 0);
+ primitive_tex("char", char_num_cmd, 0, 0);
+ primitive_tex("csname", cs_name_cmd, 0, 0);
+ primitive_luatex("lastnamedcs", cs_name_cmd, 1, 0);
+ primitive_luatex("begincsname", cs_name_cmd, 2, 0);
+ primitive_tex("delimiter", delim_num_cmd, 0, 0);
+ primitive_luatex("Udelimiter", delim_num_cmd, 1, 0);
+ primitive_tex("divide", divide_cmd, 0, 0);
+ primitive_tex("endcsname", end_cs_name_cmd, 0, 0);
+ primitive_tex("endgroup", end_group_cmd, 0, 0);
+ cs_text(frozen_end_group) = maketexstring("endgroup");
+ eqtb[frozen_end_group] = eqtb[cur_val];
+ primitive_tex("expandafter", expand_after_cmd, 0, 0);
+ primitive_tex("font", def_font_cmd, 0, 0);
+ primitive_luatex("letterspacefont", letterspace_font_cmd, 0, 0);
+ primitive_luatex("expandglyphsinfont", normal_cmd, expand_font_code, 0);
+ primitive_luatex("copyfont", copy_font_cmd, 0, 0);
+ primitive_luatex("setfontid", set_font_id_cmd, 0, 0);
+ primitive_tex("fontdimen", assign_font_dimen_cmd, 0, 0);
+ primitive_tex("halign", halign_cmd, 0, 0);
+ primitive_tex("hrule", hrule_cmd, 0, 0);
+ primitive_luatex("nohrule", no_hrule_cmd, 0, 0);
+ primitive_tex("ignorespaces", ignore_spaces_cmd, 0, 0);
+ primitive_tex("insert", insert_cmd, 0, 0);
+ primitive_luatex("leftghost", char_ghost_cmd, 0, 0);
+ primitive_tex("mark", mark_cmd, 0, 0);
+ primitive_tex("mathaccent", math_accent_cmd, 0, 0);
+ primitive_luatex("Umathaccent", math_accent_cmd, 1, 0);
+ primitive_tex("mathchar", math_char_num_cmd, 0, 0);
+ primitive_luatex("Umathchar", math_char_num_cmd, 1, 0);
+ primitive_luatex("Umathcharnum", math_char_num_cmd, 2, 0);
+ primitive_tex("mathchoice", math_choice_cmd, 0, 0);
+ primitive_luatex("Ustack", math_choice_cmd, 1, 0);
+ primitive_tex("multiply", multiply_cmd, 0, 0);
+ primitive_tex("noalign", no_align_cmd, 0, 0);
+ primitive_tex("noboundary", boundary_cmd, 0, 0);
+ primitive_tex("boundary", boundary_cmd, 1, 0);
+ primitive_tex("protrusionboundary", boundary_cmd, 2, 0);
+ primitive_tex("wordboundary", boundary_cmd, 3, 0);
+ primitive_tex("noexpand", no_expand_cmd, 0, 0);
+ primitive_luatex("primitive", no_expand_cmd, 1, 0);
+ primitive_tex("nonscript", non_script_cmd, 0, 0);
+ primitive_tex("omit", omit_cmd, 0, 0);
+ primitive_tex("parshape", set_tex_shape_cmd, par_shape_loc, par_shape_loc);
+ primitive_tex("penalty", break_penalty_cmd, 0, 0);
+ primitive_tex("prevgraf", set_prev_graf_cmd, 0, 0);
+ primitive_tex("radical", radical_cmd, 0, 0);
+ primitive_luatex("Uradical", radical_cmd, 1, 0);
+ primitive_luatex("Uroot", radical_cmd, 2, 0);
+ primitive_luatex("Uunderdelimiter", radical_cmd, 3, 0);
+ primitive_luatex("Uoverdelimiter", radical_cmd, 4, 0);
+ primitive_luatex("Udelimiterunder", radical_cmd, 5, 0);
+ primitive_luatex("Udelimiterover", radical_cmd, 6, 0);
+ primitive_luatex("Uhextensible", radical_cmd, 7, 0);
+ primitive_tex("read", read_to_cs_cmd, 0, 0);
+ primitive_tex("relax", relax_cmd, too_big_char, too_big_char);
+ cs_text(frozen_relax) = maketexstring("relax");
+ eqtb[frozen_relax] = eqtb[cur_val];
+ primitive_luatex("rightghost", char_ghost_cmd, 1, 0);
+ primitive_tex("setbox", set_box_cmd, 0, 0);
+ primitive_tex("the", the_cmd, 0, 0);
+ primitive_luatex("toksapp", combine_toks_cmd, 0, 0);
+ primitive_luatex("tokspre", combine_toks_cmd, 1, 0);
+ primitive_luatex("etoksapp", combine_toks_cmd, 2, 0);
+ primitive_luatex("etokspre", combine_toks_cmd, 3, 0);
+ primitive_tex("toks", toks_register_cmd, 0, 0);
+ primitive_tex("vadjust", vadjust_cmd, 0, 0);
+ primitive_tex("valign", valign_cmd, 0, 0);
+ primitive_tex("vcenter", vcenter_cmd, 0, 0);
+ primitive_tex("vrule", vrule_cmd, 0, 0);
+ primitive_luatex("novrule", no_vrule_cmd, 0, 0);
+ primitive_tex("par", par_end_cmd, too_big_char, too_big_char); /* cf.\ |scan_file_name| */
+ par_loc = cur_val;
+ par_token = cs_token_flag + par_loc;
+ @<Create a bunch of primitives@>;
+ @<Create the math param primitives@>;
+ @<Create another bunch of primitives@>;
+}
+
+
+@ These are in a separate module due to a CWEAVE limitation.
+
+@<Create a bunch of primitives@>=
+
+ /*
+ The processing of \.{\\input} involves the |start_input| subroutine,
+ which will be declared later; the processing of \.{\\endinput} is trivial.
+ */
+
+ primitive_tex("input", input_cmd, 0, 0);
+ primitive_tex("endinput", input_cmd, 1, 0);
+ primitive_tex("topmark", top_bot_mark_cmd, top_mark_code, 0);
+ primitive_tex("firstmark", top_bot_mark_cmd, first_mark_code, 0);
+ primitive_tex("botmark", top_bot_mark_cmd, bot_mark_code, 0);
+ primitive_tex("splitfirstmark", top_bot_mark_cmd, split_first_mark_code, 0);
+ primitive_tex("splitbotmark", top_bot_mark_cmd, split_bot_mark_code, 0);
+ primitive_luatex("clearmarks", mark_cmd, clear_marks_code, 0);
+ primitive_etex("marks", mark_cmd, marks_code, 0);
+ primitive_etex("topmarks", top_bot_mark_cmd, top_mark_code + marks_code, 0);
+ primitive_etex("firstmarks", top_bot_mark_cmd, first_mark_code + marks_code, 0);
+ primitive_etex("botmarks", top_bot_mark_cmd, bot_mark_code + marks_code, 0);
+ primitive_etex("splitfirstmarks", top_bot_mark_cmd, split_first_mark_code + marks_code, 0);
+ primitive_etex("splitbotmarks", top_bot_mark_cmd, split_bot_mark_code + marks_code, 0);
+
+ /*
+ The hash table is initialized with `\.{\\count}', `\.{\\attribute}',
+ `\.{\\dimen}', `\.{\\skip}', and `\.{\\muskip}' all having |register|
+ as their command code; they are distinguished by the |chr_code|, which
+ is either |int_val|, |attr_val|, |dimen_val|, |glue_val|, or |mu_val|.
+ */
+
+ primitive_tex("count", register_cmd, int_val_level, 0);
+ primitive_luatex("attribute", register_cmd, attr_val_level, 0);
+ primitive_tex("dimen", register_cmd, dimen_val_level, 0);
+ primitive_tex("skip", register_cmd, glue_val_level, 0);
+ primitive_tex("muskip", register_cmd, mu_val_level, 0);
+
+ primitive_tex("spacefactor", set_aux_cmd, hmode, 0);
+ primitive_tex("prevdepth", set_aux_cmd, vmode, 0);
+ primitive_tex("deadcycles", set_page_int_cmd, 0, 0);
+ primitive_tex("insertpenalties", set_page_int_cmd, 1, 0);
+ primitive_tex("wd", set_box_dimen_cmd, width_offset, 0);
+ primitive_tex("ht", set_box_dimen_cmd, height_offset, 0);
+ primitive_tex("dp", set_box_dimen_cmd, depth_offset, 0);
+ primitive_tex("lastpenalty", last_item_cmd, lastpenalty_code, 0);
+ primitive_tex("lastkern", last_item_cmd, lastkern_code, 0);
+ primitive_tex("lastskip", last_item_cmd, lastskip_code, 0);
+ primitive_tex("inputlineno", last_item_cmd, input_line_no_code, 0);
+ primitive_tex("badness", last_item_cmd, badness_code, 0);
+ primitive_luatex("luatexversion", last_item_cmd, luatex_version_code, 0);
+ primitive_luatex("lastsavedboxresourceindex", last_item_cmd, last_saved_box_resource_index_code, 0);
+ primitive_luatex("lastsavedimageresourceindex", last_item_cmd, last_saved_image_resource_index_code, 0);
+ primitive_luatex("lastsavedimageresourcepages", last_item_cmd, last_saved_image_resource_pages_code, 0);
+ primitive_luatex("lastxpos", last_item_cmd, last_x_pos_code, 0);
+ primitive_luatex("lastypos", last_item_cmd, last_y_pos_code, 0);
+ primitive_luatex("randomseed", last_item_cmd, random_seed_code, 0);
+
+ primitive_tex("number", convert_cmd, number_code, 0);
+ primitive_tex("romannumeral", convert_cmd, roman_numeral_code, 0);
+ primitive_tex("string", convert_cmd, string_code, 0);
+ primitive_tex("csstring", convert_cmd, cs_string_code, 0);
+ primitive_tex("meaning", convert_cmd, meaning_code, 0);
+ primitive_etex("eTeXVersion", convert_cmd, etex_code, 0);
+ primitive_tex("fontname", convert_cmd, font_name_code, 0);
+ primitive_luatex("fontid", convert_cmd, font_id_code, 0);
+ primitive_luatex("luatexrevision", convert_cmd, luatex_revision_code, 0);
+ primitive_luatex("luatexdatestamp", convert_cmd, luatex_date_code, 0);
+ primitive_luatex("luatexbanner", convert_cmd, luatex_banner_code, 0);
+ primitive_luatex("leftmarginkern", convert_cmd, left_margin_kern_code, 0);
+ primitive_luatex("rightmarginkern", convert_cmd, right_margin_kern_code, 0);
+ primitive_luatex("uniformdeviate", convert_cmd, uniform_deviate_code, 0);
+ primitive_luatex("normaldeviate", convert_cmd, normal_deviate_code, 0);
+ primitive_core("directlua", convert_cmd, lua_code, 0);
+ primitive_luatex("luafunction", convert_cmd, lua_function_code, 0);
+ primitive_luatex("luaescapestring", convert_cmd, lua_escape_string_code, 0);
+ primitive_luatex("mathstyle", convert_cmd, math_style_code, 0);
+ primitive_luatex("expanded", convert_cmd, expanded_code, 0);
+ primitive_tex("jobname", convert_cmd, job_name_code, 0);
+ primitive_luatex("formatname", convert_cmd, format_name_code, 0);
+ primitive_luatex("Uchar", convert_cmd, uchar_code, 0);
+
+ primitive_luatex("Umathcharclass", convert_cmd, math_char_class_code, 0);
+ primitive_luatex("Umathcharfam", convert_cmd, math_char_fam_code, 0);
+ primitive_luatex("Umathcharslot", convert_cmd, math_char_slot_code, 0);
+
+ primitive_tex("if", if_test_cmd, if_char_code, 0);
+ primitive_tex("ifcat", if_test_cmd, if_cat_code, 0);
+ primitive_tex("ifnum", if_test_cmd, if_int_code, 0);
+ primitive_tex("ifdim", if_test_cmd, if_dim_code, 0);
+ primitive_tex("ifodd", if_test_cmd, if_odd_code, 0);
+ primitive_tex("ifvmode", if_test_cmd, if_vmode_code, 0);
+ primitive_tex("ifhmode", if_test_cmd, if_hmode_code, 0);
+ primitive_tex("ifmmode", if_test_cmd, if_mmode_code, 0);
+ primitive_tex("ifinner", if_test_cmd, if_inner_code, 0);
+ primitive_tex("ifvoid", if_test_cmd, if_void_code, 0);
+
+ primitive_tex("ifhbox", if_test_cmd, if_hbox_code, 0);
+ primitive_tex("ifvbox", if_test_cmd, if_vbox_code, 0);
+ primitive_tex("ifx", if_test_cmd, ifx_code, 0);
+ primitive_tex("ifeof", if_test_cmd, if_eof_code, 0);
+ primitive_tex("iftrue", if_test_cmd, if_true_code, 0);
+ primitive_tex("iffalse", if_test_cmd, if_false_code, 0);
+ primitive_tex("ifcase", if_test_cmd, if_case_code, 0);
+ primitive_luatex("ifprimitive", if_test_cmd, if_primitive_code, 0);
+ primitive_tex("fi", fi_or_else_cmd, fi_code, 0);
+ cs_text(frozen_fi) = maketexstring("fi");
+ eqtb[frozen_fi] = eqtb[cur_val];
+ primitive_tex("or", fi_or_else_cmd, or_code, 0);
+ primitive_tex("else", fi_or_else_cmd, else_code, 0);
+
+ /*
+ \TeX\ always knows at least one font, namely the null font. It has no
+ characters, and its seven parameters are all equal to zero.
+ */
+
+ primitive_tex("nullfont", set_font_cmd, null_font, 0);
+ cs_text(frozen_null_font) = maketexstring("nullfont");
+ eqtb[frozen_null_font] = eqtb[cur_val];
+
+ primitive_tex("span", tab_mark_cmd, span_code, tab_mark_cmd_code);
+ primitive_luatex("aligntab", tab_mark_cmd, tab_mark_cmd_code, tab_mark_cmd_code);
+ primitive_luatex("alignmark", mac_param_cmd, tab_mark_cmd_code, tab_mark_cmd_code);
+ primitive_tex("cr", car_ret_cmd, cr_code, cr_code);
+ cs_text(frozen_cr) = maketexstring("cr");
+ eqtb[frozen_cr] = eqtb[cur_val];
+ primitive_tex("crcr", car_ret_cmd, cr_cr_code, cr_code);
+ cs_text(frozen_end_template) = maketexstring("endtemplate");
+ cs_text(frozen_endv) = maketexstring("endtemplate");
+ set_eq_type(frozen_endv, endv_cmd);
+ set_equiv(frozen_endv, null_list);
+ set_eq_level(frozen_endv, level_one);
+ eqtb[frozen_end_template] = eqtb[frozen_endv];
+ set_eq_type(frozen_end_template, end_template_cmd);
+
+ primitive_tex("pagegoal", set_page_dimen_cmd, 0, 0);
+ primitive_tex("pagetotal", set_page_dimen_cmd, 1, 0);
+ primitive_tex("pagestretch", set_page_dimen_cmd, 2, 0);
+ primitive_tex("pagefilstretch", set_page_dimen_cmd, 3, 0);
+ primitive_tex("pagefillstretch", set_page_dimen_cmd, 4, 0);
+ primitive_tex("pagefilllstretch", set_page_dimen_cmd, 5, 0);
+ primitive_tex("pageshrink", set_page_dimen_cmd, 6, 0);
+ primitive_tex("pagedepth", set_page_dimen_cmd, 7, 0);
+
+ /*
+ Either \.{\\dump} or \.{\\end} will cause |main_control| to enter the
+ endgame, since both of them have `|stop|' as their command code.
+ */
+
+ primitive_tex("end", stop_cmd, 0, 0);
+ primitive_tex("dump", stop_cmd, 1, 0);
+
+ primitive_tex("hskip", hskip_cmd, skip_code, 0);
+ primitive_tex("hfil", hskip_cmd, fil_code, 0);
+ primitive_tex("hfill", hskip_cmd, fill_code, 0);
+ primitive_tex("hss", hskip_cmd, ss_code, 0);
+ primitive_tex("hfilneg", hskip_cmd, fil_neg_code, 0);
+ primitive_tex("vskip", vskip_cmd, skip_code, 0);
+ primitive_tex("vfil", vskip_cmd, fil_code, 0);
+ primitive_tex("vfill", vskip_cmd, fill_code, 0);
+ primitive_tex("vss", vskip_cmd, ss_code, 0);
+ primitive_tex("vfilneg", vskip_cmd, fil_neg_code, 0);
+ primitive_tex("mskip", mskip_cmd, mskip_code, 0);
+ primitive_tex("kern", kern_cmd, explicit_kern, 0);
+ primitive_tex("mkern", mkern_cmd, mu_glue, 0);
+ primitive_tex("moveleft", hmove_cmd, 1, 0);
+ primitive_tex("moveright", hmove_cmd, 0, 0);
+ primitive_tex("raise", vmove_cmd, 1, 0);
+ primitive_tex("lower", vmove_cmd, 0, 0);
+ primitive_tex("box", make_box_cmd, box_code, 0);
+ primitive_tex("copy", make_box_cmd, copy_code, 0);
+ primitive_tex("lastbox", make_box_cmd, last_box_code, 0);
+ primitive_tex("vsplit", make_box_cmd, vsplit_code, 0);
+ primitive_tex("tpack", make_box_cmd, tpack_code, 0);
+ primitive_tex("vpack", make_box_cmd, vpack_code, 0);
+ primitive_tex("hpack", make_box_cmd, hpack_code, 0);
+ primitive_tex("vtop", make_box_cmd, vtop_code, 0);
+ primitive_tex("vbox", make_box_cmd, vtop_code + vmode, 0);
+ primitive_tex("hbox", make_box_cmd, vtop_code + hmode, 0);
+ primitive_tex("shipout", leader_ship_cmd, a_leaders - 1, 0); /* |ship_out_flag=leader_flag-1| */
+ primitive_tex("leaders", leader_ship_cmd, a_leaders, 0);
+ primitive_tex("cleaders", leader_ship_cmd, c_leaders, 0);
+ primitive_tex("xleaders", leader_ship_cmd, x_leaders, 0);
+ primitive_luatex("gleaders", leader_ship_cmd, g_leaders, 0);
+ primitive_luatex("boxdir", assign_box_dir_cmd, 0, 0);
+ primitive_tex("indent", start_par_cmd, 1, 0);
+ primitive_tex("noindent", start_par_cmd, 0, 0);
+ primitive_luatex("quitvmode", start_par_cmd, 2, 0);
+ primitive_tex("unpenalty", remove_item_cmd, penalty_node, 0);
+ primitive_tex("unkern", remove_item_cmd, kern_node, 0);
+ primitive_tex("unskip", remove_item_cmd, glue_node, 0);
+ primitive_tex("unhbox", un_hbox_cmd, box_code, 0);
+ primitive_tex("unhcopy", un_hbox_cmd, copy_code, 0);
+ primitive_tex("unvbox", un_vbox_cmd, box_code, 0);
+ primitive_tex("unvcopy", un_vbox_cmd, copy_code, 0);
+ primitive_tex("-", discretionary_cmd, explicit_disc, 0);
+ primitive_tex("discretionary", discretionary_cmd, discretionary_disc, 0);
+ primitive_luatex("localleftbox", assign_local_box_cmd, 0, 0);
+ primitive_luatex("localrightbox", assign_local_box_cmd, 1, 0);
+
+ primitive_luatex("Ustartmath", math_shift_cs_cmd, text_style, 0);
+ primitive_luatex("Ustopmath", math_shift_cs_cmd, cramped_text_style, 0);
+ primitive_luatex("Ustartdisplaymath", math_shift_cs_cmd, display_style, 0);
+ primitive_luatex("Ustopdisplaymath", math_shift_cs_cmd, cramped_display_style, 0);
+ primitive_tex("eqno", eq_no_cmd, 0, 0);
+ primitive_tex("leqno", eq_no_cmd, 1, 0);
+ primitive_tex("mathord", math_comp_cmd, ord_noad_type, 0);
+ primitive_tex("mathop", math_comp_cmd, op_noad_type_normal, 0);
+ primitive_tex("mathbin", math_comp_cmd, bin_noad_type, 0);
+ primitive_tex("mathrel", math_comp_cmd, rel_noad_type, 0);
+ primitive_tex("mathopen", math_comp_cmd, open_noad_type, 0);
+ primitive_tex("mathclose", math_comp_cmd, close_noad_type, 0);
+ primitive_tex("mathpunct", math_comp_cmd, punct_noad_type, 0);
+ primitive_tex("mathinner", math_comp_cmd, inner_noad_type, 0);
+ primitive_tex("underline", math_comp_cmd, under_noad_type, 0);
+ primitive_tex("overline", math_comp_cmd, over_noad_type, 0);
+ primitive_tex("displaylimits", limit_switch_cmd, op_noad_type_normal, 0);
+ primitive_tex("limits", limit_switch_cmd, op_noad_type_limits, 0);
+ primitive_tex("nolimits", limit_switch_cmd, op_noad_type_no_limits, 0);
+ primitive_tex("displaystyle", math_style_cmd, display_style, 0);
+ primitive_tex("textstyle", math_style_cmd, text_style, 0);
+ primitive_tex("scriptstyle", math_style_cmd, script_style, 0);
+ primitive_tex("scriptscriptstyle", math_style_cmd, script_script_style, 0);
+ primitive_luatex("crampeddisplaystyle", math_style_cmd, cramped_display_style, 0);
+ primitive_luatex("crampedtextstyle", math_style_cmd, cramped_text_style, 0);
+ primitive_luatex("crampedscriptstyle", math_style_cmd, cramped_script_style, 0);
+ primitive_luatex("crampedscriptscriptstyle", math_style_cmd, cramped_script_script_style, 0);
+ primitive_luatex("Usuperscript", super_sub_script_cmd, sup_mark_cmd, sup_mark_cmd);
+ primitive_luatex("Usubscript", super_sub_script_cmd, sub_mark_cmd, sup_mark_cmd);
+ primitive_tex("above", above_cmd, above_code, 0);
+ primitive_tex("over", above_cmd, over_code, 0);
+ primitive_tex("atop", above_cmd, atop_code, 0);
+ primitive_luatex("Uskewed", above_cmd, skewed_code, 0);
+ primitive_tex("abovewithdelims", above_cmd, delimited_code + above_code, 0);
+ primitive_tex("overwithdelims", above_cmd, delimited_code + over_code, 0);
+ primitive_tex("atopwithdelims", above_cmd, delimited_code + atop_code, 0);
+ primitive_luatex("Uskewedwithdelims", above_cmd, delimited_code + skewed_code, 0);
+ primitive_tex("left", left_right_cmd, left_noad_side, 0);
+ primitive_tex("right", left_right_cmd, right_noad_side, 0);
+ primitive_tex("middle", left_right_cmd, middle_noad_side, 0);
+ primitive_tex("Uleft", left_right_cmd, 10+left_noad_side, 0);
+ primitive_tex("Uright", left_right_cmd, 10+right_noad_side, 0);
+ primitive_tex("Umiddle", left_right_cmd, 10+middle_noad_side, 0);
+ primitive_luatex("Uvextensible", left_right_cmd, 10+no_noad_side, 0);
+ cs_text(frozen_right) = maketexstring("right");
+ eqtb[frozen_right] = eqtb[cur_val];
+
+ primitive_tex("long", prefix_cmd, 1, 0);
+ primitive_tex("outer", prefix_cmd, 2, 0);
+ primitive_tex("global", prefix_cmd, 4, 0);
+ primitive_tex("def", def_cmd, 0, 0);
+ primitive_tex("gdef", def_cmd, 1, 0);
+ primitive_tex("edef", def_cmd, 2, 0);
+ primitive_tex("xdef", def_cmd, 3, 0);
+ primitive_tex("let", let_cmd, normal, 0);
+ primitive_tex("futurelet", let_cmd, normal + 1, 0);
+ primitive_luatex("letcharcode", let_cmd, normal + 2, 0);
+ primitive_tex("chardef", shorthand_def_cmd, char_def_code, 0);
+ primitive_tex("mathchardef", shorthand_def_cmd, math_char_def_code, 0);
+ primitive_luatex("Umathchardef", shorthand_def_cmd, xmath_char_def_code, 0);
+ primitive_luatex("Umathcharnumdef", shorthand_def_cmd, umath_char_def_code, 0);
+ primitive_tex("countdef", shorthand_def_cmd, count_def_code, 0);
+ primitive_luatex("attributedef", shorthand_def_cmd, attribute_def_code, 0);
+ primitive_tex("dimendef", shorthand_def_cmd, dimen_def_code, 0);
+ primitive_tex("skipdef", shorthand_def_cmd, skip_def_code, 0);
+ primitive_tex("muskipdef", shorthand_def_cmd, mu_skip_def_code, 0);
+ primitive_tex("toksdef", shorthand_def_cmd, toks_def_code, 0);
+ primitive_tex("catcode", def_char_code_cmd, cat_code_base, cat_code_base);
+ primitive_tex("mathcode", def_char_code_cmd, math_code_base, cat_code_base);
+ primitive_tex("lccode", def_char_code_cmd, lc_code_base, cat_code_base);
+ primitive_tex("uccode", def_char_code_cmd, uc_code_base, cat_code_base);
+ primitive_tex("sfcode", def_char_code_cmd, sf_code_base, cat_code_base);
+ primitive_tex("delcode", def_del_code_cmd, del_code_base, del_code_base);
+ primitive_tex("textfont", def_family_cmd, text_size, 0);
+ primitive_tex("scriptfont", def_family_cmd, script_size, 0);
+ primitive_tex("scriptscriptfont", def_family_cmd, script_script_size, 0);
+ primitive_luatex("Umathquad", set_math_param_cmd, math_param_quad, 0);
+ primitive_luatex("Umathaxis", set_math_param_cmd, math_param_axis, 0);
+
+@ These are in a separate module due to a CWEAVE limitation.
+
+@<Create the math param primitives@>=
+ primitive_luatex("Umathoperatorsize", set_math_param_cmd, math_param_operator_size, 0);
+ primitive_luatex("Umathoverbarkern", set_math_param_cmd, math_param_overbar_kern, 0);
+ primitive_luatex("Umathoverbarrule", set_math_param_cmd, math_param_overbar_rule, 0);
+ primitive_luatex("Umathoverbarvgap", set_math_param_cmd, math_param_overbar_vgap, 0);
+ primitive_luatex("Umathunderbarkern", set_math_param_cmd, math_param_underbar_kern, 0);
+ primitive_luatex("Umathunderbarrule", set_math_param_cmd, math_param_underbar_rule, 0);
+ primitive_luatex("Umathunderbarvgap", set_math_param_cmd, math_param_underbar_vgap, 0);
+ primitive_luatex("Umathradicalkern", set_math_param_cmd, math_param_radical_kern, 0);
+ primitive_luatex("Umathradicalrule", set_math_param_cmd, math_param_radical_rule, 0);
+ primitive_luatex("Umathradicalvgap", set_math_param_cmd, math_param_radical_vgap, 0);
+ primitive_luatex("Umathradicaldegreebefore", set_math_param_cmd, math_param_radical_degree_before, 0);
+ primitive_luatex("Umathradicaldegreeafter", set_math_param_cmd, math_param_radical_degree_after, 0);
+ primitive_luatex("Umathradicaldegreeraise", set_math_param_cmd, math_param_radical_degree_raise, 0);
+ primitive_luatex("Umathstackvgap", set_math_param_cmd, math_param_stack_vgap, 0);
+ primitive_luatex("Umathstacknumup", set_math_param_cmd, math_param_stack_num_up, 0);
+ primitive_luatex("Umathstackdenomdown", set_math_param_cmd, math_param_stack_denom_down, 0);
+ primitive_luatex("Umathfractionrule", set_math_param_cmd, math_param_fraction_rule, 0);
+ primitive_luatex("Umathfractionnumvgap", set_math_param_cmd, math_param_fraction_num_vgap, 0);
+ primitive_luatex("Umathfractionnumup", set_math_param_cmd, math_param_fraction_num_up, 0);
+ primitive_luatex("Umathfractiondenomvgap", set_math_param_cmd, math_param_fraction_denom_vgap, 0);
+ primitive_luatex("Umathfractiondenomdown", set_math_param_cmd, math_param_fraction_denom_down, 0);
+ primitive_luatex("Umathfractiondelsize", set_math_param_cmd, math_param_fraction_del_size, 0);
+ primitive_luatex("Umathskewedfractionvgap", set_math_param_cmd, math_param_skewed_fraction_vgap, 0);
+ primitive_luatex("Umathskewedfractionhgap", set_math_param_cmd, math_param_skewed_fraction_hgap, 0);
+ primitive_luatex("Umathlimitabovevgap", set_math_param_cmd, math_param_limit_above_vgap, 0);
+ primitive_luatex("Umathlimitabovebgap", set_math_param_cmd, math_param_limit_above_bgap, 0);
+ primitive_luatex("Umathlimitabovekern", set_math_param_cmd, math_param_limit_above_kern, 0);
+ primitive_luatex("Umathlimitbelowvgap", set_math_param_cmd, math_param_limit_below_vgap, 0);
+ primitive_luatex("Umathlimitbelowbgap", set_math_param_cmd, math_param_limit_below_bgap, 0);
+ primitive_luatex("Umathlimitbelowkern", set_math_param_cmd, math_param_limit_below_kern, 0);
+ primitive_luatex("Umathnolimitsubfactor", set_math_param_cmd, math_param_nolimit_sub_factor, 0); /* bonus */
+ primitive_luatex("Umathnolimitsupfactor", set_math_param_cmd, math_param_nolimit_sup_factor, 0); /* bonus */
+ primitive_luatex("Umathunderdelimitervgap", set_math_param_cmd, math_param_under_delimiter_vgap, 0);
+ primitive_luatex("Umathunderdelimiterbgap", set_math_param_cmd, math_param_under_delimiter_bgap, 0);
+ primitive_luatex("Umathoverdelimitervgap", set_math_param_cmd, math_param_over_delimiter_vgap, 0);
+ primitive_luatex("Umathoverdelimiterbgap", set_math_param_cmd, math_param_over_delimiter_bgap, 0);
+ primitive_luatex("Umathsubshiftdrop", set_math_param_cmd, math_param_sub_shift_drop, 0);
+ primitive_luatex("Umathsupshiftdrop", set_math_param_cmd, math_param_sup_shift_drop, 0);
+ primitive_luatex("Umathsubshiftdown", set_math_param_cmd, math_param_sub_shift_down, 0);
+ primitive_luatex("Umathsubsupshiftdown", set_math_param_cmd, math_param_sub_sup_shift_down, 0);
+ primitive_luatex("Umathsubtopmax", set_math_param_cmd, math_param_sub_top_max, 0);
+ primitive_luatex("Umathsupshiftup", set_math_param_cmd, math_param_sup_shift_up, 0);
+ primitive_luatex("Umathsupbottommin", set_math_param_cmd, math_param_sup_bottom_min, 0);
+ primitive_luatex("Umathsupsubbottommax", set_math_param_cmd, math_param_sup_sub_bottom_max, 0);
+ primitive_luatex("Umathsubsupvgap", set_math_param_cmd, math_param_subsup_vgap, 0);
+ primitive_luatex("Umathspaceafterscript", set_math_param_cmd, math_param_space_after_script, 0);
+ primitive_luatex("Umathconnectoroverlapmin", set_math_param_cmd, math_param_connector_overlap_min, 0);
+ primitive_luatex("Umathordordspacing", set_math_param_cmd, math_param_ord_ord_spacing, 0);
+ primitive_luatex("Umathordopspacing", set_math_param_cmd, math_param_ord_op_spacing, 0);
+ primitive_luatex("Umathordbinspacing", set_math_param_cmd, math_param_ord_bin_spacing, 0);
+ primitive_luatex("Umathordrelspacing", set_math_param_cmd, math_param_ord_rel_spacing, 0);
+ primitive_luatex("Umathordopenspacing", set_math_param_cmd, math_param_ord_open_spacing, 0);
+ primitive_luatex("Umathordclosespacing", set_math_param_cmd, math_param_ord_close_spacing, 0);
+ primitive_luatex("Umathordpunctspacing", set_math_param_cmd, math_param_ord_punct_spacing, 0);
+ primitive_luatex("Umathordinnerspacing", set_math_param_cmd, math_param_ord_inner_spacing, 0);
+ primitive_luatex("Umathopordspacing", set_math_param_cmd, math_param_op_ord_spacing, 0);
+ primitive_luatex("Umathopopspacing", set_math_param_cmd, math_param_op_op_spacing, 0);
+ primitive_luatex("Umathopbinspacing", set_math_param_cmd, math_param_op_bin_spacing, 0);
+ primitive_luatex("Umathoprelspacing", set_math_param_cmd, math_param_op_rel_spacing, 0);
+ primitive_luatex("Umathopopenspacing", set_math_param_cmd, math_param_op_open_spacing, 0);
+ primitive_luatex("Umathopclosespacing", set_math_param_cmd, math_param_op_close_spacing, 0);
+ primitive_luatex("Umathoppunctspacing", set_math_param_cmd, math_param_op_punct_spacing, 0);
+ primitive_luatex("Umathopinnerspacing", set_math_param_cmd, math_param_op_inner_spacing, 0);
+ primitive_luatex("Umathbinordspacing", set_math_param_cmd, math_param_bin_ord_spacing, 0);
+ primitive_luatex("Umathbinopspacing", set_math_param_cmd, math_param_bin_op_spacing, 0);
+ primitive_luatex("Umathbinbinspacing", set_math_param_cmd, math_param_bin_bin_spacing, 0);
+ primitive_luatex("Umathbinrelspacing", set_math_param_cmd, math_param_bin_rel_spacing, 0);
+ primitive_luatex("Umathbinopenspacing", set_math_param_cmd, math_param_bin_open_spacing, 0);
+ primitive_luatex("Umathbinclosespacing", set_math_param_cmd, math_param_bin_close_spacing, 0);
+ primitive_luatex("Umathbinpunctspacing", set_math_param_cmd, math_param_bin_punct_spacing, 0);
+ primitive_luatex("Umathbininnerspacing", set_math_param_cmd, math_param_bin_inner_spacing, 0);
+ primitive_luatex("Umathrelordspacing", set_math_param_cmd, math_param_rel_ord_spacing, 0);
+ primitive_luatex("Umathrelopspacing", set_math_param_cmd, math_param_rel_op_spacing, 0);
+ primitive_luatex("Umathrelbinspacing", set_math_param_cmd, math_param_rel_bin_spacing, 0);
+ primitive_luatex("Umathrelrelspacing", set_math_param_cmd, math_param_rel_rel_spacing, 0);
+ primitive_luatex("Umathrelopenspacing", set_math_param_cmd, math_param_rel_open_spacing, 0);
+ primitive_luatex("Umathrelclosespacing", set_math_param_cmd, math_param_rel_close_spacing, 0);
+ primitive_luatex("Umathrelpunctspacing", set_math_param_cmd, math_param_rel_punct_spacing, 0);
+ primitive_luatex("Umathrelinnerspacing", set_math_param_cmd, math_param_rel_inner_spacing, 0);
+ primitive_luatex("Umathopenordspacing", set_math_param_cmd, math_param_open_ord_spacing, 0);
+ primitive_luatex("Umathopenopspacing", set_math_param_cmd, math_param_open_op_spacing, 0);
+ primitive_luatex("Umathopenbinspacing", set_math_param_cmd, math_param_open_bin_spacing, 0);
+ primitive_luatex("Umathopenrelspacing", set_math_param_cmd, math_param_open_rel_spacing, 0);
+ primitive_luatex("Umathopenopenspacing", set_math_param_cmd, math_param_open_open_spacing, 0);
+ primitive_luatex("Umathopenclosespacing", set_math_param_cmd, math_param_open_close_spacing, 0);
+ primitive_luatex("Umathopenpunctspacing", set_math_param_cmd, math_param_open_punct_spacing, 0);
+ primitive_luatex("Umathopeninnerspacing", set_math_param_cmd, math_param_open_inner_spacing, 0);
+ primitive_luatex("Umathcloseordspacing", set_math_param_cmd, math_param_close_ord_spacing, 0);
+ primitive_luatex("Umathcloseopspacing", set_math_param_cmd, math_param_close_op_spacing, 0);
+ primitive_luatex("Umathclosebinspacing", set_math_param_cmd, math_param_close_bin_spacing, 0);
+ primitive_luatex("Umathcloserelspacing", set_math_param_cmd, math_param_close_rel_spacing, 0);
+ primitive_luatex("Umathcloseopenspacing", set_math_param_cmd, math_param_close_open_spacing, 0);
+ primitive_luatex("Umathcloseclosespacing", set_math_param_cmd, math_param_close_close_spacing, 0);
+ primitive_luatex("Umathclosepunctspacing", set_math_param_cmd, math_param_close_punct_spacing, 0);
+ primitive_luatex("Umathcloseinnerspacing", set_math_param_cmd, math_param_close_inner_spacing, 0);
+ primitive_luatex("Umathpunctordspacing", set_math_param_cmd, math_param_punct_ord_spacing, 0);
+ primitive_luatex("Umathpunctopspacing", set_math_param_cmd, math_param_punct_op_spacing, 0);
+ primitive_luatex("Umathpunctbinspacing", set_math_param_cmd, math_param_punct_bin_spacing, 0);
+ primitive_luatex("Umathpunctrelspacing", set_math_param_cmd, math_param_punct_rel_spacing, 0);
+ primitive_luatex("Umathpunctopenspacing", set_math_param_cmd, math_param_punct_open_spacing, 0);
+ primitive_luatex("Umathpunctclosespacing", set_math_param_cmd, math_param_punct_close_spacing, 0);
+ primitive_luatex("Umathpunctpunctspacing", set_math_param_cmd, math_param_punct_punct_spacing, 0);
+ primitive_luatex("Umathpunctinnerspacing", set_math_param_cmd, math_param_punct_inner_spacing, 0);
+ primitive_luatex("Umathinnerordspacing", set_math_param_cmd, math_param_inner_ord_spacing, 0);
+ primitive_luatex("Umathinneropspacing", set_math_param_cmd, math_param_inner_op_spacing, 0);
+ primitive_luatex("Umathinnerbinspacing", set_math_param_cmd, math_param_inner_bin_spacing, 0);
+ primitive_luatex("Umathinnerrelspacing", set_math_param_cmd, math_param_inner_rel_spacing, 0);
+ primitive_luatex("Umathinneropenspacing", set_math_param_cmd, math_param_inner_open_spacing, 0);
+ primitive_luatex("Umathinnerclosespacing", set_math_param_cmd, math_param_inner_close_spacing, 0);
+ primitive_luatex("Umathinnerpunctspacing", set_math_param_cmd, math_param_inner_punct_spacing, 0);
+ primitive_luatex("Umathinnerinnerspacing", set_math_param_cmd, math_param_inner_inner_spacing, 0);
+
+@ These are in a separate module due to a CWEAVE limitation.
+
+@<Create another bunch of primitives@>=
+ primitive_luatex("Umathcode", extdef_math_code_cmd, math_code_base, math_code_base);
+ primitive_luatex("Udelcode", extdef_del_code_cmd, del_code_base, del_code_base);
+ primitive_luatex("Umathcodenum", extdef_math_code_cmd, math_code_base + 1, math_code_base);
+ primitive_luatex("Udelcodenum", extdef_del_code_cmd, del_code_base + 1, del_code_base);
+ primitive_tex("hyphenation", hyph_data_cmd, 0, 0);
+ primitive_tex("patterns", hyph_data_cmd, 1, 0);
+ primitive_luatex("prehyphenchar", hyph_data_cmd, 2, 0);
+ primitive_luatex("posthyphenchar", hyph_data_cmd, 3, 0);
+ primitive_luatex("preexhyphenchar", hyph_data_cmd, 4, 0);
+ primitive_luatex("postexhyphenchar", hyph_data_cmd, 5, 0);
+ primitive_luatex("hyphenationmin", hyph_data_cmd, 6, 0);
+ primitive_luatex("hjcode", hyph_data_cmd, 7, 0);
+ primitive_tex("hyphenchar", assign_font_int_cmd, 0, 0);
+ primitive_tex("skewchar", assign_font_int_cmd, 1, 0);
+ primitive_luatex("lpcode", assign_font_int_cmd, lp_code_base, 0);
+ primitive_luatex("rpcode", assign_font_int_cmd, rp_code_base, 0);
+ primitive_luatex("efcode", assign_font_int_cmd, ef_code_base, 0);
+ primitive_luatex("tagcode", assign_font_int_cmd, tag_code, 0);
+ primitive_luatex("ignoreligaturesinfont", assign_font_int_cmd, no_lig_code, 0);
+ primitive_tex("batchmode", set_interaction_cmd, batch_mode, 0);
+ primitive_tex("nonstopmode", set_interaction_cmd, nonstop_mode, 0);
+ primitive_tex("scrollmode", set_interaction_cmd, scroll_mode, 0);
+ primitive_tex("errorstopmode", set_interaction_cmd, error_stop_mode, 0);
+ primitive_tex("openin", in_stream_cmd, 1, 0);
+ primitive_tex("closein", in_stream_cmd, 0, 0);
+ primitive_tex("message", message_cmd, 0, 0);
+ primitive_tex("errmessage", message_cmd, 1, 0);
+ primitive_tex("lowercase", case_shift_cmd, lc_code_base, lc_code_base);
+ primitive_tex("uppercase", case_shift_cmd, uc_code_base, lc_code_base);
+ primitive_tex("show", xray_cmd, show_code, 0);
+ primitive_tex("showbox", xray_cmd, show_box_code, 0);
+ primitive_tex("showthe", xray_cmd, show_the_code, 0);
+ primitive_tex("showlists", xray_cmd, show_lists, 0);
+
+ primitive_tex("openout", extension_cmd, open_code, 0);
+ primitive_tex("write", extension_cmd, write_code, 0);
+ write_loc = cur_val;
+ primitive_tex("closeout", extension_cmd, close_code, 0);
+ primitive_tex("special", extension_cmd, special_code, 0);
+ cs_text(frozen_special) = maketexstring("special");
+ eqtb[frozen_special] = eqtb[cur_val];
+ primitive_tex("immediate", extension_cmd, immediate_code, 0);
+ primitive_luatex("localinterlinepenalty", assign_int_cmd, int_base + local_inter_line_penalty_code, int_base);
+ primitive_luatex("localbrokenpenalty", assign_int_cmd, int_base + local_broken_penalty_code, int_base);
+ primitive_luatex("pagedir", assign_dir_cmd, int_base + page_direction_code, dir_base);
+ primitive_luatex("bodydir", assign_dir_cmd, int_base + body_direction_code, dir_base);
+ primitive_luatex("pardir", assign_dir_cmd, int_base + par_direction_code, dir_base);
+ primitive_luatex("textdir", assign_dir_cmd, int_base + text_direction_code, dir_base);
+ primitive_luatex("mathdir", assign_dir_cmd, int_base + math_direction_code, dir_base);
+ primitive_luatex("linedir", assign_dir_cmd, int_base + line_direction_code, dir_base);
+ primitive_luatex("pageleftoffset", assign_dimen_cmd, dimen_base + page_left_offset_code, dimen_base);
+ primitive_luatex("pagetopoffset", assign_dimen_cmd, dimen_base + page_top_offset_code, dimen_base);
+ primitive_luatex("pagerightoffset", assign_dimen_cmd, dimen_base + page_right_offset_code, dimen_base);
+ primitive_luatex("pagebottomoffset", assign_dimen_cmd, dimen_base + page_bottom_offset_code, dimen_base);
+ primitive_luatex("saveboxresource", extension_cmd, save_box_resource_code, 0);
+ primitive_luatex("useboxresource", extension_cmd, use_box_resource_code, 0);
+ primitive_luatex("saveimageresource", extension_cmd, save_image_resource_code, 0);
+ primitive_luatex("useimageresource", extension_cmd, use_image_resource_code, 0);
+ primitive_luatex("savepos", normal_cmd, save_pos_code, 0);
+ primitive_luatex("savecatcodetable", normal_cmd, save_cat_code_table_code, 0);
+ primitive_luatex("initcatcodetable", normal_cmd, init_cat_code_table_code, 0);
+ primitive_luatex("setrandomseed", normal_cmd, set_random_seed_code, 0);
+ primitive_luatex("latelua", normal_cmd, late_lua_code, 0);
+ primitive_luatex("insertht", convert_cmd, insert_ht_code, 0);
+ primitive_luatex("dviextension", extension_cmd, dvi_extension_code, 0);
+ primitive_luatex("dvifeedback", feedback_cmd, dvi_feedback_code, 0);
+ primitive_luatex("dvivariable", variable_cmd, dvi_variable_code, 0);
+ primitive_luatex("pdfextension", extension_cmd, pdf_extension_code, 0);
+ primitive_luatex("pdffeedback", feedback_cmd, pdf_feedback_code, 0);
+ primitive_luatex("pdfvariable", variable_cmd, pdf_variable_code, 0);
+ primitive_luatex("mathoption", option_cmd, math_option_code, 0);
+
+ /*
+ some of the internal integer parameters are not associated with actual
+ primitives at all.
+ */
+
+ primitive_no("nolocalwhatsits", assign_int_cmd, int_base + no_local_whatsits_code, int_base);
+ primitive_no("nolocaldirs", assign_int_cmd, int_base + no_local_dirs_code, int_base);
+
+
+@ @c
+void initialize_etex_commands(void)
+{
+ primitive_etex("lastnodetype", last_item_cmd, last_node_type_code, 0);
+ primitive_etex("eTeXversion", last_item_cmd, eTeX_version_code, 0);
+ primitive_etex("eTeXminorversion", last_item_cmd, eTeX_minor_version_code, 0);
+ primitive_etex("eTeXrevision", convert_cmd, eTeX_revision_code, 0);
+
+ /*
+ First we implement the additional \eTeX\ parameters in the table of equivalents.
+ */
+
+ primitive_etex("everyeof", assign_toks_cmd, every_eof_loc, local_base);
+ primitive_etex("tracingassigns", assign_int_cmd, int_base + tracing_assigns_code, int_base);
+ primitive_etex("tracinggroups", assign_int_cmd, int_base + tracing_groups_code, int_base);
+ primitive_etex("tracingifs", assign_int_cmd, int_base + tracing_ifs_code, int_base);
+ primitive_etex("tracingscantokens", assign_int_cmd, int_base + tracing_scan_tokens_code, int_base);
+ primitive_etex("tracingnesting", assign_int_cmd, int_base + tracing_nesting_code, int_base);
+ primitive_etex("predisplaydirection", assign_int_cmd, int_base + pre_display_direction_code, int_base);
+ primitive_etex("lastlinefit", assign_int_cmd, int_base + last_line_fit_code, int_base);
+ primitive_etex("savingvdiscards", assign_int_cmd, int_base + saving_vdiscards_code, int_base);
+ primitive_etex("savinghyphcodes", assign_int_cmd, int_base + saving_hyph_codes_code, int_base);
+ primitive_luatex("suppressfontnotfounderror", assign_int_cmd, int_base + suppress_fontnotfound_error_code, int_base);
+ primitive_luatex("suppresslongerror", assign_int_cmd, int_base + suppress_long_error_code, int_base);
+ primitive_luatex("suppressmathparerror", assign_int_cmd, int_base + suppress_mathpar_error_code, int_base);
+ primitive_luatex("suppressifcsnameerror", assign_int_cmd, int_base + suppress_ifcsname_error_code, int_base);
+ primitive_luatex("suppressoutererror", assign_int_cmd, int_base + suppress_outer_error_code, int_base);
+ primitive_luatex("matheqnogapstep", assign_int_cmd, int_base + math_eqno_gap_step_code, int_base);
+ primitive_luatex("mathdisplayskipmode", assign_int_cmd, int_base + math_display_skip_mode_code, int_base);
+ primitive_luatex("mathscriptsmode", assign_int_cmd, int_base + math_scripts_mode_code, int_base);
+ primitive_luatex("mathnolimitsmode", assign_int_cmd, int_base + math_nolimits_mode_code, int_base);
+ primitive_luatex("mathrulesmode", assign_int_cmd, int_base + math_rules_mode_code, int_base);
+ primitive_luatex("mathrulesfam", assign_int_cmd, int_base + math_rules_fam_code, int_base);
+ primitive_luatex("synctex", assign_int_cmd, int_base + synctex_code, int_base);
+
+ primitive_etex("currentgrouplevel", last_item_cmd, current_group_level_code, 0);
+ primitive_etex("currentgrouptype", last_item_cmd, current_group_type_code, 0);
+
+ primitive_etex("currentiflevel", last_item_cmd, current_if_level_code, 0);
+ primitive_etex("currentiftype", last_item_cmd, current_if_type_code, 0);
+ primitive_etex("currentifbranch", last_item_cmd, current_if_branch_code, 0);
+ primitive_etex("fontcharwd", last_item_cmd, font_char_wd_code, 0);
+ primitive_etex("fontcharht", last_item_cmd, font_char_ht_code, 0);
+ primitive_etex("fontchardp", last_item_cmd, font_char_dp_code, 0);
+ primitive_etex("fontcharic", last_item_cmd, font_char_ic_code, 0);
+
+ primitive_etex("parshapelength", last_item_cmd, par_shape_length_code, 0);
+ primitive_etex("parshapeindent", last_item_cmd, par_shape_indent_code, 0);
+ primitive_etex("parshapedimen", last_item_cmd, par_shape_dimen_code, 0);
+
+ primitive_luatex("shapemode", assign_int_cmd, int_base + shape_mode_code, int_base);
+ primitive_luatex("hyphenationbounds", assign_int_cmd, int_base + hyphenation_bounds_code, int_base);
+
+ primitive_etex("showgroups", xray_cmd, show_groups, 0);
+
+ /*
+ The \.{\\showtokens} command displays a token list.
+ */
+
+ primitive_etex("showtokens", xray_cmd, show_tokens, 0);
+
+ /*
+ The \.{\\unexpanded} primitive prevents expansion of tokens much as
+ the result from \.{\\the} applied to a token variable. The
+ \.{\\detokenize} primitive converts a token list into a list of
+ character tokens much as if the token list were written to a file. We
+ use the fact that the command modifiers for \.{\\unexpanded} and
+ \.{\\detokenize} are odd whereas those for \.{\\the} and \.{\\showthe}
+ are even.
+ */
+
+ primitive_etex("unexpanded", the_cmd, 1, 0);
+ primitive_etex("detokenize", the_cmd, show_tokens, 0);
+
+ /*
+ The \.{\\showifs} command displays all currently active conditionals.
+ */
+
+ primitive_etex("showifs", xray_cmd, show_ifs, 0);
+
+ /*
+ The \.{\\interactionmode} primitive allows to query and set the interaction mode.
+ */
+
+ primitive_etex("interactionmode", set_page_int_cmd, 2, 0);
+
+ /*
+ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens} primitive.
+ */
+
+ primitive_etex("scantokens", input_cmd, 2, 0);
+ primitive_luatex("scantextokens", input_cmd, 3, 0);
+
+ primitive_etex("readline", read_to_cs_cmd, 1, 0);
+
+ primitive_etex("unless", expand_after_cmd, 1, 0);
+ primitive_etex("ifdefined", if_test_cmd, if_def_code, 0);
+ primitive_etex("ifcsname", if_test_cmd, if_cs_code, 0);
+ primitive_etex("iffontchar", if_test_cmd, if_font_char_code, 0);
+ primitive_luatex("ifincsname", if_test_cmd, if_in_csname_code, 0);
+ primitive_luatex("ifabsnum", if_test_cmd, if_abs_num_code, 0);
+ primitive_luatex("ifabsdim", if_test_cmd, if_abs_dim_code, 0);
+
+ /*
+ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix
+ command for macro definitions. Such macros are protected against
+ expansions when lists of expanded tokens are built, e.g., for \.{\\edef}
+ or during \.{\\write}.
+ */
+
+ primitive_etex("protected", prefix_cmd, 8, 0);
+
+ /*
+ Here are the additional \eTeX\ primitives for expressions.
+ */
+
+ primitive_etex("numexpr", last_item_cmd, eTeX_expr - int_val_level + int_val_level, 0);
+ primitive_etex("dimexpr", last_item_cmd, eTeX_expr - int_val_level + dimen_val_level, 0);
+ primitive_etex("glueexpr", last_item_cmd, eTeX_expr - int_val_level + glue_val_level, 0);
+ primitive_etex("muexpr", last_item_cmd, eTeX_expr - int_val_level + mu_val_level, 0);
+
+ primitive_etex("gluestretchorder", last_item_cmd, glue_stretch_order_code, 0);
+ primitive_etex("glueshrinkorder", last_item_cmd, glue_shrink_order_code, 0);
+ primitive_etex("gluestretch", last_item_cmd, glue_stretch_code, 0);
+ primitive_etex("glueshrink", last_item_cmd, glue_shrink_code, 0);
+
+ primitive_etex("mutoglue", last_item_cmd, mu_to_glue_code, 0);
+ primitive_etex("gluetomu", last_item_cmd, glue_to_mu_code, 0);
+
+ /*
+ The \.{\\pagediscards} and \.{\\splitdiscards} commands share the
+ command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are
+ distinguished by their |chr_code| values |last_box_code| and
+ |vsplit_code|. These |chr_code| values are larger than |box_code| and
+ |copy_code|.
+ */
+
+ primitive_etex("pagediscards", un_vbox_cmd, last_box_code, 0);
+ primitive_etex("splitdiscards", un_vbox_cmd, vsplit_code, 0);
+
+ /*
+ The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties},
+ and \.{\\displaywidowpenalties} commands allow to define arrays of
+ penalty values to be used instead of the corresponding single values.
+ */
+
+ primitive_etex("interlinepenalties", set_etex_shape_cmd, inter_line_penalties_loc, etex_pen_base);
+ primitive_etex("clubpenalties", set_etex_shape_cmd, club_penalties_loc, etex_pen_base);
+ primitive_etex("widowpenalties", set_etex_shape_cmd, widow_penalties_loc, etex_pen_base);
+ primitive_etex("displaywidowpenalties", set_etex_shape_cmd, display_widow_penalties_loc, etex_pen_base);
+
+}
diff --git a/Build/source/texk/web2c/luatexdir/tex/dumpdata.w b/Build/source/texk/web2c/luatexdir/tex/dumpdata.w
index dd0cf3b5aba..8f1261fb426 100644
--- a/Build/source/texk/web2c/luatexdir/tex/dumpdata.w
+++ b/Build/source/texk/web2c/luatexdir/tex/dumpdata.w
@@ -1,526 +1,526 @@
-% dumpdata.w
-%
-% Copyright 2009-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
-
-#include "ptexlib.h"
-
-/* we start with 907: the sum of the values of the bytes of "don knuth" */
-
-#define FORMAT_ID (907+24)
-#if ((FORMAT_ID>=0) && (FORMAT_ID<=256))
-#error Wrong value for FORMAT_ID.
-#endif
-
-
-@ After \.{INITEX} has seen a collection of fonts and macros, it
-can write all the necessary information on an auxiliary file so
-that production versions of \TeX\ are able to initialize their
-memory at high speed. The present section of the program takes
-care of such output and input. We shall consider simultaneously
-the processes of storing and restoring,
-so that the inverse relation between them is clear.
-@.INITEX@>
-
-The global variable |format_ident| is a string that is printed right
-after the |banner| line when \TeX\ is ready to start. For \.{INITEX} this
-string says simply `\.{(INITEX)}'; for other versions of \TeX\ it says,
-for example, `\.{(preloaded format=plain 1982.11.19)}', showing the year,
-month, and day that the format file was created. We have |format_ident=0|
-before \TeX's tables are loaded. |FORMAT_ID| is a new field of type int
-suitable for the identification of a format: values between 0 and 256
-(included) can not be used because in the previous format they are used
-for the length of the name of the engine.
-@c
-str_number format_ident;
-str_number format_name; /* principal file name */
-
-
-@ Format files consist of |memory_word| items, and we use the following
-macros to dump words of different types:
-
-@c
-FILE *fmt_file; /* for input or output of format information */
-
-@ @c
-void store_fmt_file(void)
-{
- int j, k, l; /* all-purpose indices */
- halfword p; /* all-purpose pointer */
- int x; /* something to dump */
- char *format_engine;
- int callback_id; /* |pre_dump| callback */
- char *fmtname = NULL;
- /* If dumping is not allowed, abort */
- /* The user is not allowed to dump a format file unless |save_ptr=0|.
- This condition implies that |cur_level=level_one|, hence
- the |xeq_level| array is constant and it need not be dumped. */
- if (save_ptr != 0) {
- print_err("You can't dump inside a group");
- help1("`{...\\dump}' is a no-no.");
- succumb();
- }
-
- /* Create the |format_ident|, open the format file, and inform the user
- that dumping has begun */
- callback_id = callback_defined(pre_dump_callback);
- if (callback_id > 0) {
- (void) run_callback(callback_id, "->");
- }
- selector = new_string;
- tprint(" (format=");
- print(job_name);
- print_char(' ');
- print_int(year_par);
- print_char('.');
- print_int(month_par);
- print_char('.');
- print_int(day_par);
- print_char(')');
- str_room(2);
- format_ident = make_string();
- print(job_name);
- format_name = make_string();
- if (interaction == batch_mode)
- selector = log_only;
- else
- selector = term_and_log;
-
- fmtname = pack_job_name(format_extension);
- while (!zopen_w_output(&fmt_file, fmtname, FOPEN_WBIN_MODE)) {
- fmtname = prompt_file_name("format file name", format_extension);
- }
- tprint_nl("Beginning to dump on file ");
- tprint(fmtname);
- free(fmtname);
- tprint_nl("");
- print(format_ident);
-
- /* Dump constants for consistency check */
- /* The next few sections of the program should make it clear how we use the
- dump/undump macros. */
-
- dump_int(0x57325458); /* Web2C \TeX's magic constant: "W2TX" */
- dump_int(FORMAT_ID);
-
- /* Align engine to 4 bytes with one or more trailing NUL */
- x = (int) strlen(engine_name);
- format_engine = xmalloc((unsigned) (x + 4));
- strcpy(format_engine, engine_name);
- for (k = x; k <= x + 3; k++)
- format_engine[k] = 0;
- x = x + 4 - (x % 4);
- dump_int(x);
- dump_things(format_engine[0], x);
- xfree(format_engine);
- dump_int(0x57325458); /* TODO HM, what checksum would make sense? */
- dump_int(max_halfword);
- dump_int(hash_high);
- dump_int(eqtb_size);
- dump_int(hash_prime);
-
- /* Dump the string pool */
- k = dump_string_pool();
- print_ln();
- print_int(k);
- tprint(" strings using ");
- print_int((longinteger) pool_size);
- tprint(" bytes");
-
- /* Dump the dynamic memory */
- /* By sorting the list of available spaces in the variable-size portion of
- |mem|, we are usually able to get by without having to dump very much
- of the dynamic memory.
-
- We recompute |var_used| and |dyn_used|, so that \.{INITEX} dumps valid
- information even when it has not been gathering statistics.
- */
- dump_node_mem();
- dump_int(temp_token_head);
- dump_int(hold_token_head);
- dump_int(omit_template);
- dump_int(null_list);
- dump_int(backup_head);
- dump_int(garbage);
- x = (int) fix_mem_min;
- dump_int(x);
- x = (int) fix_mem_max;
- dump_int(x);
- x = (int) fix_mem_end;
- dump_int(x);
- dump_int(avail);
- dyn_used = (int) fix_mem_end + 1;
- dump_things(fixmem[fix_mem_min], fix_mem_end - fix_mem_min + 1);
- x = x + (int) (fix_mem_end + 1 - fix_mem_min);
- p = avail;
- while (p != null) {
- decr(dyn_used);
- p = token_link(p);
- }
- dump_int(dyn_used);
- print_ln();
- print_int(x);
- tprint(" memory locations dumped; current usage is ");
- print_int(var_used);
- print_char('&');
- print_int(dyn_used);
-
- /* Dump the table of equivalents */
- /* Dump regions 1 to 4 of |eqtb| */
- /*The table of equivalents usually contains repeated information, so we dump it
- in compressed form: The sequence of $n+2$ values $(n,x_1,\ldots,x_n,m)$ in the
- format file represents $n+m$ consecutive entries of |eqtb|, with |m| extra
- copies of $x_n$, namely $(x_1,\ldots,x_n,x_n,\ldots,x_n)$.
- */
- k = null_cs;
- do {
- j = k;
- while (j < int_base - 1) {
- if ((equiv(j) == equiv(j + 1)) && (eq_type(j) == eq_type(j + 1)) &&
- (eq_level(j) == eq_level(j + 1)))
- goto FOUND1;
- incr(j);
- }
- l = int_base;
- goto DONE1; /* |j=int_base-1| */
- FOUND1:
- incr(j);
- l = j;
- while (j < int_base - 1) {
- if ((equiv(j) != equiv(j + 1)) || (eq_type(j) != eq_type(j + 1)) ||
- (eq_level(j) != eq_level(j + 1)))
- goto DONE1;
- incr(j);
- }
- DONE1:
- dump_int(l - k);
- dump_things(eqtb[k], l - k);
- k = j + 1;
- dump_int(k - l);
- } while (k != int_base);
-
- /* Dump regions 5 and 6 of |eqtb| */
- do {
- j = k;
- while (j < eqtb_size) {
- if (eqtb[j].cint == eqtb[j + 1].cint)
- goto FOUND2;
- incr(j);
- }
- l = eqtb_size + 1;
- goto DONE2; /* |j=eqtb_size| */
- FOUND2:
- incr(j);
- l = j;
- while (j < eqtb_size) {
- if (eqtb[j].cint != eqtb[j + 1].cint)
- goto DONE2;
- incr(j);
- }
- DONE2:
- dump_int(l - k);
- dump_things(eqtb[k], l - k);
- k = j + 1;
- dump_int(k - l);
- } while (k <= eqtb_size);
- if (hash_high > 0)
- dump_things(eqtb[eqtb_size + 1], hash_high); /* dump |hash_extra| part */
-
- dump_int(par_loc);
- dump_int(write_loc);
- dump_math_codes();
- dump_text_codes();
- /* Dump the hash table */
- /* A different scheme is used to compress the hash table, since its lower
- region is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output
- two words, |p| and |hash[p]|. The hash table is, of course, densely packed
- for |p>=hash_used|, so the remaining entries are output in a~block.
- */
- dump_primitives();
- dump_int(hash_used);
- cs_count = frozen_control_sequence - 1 - hash_used + hash_high;
- for (p = hash_base; p <= hash_used; p++) {
- if (cs_text(p) != 0) {
- dump_int(p);
- dump_hh(hash[p]);
- incr(cs_count);
- }
- }
- dump_things(hash[hash_used + 1],
- undefined_control_sequence - 1 - hash_used);
- if (hash_high > 0)
- dump_things(hash[eqtb_size + 1], hash_high);
- dump_int(cs_count);
- print_ln();
- print_int(cs_count);
- tprint(" multiletter control sequences");
-
- /* Dump the font information */
- dump_int(max_font_id());
- for (k = 0; k <= max_font_id(); k++) {
- /* Dump the array info for internal font number |k| */
- dump_font(k);
- tprint_nl("\\font");
- print_esc(font_id_text(k));
- print_char('=');
- tprint_file_name((unsigned char *) font_name(k),
- (unsigned char *) font_area(k), NULL);
- if (font_size(k) != font_dsize(k)) {
- tprint(" at ");
- print_scaled(font_size(k));
- tprint("pt");
- }
- }
- print_ln();
- print_int(max_font_id());
- tprint(" preloaded font");
- if (max_font_id() != 1)
- print_char('s');
- dump_math_data();
-
- /* Dump the hyphenation tables */
- dump_language_data();
-
- /* Dump a couple more things and the closing check word */
- dump_int(interaction);
- dump_int(format_ident);
- dump_int(format_name);
- dump_int(69069);
- /* We have already printed a lot of statistics, so we set |tracing_stats:=0|
- to prevent them from appearing again. */
- tracing_stats_par = 0;
-
- /* Dump the lua bytecodes */
- dump_luac_registers();
-
- /* Close the format file */
- zwclose(fmt_file);
-}
-
-@ Corresponding to the procedure that dumps a format file, we have a function
-that reads one in. The function returns |false| if the dumped format is
-incompatible with the present \TeX\ table sizes, etc.
-
-@c
-#define too_small(A) do { \
- wake_up_terminal(); \
- wterm_cr(); \
- fprintf(term_out,"---! Must increase the %s",(A)); \
- goto BAD_FMT; \
- } while (0)
-
-@ The inverse macros are slightly more complicated, since we need to check
-the range of the values we are reading in. We say `|undump(a)(b)(x)|' to
-read an integer value |x| that is supposed to be in the range |a<=x<=b|.
-
-@c
-#define undump(A,B,C) do { \
- undump_int(x); \
- if (x<(A) || x>(B)) goto BAD_FMT; \
- else (C) = x; \
- } while (0)
-
-
-#define format_debug(A,B) do { \
- if (debug_format_file) { \
- fprintf (stderr, "fmtdebug: %s=%d", (A), (int)(B)); \
- } \
- } while (0)
-
-#define undump_size(A,B,C,D) do { \
- undump_int(x); \
- if (x<(A)) goto BAD_FMT; \
- if (x>(B)) too_small(C); \
- else format_debug (C,x); \
- (D) = x; \
- } while (0)
-
-
-@ @c
-boolean load_fmt_file(const char *fmtname)
-{
- int j, k; /* all-purpose indices */
- halfword p; /* all-purpose pointer */
- int x; /* something undumped */
- char *format_engine;
- /* Undump constants for consistency check */
- if (ini_version) {
- libcfree(hash);
- libcfree(eqtb);
- libcfree(fixmem);
- libcfree(varmem);
- }
- undump_int(x);
- format_debug("format magic number", x);
- if (x != 0x57325458)
- goto BAD_FMT; /* not a format file */
-
- undump_int(x);
- format_debug("format id", x);
- if (x != FORMAT_ID)
- goto BAD_FMT; /* FORMAT_ID mismatch */
-
- undump_int(x);
- format_debug("engine name size", x);
- if ((x < 0) || (x > 256))
- goto BAD_FMT; /* corrupted format file */
-
- format_engine = xmalloc((unsigned) x);
- undump_things(format_engine[0], x);
- format_engine[x - 1] = 0; /* force string termination, just in case */
- if (strcmp(engine_name, format_engine)) {
- wake_up_terminal();
- wterm_cr();
- fprintf(term_out, "---! %s was written by %s", fmtname, format_engine);
- xfree(format_engine);
- goto BAD_FMT;
- }
- xfree(format_engine);
- undump_int(x);
- format_debug("string pool checksum", x);
- if (x != 0x57325458) { /* todo: @@\$ *//* check that strings are the same */
- wake_up_terminal();
- wterm_cr();
- fprintf(term_out, "---! %s was written by a different version",
- fmtname);
- goto BAD_FMT;
- }
- undump_int(x);
- if (x != max_halfword)
- goto BAD_FMT; /* check |max_halfword| */
- undump_int(hash_high);
- if ((hash_high < 0) || (hash_high > sup_hash_extra))
- goto BAD_FMT;
- if (hash_extra < hash_high)
- hash_extra = hash_high;
- eqtb_top = eqtb_size + hash_extra;
- if (hash_extra == 0)
- hash_top = undefined_control_sequence;
- else
- hash_top = eqtb_top;
- hash = xmallocarray(two_halves, (unsigned) (1 + hash_top));
- memset(hash, 0, sizeof(two_halves) * (unsigned) (hash_top + 1));
- eqtb = xmallocarray(memory_word, (unsigned) (eqtb_top + 1));
- set_eq_type(undefined_control_sequence, undefined_cs_cmd);
- set_equiv(undefined_control_sequence, null);
- set_eq_level(undefined_control_sequence, level_zero);
- for (x = eqtb_size + 1; x <= eqtb_top; x++)
- eqtb[x] = eqtb[undefined_control_sequence];
- undump_int(x);
- if (x != eqtb_size)
- goto BAD_FMT;
- undump_int(x);
- if (x != hash_prime)
- goto BAD_FMT;
-
- /* Undump the string pool */
- str_ptr = undump_string_pool();
- /* Undump the dynamic memory */
- undump_node_mem();
- undump_int(temp_token_head);
- undump_int(hold_token_head);
- undump_int(omit_template);
- undump_int(null_list);
- undump_int(backup_head);
- undump_int(garbage);
- undump_int(fix_mem_min);
- undump_int(fix_mem_max);
- fixmem = xmallocarray(smemory_word, fix_mem_max + 1);
- memset(voidcast(fixmem), 0, (fix_mem_max + 1) * sizeof(smemory_word));
- undump_int(fix_mem_end);
- undump_int(avail);
- undump_things(fixmem[fix_mem_min], fix_mem_end - fix_mem_min + 1);
- undump_int(dyn_used);
-
- /* Undump the table of equivalents */
- /* Undump regions 1 to 6 of |eqtb| */
- k = null_cs;
- do {
- undump_int(x);
- if ((x < 1) || (k + x > eqtb_size + 1))
- goto BAD_FMT;
- undump_things(eqtb[k], x);
- k = k + x;
- undump_int(x);
- if ((x < 0) || (k + x > eqtb_size + 1))
- goto BAD_FMT;
- for (j = k; j <= k + x - 1; j++)
- eqtb[j] = eqtb[k - 1];
- k = k + x;
- } while (k <= eqtb_size);
- if (hash_high > 0) /* undump |hash_extra| part */
- undump_things(eqtb[eqtb_size + 1], hash_high);
-
- undump(hash_base, hash_top, par_loc);
- par_token = cs_token_flag + par_loc;
- undump(hash_base, hash_top, write_loc);
- undump_math_codes();
- undump_text_codes();
- /* Undump the hash table */
- undump_primitives();
- undump(hash_base, frozen_control_sequence, hash_used);
- p = hash_base - 1;
- do {
- undump(p + 1, hash_used, p);
- undump_hh(hash[p]);
- } while (p != hash_used);
- undump_things(hash[hash_used + 1],
- undefined_control_sequence - 1 - hash_used);
- if (debug_format_file)
- print_csnames(hash_base, undefined_control_sequence - 1);
- if (hash_high > 0) {
- undump_things(hash[eqtb_size + 1], hash_high);
- if (debug_format_file)
- print_csnames(eqtb_size + 1, hash_high - (eqtb_size + 1));
- }
- undump_int(cs_count);
-
- /* Undump the font information */
- undump_int(x);
- set_max_font_id(x);
- for (k = 0; k <= max_font_id(); k++) {
- /* Undump the array info for internal font number |k| */
- undump_font(k);
- }
- undump_math_data();
-
- /* Undump the hyphenation tables */
- undump_language_data();
-
- /* Undump a couple more things and the closing check word */
- undump(batch_mode, error_stop_mode, interaction);
- if (interactionoption != unspecified_mode)
- interaction = interactionoption;
- undump(0, str_ptr, format_ident);
- undump(0, str_ptr, format_name);
- undump_int(x);
- if (x != 69069)
- goto BAD_FMT;
-
- /* Undump the lua bytecodes */
- undump_luac_registers();
-
- prev_depth_par = ignore_depth;
- return true; /* it worked! */
- BAD_FMT:
- wake_up_terminal();
- wterm_cr();
- fprintf(term_out, "(Fatal format file error; I'm stymied)");
- return false;
-}
+% dumpdata.w
+%
+% Copyright 2009-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
+
+#include "ptexlib.h"
+
+/* we start with 907: the sum of the values of the bytes of "don knuth" */
+
+#define FORMAT_ID (907+25)
+#if ((FORMAT_ID>=0) && (FORMAT_ID<=256))
+#error Wrong value for FORMAT_ID.
+#endif
+
+
+@ After \.{INITEX} has seen a collection of fonts and macros, it
+can write all the necessary information on an auxiliary file so
+that production versions of \TeX\ are able to initialize their
+memory at high speed. The present section of the program takes
+care of such output and input. We shall consider simultaneously
+the processes of storing and restoring,
+so that the inverse relation between them is clear.
+@.INITEX@>
+
+The global variable |format_ident| is a string that is printed right
+after the |banner| line when \TeX\ is ready to start. For \.{INITEX} this
+string says simply `\.{(INITEX)}'; for other versions of \TeX\ it says,
+for example, `\.{(preloaded format=plain 1982.11.19)}', showing the year,
+month, and day that the format file was created. We have |format_ident=0|
+before \TeX's tables are loaded. |FORMAT_ID| is a new field of type int
+suitable for the identification of a format: values between 0 and 256
+(included) can not be used because in the previous format they are used
+for the length of the name of the engine.
+@c
+str_number format_ident;
+str_number format_name; /* principal file name */
+
+
+@ Format files consist of |memory_word| items, and we use the following
+macros to dump words of different types:
+
+@c
+FILE *fmt_file; /* for input or output of format information */
+
+@ @c
+void store_fmt_file(void)
+{
+ int j, k, l; /* all-purpose indices */
+ halfword p; /* all-purpose pointer */
+ int x; /* something to dump */
+ char *format_engine;
+ int callback_id; /* |pre_dump| callback */
+ char *fmtname = NULL;
+ /* If dumping is not allowed, abort */
+ /* The user is not allowed to dump a format file unless |save_ptr=0|.
+ This condition implies that |cur_level=level_one|, hence
+ the |xeq_level| array is constant and it need not be dumped. */
+ if (save_ptr != 0) {
+ print_err("You can't dump inside a group");
+ help1("`{...\\dump}' is a no-no.");
+ succumb();
+ }
+
+ /* Create the |format_ident|, open the format file, and inform the user
+ that dumping has begun */
+ callback_id = callback_defined(pre_dump_callback);
+ if (callback_id > 0) {
+ (void) run_callback(callback_id, "->");
+ }
+ selector = new_string;
+ tprint(" (format=");
+ print(job_name);
+ print_char(' ');
+ print_int(year_par);
+ print_char('.');
+ print_int(month_par);
+ print_char('.');
+ print_int(day_par);
+ print_char(')');
+ str_room(2);
+ format_ident = make_string();
+ print(job_name);
+ format_name = make_string();
+ if (interaction == batch_mode)
+ selector = log_only;
+ else
+ selector = term_and_log;
+
+ fmtname = pack_job_name(format_extension);
+ while (!zopen_w_output(&fmt_file, fmtname, FOPEN_WBIN_MODE)) {
+ fmtname = prompt_file_name("format file name", format_extension);
+ }
+ tprint_nl("Beginning to dump on file ");
+ tprint(fmtname);
+ free(fmtname);
+ tprint_nl("");
+ print(format_ident);
+
+ /* Dump constants for consistency check */
+ /* The next few sections of the program should make it clear how we use the
+ dump/undump macros. */
+
+ dump_int(0x57325458); /* Web2C \TeX's magic constant: "W2TX" */
+ dump_int(FORMAT_ID);
+
+ /* Align engine to 4 bytes with one or more trailing NUL */
+ x = (int) strlen(engine_name);
+ format_engine = xmalloc((unsigned) (x + 4));
+ strcpy(format_engine, engine_name);
+ for (k = x; k <= x + 3; k++)
+ format_engine[k] = 0;
+ x = x + 4 - (x % 4);
+ dump_int(x);
+ dump_things(format_engine[0], x);
+ xfree(format_engine);
+ dump_int(0x57325458); /* TODO HM, what checksum would make sense? */
+ dump_int(max_halfword);
+ dump_int(hash_high);
+ dump_int(eqtb_size);
+ dump_int(hash_prime);
+
+ /* Dump the string pool */
+ k = dump_string_pool();
+ print_ln();
+ print_int(k);
+ tprint(" strings using ");
+ print_int((longinteger) pool_size);
+ tprint(" bytes");
+
+ /* Dump the dynamic memory */
+ /* By sorting the list of available spaces in the variable-size portion of
+ |mem|, we are usually able to get by without having to dump very much
+ of the dynamic memory.
+
+ We recompute |var_used| and |dyn_used|, so that \.{INITEX} dumps valid
+ information even when it has not been gathering statistics.
+ */
+ dump_node_mem();
+ dump_int(temp_token_head);
+ dump_int(hold_token_head);
+ dump_int(omit_template);
+ dump_int(null_list);
+ dump_int(backup_head);
+ dump_int(garbage);
+ x = (int) fix_mem_min;
+ dump_int(x);
+ x = (int) fix_mem_max;
+ dump_int(x);
+ x = (int) fix_mem_end;
+ dump_int(x);
+ dump_int(avail);
+ dyn_used = (int) fix_mem_end + 1;
+ dump_things(fixmem[fix_mem_min], fix_mem_end - fix_mem_min + 1);
+ x = x + (int) (fix_mem_end + 1 - fix_mem_min);
+ p = avail;
+ while (p != null) {
+ decr(dyn_used);
+ p = token_link(p);
+ }
+ dump_int(dyn_used);
+ print_ln();
+ print_int(x);
+ tprint(" memory locations dumped; current usage is ");
+ print_int(var_used);
+ print_char('&');
+ print_int(dyn_used);
+
+ /* Dump the table of equivalents */
+ /* Dump regions 1 to 4 of |eqtb| */
+ /*The table of equivalents usually contains repeated information, so we dump it
+ in compressed form: The sequence of $n+2$ values $(n,x_1,\ldots,x_n,m)$ in the
+ format file represents $n+m$ consecutive entries of |eqtb|, with |m| extra
+ copies of $x_n$, namely $(x_1,\ldots,x_n,x_n,\ldots,x_n)$.
+ */
+ k = null_cs;
+ do {
+ j = k;
+ while (j < int_base - 1) {
+ if ((equiv(j) == equiv(j + 1)) && (eq_type(j) == eq_type(j + 1)) &&
+ (eq_level(j) == eq_level(j + 1)))
+ goto FOUND1;
+ incr(j);
+ }
+ l = int_base;
+ goto DONE1; /* |j=int_base-1| */
+ FOUND1:
+ incr(j);
+ l = j;
+ while (j < int_base - 1) {
+ if ((equiv(j) != equiv(j + 1)) || (eq_type(j) != eq_type(j + 1)) ||
+ (eq_level(j) != eq_level(j + 1)))
+ goto DONE1;
+ incr(j);
+ }
+ DONE1:
+ dump_int(l - k);
+ dump_things(eqtb[k], l - k);
+ k = j + 1;
+ dump_int(k - l);
+ } while (k != int_base);
+
+ /* Dump regions 5 and 6 of |eqtb| */
+ do {
+ j = k;
+ while (j < eqtb_size) {
+ if (eqtb[j].cint == eqtb[j + 1].cint)
+ goto FOUND2;
+ incr(j);
+ }
+ l = eqtb_size + 1;
+ goto DONE2; /* |j=eqtb_size| */
+ FOUND2:
+ incr(j);
+ l = j;
+ while (j < eqtb_size) {
+ if (eqtb[j].cint != eqtb[j + 1].cint)
+ goto DONE2;
+ incr(j);
+ }
+ DONE2:
+ dump_int(l - k);
+ dump_things(eqtb[k], l - k);
+ k = j + 1;
+ dump_int(k - l);
+ } while (k <= eqtb_size);
+ if (hash_high > 0)
+ dump_things(eqtb[eqtb_size + 1], hash_high); /* dump |hash_extra| part */
+
+ dump_int(par_loc);
+ dump_int(write_loc);
+ dump_math_codes();
+ dump_text_codes();
+ /* Dump the hash table */
+ /* A different scheme is used to compress the hash table, since its lower
+ region is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output
+ two words, |p| and |hash[p]|. The hash table is, of course, densely packed
+ for |p>=hash_used|, so the remaining entries are output in a~block.
+ */
+ dump_primitives();
+ dump_int(hash_used);
+ cs_count = frozen_control_sequence - 1 - hash_used + hash_high;
+ for (p = hash_base; p <= hash_used; p++) {
+ if (cs_text(p) != 0) {
+ dump_int(p);
+ dump_hh(hash[p]);
+ incr(cs_count);
+ }
+ }
+ dump_things(hash[hash_used + 1],
+ undefined_control_sequence - 1 - hash_used);
+ if (hash_high > 0)
+ dump_things(hash[eqtb_size + 1], hash_high);
+ dump_int(cs_count);
+ print_ln();
+ print_int(cs_count);
+ tprint(" multiletter control sequences");
+
+ /* Dump the font information */
+ dump_int(max_font_id());
+ for (k = 0; k <= max_font_id(); k++) {
+ /* Dump the array info for internal font number |k| */
+ dump_font(k);
+ tprint_nl("\\font");
+ print_esc(font_id_text(k));
+ print_char('=');
+ tprint_file_name((unsigned char *) font_name(k),
+ (unsigned char *) font_area(k), NULL);
+ if (font_size(k) != font_dsize(k)) {
+ tprint(" at ");
+ print_scaled(font_size(k));
+ tprint("pt");
+ }
+ }
+ print_ln();
+ print_int(max_font_id());
+ tprint(" preloaded font");
+ if (max_font_id() != 1)
+ print_char('s');
+ dump_math_data();
+
+ /* Dump the hyphenation tables */
+ dump_language_data();
+
+ /* Dump a couple more things and the closing check word */
+ dump_int(interaction);
+ dump_int(format_ident);
+ dump_int(format_name);
+ dump_int(69069);
+ /* We have already printed a lot of statistics, so we set |tracing_stats:=0|
+ to prevent them from appearing again. */
+ tracing_stats_par = 0;
+
+ /* Dump the lua bytecodes */
+ dump_luac_registers();
+
+ /* Close the format file */
+ zwclose(fmt_file);
+}
+
+@ Corresponding to the procedure that dumps a format file, we have a function
+that reads one in. The function returns |false| if the dumped format is
+incompatible with the present \TeX\ table sizes, etc.
+
+@c
+#define too_small(A) do { \
+ wake_up_terminal(); \
+ wterm_cr(); \
+ fprintf(term_out,"---! Must increase the %s",(A)); \
+ goto BAD_FMT; \
+ } while (0)
+
+@ The inverse macros are slightly more complicated, since we need to check
+the range of the values we are reading in. We say `|undump(a)(b)(x)|' to
+read an integer value |x| that is supposed to be in the range |a<=x<=b|.
+
+@c
+#define undump(A,B,C) do { \
+ undump_int(x); \
+ if (x<(A) || x>(B)) goto BAD_FMT; \
+ else (C) = x; \
+ } while (0)
+
+
+#define format_debug(A,B) do { \
+ if (debug_format_file) { \
+ fprintf (stderr, "fmtdebug: %s=%d", (A), (int)(B)); \
+ } \
+ } while (0)
+
+#define undump_size(A,B,C,D) do { \
+ undump_int(x); \
+ if (x<(A)) goto BAD_FMT; \
+ if (x>(B)) too_small(C); \
+ else format_debug (C,x); \
+ (D) = x; \
+ } while (0)
+
+
+@ @c
+boolean load_fmt_file(const char *fmtname)
+{
+ int j, k; /* all-purpose indices */
+ halfword p; /* all-purpose pointer */
+ int x; /* something undumped */
+ char *format_engine;
+ /* Undump constants for consistency check */
+ if (ini_version) {
+ libcfree(hash);
+ libcfree(eqtb);
+ libcfree(fixmem);
+ libcfree(varmem);
+ }
+ undump_int(x);
+ format_debug("format magic number", x);
+ if (x != 0x57325458)
+ goto BAD_FMT; /* not a format file */
+
+ undump_int(x);
+ format_debug("format id", x);
+ if (x != FORMAT_ID)
+ goto BAD_FMT; /* FORMAT_ID mismatch */
+
+ undump_int(x);
+ format_debug("engine name size", x);
+ if ((x < 0) || (x > 256))
+ goto BAD_FMT; /* corrupted format file */
+
+ format_engine = xmalloc((unsigned) x);
+ undump_things(format_engine[0], x);
+ format_engine[x - 1] = 0; /* force string termination, just in case */
+ if (strcmp(engine_name, format_engine)) {
+ wake_up_terminal();
+ wterm_cr();
+ fprintf(term_out, "---! %s was written by %s", fmtname, format_engine);
+ xfree(format_engine);
+ goto BAD_FMT;
+ }
+ xfree(format_engine);
+ undump_int(x);
+ format_debug("string pool checksum", x);
+ if (x != 0x57325458) { /* todo: @@\$ *//* check that strings are the same */
+ wake_up_terminal();
+ wterm_cr();
+ fprintf(term_out, "---! %s was written by a different version",
+ fmtname);
+ goto BAD_FMT;
+ }
+ undump_int(x);
+ if (x != max_halfword)
+ goto BAD_FMT; /* check |max_halfword| */
+ undump_int(hash_high);
+ if ((hash_high < 0) || (hash_high > sup_hash_extra))
+ goto BAD_FMT;
+ if (hash_extra < hash_high)
+ hash_extra = hash_high;
+ eqtb_top = eqtb_size + hash_extra;
+ if (hash_extra == 0)
+ hash_top = undefined_control_sequence;
+ else
+ hash_top = eqtb_top;
+ hash = xmallocarray(two_halves, (unsigned) (1 + hash_top));
+ memset(hash, 0, sizeof(two_halves) * (unsigned) (hash_top + 1));
+ eqtb = xmallocarray(memory_word, (unsigned) (eqtb_top + 1));
+ set_eq_type(undefined_control_sequence, undefined_cs_cmd);
+ set_equiv(undefined_control_sequence, null);
+ set_eq_level(undefined_control_sequence, level_zero);
+ for (x = eqtb_size + 1; x <= eqtb_top; x++)
+ eqtb[x] = eqtb[undefined_control_sequence];
+ undump_int(x);
+ if (x != eqtb_size)
+ goto BAD_FMT;
+ undump_int(x);
+ if (x != hash_prime)
+ goto BAD_FMT;
+
+ /* Undump the string pool */
+ str_ptr = undump_string_pool();
+ /* Undump the dynamic memory */
+ undump_node_mem();
+ undump_int(temp_token_head);
+ undump_int(hold_token_head);
+ undump_int(omit_template);
+ undump_int(null_list);
+ undump_int(backup_head);
+ undump_int(garbage);
+ undump_int(fix_mem_min);
+ undump_int(fix_mem_max);
+ fixmem = xmallocarray(smemory_word, fix_mem_max + 1);
+ memset(voidcast(fixmem), 0, (fix_mem_max + 1) * sizeof(smemory_word));
+ undump_int(fix_mem_end);
+ undump_int(avail);
+ undump_things(fixmem[fix_mem_min], fix_mem_end - fix_mem_min + 1);
+ undump_int(dyn_used);
+
+ /* Undump the table of equivalents */
+ /* Undump regions 1 to 6 of |eqtb| */
+ k = null_cs;
+ do {
+ undump_int(x);
+ if ((x < 1) || (k + x > eqtb_size + 1))
+ goto BAD_FMT;
+ undump_things(eqtb[k], x);
+ k = k + x;
+ undump_int(x);
+ if ((x < 0) || (k + x > eqtb_size + 1))
+ goto BAD_FMT;
+ for (j = k; j <= k + x - 1; j++)
+ eqtb[j] = eqtb[k - 1];
+ k = k + x;
+ } while (k <= eqtb_size);
+ if (hash_high > 0) /* undump |hash_extra| part */
+ undump_things(eqtb[eqtb_size + 1], hash_high);
+
+ undump(hash_base, hash_top, par_loc);
+ par_token = cs_token_flag + par_loc;
+ undump(hash_base, hash_top, write_loc);
+ undump_math_codes();
+ undump_text_codes();
+ /* Undump the hash table */
+ undump_primitives();
+ undump(hash_base, frozen_control_sequence, hash_used);
+ p = hash_base - 1;
+ do {
+ undump(p + 1, hash_used, p);
+ undump_hh(hash[p]);
+ } while (p != hash_used);
+ undump_things(hash[hash_used + 1],
+ undefined_control_sequence - 1 - hash_used);
+ if (debug_format_file)
+ print_csnames(hash_base, undefined_control_sequence - 1);
+ if (hash_high > 0) {
+ undump_things(hash[eqtb_size + 1], hash_high);
+ if (debug_format_file)
+ print_csnames(eqtb_size + 1, hash_high - (eqtb_size + 1));
+ }
+ undump_int(cs_count);
+
+ /* Undump the font information */
+ undump_int(x);
+ set_max_font_id(x);
+ for (k = 0; k <= max_font_id(); k++) {
+ /* Undump the array info for internal font number |k| */
+ undump_font(k);
+ }
+ undump_math_data();
+
+ /* Undump the hyphenation tables */
+ undump_language_data();
+
+ /* Undump a couple more things and the closing check word */
+ undump(batch_mode, error_stop_mode, interaction);
+ if (interactionoption != unspecified_mode)
+ interaction = interactionoption;
+ undump(0, str_ptr, format_ident);
+ undump(0, str_ptr, format_name);
+ undump_int(x);
+ if (x != 69069)
+ goto BAD_FMT;
+
+ /* Undump the lua bytecodes */
+ undump_luac_registers();
+
+ prev_depth_par = ignore_depth;
+ return true; /* it worked! */
+ BAD_FMT:
+ wake_up_terminal();
+ wterm_cr();
+ fprintf(term_out, "(Fatal format file error; I'm stymied)");
+ return false;
+}
diff --git a/Build/source/texk/web2c/luatexdir/tex/equivalents.h b/Build/source/texk/web2c/luatexdir/tex/equivalents.h
index d12ae5b29f5..80f8108393f 100644
--- a/Build/source/texk/web2c/luatexdir/tex/equivalents.h
+++ b/Build/source/texk/web2c/luatexdir/tex/equivalents.h
@@ -286,6 +286,7 @@ the |number_regs| \.{\\dimen} registers.
# define first_valid_language_code 95
# define hyphenation_bounds_code 96
# define math_skip_mode_code 97
+# define math_pre_display_gap_factor_code 98
# define math_option_code (math_skip_mode_code+1)
@@ -742,6 +743,8 @@ extern halfword last_cs_name;
#define math_use_old_fraction_scaling_par mathoption_int_par(c_mathoption_use_old_fraction_scaling_code)
#define math_umathcode_meaning_par mathoption_int_par(c_mathoption_umathcode_meaning_code)
+#define math_pre_display_gap_factor_par int_par(math_pre_display_gap_factor_code)
+
#define time_par int_par(time_code)
#define day_par int_par(day_code)
#define month_par int_par(month_code)
diff --git a/Build/source/texk/web2c/luatexdir/tex/maincontrol.w b/Build/source/texk/web2c/luatexdir/tex/maincontrol.w
index cbfd333bbb7..45e9bb46934 100644
--- a/Build/source/texk/web2c/luatexdir/tex/maincontrol.w
+++ b/Build/source/texk/web2c/luatexdir/tex/maincontrol.w
@@ -1,3638 +1,3639 @@
-% maincontrol.w
-%
-% Copyright 2009-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
-
-#include "ptexlib.h"
-#include "lua/luatex-api.h"
-
-@ @c
-#define mode mode_par
-#define tail tail_par
-#define head head_par
-#define dir_save dirs_par
-
-@ We come now to the |main_control| routine, which contains the master
-switch that causes all the various pieces of \TeX\ to do their things,
-in the right order.
-
-In a sense, this is the grand climax of the program: It applies all the
-tools that we have worked so hard to construct. In another sense, this is
-the messiest part of the program: It necessarily refers to other pieces
-of code all over the place, so that a person can't fully understand what is
-going on without paging back and forth to be reminded of conventions that
-are defined elsewhere. We are now at the hub of the web, the central nervous
-system that touches most of the other parts and ties them together.
-@^brain@>
-
-The structure of |main_control| itself is quite simple. There's a label
-called |big_switch|, at which point the next token of input is fetched
-using |get_x_token|. Then the program branches at high speed into one of
-about 100 possible directions, based on the value of the current
-mode and the newly fetched command code; the sum |abs(mode)+cur_cmd|
-indicates what to do next. For example, the case `|vmode+letter|' arises
-when a letter occurs in vertical mode (or internal vertical mode); this
-case leads to instructions that initialize a new paragraph and enter
-horizontal mode.
-
-The big |case| statement that contains this multiway switch has been labeled
-|reswitch|, so that the program can |goto reswitch| when the next token
-has already been fetched. Most of the cases are quite short; they call
-an ``action procedure'' that does the work for that case, and then they
-either |goto reswitch| or they ``fall through'' to the end of the |case|
-statement, which returns control back to |big_switch|. Thus, |main_control|
-is not an extremely large procedure, in spite of the multiplicity of things
-it must do; it is small enough to be handled by PASCAL compilers that put
-severe restrictions on procedure size.
-@!@^action procedure@>
-
-One case is singled out for special treatment, because it accounts for most
-of \TeX's activities in typical applications. The process of reading simple
-text and converting it into |char_node| records, while looking for ligatures
-and kerns, is part of \TeX's ``inner loop''; the whole program runs
-efficiently when its inner loop is fast, so this part has been written
-with particular care.
-
-We leave the |space_factor| unchanged if |sf_code(cur_chr)=0|; otherwise we
-set it equal to |sf_code(cur_chr)|, except that it should never change
-from a value less than 1000 to a value exceeding 1000. The most common
-case is |sf_code(cur_chr)=1000|, so we want that case to be fast.
-
-@c
-void adjust_space_factor(void)
-{
- halfword s = get_sf_code(cur_chr);
- if (s == 1000) {
- space_factor_par = 1000;
- } else if (s < 1000) {
- if (s > 0)
- space_factor_par = s;
- } else if (space_factor_par < 1000) {
- space_factor_par = 1000;
- } else {
- space_factor_par = s;
- }
-}
-
-@ From Knuth: ``Having |font_glue| allocated for each text font saves
-both time and memory.'' That may be true, but it also punches through
-the API wall for fonts, so I removed that -- Taco. But a bit of caching
-is very welcome, which is why I need to have the next two globals:
-
-@ To handle the execution state of |main_control|'s eternal loop,
-an extra global variable is used, along with a macro to define
-its values.
-
-@c
-#define goto_next 0
-#define goto_skip_token 1
-#define goto_return 2
-
-static int main_control_state;
-
-@* Main control helpers.
-
-Here are all the functions that are called from |main_control| that
-are not already defined elsewhere. For the moment, this list simply
-in the order that the appear in |init_main_control|, below.
-
-@
-@c
-static void run_char_num (void) {
- scan_char_num();
- cur_chr = cur_val;
- adjust_space_factor();
- tail_append(new_char(cur_font_par, cur_chr));
-}
-
-static void run_char (void) {
- adjust_space_factor();
- tail_append(new_char(cur_font_par, cur_chr));
-}
-
-@
-The occurrence of blank spaces is almost part of \TeX's inner loop,
-since we usually encounter about one space for every five non-blank characters.
-Therefore |main_control| gives second-highest priority to ordinary spaces.
-
-When a glue parameter like \.{\\spaceskip} is set to `\.{0pt}', we will
-see to it later that the corresponding glue specification is precisely
-|zero_glue|, not merely a pointer to some specification that happens
-to be full of zeroes. Therefore it is simple to test whether a glue parameter
-is zero or~not.
-
-@c
-static void run_app_space (void) {
- halfword p; /* was a global temp_ptr */
- int method = disable_space_par ;
- if (method == 1) {
- /* don't inject anything, not even zero skip */
- } else if (method == 2) {
- p = new_glue(zero_glue);
- couple_nodes(tail,p);
- tail = p;
- } else if ((abs(mode) + cur_cmd == hmode + spacer_cmd) && (!(space_factor_par == 1000))) {
- app_space();
- } else {
- /* Append a normal inter-word space to the current list */
- if (glue_is_zero(space_skip_par)) {
- /* Find the glue specification for text spaces in the current font */
- p = new_glue(zero_glue);
- width(p) = space(cur_font_par);
- stretch(p) = space_stretch(cur_font_par);
- shrink(p) = space_shrink(cur_font_par);
-
- } else {
- p = new_param_glue(space_skip_code);
- }
- /* so from now we have a subtype with spaces: */
- subtype(p) = space_skip_code + 1 ;
- couple_nodes(tail,p);
- tail = p;
- }
-}
-
-@ Append a |boundary_node|
-@c
-static void run_boundary (void) {
- halfword n ;
- n = new_node(boundary_node,cur_chr);
- if ((cur_chr == 1) || (cur_chr == 2) ) {
- /* user boundary or protrusion boundary */
- scan_int();
- boundary_value(n) = cur_val;
- }
- couple_nodes(tail, n);
- tail = n;
-}
-
-@ @c
-static void run_char_ghost (void) {
- int t;
- t = cur_chr;
- get_x_token();
- if ((cur_cmd == letter_cmd) || (cur_cmd == other_char_cmd)
- || (cur_cmd == char_given_cmd) || (cur_cmd == char_num_cmd)) {
- halfword p = new_glyph(get_cur_font(), cur_chr);
- if (t == 0) {
- set_is_leftghost(p);
- } else {
- set_is_rightghost(p);
- }
- tail_append(p);
- }
-}
-
-@ @c
-static void run_relax (void) {
- return;
-}
-
-@ |ignore_spaces| is a special case: after it has acted, |get_x_token| has already
-fetched the next token from the input, so that operation in |main_control|
-should be skipped.
-
-@c
-static void run_ignore_spaces (void) {
- if (cur_chr == 0) {
- /* Get the next non-blank non-call... */
- do {
- get_x_token();
- } while (cur_cmd == spacer_cmd);
- main_control_state = goto_skip_token;
- } else {
- int t = scanner_status;
- scanner_status = normal;
- get_next();
- scanner_status = t;
- cur_cs = prim_lookup(cs_text(cur_cs));
- if (cur_cs != undefined_primitive) {
- cur_cmd = get_prim_eq_type(cur_cs);
- cur_chr = get_prim_equiv(cur_cs);
- cur_tok = (cur_cmd * STRING_OFFSET) + cur_chr;
- main_control_state = goto_skip_token;
- }
- }
-}
-
-@ |stop| is the second special case. We want |main_control| to return to its caller
-if there is nothing left to do.
-
-@c
-static void run_stop (void) {
- if (its_all_over())
- main_control_state= goto_return; /* this is the only way out */
-}
-
-@ @c
-static void run_non_math_math (void) {
- back_input();
- new_graf(true);
-}
-
-@ @c
-static void run_math_char_num (void) {
- mathcodeval mval; /* to build up an argument to |set_math_char| */
- if (cur_chr == 0)
- mval = scan_mathchar(tex_mathcode);
- else if (cur_chr == 1)
- mval = scan_mathchar(umath_mathcode);
- else
- mval = scan_mathchar(umathnum_mathcode);
- math_char_in_text(mval);
-}
-
-@ @c
-static void run_math_given (void) {
- mathcodeval mval; /* to build up an argument to |set_math_char| */
- mval = mathchar_from_integer(cur_chr, tex_mathcode);
- math_char_in_text(mval);
-}
-
-static void run_xmath_given (void) {
- mathcodeval mval; /* to build up an argument to |set_math_char| */
- mval = mathchar_from_integer(cur_chr, umath_mathcode);
- math_char_in_text(mval);
-}
-
-@ The most important parts of |main_control| are concerned with \TeX's
-chief mission of box-making. We need to control the activities that put
-entries on vlists and hlists, as well as the activities that convert
-those lists into boxes. All of the necessary machinery has already been
-developed; it remains for us to ``push the buttons'' at the right times.
-
-As an introduction to these routines, let's consider one of the simplest
-cases: What happens when `\.{\\hrule}' occurs in vertical mode, or
-`\.{\\vrule}' in horizontal mode or math mode? The code in |main_control|
-is short, since the |scan_rule_spec| routine already does most of what is
-required; thus, there is no need for a special action procedure.
-
-Note that baselineskip calculations are disabled after a rule in vertical
-mode, by setting |prev_depth:=ignore_depth|.
-
-@c
-static void run_rule (void) {
- tail_append(scan_rule_spec());
- if (abs(mode) == vmode)
- prev_depth_par = ignore_depth;
- else if (abs(mode) == hmode)
- space_factor_par = 1000;
-}
-
-@
-Many of the actions related to box-making are triggered by the appearance
-of braces in the input. For example, when the user says `\.{\\hbox}
-\.{to} \.{100pt\{$\langle\,\hbox{hlist}\,\rangle$\}}' in vertical mode,
-the information about the box size (100pt, |exactly|) is put onto |save_stack|
-with a level boundary word just above it, and |cur_group:=adjusted_hbox_group|;
-\TeX\ enters restricted horizontal mode to process the hlist. The right
-brace eventually causes |save_stack| to be restored to its former state,
-at which time the information about the box size (100pt, |exactly|) is
-available once again; a box is packaged and we leave restricted horizontal
-mode, appending the new box to the current list of the enclosing mode
-(in this case to the current list of vertical mode), followed by any
-vertical adjustments that were removed from the box by |hpack|.
-
-The next few sections of the program are therefore concerned with the
-treatment of left and right curly braces.
-
-If a left brace occurs in the middle of a page or paragraph, it simply
-introduces a new level of grouping, and the matching right brace will not have
-such a drastic effect. Such grouping affects neither the mode nor the
-current list.
-
-@c
-static void run_left_brace (void) {
- new_save_level(simple_group);
- eq_word_define(int_base + no_local_whatsits_code, 0);
- eq_word_define(int_base + no_local_dirs_code, 0);
-}
-
-static void run_begin_group (void) {
- new_save_level(semi_simple_group);
- eq_word_define(int_base + no_local_whatsits_code, 0);
- eq_word_define(int_base + no_local_dirs_code, 0);
-}
-
-static void run_end_group (void) {
- if (cur_group == semi_simple_group) {
- fixup_directions();
- } else {
- off_save();
- }
-}
-
-@ Constructions that require a box are started by calling |scan_box| with
-a specified context code. The |scan_box| routine verifies
-that a |make_box| command comes next and then it calls |begin_box|.
-
-@c
-static void run_move (void) {
- int t = cur_chr;
- scan_normal_dimen();
- if (t == 0)
- scan_box(cur_val);
- else
- scan_box(-cur_val);
-}
-
-@ @c
-static void run_leader_ship (void) {
- scan_box(leader_flag - a_leaders + cur_chr);
-}
-
-@ @c
-static void run_make_box (void) {
- begin_box(0);
-}
-
-@ @c
-static void run_box_dir (void) {
- scan_register_num();
- cur_box = box(cur_val);
- scan_optional_equals();
- scan_direction();
- if (cur_box != null)
- box_dir(cur_box) = cur_val;
-}
-
-@ There is a really small patch to add a new primitive called
-\.{\\quitvmode}. In vertical modes, it is identical to \.{\\indent},
-but in horizontal and math modes it is really a no-op (as opposed to
-\.{\\indent}, which executes the |indent_in_hmode| procedure).
-
-A paragraph begins when horizontal-mode material occurs in vertical mode,
-or when the paragraph is explicitly started by `\.{\\quitvmode}',
-`\.{\\indent}' or `\.{\\noindent}'.
-
-@c
-static void run_start_par_vmode (void) {
- new_graf((cur_chr > 0));
-}
-
-@ @c
-static void run_start_par (void) {
- if (cur_chr != 2)
- indent_in_hmode();
-}
-
-@ @c
-static void run_new_graf (void) {
- back_input();
- new_graf(true);
-}
-
-@ A paragraph ends when a |par_end| command is sensed, or when we are in
-horizontal mode when reaching the right brace of vertical-mode routines
-like \.{\\vbox}, \.{\\insert}, or \.{\\output}.
-
-@c
-static void run_par_end_vmode (void) {
- normal_paragraph();
- if (mode > 0) {
- checked_page_filter(vmode_par);
- build_page();
- }
-}
-
-@ @c
-static void run_par_end_hmode (void) {
- if (align_state < 0)
- off_save(); /* this tries to recover from an alignment that didn't end properly */
- end_graf(bottom_level); /* this takes us to the enclosing mode, if |mode>0| */
- if (mode == vmode) {
- checked_page_filter(hmode_par);
- build_page();
- }
-}
-
-@ @c
-static void append_italic_correction_mmode (void) {
- tail_append(new_kern(0)); /* what subtype to use */
-}
-
-@ @c
-static void run_local_box (void) {
- append_local_box(cur_chr);
-}
-
-@ @c
-static void run_halign_mmode (void) {
- if (privileged()) {
- if (cur_group == math_shift_group)
- init_align();
- else
- off_save();
- }
-}
-
-@ @c
-static void run_eq_no (void) {
- if (privileged()) {
- if (cur_group == math_shift_group)
- start_eq_no();
- else
- off_save();
- }
-}
-
-@ @c
-static void run_letter_mmode (void) {
- set_math_char(get_math_code(cur_chr));
-}
-
-@ @c
-static void run_char_num_mmode (void) {
- scan_char_num();
- cur_chr = cur_val;
- set_math_char(get_math_code(cur_chr));
-}
-
-@ @c
-static void run_math_char_num_mmode (void) {
- mathcodeval mval; /* to build up an argument to |set_math_char| */
- if (cur_chr == 0)
- mval = scan_mathchar(tex_mathcode);
- else if (cur_chr == 1)
- mval = scan_mathchar(umath_mathcode);
- else
- mval = scan_mathchar(umathnum_mathcode);
- set_math_char(mval);
-}
-
-@ @c
-static void run_math_given_mmode (void) {
- mathcodeval mval; /* to build up an argument to |set_math_char| */
- mval = mathchar_from_integer(cur_chr, tex_mathcode);
- set_math_char(mval);
-}
-
-static void run_xmath_given_mmode (void) {
- mathcodeval mval; /* to build up an argument to |set_math_char| */
- mval = mathchar_from_integer(cur_chr, umath_mathcode);
- set_math_char(mval);
-}
-
-@ @c
-static void run_delim_num (void) {
- mathcodeval mval; /* to build up an argument to |set_math_char| */
- if (cur_chr == 0)
- mval = scan_delimiter_as_mathchar(tex_mathcode);
- else
- mval = scan_delimiter_as_mathchar(umath_mathcode);
- set_math_char(mval);
-
-}
-
-@ @c
-static void run_vcenter (void) {
- scan_spec(vcenter_group);
- normal_paragraph();
- push_nest();
- mode = -vmode;
- prev_depth_par = ignore_depth;
- if (every_vbox_par != null)
- begin_token_list(every_vbox_par, every_vbox_text);
-}
-
-@ @c
-static void run_math_style (void) {
- tail_append(new_style((small_number) cur_chr));
-}
-
-@ @c
-static void run_non_script (void) {
- tail_append(new_glue(zero_glue));
- subtype(tail) = cond_math_glue;
-}
-
-@ @c
-static void run_math_choice (void) {
- if (cur_chr == 0)
- append_choices();
- else
- setup_math_style();
-}
-
-@ @c
-static void run_math_shift (void) {
- if (cur_group == math_shift_group)
- after_math();
- else
- off_save();
-}
-
-@ @c
-static void run_after_assignment (void) {
- get_token();
- after_token = cur_tok;
-}
-
-@ @c
-static void run_after_group (void) {
- get_token();
- save_for_after(cur_tok);
-}
-
-@ @c
-static void run_extension (void) {
- do_extension(0);
-}
-
-static void run_normal (void) {
-{
- switch (cur_chr) {
- case save_pos_code:
- new_whatsit(save_pos_node);
- break;
- case save_cat_code_table_code:
- scan_int();
- if ((cur_val < 0) || (cur_val > 0x7FFF)) {
- print_err("Invalid \\catcode table");
- help1("All \\catcode table ids must be between 0 and 0x7FFF");
- error();
- } else {
- if (cur_val == cat_code_table_par) {
- print_err("Invalid \\catcode table");
- help1("You cannot overwrite the current \\catcode table");
- error();
- } else {
- copy_cat_codes(cat_code_table_par, cur_val);
- }
- }
- break;
- case init_cat_code_table_code:
- scan_int();
- if ((cur_val < 0) || (cur_val > 0x7FFF)) {
- print_err("Invalid \\catcode table");
- help1("All \\catcode table ids must be between 0 and 0x7FFF");
- error();
- } else {
- if (cur_val == cat_code_table_par) {
- print_err("Invalid \\catcode table");
- help1("You cannot overwrite the current \\catcode table");
- error();
- } else {
- initex_cat_codes(cur_val);
- }
- }
- break;
- case set_random_seed_code:
- /* Negative random seed values are silently converted to positive ones */
- scan_int();
- if (cur_val < 0)
- negate(cur_val);
- random_seed = cur_val;
- init_randoms(random_seed);
- break;
- case late_lua_code:
- new_whatsit(late_lua_node); /* type == normal */
- late_lua_name(tail) = scan_lua_state();
- (void) scan_toks(false, false);
- late_lua_data(tail) = def_ref;
- break;
- case expand_font_code:
- read_expand_font();
- break;
- default:
- confusion("int1");
- break;
- }
- }
-}
-
-/*
- this is experimental and not used for production, only for testing and writing
- macros (some options stay)
-
-*/
-
-#define mathoption_set_int(A) \
- scan_int(); \
- word_define(mathoption_int_base+A, cur_val);
-
-static void run_option(void) {
- int a = 0 ;
- switch (cur_chr) {
- case math_option_code:
- if (scan_keyword("old")) {
- mathoption_set_int(c_mathoption_old_code);
- } else if (scan_keyword("noitaliccompensation")) {
- mathoption_set_int(c_mathoption_no_italic_compensation_code);
- } else if (scan_keyword("nocharitalic")) {
- mathoption_set_int(c_mathoption_no_char_italic_code);
- } else if (scan_keyword("useoldfractionscaling")) {
- mathoption_set_int(c_mathoption_use_old_fraction_scaling_code);
- } else if (scan_keyword("umathcodemeaning")) {
- mathoption_set_int(c_mathoption_umathcode_meaning_code);
- } else {
- normal_warning("mathoption","unknown key");
- }
- break;
- default:
- /* harmless */
- break;
- }
-}
-
-@ For mode-independent commands, the following macro is useful.
-
-Also, there is a list of cases where the user has probably gotten into or out of math
-mode by mistake. \TeX\ will insert a dollar sign and rescan the current token, and
-it makes sense ot have a macro for that as well.
-
-@c
-#define any_mode(A,B) jump_table[vmode+(A)]=B; jump_table[hmode+(A)]=B; jump_table[mmode+(A)]=B
-#define non_math(A,B) jump_table[vmode+(A)]=B; jump_table[hmode+(A)]=B;
-
-
-@ The |main_control| uses a jump table, and |init_main_control| sets that table up.
-@c
-typedef void (*main_control_function) (void);
-main_control_function *jump_table;
-
-static void init_main_control (void) {
- jump_table = xmalloc((mmode+max_command_cmd+1) * sizeof(main_control_function)) ;
-
- jump_table[hmode + char_num_cmd] = run_char_num;
- jump_table[hmode + letter_cmd] = run_char;
- jump_table[hmode + other_char_cmd] = run_char;
- jump_table[hmode + char_given_cmd] = run_char;
- jump_table[hmode + spacer_cmd] = run_app_space;
- jump_table[hmode + ex_space_cmd] = run_app_space;
- jump_table[mmode + ex_space_cmd] = run_app_space;
- jump_table[hmode + boundary_cmd] = run_boundary;
- jump_table[hmode + char_ghost_cmd] = run_char_ghost;
- jump_table[mmode + char_ghost_cmd] = run_char_ghost;
- any_mode(relax_cmd, run_relax);
- jump_table[vmode + spacer_cmd] = run_relax;
- jump_table[mmode + spacer_cmd] = run_relax;
- jump_table[mmode + boundary_cmd] = run_relax;
- any_mode(ignore_spaces_cmd,run_ignore_spaces);
- jump_table[vmode + stop_cmd] = run_stop;
- jump_table[vmode + math_char_num_cmd] = run_non_math_math;
- jump_table[vmode + math_given_cmd] = run_non_math_math;
- jump_table[vmode + xmath_given_cmd] = run_non_math_math;
- jump_table[hmode + math_char_num_cmd] = run_math_char_num;
- jump_table[hmode + math_given_cmd] = run_math_given;
- jump_table[hmode + xmath_given_cmd] = run_xmath_given;
-
- jump_table[vmode + vmove_cmd] = report_illegal_case;
- jump_table[hmode + hmove_cmd] = report_illegal_case;
- jump_table[mmode + hmove_cmd] = report_illegal_case;
- any_mode(last_item_cmd, report_illegal_case);
- jump_table[vmode + vadjust_cmd] = report_illegal_case;
- jump_table[vmode + ital_corr_cmd] = report_illegal_case;
- non_math(eq_no_cmd,report_illegal_case);
- any_mode(mac_param_cmd,report_illegal_case);
-
- non_math(sup_mark_cmd, insert_dollar_sign);
- non_math(sub_mark_cmd, insert_dollar_sign);
- non_math(super_sub_script_cmd, insert_dollar_sign);
- non_math(math_comp_cmd, insert_dollar_sign);
- non_math(delim_num_cmd, insert_dollar_sign);
- non_math(left_right_cmd, insert_dollar_sign);
- non_math(above_cmd, insert_dollar_sign);
- non_math(radical_cmd, insert_dollar_sign);
- non_math(math_style_cmd, insert_dollar_sign);
- non_math(math_choice_cmd, insert_dollar_sign);
- non_math(vcenter_cmd, insert_dollar_sign);
- non_math(non_script_cmd, insert_dollar_sign);
- non_math(mkern_cmd, insert_dollar_sign);
- non_math(limit_switch_cmd, insert_dollar_sign);
- non_math(mskip_cmd, insert_dollar_sign);
- non_math(math_accent_cmd, insert_dollar_sign);
- jump_table[mmode + endv_cmd] = insert_dollar_sign;
- jump_table[mmode + par_end_cmd] = insert_dollar_sign_par_end;
- jump_table[mmode + stop_cmd] = insert_dollar_sign;
- jump_table[mmode + vskip_cmd] = insert_dollar_sign;
- jump_table[mmode + un_vbox_cmd] = insert_dollar_sign;
- jump_table[mmode + valign_cmd] = insert_dollar_sign;
- jump_table[mmode + hrule_cmd] = insert_dollar_sign;
- jump_table[mmode + no_hrule_cmd] = insert_dollar_sign;
- jump_table[vmode + hrule_cmd] = run_rule;
- jump_table[vmode + no_hrule_cmd] = run_rule;
- jump_table[hmode + vrule_cmd] = run_rule;
- jump_table[hmode + no_vrule_cmd] = run_rule;
- jump_table[mmode + vrule_cmd] = run_rule;
- jump_table[mmode + no_vrule_cmd] = run_rule;
- jump_table[vmode + vskip_cmd] = append_glue;
- jump_table[hmode + hskip_cmd] = append_glue;
- jump_table[mmode + hskip_cmd] = append_glue;
- jump_table[mmode + mskip_cmd] = append_glue;
- any_mode(kern_cmd, append_kern);
- jump_table[mmode + mkern_cmd] = append_kern;
- non_math(left_brace_cmd, run_left_brace);
- any_mode(begin_group_cmd,run_begin_group);
- any_mode(end_group_cmd, run_end_group);
- any_mode(right_brace_cmd, handle_right_brace);
- jump_table[vmode + hmove_cmd] = run_move;
- jump_table[hmode + vmove_cmd] = run_move;
- jump_table[mmode + vmove_cmd] = run_move;
- any_mode(leader_ship_cmd, run_leader_ship);
- any_mode(make_box_cmd, run_make_box);
- any_mode(assign_box_dir_cmd, run_box_dir);
- jump_table[vmode + start_par_cmd] = run_start_par_vmode;
- jump_table[hmode + start_par_cmd] = run_start_par;
- jump_table[mmode + start_par_cmd] = run_start_par;
- jump_table[vmode + letter_cmd] = run_new_graf;
- jump_table[vmode + other_char_cmd] = run_new_graf;
- jump_table[vmode + char_num_cmd] = run_new_graf;
- jump_table[vmode + char_given_cmd] = run_new_graf;
- jump_table[vmode + char_ghost_cmd] = run_new_graf;
- jump_table[vmode + math_shift_cmd] = run_new_graf;
- jump_table[vmode + math_shift_cs_cmd] = run_new_graf;
- jump_table[vmode + un_hbox_cmd] = run_new_graf;
- jump_table[vmode + vrule_cmd] = run_new_graf;
- jump_table[vmode + no_vrule_cmd] = run_new_graf;
- jump_table[vmode + accent_cmd] = run_new_graf;
- jump_table[vmode + discretionary_cmd] = run_new_graf;
- jump_table[vmode + hskip_cmd] = run_new_graf;
- jump_table[vmode + valign_cmd] = run_new_graf;
- jump_table[vmode + ex_space_cmd] = run_new_graf;
- jump_table[vmode + boundary_cmd] = run_new_graf;
- jump_table[vmode + par_end_cmd] = run_par_end_vmode;
- jump_table[hmode + par_end_cmd] = run_par_end_hmode;
- jump_table[hmode + stop_cmd] = head_for_vmode;
- jump_table[hmode + vskip_cmd] = head_for_vmode;
- jump_table[hmode + hrule_cmd] = head_for_vmode;
- jump_table[hmode + no_hrule_cmd] = head_for_vmode;
- jump_table[hmode + un_vbox_cmd] = head_for_vmode;
- jump_table[hmode + halign_cmd] = head_for_vmode;
- any_mode(insert_cmd,begin_insert_or_adjust);
- jump_table[hmode + vadjust_cmd] = begin_insert_or_adjust;
- jump_table[mmode + vadjust_cmd] = begin_insert_or_adjust;
- any_mode(mark_cmd, handle_mark);
- any_mode(break_penalty_cmd, append_penalty);
- any_mode(remove_item_cmd, delete_last);
- jump_table[vmode + un_vbox_cmd] = unpackage;
- jump_table[hmode + un_hbox_cmd] = unpackage;
- jump_table[mmode + un_hbox_cmd] = unpackage;
- jump_table[hmode + ital_corr_cmd] = append_italic_correction;
- jump_table[mmode + ital_corr_cmd] = append_italic_correction_mmode;
- jump_table[hmode + discretionary_cmd] = append_discretionary;
- jump_table[mmode + discretionary_cmd] = append_discretionary;
- any_mode(assign_local_box_cmd, run_local_box);
- jump_table[hmode + accent_cmd] = make_accent;
- any_mode(car_ret_cmd,align_error);
- any_mode(tab_mark_cmd,align_error);
- any_mode(no_align_cmd,no_align_error);
- any_mode(omit_cmd, omit_error);
- jump_table[vmode + halign_cmd] = init_align;
- jump_table[hmode + valign_cmd] = init_align;
- jump_table[mmode + halign_cmd] = run_halign_mmode;
- jump_table[vmode + endv_cmd] = do_endv;
- jump_table[hmode + endv_cmd] = do_endv;
- any_mode(end_cs_name_cmd, cs_error);
- jump_table[hmode + math_shift_cmd] = init_math;
- jump_table[hmode + math_shift_cs_cmd] = init_math;
- jump_table[mmode + eq_no_cmd] = run_eq_no;
- jump_table[mmode + left_brace_cmd] = math_left_brace;
- jump_table[mmode + letter_cmd] = run_letter_mmode;
- jump_table[mmode + other_char_cmd] = run_letter_mmode;
- jump_table[mmode + char_given_cmd] = run_letter_mmode;
- jump_table[mmode + char_num_cmd] = run_char_num_mmode;
- jump_table[mmode + math_char_num_cmd] = run_math_char_num_mmode;
- jump_table[mmode + math_given_cmd] = run_math_given_mmode;
- jump_table[mmode + xmath_given_cmd] = run_xmath_given_mmode;
- jump_table[mmode + delim_num_cmd] = run_delim_num;
- jump_table[mmode + math_comp_cmd] = math_math_comp;
- jump_table[mmode + limit_switch_cmd] = math_limit_switch;
- jump_table[mmode + radical_cmd] = math_radical;
- jump_table[mmode + accent_cmd] = math_ac;
- jump_table[mmode + math_accent_cmd] = math_ac;
- jump_table[mmode + vcenter_cmd] = run_vcenter;
- jump_table[mmode + math_style_cmd] = run_math_style;
- jump_table[mmode + non_script_cmd] = run_non_script;
- jump_table[mmode + math_choice_cmd] = run_math_choice;
- jump_table[mmode + above_cmd] = math_fraction;
- jump_table[mmode + sub_mark_cmd] = sub_sup;
- jump_table[mmode + sup_mark_cmd] = sub_sup;
- jump_table[mmode + super_sub_script_cmd] = sub_sup;
- jump_table[mmode + left_right_cmd] = math_left_right;
- jump_table[mmode + math_shift_cmd] = run_math_shift;
- jump_table[mmode + math_shift_cs_cmd] = run_math_shift;
- any_mode(toks_register_cmd, prefixed_command);
- any_mode(assign_toks_cmd, prefixed_command);
- any_mode(assign_int_cmd, prefixed_command);
- any_mode(assign_attr_cmd, prefixed_command);
- any_mode(assign_dir_cmd, prefixed_command);
- any_mode(assign_dimen_cmd, prefixed_command);
- any_mode(assign_glue_cmd, prefixed_command);
- any_mode(assign_mu_glue_cmd, prefixed_command);
- any_mode(assign_font_dimen_cmd, prefixed_command);
- any_mode(assign_font_int_cmd, prefixed_command);
- any_mode(set_aux_cmd, prefixed_command);
- any_mode(set_prev_graf_cmd, prefixed_command);
- any_mode(set_page_dimen_cmd, prefixed_command);
- any_mode(set_page_int_cmd, prefixed_command);
- any_mode(set_box_dimen_cmd, prefixed_command);
- any_mode(set_tex_shape_cmd, prefixed_command);
- any_mode(set_etex_shape_cmd, prefixed_command);
- any_mode(def_char_code_cmd, prefixed_command);
- any_mode(def_del_code_cmd, prefixed_command);
- any_mode(extdef_math_code_cmd, prefixed_command);
- any_mode(extdef_del_code_cmd, prefixed_command);
- any_mode(def_family_cmd, prefixed_command);
- any_mode(set_math_param_cmd, prefixed_command);
- any_mode(set_font_cmd, prefixed_command);
- any_mode(def_font_cmd, prefixed_command);
- any_mode(letterspace_font_cmd, prefixed_command);
- any_mode(copy_font_cmd, prefixed_command);
- any_mode(set_font_id_cmd, prefixed_command);
- any_mode(register_cmd, prefixed_command);
- any_mode(advance_cmd, prefixed_command);
- any_mode(multiply_cmd, prefixed_command);
- any_mode(divide_cmd, prefixed_command);
- any_mode(prefix_cmd, prefixed_command);
- any_mode(let_cmd, prefixed_command);
- any_mode(shorthand_def_cmd, prefixed_command);
- any_mode(read_to_cs_cmd, prefixed_command);
- any_mode(def_cmd, prefixed_command);
- any_mode(set_box_cmd, prefixed_command);
- any_mode(hyph_data_cmd, prefixed_command);
- any_mode(set_interaction_cmd, prefixed_command);
- any_mode(after_assignment_cmd,run_after_assignment);
- any_mode(after_group_cmd,run_after_group);
- any_mode(in_stream_cmd,open_or_close_in);
- any_mode(message_cmd,issue_message);
- any_mode(case_shift_cmd, shift_case);
- any_mode(xray_cmd, show_whatever);
- any_mode(normal_cmd, run_normal);
- any_mode(extension_cmd, run_extension);
- any_mode(option_cmd, run_option);
-}
-
-@ And here is |main_control| itself. It is quite short nowadays.
-
-@c
-void main_control(void)
-{
- main_control_state = goto_next;
- init_main_control () ;
-
- if (equiv(every_job_loc) != null)
- begin_token_list(equiv(every_job_loc), every_job_text);
-
- while (1) {
- if (main_control_state == goto_skip_token)
- main_control_state = goto_next; /* reset */
- else
- get_x_token();
-
- /* Give diagnostic information, if requested */
- /* When a new token has just been fetched at |big_switch|, we have an
- ideal place to monitor \TeX's activity. */
- if (interrupt != 0 && OK_to_interrupt) {
- back_input();
- check_interrupt();
- continue;
- }
- if (tracing_commands_par > 0)
- show_cur_cmd_chr();
-
- (jump_table[(abs(mode) + cur_cmd)])(); /* run the command */
-
- if (main_control_state == goto_return) {
- return;
- }
- }
- return; /* not reached */
-}
-
-@ @c
-void app_space(void)
-{ /* handle spaces when |space_factor<>1000| */
- halfword q; /* glue node */
- if ((space_factor_par >= 2000) && (! glue_is_zero(xspace_skip_par))) {
- q = new_param_glue(xspace_skip_code);
- /* so from now we have a subtype with spaces: */
- subtype(q) = xspace_skip_code + 1;
- } else {
- if (!glue_is_zero(space_skip_par)) {
- q = new_glue(space_skip_par);
- } else {
- q = new_glue(zero_glue);
- width(q) = space(cur_font_par);
- stretch(q) = space_stretch(cur_font_par);
- shrink(q) = space_shrink(cur_font_par);
- }
- /* Modify the glue specification in |q| according to the space factor */
- if (space_factor_par >= 2000)
- width(q) = width(q) + extra_space(cur_font_par);
- stretch(q) = xn_over_d(stretch(q), space_factor_par, 1000);
- shrink(q) = xn_over_d(shrink(q), 1000, space_factor_par);
-
- /* so from now we have a subtype with spaces: */
- subtype(q) = space_skip_code + 1;
- }
- couple_nodes(tail, q);
- tail = q;
-}
-
-@ @c
-void insert_dollar_sign(void)
-{
- back_input();
- cur_tok = math_shift_token + '$';
- print_err("Missing $ inserted");
- help2("I've inserted a begin-math/end-math symbol since I think",
- "you left one out. Proceed, with fingers crossed.");
- ins_error();
-}
-
-@ We can silently ignore \.{\\par}s in a math formula.
-
-@c
-void insert_dollar_sign_par_end(void)
-{
- if (!suppress_mathpar_error_par) {
- insert_dollar_sign() ;
- }
-}
-
-@ The `|you_cant|' procedure prints a line saying that the current command
-is illegal in the current mode; it identifies these things symbolically.
-
-@c
-void you_cant(void)
-{
- print_err("You can't use `");
- print_cmd_chr((quarterword) cur_cmd, cur_chr);
- print_in_mode(mode);
-}
-
-@
-When erroneous situations arise, \TeX\ usually issues an error message
-specific to the particular error. For example, `\.{\\noalign}' should
-not appear in any mode, since it is recognized by the |align_peek| routine
-in all of its legitimate appearances; a special error message is given
-when `\.{\\noalign}' occurs elsewhere. But sometimes the most appropriate
-error message is simply that the user is not allowed to do what he or she
-has attempted. For example, `\.{\\moveleft}' is allowed only in vertical mode,
-and `\.{\\lower}' only in non-vertical modes. Such cases are enumerated
-here and in the other sections referred to under `See also \dots.'
-
-@c
-void report_illegal_case(void)
-{
- you_cant();
- help4("Sorry, but I'm not programmed to handle this case;",
- "I'll just pretend that you didn''t ask for it.",
- "If you're in the wrong mode, you might be able to",
- "return to the right one by typing `I}' or `I$' or `I\\par'.");
- error();
-}
-
-@ Some operations are allowed only in privileged modes, i.e., in cases
-that |mode>0|. The |privileged| function is used to detect violations
-of this rule; it issues an error message and returns |false| if the
-current |mode| is negative.
-
-@c
-boolean privileged(void)
-{
- if (mode > 0) {
- return true;
- } else {
- report_illegal_case();
- return false;
- }
-}
-
-@ We don't want to leave |main_control| immediately when a |stop| command
-is sensed, because it may be necessary to invoke an \.{\\output} routine
-several times before things really grind to a halt. (The output routine
-might even say `\.{\\gdef\\end\{...\}}', to prolong the life of the job.)
-Therefore |its_all_over| is |true| only when the current page
-and contribution list are empty, and when the last output was not a
-``dead cycle.''
-
-@c
-boolean its_all_over(void)
-{ /* do this when \.{\\end} or \.{\\dump} occurs */
- if (privileged()) {
- if ((page_head == page_tail) && (head == tail) && (dead_cycles == 0)) {
- return true;
- }
- back_input(); /* we will try to end again after ejecting residual material */
- tail_append(new_null_box());
- width(tail) = hsize_par;
- tail_append(new_glue(fill_glue));
- tail_append(new_penalty(-010000000000));
- normal_page_filter(end);
- build_page(); /* append \.{\\hbox to \\hsize\{\}\\vfill\\penalty-'10000000000} */
- }
- return false;
-}
-
-
-@ The |hskip| and |vskip| command codes are used for control sequences
-like \.{\\hss} and \.{\\vfil} as well as for \.{\\hskip} and \.{\\vskip}.
-The difference is in the value of |cur_chr|.
-
-All the work relating to glue creation has been relegated to the
-following subroutine. It does not call |build_page|, because it is
-used in at least one place where that would be a mistake.
-
-@c
-void append_glue(void)
-{
- int s = cur_chr;
- switch (s) {
- case fil_code:
- cur_val = new_glue(fil_glue);
- break;
- case fill_code:
- cur_val = new_glue(fill_glue);
- break;
- case ss_code:
- cur_val = new_glue(ss_glue);
- break;
- case fil_neg_code:
- cur_val = new_glue(fil_neg_glue);
- break;
- case skip_code:
- scan_glue(glue_val_level);
- break;
- case mskip_code:
- scan_glue(mu_val_level);
- break;
- }
- /* now |cur_val| points to the glue specification */
- tail_append(new_glue(cur_val));
- flush_node(cur_val);
- if (s > skip_code) {
- subtype(tail) = mu_glue;
- }
-}
-
-@ @c
-void append_kern(void)
-{
- int s; /* |subtype| of the kern node */
- s = cur_chr;
- scan_dimen((s == mu_glue), false, false);
- tail_append(new_kern(cur_val));
- subtype(tail) = (quarterword) s;
-}
-
-@ We have to deal with errors in which braces and such things are not
-properly nested. Sometimes the user makes an error of commission by
-inserting an extra symbol, but sometimes the user makes an error of omission.
-\TeX\ can't always tell one from the other, so it makes a guess and tries
-to avoid getting into a loop.
-
-The |off_save| routine is called when the current group code is wrong. It tries
-to insert something into the user's input that will help clean off
-the top level.
-
-@c
-void off_save(void)
-{
- halfword p, q; /* inserted token */
- if (cur_group == bottom_level) {
- /* Drop current token and complain that it was unmatched */
- print_err("Extra ");
- print_cmd_chr((quarterword) cur_cmd, cur_chr);
- help1("Things are pretty mixed up, but I think the worst is over.");
- error();
-
- } else {
- back_input();
- p = get_avail();
- set_token_link(temp_token_head, p);
- print_err("Missing ");
- /* Prepare to insert a token that matches |cur_group|, and print what it is */
- /* At this point, |link(temp_token_head)=p|, a pointer to an empty one-word node. */
- switch (cur_group) {
- case semi_simple_group:
- set_token_info(p, cs_token_flag + frozen_end_group);
- tprint_esc("endgroup");
- break;
- case math_shift_group:
- set_token_info(p, math_shift_token + '$');
- print_char('$');
- break;
- case math_left_group:
- set_token_info(p, cs_token_flag + frozen_right);
- q = get_avail();
- set_token_link(p, q);
- p = token_link(p);
- set_token_info(p, other_token + '.');
- tprint_esc("right.");
- break;
- default:
- set_token_info(p, right_brace_token + '}');
- print_char('}');
- break;
- }
- tprint(" inserted");
- ins_list(token_link(temp_token_head));
- help5("I've inserted something that you may have forgotten.",
- "(See the <inserted text> above.)",
- "With luck, this will get me unwedged. But if you",
- "really didn't forget anything, try typing `2' now; then",
- "my insertion and my current dilemma will both disappear.");
- error();
- }
-}
-
-@ The routine for a |right_brace| character branches into many subcases,
-since a variety of things may happen, depending on |cur_group|. Some
-types of groups are not supposed to be ended by a right brace; error
-messages are given in hopes of pinpointing the problem. Most branches
-of this routine will be filled in later, when we are ready to understand
-them; meanwhile, we must prepare ourselves to deal with such errors.
-
-@c
-void handle_right_brace(void)
-{
- halfword p, q; /* for short-term use */
- scaled d; /* holds |split_max_depth| in |insert_group| */
- int f; /* holds |floating_penalty| in |insert_group| */
- p = null;
- switch (cur_group) {
- case simple_group:
- fixup_directions();
- break;
- case bottom_level:
- print_err("Too many }'s");
- help2("You've closed more groups than you opened.",
- "Such booboos are generally harmless, so keep going.");
- error();
- break;
- case semi_simple_group:
- case math_shift_group:
- case math_left_group:
- extra_right_brace();
- break;
- case hbox_group:
- /* When the right brace occurs at the end of an \.{\\hbox} or \.{\\vbox} or
- \.{\\vtop} construction, the |package| routine comes into action. We might
- also have to finish a paragraph that hasn't ended. */
- package(0);
- break;
- case adjusted_hbox_group:
- adjust_tail = adjust_head;
- pre_adjust_tail = pre_adjust_head;
- package(0);
- break;
- case vbox_group:
- end_graf(vbox_group);
- package(0);
- break;
- case vtop_group:
- end_graf(vtop_group);
- package(vtop_code);
- break;
- case insert_group:
- end_graf(insert_group);
- q = new_glue(split_top_skip_par);
- d = split_max_depth_par;
- f = floating_penalty_par;
- unsave();
- save_ptr--;
- /* now |saved_value(0)| is the insertion number, or the |vadjust| subtype */
- p = vpack(vlink(head), 0, additional, -1);
- pop_nest();
- if (saved_type(0) == saved_insert) {
- tail_append(new_node(ins_node, saved_value(0)));
- height(tail) = height(p) + depth(p);
- ins_ptr(tail) = list_ptr(p);
- split_top_ptr(tail) = q;
- depth(tail) = d;
- float_cost(tail) = f;
- } else if (saved_type(0) == saved_adjust) {
- tail_append(new_node(adjust_node, saved_value(0)));
- adjust_ptr(tail) = list_ptr(p);
- flush_node(q);
- } else {
- confusion("insert_group");
- }
- list_ptr(p) = null;
- flush_node(p);
- if (nest_ptr == 0) {
- checked_page_filter(insert);
- build_page();
- }
- break;
- case output_group:
- /* this is needed in case the \.{\\output} executes a \.{\\textdir} command. */
- if (dir_level(text_dir_ptr) == cur_level) {
- /* DIR: Remove from |text_dir_ptr| */
- halfword text_dir_tmp = vlink(text_dir_ptr);
- flush_node(text_dir_ptr);
- text_dir_ptr = text_dir_tmp;
- }
- resume_after_output();
- break;
- case disc_group:
- build_discretionary();
- break;
- case local_box_group:
- build_local_box();
- break;
- case align_group:
- back_input();
- cur_tok = cs_token_flag + frozen_cr;
- print_err("Missing \\cr inserted");
- help1("I'm guessing that you meant to end an alignment here.");
- ins_error();
- break;
- case no_align_group:
- end_graf(no_align_group);
- unsave();
- align_peek();
- break;
- case vcenter_group:
- end_graf(vcenter_group);
- finish_vcenter();
- break;
- case math_choice_group:
- build_choices();
- break;
- case math_group:
- close_math_group(p);
- break;
- default:
- confusion("rightbrace");
- break;
- }
-}
-
-@ @c
-void extra_right_brace(void)
-{
- print_err("Extra }, or forgotten ");
- switch (cur_group) {
- case semi_simple_group:
- tprint_esc("endgroup");
- break;
- case math_shift_group:
- print_char('$');
- break;
- case math_left_group:
- tprint_esc("right");
- break;
- }
- help5("I've deleted a group-closing symbol because it seems to be",
- "spurious, as in `$x}$'. But perhaps the } is legitimate and",
- "you forgot something else, as in `\\hbox{$x}'. In such cases",
- "the way to recover is to insert both the forgotten and the",
- "deleted material, e.g., by typing `I$}'.");
- error();
- incr(align_state);
-}
-
-@ Here is where we clear the parameters that are supposed to revert to their
-default values after every paragraph and when internal vertical mode is entered.
-
-@c
-void normal_paragraph(void)
-{
- if (looseness_par != 0)
- eq_word_define(int_base + looseness_code, 0);
- if (hang_indent_par != 0)
- eq_word_define(dimen_base + hang_indent_code, 0);
- if (hang_after_par != 1)
- eq_word_define(int_base + hang_after_code, 1);
- if (par_shape_par_ptr != null)
- eq_define(par_shape_loc, shape_ref_cmd, null);
- if (inter_line_penalties_par_ptr != null)
- eq_define(inter_line_penalties_loc, shape_ref_cmd, null);
- if (shape_mode_par > 0)
- eq_word_define(dimen_base + shape_mode_code, 0);
-}
-
-@ The global variable |cur_box| will point to a newly-made box. If the box
-is void, we will have |cur_box=null|. Otherwise we will have
-|type(cur_box)=hlist_node| or |vlist_node| or |rule_node|; the |rule_node|
-case can occur only with leaders.
-
-@c
-halfword cur_box; /* box to be placed into its context */
-
-@ The |box_end| procedure does the right thing with |cur_box|, if
-|box_context| represents the context as explained above.
-
-@c
-void box_end(int box_context)
-{
- if (box_context < box_flag) {
- /* Append box |cur_box| to the current list, shifted by |box_context| */
- /*
- The global variable |adjust_tail| will be non-null if and only if the
- current box might include adjustments that should be appended to the
- current vertical list.
- */
- if (cur_box != null) {
- shift_amount(cur_box) = box_context;
- if (abs(mode) == vmode) {
- if (pre_adjust_tail != null) {
- if (pre_adjust_head != pre_adjust_tail)
- append_list(pre_adjust_head, pre_adjust_tail);
- pre_adjust_tail = null;
- }
- append_to_vlist(cur_box,lua_key_index(box));
- if (adjust_tail != null) {
- if (adjust_head != adjust_tail)
- append_list(adjust_head, adjust_tail);
- adjust_tail = null;
- }
- if (mode > 0) {
- checked_page_filter(box);
- build_page();
- }
- } else {
- if (abs(mode) == hmode)
- space_factor_par = 1000;
- else
- cur_box = new_sub_box(cur_box);
- couple_nodes(tail, cur_box);
- tail = cur_box;
- }
- }
- } else if (box_context < ship_out_flag) {
- /* Store |cur_box| in a box register */
- if (box_context < global_box_flag)
- eq_define(box_base + box_context - box_flag, box_ref_cmd, cur_box);
- else
- geq_define(box_base + box_context - global_box_flag, box_ref_cmd, cur_box);
- } else if (cur_box != null) {
- if (box_context > ship_out_flag) {
- /* Append a new leader node that uses |cur_box| */
- /* Get the next non-blank non-relax... */
- do {
- get_x_token();
- } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
- if (((cur_cmd == hskip_cmd) && (abs(mode) != vmode)) ||
- ((cur_cmd == vskip_cmd) && (abs(mode) == vmode))) {
- append_glue();
- subtype(tail) = (quarterword) (box_context - (leader_flag - a_leaders));
- leader_ptr(tail) = cur_box;
- } else {
- print_err("Leaders not followed by proper glue");
- help3
- ("You should say `\\leaders <box or rule><hskip or vskip>'.",
- "I found the <box or rule>, but there's no suitable",
- "<hskip or vskip>, so I'm ignoring these leaders.");
- back_error();
- flush_node_list(cur_box);
- }
- } else {
- ship_out(static_pdf, cur_box, SHIPPING_PAGE);
- }
- }
-}
-
-@ the next input should specify a box or perhaps a rule
-
-@c
-void scan_box(int box_context)
-{
- /* Get the next non-blank non-relax... */
- do {
- get_x_token();
- } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
- if (cur_cmd == make_box_cmd) {
- begin_box(box_context);
- } else if ((box_context >= leader_flag) &&
- ((cur_cmd == hrule_cmd) || (cur_cmd == vrule_cmd) ||
- (cur_cmd == no_hrule_cmd) || (cur_cmd == no_vrule_cmd))) {
- cur_box = scan_rule_spec();
- box_end(box_context);
- } else {
- print_err("A <box> was supposed to be here");
- help3("I was expecting to see \\hbox or \\vbox or \\copy or \\box or",
- "something like that. So you might find something missing in",
- "your output. But keep trying; you can fix this later.");
- back_error();
- }
-}
-
-@ @c
-void new_graf(boolean indented)
-{
- halfword p, q, dir_graf_tmp;
- halfword dir_rover;
- prev_graf_par = 0;
- if ((mode == vmode) || (head != tail)) {
- tail_append(new_param_glue(par_skip_code));
- }
- push_nest();
- mode = hmode;
- space_factor_par = 1000;
- /* LOCAL: Add local paragraph node */
- tail_append(make_local_par_node(new_graf_par_code));
- if (indented) {
- p = new_null_box();
- box_dir(p) = par_direction_par;
- width(p) = par_indent_par;
- subtype(p) = indent_list;
- q = tail;
- tail_append(p);
- } else {
- q = tail;
- }
- dir_rover = text_dir_ptr;
- while (dir_rover != null) {
- if ((vlink(dir_rover) != null) || (dir_dir(dir_rover) != par_direction_par)) {
- dir_graf_tmp = new_dir(dir_dir(dir_rover));
- try_couple_nodes(dir_graf_tmp,vlink(q));
- couple_nodes(q,dir_graf_tmp);
- }
- dir_rover = vlink(dir_rover);
- }
- q = head;
- while (vlink(q) != null)
- q = vlink(q);
- tail = q;
- if (every_par_par != null)
- begin_token_list(every_par_par, every_par_text);
- if (nest_ptr == 1) {
- checked_page_filter(new_graf);
- build_page(); /* put |par_skip| glue on current page */
- }
-}
-
-@ @c
-void indent_in_hmode(void)
-{
- halfword p;
- if (cur_chr > 0) { /* \.{\\indent} */
- p = new_null_box();
- width(p) = par_indent_par;
- if (abs(mode) == hmode)
- space_factor_par = 1000;
- else
- p = new_sub_box(p);
- tail_append(p);
- }
-}
-
-@ @c
-void head_for_vmode(void)
-{
- if (mode < 0) {
- if ((cur_cmd != hrule_cmd) && (cur_cmd != no_hrule_cmd)) {
- off_save();
- } else {
- print_err("You can't use `\\hrule' here except with leaders");
- help2("To put a horizontal rule in an hbox or an alignment,",
- "you should use \\leaders or \\hrulefill (see The TeXbook).");
- error();
- }
- } else {
- back_input();
- cur_tok = par_token;
- back_input();
- token_type = inserted;
- }
-}
-
-@ TODO (BUG?): |dir_save| would have been set by |line_break| by means
-of |post_line_break|, but this is not done right now, as it introduces
-pretty heavy memory leaks. This means the current code is probably
-wrong in some way that relates to in-paragraph displays.
-
-@c
-void end_graf(int line_break_context)
-{
- if (mode == hmode) {
- if ((head == tail) || (vlink(head) == tail)) {
- if (vlink(head) == tail)
- flush_node(vlink(head));
- pop_nest(); /* null paragraphs are ignored, all contain a |local_paragraph| node */
- } else {
- line_break(false, line_break_context);
- }
- if (dir_save != null) {
- flush_node_list(dir_save);
- dir_save = null;
- }
- normal_paragraph();
- error_count = 0;
- }
-}
-
-@ @c
-void begin_insert_or_adjust(void)
-{
- if (cur_cmd != vadjust_cmd) {
- scan_register_num();
- if (cur_val == output_box_par) {
- print_err("You can't \\insert");
- print_int(output_box_par);
- help1("I'm changing to \\insert0; box \\outputbox is special.");
- error();
- cur_val = 0;
- }
- set_saved_record(0, saved_insert, 0, cur_val);
- } else if (scan_keyword("pre")) {
- set_saved_record(0, saved_adjust, 0, 1);
- } else {
- set_saved_record(0, saved_adjust, 0, 0);
- }
- save_ptr++;
- new_save_level(insert_group);
- scan_left_brace();
- normal_paragraph();
- push_nest();
- mode = -vmode;
- prev_depth_par = ignore_depth;
-}
-
-@ I (TH)'ve renamed the |make_mark| procedure to this, because if the
-current chr code is 1, then the actual command was \.{\\clearmarks},
-which does not generate a mark node but instead destroys the current
-mark tokenlists.
-
-@c
-void handle_mark(void)
-{
- halfword p; /* new node */
- halfword c; /* the mark class */
- if (cur_chr == clear_marks_code) {
- scan_mark_num();
- c = cur_val;
- delete_top_mark(c);
- delete_bot_mark(c);
- delete_first_mark(c);
- delete_split_first_mark(c);
- delete_split_bot_mark(c);
- } else {
- if (cur_chr == 0) {
- c = 0;
- } else {
- scan_mark_num();
- c = cur_val;
- if (c > biggest_used_mark)
- biggest_used_mark = c;
- }
- p = scan_toks(false, true);
- p = new_node(mark_node, 0); /* the |subtype| is not used */
- mark_class(p) = c;
- mark_ptr(p) = def_ref;
- couple_nodes(tail, p);
- tail = p;
- }
-}
-
-@ @c
-void append_penalty(void)
-{
- scan_int();
- tail_append(new_penalty(cur_val));
- if (mode == vmode) {
- checked_page_filter(penalty);
- build_page();
- }
-}
-
-@ When |delete_last| is called, |cur_chr| is the |type| of node that
-will be deleted, if present.
-
-The |remove_item| command removes a penalty, kern, or glue node if it
-appears at the tail of the current list, using a brute-force linear scan.
-Like \.{\\lastbox}, this command is not allowed in vertical mode (except
-internal vertical mode), since the current list in vertical mode is sent
-to the page builder. But if we happen to be able to implement it in
-vertical mode, we do.
-
-@c
-void delete_last(void)
-{
- halfword p, q; /* run through the current list */
- if ((mode == vmode) && (tail == head)) {
- /* Apologize for inability to do the operation now,
- unless \.{\\unskip} follows non-glue */
- if ((cur_chr != glue_node) || (last_glue != max_halfword)) {
- you_cant();
- if (cur_chr == kern_node) {
- help2
- ("Sorry...I usually can't take things from the current page.",
- "Try `I\\kern-\\lastkern' instead.");
- } else if (cur_chr != glue_node) {
- help2
- ("Sorry...I usually can't take things from the current page.",
- "Perhaps you can make the output routine do it.");
- } else {
- help2
- ("Sorry...I usually can't take things from the current page.",
- "Try `I\\vskip-\\lastskip' instead.");
- }
- error();
- }
- } else {
- /* todo: clean this up */
- if (!is_char_node(tail)) {
- if (type(tail) == cur_chr) {
- q = head;
- do {
- p = q;
- if (!is_char_node(q)) {
- if (type(q) == disc_node) {
- if (p == tail)
- return;
- }
- }
- q = vlink(p);
- } while (q != tail);
- vlink(p) = null;
- flush_node_list(tail);
- tail = p;
- }
- }
- }
-}
-
-@ @c
-void unpackage(void)
-{
- halfword p; /* the box */
- halfword r; /* to remove marginal kern nodes */
- int c; /* should we copy? */
- halfword s; /* for varmem assignment */
- if (cur_chr > copy_code) {
- /* Handle saved items and |goto done| */
- try_couple_nodes(tail, disc_ptr[cur_chr]);
- disc_ptr[cur_chr] = null;
- goto DONE;
- }
- c = cur_chr;
- scan_register_num();
- p = box(cur_val);
- if (p == null)
- return;
- if ((abs(mode) == mmode)
- || ((abs(mode) == vmode) && (type(p) != vlist_node))
- || ((abs(mode) == hmode) && (type(p) != hlist_node))) {
- print_err("Incompatible list can't be unboxed");
- help3("Sorry, Pandora. (You sneaky devil.)",
- "I refuse to unbox an \\hbox in vertical mode or vice versa.",
- "And I can't open any boxes in math mode.");
- error();
- return;
- }
- if (c == copy_code) {
- s = copy_node_list(list_ptr(p));
- try_couple_nodes(tail,s);
- } else {
- try_couple_nodes(tail,list_ptr(p));
- box(cur_val) = null;
- list_ptr(p) = null;
- flush_node(p);
- }
- DONE:
- while (vlink(tail) != null) {
- r = vlink(tail);
- if (!is_char_node(r) && (type(r) == margin_kern_node)) {
- try_couple_nodes(tail,vlink(r));
- flush_node(r);
- }
- tail = vlink(tail);
- }
-}
-
-@
-Italic corrections are converted to kern nodes when the |ital_corr| command
-follows a character. In math mode the same effect is achieved by appending
-a kern of zero here, since italic corrections are supplied later.
-
-@c
-void append_italic_correction(void)
-{
- halfword p; /* |char_node| at the tail of the current list */
- internal_font_number f; /* the font in the |char_node| */
- if (tail != head) {
- if (is_char_node(tail))
- p = tail;
- else
- return;
- f = font(p);
- tail_append(new_kern(char_italic(f, character(p))));
- subtype(tail) = italic_kern;
- }
-}
-
-@ @c
-void append_local_box(int kind)
-{
- incr(save_ptr);
- set_saved_record(-1, saved_boxtype, 0, kind);
- new_save_level(local_box_group);
- scan_left_brace();
- push_nest();
- mode = -hmode;
- space_factor_par = 1000;
-}
-
-@ Discretionary nodes are easy in the common case `\.{\\-}', but in the
-general case we must process three braces full of items.
-
-The space factor does not change when we append a discretionary node,
-but it starts out as 1000 in the subsidiary lists.
-
-@c
-void append_discretionary(void)
-{
- int c;
- tail_append(new_disc());
- subtype(tail) = (quarterword) cur_chr;
- if (cur_chr == explicit_disc) {
- /* \- */
- c = get_pre_hyphen_char(cur_lang_par);
- if (c != 0) {
- vlink(pre_break(tail)) = new_char(equiv(cur_font_loc), c);
- alink(vlink(pre_break(tail))) = pre_break(tail);
- tlink(pre_break(tail)) = vlink(pre_break(tail));
- }
- c = get_post_hyphen_char(cur_lang_par);
- if (c != 0) {
- vlink(post_break(tail)) = new_char(equiv(cur_font_loc), c);
- alink(vlink(post_break(tail))) = post_break(tail);
- tlink(post_break(tail)) = vlink(post_break(tail));
- }
- disc_penalty(tail) = ex_hyphen_penalty_par;
- } else {
- /* \discretionary */
- if (scan_keyword("penalty")) {
- scan_int();
- disc_penalty(tail) = cur_val;
- }
- incr(save_ptr);
- set_saved_record(-1, saved_disc, 0, 0);
- new_save_level(disc_group);
- scan_left_brace();
- push_nest();
- mode = -hmode;
- space_factor_par = 1000;
- /* already preset: disc_penalty(tail) = hyphen_penalty_par; */
- }
-}
-
-@ The test for |p != null| ensures that empty \.{\\localleftbox} and
- \.{\\localrightbox} commands are not applied.
-
-@c
-void build_local_box(void)
-{
- halfword p;
- int kind;
- unsave();
- assert(saved_type(-1) == saved_boxtype);
- kind = saved_value(-1);
- decr(save_ptr);
- p = vlink(head);
- pop_nest();
- if (p != null)
- p = hpack(p, 0, additional, -1);
- if (kind == 0)
- eq_define(local_left_box_base, box_ref_cmd, p);
- else
- eq_define(local_right_box_base, box_ref_cmd, p);
- if (abs(mode) == hmode) {
- /* LOCAL: Add local paragraph node */
- tail_append(make_local_par_node(local_box_par_code));
- }
- eq_word_define(int_base + no_local_whatsits_code, no_local_whatsits_par + 1);
-}
-
-@ The three discretionary lists are constructed somewhat as if they were
-hboxes. A~subroutine called |build_discretionary| handles the transitions.
-(This is sort of fun.)
-
-@c
-void build_discretionary(void)
-{
- halfword p, q; /* for link manipulation */
- int n; /* length of discretionary list */
- unsave();
- /* Prune the current list, if necessary, until it contains only
- |char_node|, |kern_node|, |hlist_node|, |vlist_node| and
- |rule_node| items; set |n| to the length of the list,
- and set |q| to the lists tail */
- /* During this loop, |p=vlink(q)| and there are |n| items preceding |p|. */
- q = head;
- p = vlink(q);
- n = 0;
- while (p != null) {
- if (!is_char_node(p) && type(p) > rule_node && type(p) != kern_node) {
- print_err("Improper discretionary list");
- help1("Discretionary lists must contain only boxes and kerns.");
- error();
- begin_diagnostic();
- tprint_nl("The following discretionary sublist has been deleted:");
- show_box(p);
- end_diagnostic(true);
- flush_node_list(p);
- vlink(q) = null;
- break;
- }
- alink(p) = q;
- q = p;
- p = vlink(q);
- incr(n);
- }
-
- p = vlink(head);
- pop_nest();
- assert(saved_type(-1) == saved_disc);
- switch (saved_value(-1)) {
- case 0:
- if (n > 0) {
- vlink(pre_break(tail)) = p;
- alink(p) = pre_break(tail);
- tlink(pre_break(tail)) = q;
- }
- break;
- case 1:
- if (n > 0) {
- vlink(post_break(tail)) = p;
- alink(p) = post_break(tail);
- tlink(post_break(tail)) = q;
- }
- break;
- case 2:
- /* Attach list |p| to the current list, and record its length;
- then finish up and |return| */
- if ((n > 0) && (abs(mode) == mmode)) {
- print_err("Illegal math \\discretionary");
- help2("Sorry: The third part of a discretionary break must be",
- "empty, in math formulas. I had to delete your third part.");
- flush_node_list(p);
- error();
- } else {
- if (n > 0) {
- vlink(no_break(tail)) = p;
- alink(p) = no_break(tail);
- tlink(no_break(tail)) = q;
- }
- }
- decr(save_ptr);
- return;
- break;
- } /* there are no other cases */
- set_saved_record(-1, saved_disc, 0, (saved_value(-1) + 1));
- new_save_level(disc_group);
- scan_left_brace();
- push_nest();
- mode = -hmode;
- space_factor_par = 1000;
-}
-
-@ The positioning of accents is straightforward but tedious. Given an accent
-of width |a|, designed for characters of height |x| and slant |s|;
-and given a character of width |w|, height |h|, and slant |t|: We will shift
-the accent down by |x-h|, and we will insert kern nodes that have the effect of
-centering the accent over the character and shifting the accent to the
-right by $\delta={1\over2}(w-a)+h\cdot t-x\cdot s$. If either character is
-absent from the font, we will simply use the other, without shifting.
-
-@c
-void make_accent(void)
-{
- double s, t; /* amount of slant */
- halfword p, q, r; /* character, box, and kern nodes */
- internal_font_number f; /* relevant font */
- scaled a, h, x, w, delta; /* heights and widths, as explained above */
- scan_char_num();
- f = equiv(cur_font_loc);
- p = new_glyph(f, cur_val);
- if (p != null) {
- x = x_height(f);
- s = float_cast(slant(f)) / float_constant(65536); /* real division */
- a = glyph_width(p);
- do_assignments();
- /* Create a character node |q| for the next character,
- but set |q:=null| if problems arise */
- q = null;
- f = equiv(cur_font_loc);
- if ((cur_cmd == letter_cmd) ||
- (cur_cmd == other_char_cmd) || (cur_cmd == char_given_cmd)) {
- q = new_glyph(f, cur_chr);
- } else if (cur_cmd == char_num_cmd) {
- scan_char_num();
- q = new_glyph(f, cur_val);
- } else {
- back_input();
- }
-
- if (q != null) {
- /* Append the accent with appropriate kerns, then set |p:=q| */
- /* The kern nodes appended here must be distinguished from other kerns, lest
- they be wiped away by the hyphenation algorithm or by a previous line break.
-
- The two kerns are computed with (machine-dependent) |real| arithmetic, but
- their sum is machine-independent; the net effect is machine-independent,
- because the user cannot remove these nodes nor access them via \.{\\lastkern}.
- */
- t = float_cast(slant(f)) / float_constant(65536); /* real division */
- w = glyph_width(q);
- h = glyph_height(q);
- if (h != x) { /* the accent must be shifted up or down */
- p = hpack(p, 0, additional, -1);
- shift_amount(p) = x - h;
- }
- delta = round(float_cast(w - a) / float_constant(2) + h * t - x * s); /* real multiplication */
- r = new_kern(delta);
- subtype(r) = accent_kern;
- couple_nodes(tail, r);
- couple_nodes(r, p);
- tail = new_kern(-a - delta);
- subtype(tail) = accent_kern;
- couple_nodes(p, tail);
- p = q;
-
- }
- couple_nodes(tail, p);
- tail = p;
- space_factor_par = 1000;
- }
-}
-
-@ When `\.{\\cr}' or `\.{\\span}' or a tab mark comes through the scanner
-into |main_control|, it might be that the user has foolishly inserted
-one of them into something that has nothing to do with alignment. But it is
-far more likely that a left brace or right brace has been omitted, since
-|get_next| takes actions appropriate to alignment only when `\.{\\cr}'
-or `\.{\\span}' or tab marks occur with |align_state=0|. The following
-program attempts to make an appropriate recovery.
-
-@c
-void align_error(void)
-{
- if (abs(align_state) > 2) {
- /* Express consternation over the fact that no alignment is in progress */
- print_err("Misplaced ");
- print_cmd_chr((quarterword) cur_cmd, cur_chr);
- if (cur_tok == tab_token + '&') {
- help6("I can't figure out why you would want to use a tab mark",
- "here. If you just want an ampersand, the remedy is",
- "simple: Just type `I\\&' now. But if some right brace",
- "up above has ended a previous alignment prematurely,",
- "you're probably due for more error messages, and you",
- "might try typing `S' now just to see what is salvageable.");
- } else {
- help5("I can't figure out why you would want to use a tab mark",
- "or \\cr or \\span just now. If something like a right brace",
- "up above has ended a previous alignment prematurely,",
- "you're probably due for more error messages, and you",
- "might try typing `S' now just to see what is salvageable.");
- }
- error();
-
- } else {
- back_input();
- if (align_state < 0) {
- print_err("Missing { inserted");
- incr(align_state);
- cur_tok = left_brace_token + '{';
- } else {
- print_err("Missing } inserted");
- decr(align_state);
- cur_tok = right_brace_token + '}';
- }
- help3("I've put in what seems to be necessary to fix",
- "the current column of the current alignment.",
- "Try to go on, since this might almost work.");
- ins_error();
- }
-}
-
-@ The help messages here contain a little white lie, since \.{\\noalign}
-and \.{\\omit} are allowed also after `\.{\\noalign\{...\}}'.
-
-@c
-void no_align_error(void)
-{
- print_err("Misplaced \\noalign");
- help2("I expect to see \\noalign only after the \\cr of",
- "an alignment. Proceed, and I'll ignore this case.");
- error();
-}
-
-void omit_error(void)
-{
- print_err("Misplaced \\omit");
- help2("I expect to see \\omit only after tab marks or the \\cr of",
- "an alignment. Proceed, and I'll ignore this case.");
- error();
-}
-
-@ We've now covered most of the abuses of \.{\\halign} and \.{\\valign}.
-Let's take a look at what happens when they are used correctly.
-
-An |align_group| code is supposed to remain on the |save_stack|
-during an entire alignment, until |fin_align| removes it.
-
-A devious user might force an |endv| command to occur just about anywhere;
-we must defeat such hacks.
-
-@c
-void do_endv(void)
-{
- base_ptr = input_ptr;
- input_stack[base_ptr] = cur_input;
- while ((input_stack[base_ptr].index_field != v_template) &&
- (input_stack[base_ptr].loc_field == null) &&
- (input_stack[base_ptr].state_field == token_list))
- decr(base_ptr);
- if ((input_stack[base_ptr].index_field != v_template) ||
- (input_stack[base_ptr].loc_field != null) ||
- (input_stack[base_ptr].state_field != token_list))
- fatal_error("(interwoven alignment preambles are not allowed)");
- /*.interwoven alignment preambles... */
- if (cur_group == align_group) {
- end_graf(align_group);
- if (fin_col())
- fin_row();
- } else {
- off_save();
- }
-}
-
-@ Finally, \.{\\endcsname} is not supposed to get through to |main_control|.
-
-@c
-void cs_error(void)
-{
- print_err("Extra \\endcsname");
- help1("I'm ignoring this, since I wasn't doing a \\csname.");
- error();
-}
-
-@
- Assignments to values in |eqtb| can be global or local. Furthermore, a
- control sequence can be defined to be `\.{\\long}', `\.{\\protected}',
- or `\.{\\outer}', and it might or might not be expanded. The prefixes
- `\.{\\global}', `\.{\\long}', `\.{\\protected}',
- and `\.{\\outer}' can occur in any order. Therefore we assign binary numeric
- codes, making it possible to accumulate the union of all specified prefixes
- by adding the corresponding codes. (PASCAL's |set| operations could also
- have been used.)
-
- Every prefix, and every command code that might or might not be prefixed,
- calls the action procedure |prefixed_command|. This routine accumulates
- a sequence of prefixes until coming to a non-prefix, then it carries out
- the command.
-
-@ If the user says, e.g., `\.{\\global\\global}', the redundancy is
-silently accepted.
-
-
-@ The different types of code values have different legal ranges; the
-following program is careful to check each case properly.
-
-@c
-#define check_def_code(A) do { \
- if (((cur_val<0)&&(p<(A)))||(cur_val>n)) { \
- print_err("Invalid code ("); \
- print_int(cur_val); \
- if (p<(A)) \
- tprint("), should be in the range 0.."); \
- else \
- tprint("), should be at most "); \
- print_int(n); \
- help1("I'm going to use 0 instead of that illegal code value."); \
- error(); \
- cur_val=0; \
- } \
-} while (0)
-
-@ @c
-/*
-halfword swap_hang_indent(halfword indentation, halfword shape_mode) {
- if (shape_mode == 1 || shape_mode == 3 || shape_mode == -1 || shape_mode == -3) {
- return negate(indentation);
- } else {
- return indentation;
- }
-}
-
-halfword swap_parshape_indent(halfword indentation, halfword width, halfword shape_mode) {
- if (shape_mode == 2 || shape_mode == 3 || shape_mode == -2 || shape_mode == -3) {
- return hsize_par - width - indentation;
- } else {
- return indentation;
- }
-}
-
-*/
-
-void prefixed_command(void)
-{
- int a; /* accumulated prefix codes so far */
- internal_font_number f; /* identifies a font */
- halfword j; /* index into a \.{\\parshape} specification */
- halfword p, q; /* for temporary short-term use */
- int n; /* ditto */
- boolean e, check_glue; /* should a definition be expanded? or was \.{\\let} not done? */
- mathcodeval mval; /* for handling of \.{\\mathchardef}s */
- a = 0;
- while (cur_cmd == prefix_cmd) {
- if (!odd(a / cur_chr))
- a = a + cur_chr;
- /* Get the next non-blank non-relax... */
- do {
- get_x_token();
- } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
-
- if (cur_cmd <= max_non_prefixed_command) {
- /* Discard erroneous prefixes and |return| */
- print_err("You can't use a prefix with `");
- print_cmd_chr((quarterword) cur_cmd, cur_chr);
- print_char('\'');
- help2
- ("I'll pretend you didn't say \\long or \\outer or \\global or",
- "\\protected.");
- back_error();
- return;
- }
- if (tracing_commands_par > 2)
- show_cur_cmd_chr();
- }
- /* Discard the prefixes \.{\\long} and \.{\\outer} if they are irrelevant */
- if (a >= 8) {
- j = protected_token;
- a = a - 8;
- } else {
- j = 0;
- }
- if ((cur_cmd != def_cmd) && ((a % 4 != 0) || (j != 0))) {
- print_err("You can't use `\\long' or `\\outer' or `\\protected' with `");
- print_cmd_chr((quarterword) cur_cmd, cur_chr);
- print_char('\'');
- help1("I'll pretend you didn't say \\long or \\outer or \\protected here.");
- error();
- }
- /* Adjust for the setting of \.{\\globaldefs} */
- if (global_defs_par != 0) {
- if (global_defs_par < 0) {
- if (is_global(a))
- a = a - 4;
- } else {
- if (!is_global(a))
- a = a + 4;
- }
- }
- switch (cur_cmd) {
- case set_font_cmd:
- /* Here's an example of the way many of the following routines operate.
- (Unfortunately, they aren't all as simple as this.) */
- define(cur_font_loc, data_cmd, cur_chr);
- break;
- case def_cmd:
- /* When a |def| command has been scanned,
- |cur_chr| is odd if the definition is supposed to be global, and
- |cur_chr>=2| if the definition is supposed to be expanded. */
-
- if (odd(cur_chr) && !is_global(a) && (global_defs_par >= 0))
- a = a + 4;
- e = (cur_chr >= 2);
- get_r_token();
- p = cur_cs;
- q = scan_toks(true, e);
- if (j != 0) {
- q = get_avail();
- set_token_info(q, j);
- set_token_link(q, token_link(def_ref));
- set_token_link(def_ref, q);
- }
- define(p, call_cmd + (a % 4), def_ref);
- break;
- case let_cmd:
- n = cur_chr;
- if (n == normal) {
- get_r_token();
- p = cur_cs;
- do {
- get_token();
- } while (cur_cmd == spacer_cmd);
- if (cur_tok == other_token + '=') {
- get_token();
- if (cur_cmd == spacer_cmd)
- get_token();
- }
- } else if (n == normal + 1) {
- /* futurelet */
- get_r_token();
- p = cur_cs;
- get_token();
- q = cur_tok;
- get_token();
- back_input();
- cur_tok = q;
- /* look ahead, then back up */
- /* note that |back_input| doesn't affect |cur_cmd|, |cur_chr| */
- back_input();
- } else {
- /* letcharcode */
- scan_int();
- if (cur_val > 0) {
- cur_cs = active_to_cs(cur_val, true);
- set_token_info(cur_cs, cur_cs + cs_token_flag);
- p = cur_cs;
- do {
- get_token();
- } while (cur_cmd == spacer_cmd);
- if (cur_tok == other_token + '=') {
- get_token();
- if (cur_cmd == spacer_cmd)
- get_token();
- }
- } else {
- p = null;
- tex_error("invalid number for \\letcharcode",NULL);
- }
- }
- if (cur_cmd >= call_cmd)
- add_token_ref(cur_chr);
- define(p, cur_cmd, cur_chr);
- break;
- case shorthand_def_cmd:
- /* We temporarily define |p| to be |relax|, so that an occurrence of |p|
- while scanning the definition will simply stop the scanning instead of
- producing an ``undefined control sequence'' error or expanding the
- previous meaning. This allows, for instance, `\.{\\chardef\\foo=123\\foo}'.
- */
- n = cur_chr;
- get_r_token();
- p = cur_cs;
- define(p, relax_cmd, too_big_char);
- scan_optional_equals();
- switch (n) {
- case char_def_code:
- scan_char_num();
- define(p, char_given_cmd, cur_val);
- break;
- case math_char_def_code:
- mval = scan_mathchar(tex_mathcode);
- if (math_umathcode_meaning_par == 1) {
- cur_val = (mval.class_value + (8 * mval.family_value)) * (65536 * 32) + mval.character_value;
- define(p, xmath_given_cmd, cur_val);
- } else {
- cur_val = (mval.class_value * 16 + mval.family_value) * 256 + mval.character_value;
- define(p, math_given_cmd, cur_val);
- }
- break;
- case xmath_char_def_code:
- mval = scan_mathchar(umath_mathcode);
- cur_val = (mval.class_value + (8 * mval.family_value)) * (65536 * 32) + mval.character_value;
- define(p, xmath_given_cmd, cur_val);
- break;
- case umath_char_def_code:
- mval = scan_mathchar(umathnum_mathcode);
- cur_val = (mval.class_value + (8 * mval.family_value)) * (65536 * 32) + mval.character_value;
- define(p, xmath_given_cmd, cur_val);
- break;
- default:
- scan_register_num();
- switch (n) {
- case count_def_code:
- define(p, assign_int_cmd, count_base + cur_val);
- break;
- case attribute_def_code:
- define(p, assign_attr_cmd, attribute_base + cur_val);
- break;
- case dimen_def_code:
- define(p, assign_dimen_cmd, scaled_base + cur_val);
- break;
- case skip_def_code:
- define(p, assign_glue_cmd, skip_base + cur_val);
- break;
- case mu_skip_def_code:
- define(p, assign_mu_glue_cmd, mu_skip_base + cur_val);
- break;
- case toks_def_code:
- define(p, assign_toks_cmd, toks_base + cur_val);
- break;
- default:
- confusion("shorthand_def");
- break;
- }
- break;
- }
- break;
- case read_to_cs_cmd:
- j = cur_chr;
- scan_int();
- n = cur_val;
- if (!scan_keyword("to")) {
- print_err("Missing `to' inserted");
- help2("You should have said `\\read<number> to \\cs'.",
- "I'm going to look for the \\cs now.");
- error();
- }
- get_r_token();
- p = cur_cs;
- read_toks(n, p, j);
- define(p, call_cmd, cur_val);
- break;
- case toks_register_cmd:
- case assign_toks_cmd:
- /* The token-list parameters, \.{\\output} and \.{\\everypar}, etc., receive
- their values in the following way. (For safety's sake, we place an
- enclosing pair of braces around an \.{\\output} list.) */
- q = cur_cs;
- if (cur_cmd == toks_register_cmd) {
- scan_register_num();
- p = toks_base + cur_val;
- } else {
- p = cur_chr; /* |p=every_par_loc| or |output_routine_loc| or \dots */
- }
- scan_optional_equals();
- /* Get the next non-blank non-relax non-call token */
- do {
- get_x_token();
- } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
-
- if (cur_cmd != left_brace_cmd) {
- /* If the right-hand side is a token parameter
- or token register, finish the assignment and |goto done| */
- if (cur_cmd == toks_register_cmd) {
- scan_register_num();
- cur_cmd = assign_toks_cmd;
- cur_chr = toks_base + cur_val;
- }
- if (cur_cmd == assign_toks_cmd) {
- q = equiv(cur_chr);
- if (q == null) {
- define(p, undefined_cs_cmd, null);
- } else {
- add_token_ref(q);
- define(p, call_cmd, q);
- }
- goto DONE;
- }
- }
- back_input();
- cur_cs = q;
- q = scan_toks(false, false);
- if (token_link(def_ref) == null) { /* empty list: revert to the default */
- define(p, undefined_cs_cmd, null);
- free_avail(def_ref);
- } else {
- if (p == output_routine_loc) { /* enclose in curlies */
- p = get_avail();
- set_token_link(q, p);
- p = output_routine_loc;
- q = token_link(q);
- set_token_info(q, right_brace_token + '}');
- q = get_avail();
- set_token_info(q, left_brace_token + '{');
- set_token_link(q, token_link(def_ref));
- set_token_link(def_ref, q);
- }
- define(p, call_cmd, def_ref);
- }
- break;
- case assign_int_cmd:
- /* Similar routines are used to assign values to the numeric parameters. */
- p = cur_chr;
- scan_optional_equals();
- scan_int();
- assign_internal_value(a, p, cur_val);
- break;
- case assign_attr_cmd:
- p = cur_chr;
- scan_optional_equals();
- scan_int();
- if ((p - attribute_base) > max_used_attr)
- max_used_attr = (p - attribute_base);
- attr_list_cache = cache_disabled;
- word_define(p, cur_val);
- break;
- case assign_dir_cmd:
- /* DIR: Assign direction codes */
- scan_direction();
- switch (cur_chr) {
- case int_base + page_direction_code:
- eq_word_define(int_base + page_direction_code, cur_val);
- break;
- case int_base + body_direction_code:
- eq_word_define(int_base + body_direction_code, cur_val);
- break;
- case int_base + par_direction_code:
- eq_word_define(int_base + par_direction_code, cur_val);
- break;
- case int_base + math_direction_code:
- eq_word_define(int_base + math_direction_code, cur_val);
- break;
- case int_base + text_direction_code:
- case int_base + line_direction_code:
- /*
- pre version 0.97 this was a commented section because various tests hint that this
- is unnecessary and sometimes even produces weird results, like:
-
- (\hbox{\textdir TRT ABC\textdir TLT DEF}))
-
- becomes
-
- (DEFCBA)
-
- in the output when we use
-
- tail_append(new_dir(text_direction_par)
-
- but when we append the reverse of the current it goes better
-
- */
- check_glue = (cur_chr == (int_base + line_direction_code));
- if (check_glue) {
- cur_chr = int_base + text_direction_code ;
- }
- if (abs(mode) == hmode) {
- if (no_local_dirs_par > 0) {
- /* tail is non zero but we test anyway */
- if (check_glue && (tail != null && type(tail) == glue_node)) {
- halfword prev = alink(tail);
- halfword dirn = new_dir(text_direction_par - dir_swap);
- couple_nodes(prev,dirn);
- couple_nodes(dirn,tail);
- } else {
- tail_append(new_dir(text_direction_par - dir_swap));
- }
- } else {
- /* what is the use of nolocaldirs .. maybe we should get rid of it */
- }
- update_text_dir_ptr(cur_val);
- tail_append(new_dir(cur_val));
- dir_level(tail) = cur_level;
- } else {
- update_text_dir_ptr(cur_val);
- }
- /* original:
-
- // if ((no_local_dirs_par > 0) && (abs(mode) == hmode)) {
- // // tail_append(new_dir(text_direction_par) // kind of wrong
- // tail_append(new_dir(text_direction_par - dir_swap)); // better
- // }
-
- update_text_dir_ptr(cur_val);
- if (abs(mode) == hmode) {
- tail_append(new_dir(cur_val));
- dir_level(tail) = cur_level;
- }
- */
- eq_word_define(int_base + text_direction_code, cur_val);
- eq_word_define(int_base + no_local_dirs_code, no_local_dirs_par + 1);
- break;
- }
- break;
- case assign_dimen_cmd:
- p = cur_chr;
- scan_optional_equals();
- scan_normal_dimen();
- assign_internal_value(a, p, cur_val);
- break;
- case assign_glue_cmd:
- case assign_mu_glue_cmd:
- p = cur_chr;
- n = cur_cmd;
- scan_optional_equals();
- if (n == assign_mu_glue_cmd)
- scan_glue(mu_val_level);
- else
- scan_glue(glue_val_level);
- define(p, glue_ref_cmd, cur_val);
- break;
- case def_char_code_cmd:
- case def_del_code_cmd:
- /* Let |n| be the largest legal code value, based on |cur_chr| */
- if (cur_chr == cat_code_base)
- n = max_char_code;
- else if (cur_chr == sf_code_base)
- n = 077777;
- else
- n = biggest_char;
-
- p = cur_chr;
- if (cur_chr == math_code_base) {
- if (is_global(a))
- cur_val1 = level_one;
- else
- cur_val1 = cur_level;
- scan_extdef_math_code(cur_val1, tex_mathcode);
- } else if (cur_chr == lc_code_base) {
- scan_char_num();
- p = cur_val;
- scan_optional_equals();
- scan_int();
- check_def_code(lc_code_base);
- define_lc_code(p, cur_val);
- } else if (cur_chr == uc_code_base) {
- scan_char_num();
- p = cur_val;
- scan_optional_equals();
- scan_int();
- check_def_code(uc_code_base);
- define_uc_code(p, cur_val);
- } else if (cur_chr == sf_code_base) {
- scan_char_num();
- p = cur_val;
- scan_optional_equals();
- scan_int();
- check_def_code(sf_code_base);
- define_sf_code(p, cur_val);
- } else if (cur_chr == cat_code_base) {
- scan_char_num();
- p = cur_val;
- scan_optional_equals();
- scan_int();
- check_def_code(cat_code_base);
- define_cat_code(p, cur_val);
- } else if (cur_chr == del_code_base) {
- if (is_global(a))
- cur_val1 = level_one;
- else
- cur_val1 = cur_level;
- scan_extdef_del_code(cur_val1, tex_mathcode);
- }
- break;
- case extdef_math_code_cmd:
- case extdef_del_code_cmd:
- if (is_global(a))
- cur_val1 = level_one;
- else
- cur_val1 = cur_level;
- if (cur_chr == math_code_base)
- scan_extdef_math_code(cur_val1, umath_mathcode);
- else if (cur_chr == math_code_base + 1)
- scan_extdef_math_code(cur_val1, umathnum_mathcode);
- else if (cur_chr == del_code_base)
- scan_extdef_del_code(cur_val1, umath_mathcode);
- else if (cur_chr == del_code_base + 1)
- scan_extdef_del_code(cur_val1, umathnum_mathcode);
- break;
- case def_family_cmd:
- p = cur_chr;
- scan_math_family_int();
- cur_val1 = cur_val;
- scan_optional_equals();
- scan_font_ident();
- define_fam_fnt(cur_val1, p, cur_val);
- break;
- case set_math_param_cmd:
- p = cur_chr;
- get_token();
- if (cur_cmd != math_style_cmd) {
- print_err("Missing math style, treated as \\displaystyle");
- help1
- ("A style should have been here; I inserted `\\displaystyle'.");
- cur_val1 = display_style;
- back_error();
- } else {
- cur_val1 = cur_chr;
- }
- scan_optional_equals();
- if (p < math_param_first_mu_glue) {
- if (p == math_param_radical_degree_raise)
- scan_int();
- else
- scan_dimen(false, false, false);
- } else {
- scan_glue(mu_val_level);
- if (cur_val == thin_mu_skip_par)
- cur_val = thin_mu_skip_code;
- else if (cur_val == med_mu_skip_par)
- cur_val = med_mu_skip_code;
- else if (cur_val == thick_mu_skip_par)
- cur_val = thick_mu_skip_code;
- }
- define_math_param(p, cur_val1, cur_val);
- break;
- case register_cmd:
- case advance_cmd:
- case multiply_cmd:
- case divide_cmd:
- do_register_command(a);
- break;
- case set_box_cmd:
- /* The processing of boxes is somewhat different, because we may need
- to scan and create an entire box before we actually change the value
- of the old one. */
- scan_register_num();
- if (is_global(a))
- n = global_box_flag + cur_val;
- else
- n = box_flag + cur_val;
- scan_optional_equals();
- if (set_box_allowed) {
- scan_box(n);
- } else {
- print_err("Improper \\setbox");
- help2("Sorry, \\setbox is not allowed after \\halign in a display,",
- "or between \\accent and an accented character.");
- error();
- }
- break;
- case set_aux_cmd:
- /* The |space_factor| or |prev_depth| settings are changed when a |set_aux|
- command is sensed. Similarly, |prev_graf| is changed in the presence of
- |set_prev_graf|, and |dead_cycles| or |insert_penalties| in the presence of
- |set_page_int|. These definitions are always global. */
- alter_aux();
- break;
- case set_prev_graf_cmd:
- alter_prev_graf();
- break;
- case set_page_dimen_cmd:
- alter_page_so_far();
- break;
- case set_page_int_cmd:
- alter_integer();
- break;
- case set_box_dimen_cmd:
- /* When some dimension of a box register is changed, the change isn't exactly
- global; but \TeX\ does not look at the \.{\\global} switch. */
- alter_box_dimen();
- break;
- case set_tex_shape_cmd:
- q = cur_chr;
- scan_optional_equals();
- scan_int();
- n = cur_val;
- if (n <= 0) {
- p = null;
- } else {
- p = new_node(shape_node, 2 * (n + 1) + 1);
- vinfo(p + 1) = n;
- for (j = 1; j <= n; j++) {
- scan_normal_dimen();
- varmem[p + 2 * j].cint = cur_val; /* indentation */
- scan_normal_dimen();
- varmem[p + 2 * j + 1].cint = cur_val; /* width */
- }
- }
- define(q, shape_ref_cmd, p);
- break;
- case set_etex_shape_cmd:
- q = cur_chr;
- scan_optional_equals();
- scan_int();
- n = cur_val;
- if (n <= 0) {
- p = null;
- } else {
- n = (cur_val / 2) + 1;
- p = new_node(shape_node, 2 * n + 1 + 1);
- vinfo(p + 1) = n;
- n = cur_val;
- varmem[p + 2].cint = n; /* number of penalties */
- for (j = p + 3; j <= p + n + 2; j++) {
- scan_int();
- varmem[j].cint = cur_val; /* penalty values */
- }
- if (!odd(n))
- varmem[p + n + 3].cint = 0; /* unused */
- }
- define(q, shape_ref_cmd, p);
- break;
- case hyph_data_cmd:
- /* All of \TeX's parameters are kept in |eqtb| except the font information,
- the interaction mode, and the hyphenation tables; these are strictly global.
- */
- switch (cur_chr) {
- case 0:
- new_hyph_exceptions();
- break;
- case 1:
- new_patterns();
- break;
- case 2:
- new_pre_hyphen_char();
- break;
- case 3:
- new_post_hyphen_char();
- break;
- case 4:
- new_pre_exhyphen_char();
- break;
- case 5:
- new_post_exhyphen_char();
- break;
- case 6:
- new_hyphenation_min();
- break;
- case 7:
- new_hj_code();
- break;
- }
- break;
- case assign_font_dimen_cmd:
- set_font_dimen();
- break;
- case assign_font_int_cmd:
- n = cur_chr;
- scan_font_ident();
- f = cur_val;
- if (n == no_lig_code) {
- set_no_ligatures(f);
- } else if (n < lp_code_base) {
- scan_optional_equals();
- scan_int();
- if (n == 0)
- set_hyphen_char(f, cur_val);
- else
- set_skew_char(f, cur_val);
- } else {
- scan_char_num();
- p = cur_val;
- scan_optional_equals();
- scan_int();
- switch (n) {
- case lp_code_base:
- set_lp_code(f, p, cur_val);
- break;
- case rp_code_base:
- set_rp_code(f, p, cur_val);
- break;
- case ef_code_base:
- set_ef_code(f, p, cur_val);
- break;
- case tag_code:
- set_tag_code(f, p, cur_val);
- break;
- }
- }
- break;
- case def_font_cmd:
- /* Here is where the information for a new font gets loaded. */
- tex_def_font((small_number) a);
- break;
- case letterspace_font_cmd:
- new_letterspaced_font((small_number) a);
- break;
- case copy_font_cmd:
- make_font_copy((small_number) a);
- break;
- case set_font_id_cmd:
- scan_int();
- if (is_valid_font(cur_val))
- zset_cur_font(cur_val);
- break ;
- case set_interaction_cmd:
- new_interaction();
- break;
- default:
- confusion("prefix");
- break;
- } /* end of Assignments cases */
- DONE:
- /* Insert a token saved by \.{\\afterassignment}, if any */
- if (after_token != 0) {
- cur_tok = after_token;
- back_input();
- after_token = 0;
- }
-}
-
-@ @c
-void fixup_directions(void)
-{
- int temp_no_whatsits = no_local_whatsits_par;
- int temp_no_dirs = no_local_dirs_par;
- int temporary_dir = text_direction_par;
- if (dir_level(text_dir_ptr) == cur_level) {
- /* DIR: Remove from |text_dir_ptr| */
- halfword text_dir_tmp = vlink(text_dir_ptr);
- flush_node(text_dir_ptr);
- text_dir_ptr = text_dir_tmp;
- }
- unsave();
- if (abs(mode) == hmode) {
- if (temp_no_dirs != 0) {
- /* DIR: Add local dir node */
- tail_append(new_dir(text_direction_par));
- dir_dir(tail) = temporary_dir - dir_swap;
- }
- if (temp_no_whatsits != 0) {
- /* LOCAL: Add local paragraph node */
- tail_append(make_local_par_node(hmode_par_par_code));
- }
- }
-}
-
-@ When a control sequence is to be defined, by \.{\\def} or \.{\\let} or
-something similar, the |get_r_token| routine will substitute a special
-control sequence for a token that is not redefinable.
-
-@c
-void get_r_token(void)
-{
- RESTART:
- do {
- get_token();
- } while (cur_tok == space_token);
- if ((cur_cs == 0) || (cur_cs > eqtb_top) ||
- ((cur_cs > frozen_control_sequence) && (cur_cs <= eqtb_size))) {
- print_err("Missing control sequence inserted");
- help5("Please don't say `\\def cs{...}', say `\\def\\cs{...}'.",
- "I've inserted an inaccessible control sequence so that your",
- "definition will be completed without mixing me up too badly.",
- "You can recover graciously from this error, if you're",
- "careful; see exercise 27.2 in The TeXbook.");
- if (cur_cs == 0)
- back_input();
- cur_tok = cs_token_flag + frozen_protection;
- ins_error();
- goto RESTART;
- }
-}
-
-@ @c
-void assign_internal_value(int a, halfword p, int val)
-{
- halfword n;
- if ((p >= int_base) && (p < attribute_base)) {
- switch ((p - int_base)) {
- case cat_code_table_code:
- if (valid_catcode_table(val)) {
- if (val != cat_code_table_par)
- word_define(p, val);
- } else {
- print_err("Invalid \\catcode table");
- help2
- ("You can only switch to a \\catcode table that is initialized",
- "using \\savecatcodetable or \\initcatcodetable, or to table 0");
- error();
- }
- break;
- case output_box_code:
- if ((val > 65535) | (val < 0)) {
- print_err("Invalid \\outputbox");
- help1
- ("The value for \\outputbox has to be between 0 and 65535.");
- error();
- } else {
- word_define(p, val);
- }
- break;
- case new_line_char_code:
- if (val > 127) {
- print_err("Invalid \\newlinechar");
- help2
- ("The value for \\newlinechar has to be no higher than 127.",
- "Your invalid assignment will be ignored.");
- error();
- } else {
- word_define(p, val);
- }
- break;
- case end_line_char_code:
- if (val > 127) {
- print_err("Invalid \\endlinechar");
- help2
- ("The value for \\endlinechar has to be no higher than 127.",
- "Your invalid assignment will be ignored.");
- error();
- } else {
- word_define(p, val);
- }
- break;
- case language_code:
- if (val < 0) {
- word_define(int_base + cur_lang_code, -1);
- word_define(p, -1);
- } else if (val > 16383) {
- print_err("Invalid \\language");
- help2
- ("The absolute value for \\language has to be no higher than 16383.",
- "Your invalid assignment will be ignored.");
- error();
- } else {
- word_define(int_base + cur_lang_code, val);
- word_define(p, val);
- }
- break;
- default:
- word_define(p, val);
- break;
- }
- /* If we are defining subparagraph penalty levels while we are
- in hmode, then we put out a whatsit immediately, otherwise
- we leave it alone. This mechanism might not be sufficiently
- powerful, and some other algorithm, searching down the stack,
- might be necessary. Good first step. */
- if ((abs(mode) == hmode) &&
- ((p == (int_base + local_inter_line_penalty_code)) ||
- (p == (int_base + local_broken_penalty_code)))) {
- /* LOCAL: Add local paragraph node */
- tail_append(make_local_par_node(penalty_par_code));
- eq_word_define(int_base + no_local_whatsits_code, no_local_whatsits_par + 1);
- }
- } else if ((p >= dimen_base) && (p <= eqtb_size)) {
- if (p == (dimen_base + page_left_offset_code)) {
- n = val - one_true_inch;
- word_define(dimen_base + h_offset_code, n);
- } else if (p == (dimen_base + h_offset_code)) {
- n = val + one_true_inch;
- word_define(dimen_base + page_left_offset_code, n);
- } else if (p == (dimen_base + page_top_offset_code)) {
- n = val - one_true_inch;
- word_define(dimen_base + v_offset_code, n);
- } else if (p == (dimen_base + v_offset_code)) {
- n = val + one_true_inch;
- word_define(dimen_base + page_top_offset_code, n);
- }
- word_define(p, val);
- } else if ((p >= local_base) && (p < toks_base)) { /* internal locals */
- define(p, call_cmd, val);
- } else {
- confusion("assign internal value");
- }
-}
-
-@ We use the fact that |register<advance<multiply<divide|
-
-Compute the register location |l| and its type |p|; but |return| if invalid
-Here we use the fact that the consecutive codes |int_val..mu_val| and
-|assign_int..assign_mu_glue| correspond to each other nicely.
-
-@c
-void do_register_command(int a)
-{
- int p;
- halfword q = cur_cmd;
- halfword l = 0;
- if (q != register_cmd) {
- get_x_token();
- if ((cur_cmd >= assign_int_cmd) && (cur_cmd <= assign_mu_glue_cmd)) {
- l = cur_chr;
- p = cur_cmd - assign_int_cmd;
- goto FOUND;
- }
- if (cur_cmd != register_cmd) {
- print_err("You can't use `");
- print_cmd_chr((quarterword) cur_cmd, cur_chr);
- tprint("' after ");
- print_cmd_chr((quarterword) q, 0);
- help1("I'm forgetting what you said and not changing anything.");
- error();
- return;
- }
- }
- p = cur_chr;
- scan_register_num();
- if (p == int_val_level)
- l = cur_val + count_base;
- else if (p == attr_val_level)
- l = cur_val + attribute_base;
- else if (p == dimen_val_level)
- l = cur_val + scaled_base;
- else if (p == glue_val_level)
- l = cur_val + skip_base;
- else if (p == mu_val_level)
- l = cur_val + mu_skip_base;
- FOUND:
- if (q == register_cmd) {
- scan_optional_equals();
- } else if (scan_keyword("by")) {
- /* optional `\.{by}' */
- }
- arith_error = false;
- if (q < multiply_cmd) {
- /* Compute result of |register| or |advance|, put it in |cur_val| */
- if (p < glue_val_level) {
- if ((p == int_val_level) || (p == attr_val_level))
- scan_int();
- else
- scan_normal_dimen();
- if (q == advance_cmd)
- cur_val = cur_val + eqtb[l].cint;
- } else {
- /* we can probably save a copy */
- scan_glue(p);
- if (q == advance_cmd) {
- /* Compute the sum of two glue specs */
- halfword r = equiv(l);
- q = new_spec(cur_val);
- flush_node(cur_val);
- width(q) = width(q) + width(r);
- if (stretch(q) == 0) {
- stretch_order(q) = normal;
- }
- if (stretch_order(q) == stretch_order(r)) {
- stretch(q) = stretch(q) + stretch(r);
- } else if ((stretch_order(q) < stretch_order(r)) && (stretch(r) != 0)) {
- stretch(q) = stretch(r);
- stretch_order(q) = stretch_order(r);
- }
- if (shrink(q) == 0) {
- shrink_order(q) = normal;
- }
- if (shrink_order(q) == shrink_order(r)) {
- shrink(q) = shrink(q) + shrink(r);
- } else if ((shrink_order(q) < shrink_order(r)) && (shrink(r) != 0)) {
- shrink(q) = shrink(r);
- shrink_order(q) = shrink_order(r);
- }
- cur_val = q;
- }
- }
- } else {
- /* Compute result of |multiply| or |divide|, put it in |cur_val| */
- scan_int();
- if (p < glue_val_level) {
- if (q == multiply_cmd) {
- if ((p == int_val_level) || (p == attr_val_level)) {
- cur_val = mult_integers(eqtb[l].cint, cur_val);
- } else {
- cur_val = nx_plus_y(eqtb[l].cint, cur_val, 0);
- }
- } else {
- cur_val = x_over_n(eqtb[l].cint, cur_val);
- }
- } else {
- halfword s = equiv(l);
- halfword r = new_spec(s);
- if (q == multiply_cmd) {
- width(r) = nx_plus_y(width(s), cur_val, 0);
- stretch(r) = nx_plus_y(stretch(s), cur_val, 0);
- shrink(r) = nx_plus_y(shrink(s), cur_val, 0);
- } else {
- width(r) = x_over_n(width(s), cur_val);
- stretch(r) = x_over_n(stretch(s), cur_val);
- shrink(r) = x_over_n(shrink(s), cur_val);
- }
- cur_val = r;
- }
- }
- if (arith_error) {
- print_err("Arithmetic overflow");
- help2("I can't carry out that multiplication or division,",
- "since the result is out of range.");
- if (p >= glue_val_level)
- flush_node(cur_val);
- error();
- return;
- }
- if (p < glue_val_level) {
- if (p == attr_val_level) {
- if ((l - attribute_base) > max_used_attr)
- max_used_attr = (l - attribute_base);
- attr_list_cache = cache_disabled;
- }
- if ((p == int_val_level) || (p == dimen_val_level))
- assign_internal_value(a, l, cur_val);
- else
- word_define(l, cur_val);
- } else {
- define(l, glue_ref_cmd, cur_val);
- }
-}
-
-@ @c
-void alter_aux(void)
-{
- halfword c; /* |hmode| or |vmode| */
- if (cur_chr != abs(mode)) {
- report_illegal_case();
- } else {
- c = cur_chr;
- scan_optional_equals();
- if (c == vmode) {
- scan_normal_dimen();
- prev_depth_par = cur_val;
- } else {
- scan_int();
- if ((cur_val <= 0) || (cur_val > 32767)) {
- print_err("Bad space factor");
- help1("I allow only values in the range 1..32767 here.");
- int_error(cur_val);
- } else {
- space_factor_par = cur_val;
- }
- }
- }
-}
-
-@ @c
-void alter_prev_graf(void)
-{
- int p; /* index into |nest| */
- p = nest_ptr;
- while (abs(nest[p].mode_field) != vmode)
- decr(p);
- scan_optional_equals();
- scan_int();
- if (cur_val < 0) {
- print_err("Bad \\prevgraf");
- help1("I allow only nonnegative values here.");
- int_error(cur_val);
- } else {
- nest[p].pg_field = cur_val;
- }
-}
-
-@ @c
-void alter_page_so_far(void)
-{
- int c; /* index into |page_so_far| */
- c = cur_chr;
- scan_optional_equals();
- scan_normal_dimen();
- page_so_far[c] = cur_val;
-}
-
-@ @c
-void alter_integer(void)
-{
- int c; /* 0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc. */
- c = cur_chr;
- scan_optional_equals();
- scan_int();
- if (c == 0) {
- dead_cycles = cur_val;
- } else if (c == 2) {
- if ((cur_val < batch_mode) || (cur_val > error_stop_mode)) {
- print_err("Bad interaction mode");
- help2("Modes are 0=batch, 1=nonstop, 2=scroll, and",
- "3=errorstop. Proceed, and I'll ignore this case.");
- int_error(cur_val);
- } else {
- cur_chr = cur_val;
- new_interaction();
- }
- } else {
- insert_penalties = cur_val;
- }
-}
-
-@ @c
-void alter_box_dimen(void)
-{
- int c; /* |width_offset| or |height_offset| or |depth_offset| */
- int b; /* box number */
- c = cur_chr;
- scan_register_num();
- b = cur_val;
- scan_optional_equals();
- scan_normal_dimen();
- if (box(b) != null)
- varmem[box(b) + c].cint = cur_val;
-}
-
-@ @c
-void new_interaction(void)
-{
- print_ln();
- interaction = cur_chr;
- if (interaction == batch_mode)
- kpse_make_tex_discard_errors = 1;
- else
- kpse_make_tex_discard_errors = 0;
- fixup_selector(log_opened_global);
-}
-
-@ The \.{\\afterassignment} command puts a token into the global
-variable |after_token|. This global variable is examined just after
-every assignment has been performed.
-
-@c
-halfword after_token; /* zero, or a saved token */
-
-@ Here is a procedure that might be called `Get the next non-blank non-relax
-non-call non-assignment token'.
-
-@c
-void do_assignments(void)
-{
- while (true) {
- /* Get the next non-blank non-relax... */
- do {
- get_x_token();
- } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
- if (cur_cmd <= max_non_prefixed_command)
- return;
- set_box_allowed = false;
- prefixed_command();
- set_box_allowed = true;
- }
-}
-
-@ @c
-void open_or_close_in(void)
-{
- int c; /* 1 for \.{\\openin}, 0 for \.{\\closein} */
- int n; /* stream number */
- char *fn;
- c = cur_chr;
- scan_four_bit_int();
- n = cur_val;
- if (read_open[n] != closed) {
- lua_a_close_in(read_file[n], (n + 1));
- read_open[n] = closed;
- }
- if (c != 0) {
- scan_optional_equals();
- do {
- get_x_token();
- } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
- back_input();
- if (cur_cmd != left_brace_cmd) {
- scan_file_name(); /* set |cur_name| to desired file name */
- if (cur_ext == get_nullstr())
- cur_ext = maketexstring(".tex");
- } else {
- scan_file_name_toks();
- }
- fn = pack_file_name(cur_name, cur_area, cur_ext);
- if (lua_a_open_in(&(read_file[n]), fn, (n + 1))) {
- read_open[n] = just_open;
- }
- }
-}
-
-@ @c
-boolean long_help_seen; /* has the long \.{\\errmessage} help been used? */
-
-void issue_message(void)
-{
- int old_setting; /* holds |selector| setting */
- int c; /* identifies \.{\\message} and \.{\\errmessage} */
- str_number s; /* the message */
- c = cur_chr;
- (void) scan_toks(false, true);
- old_setting = selector;
- selector = new_string;
- token_show(def_ref);
- selector = old_setting;
- flush_list(def_ref);
- str_room(1);
- s = make_string();
- if (c == 0) {
- /* Print string |s| on the terminal */
- if (term_offset + (int) str_length(s) > max_print_line - 2)
- print_ln();
- else if ((term_offset > 0) || (file_offset > 0))
- print_char(' ');
- print(s);
- update_terminal();
-
- } else {
- /* Print string |s| as an error message */
- /* If \.{\\errmessage} occurs often in |scroll_mode|, without user-defined
- \.{\\errhelp}, we don't want to give a long help message each time. So we
- give a verbose explanation only once. */
- print_err("");
- print(s);
- if (err_help_par != null) {
- use_err_help = true;
- } else if (long_help_seen) {
- help1("(That was another \\errmessage.)");
- } else {
- if (interaction < error_stop_mode)
- long_help_seen = true;
- help4("This error message was generated by an \\errmessage",
- "command, so I can't give any explicit help.",
- "Pretend that you're Hercule Poirot: Examine all clues,",
- "and deduce the truth by order and method.");
- }
- error();
- use_err_help = false;
-
- }
- flush_str(s);
-}
-
-@ The |error| routine calls on |give_err_help| if help is requested from
-the |err_help| parameter.
-
-@c
-void give_err_help(void)
-{
- token_show(err_help_par);
-}
-
-@ The \.{\\uppercase} and \.{\\lowercase} commands are implemented by
-building a token list and then changing the cases of the letters in it.
-
-@c
-void shift_case(void)
-{
- halfword b; /* |lc_code_base| or |uc_code_base| */
- halfword p; /* runs through the token list */
- halfword t; /* token */
- halfword c; /* character code */
- halfword i; /* inbetween */
- b = cur_chr;
- p = scan_toks(false, false);
- p = token_link(def_ref);
- while (p != null) {
- /* Change the case of the token in |p|, if a change is appropriate */
- /*
- When the case of a |chr_code| changes, we don't change the |cmd|.
- We also change active characters.
- */
- t = token_info(p);
- if (t < cs_token_flag) {
- c = t % STRING_OFFSET;
- if (b == uc_code_base)
- i = get_uc_code(c);
- else
- i = get_lc_code(c);
- if (i != 0)
- set_token_info(p, t - c + i);
- } else if (is_active_cs(cs_text(t - cs_token_flag))) {
- c = active_cs_value(cs_text(t - cs_token_flag));
- if (b == uc_code_base)
- i = get_uc_code(c);
- else
- i = get_lc_code(c);
- if (i != 0)
- set_token_info(p, active_to_cs(i, true) + cs_token_flag);
- }
- p = token_link(p);
- }
- back_list(token_link(def_ref));
- free_avail(def_ref); /* omit reference count */
-}
-
-@ We come finally to the last pieces missing from |main_control|, namely the
-`\.{\\show}' commands that are useful when debugging.
-
-@c
-void show_whatever(void)
-{
- halfword p; /* tail of a token list to show */
- int t; /* type of conditional being shown */
- int m; /* upper bound on |fi_or_else| codes */
- int l; /* line where that conditional began */
- int n; /* level of \.{\\if...\\fi} nesting */
- switch (cur_chr) {
- case show_lists:
- begin_diagnostic();
- show_activities();
- break;
- case show_box_code:
- /* Show the current contents of a box */
- scan_register_num();
- begin_diagnostic();
- tprint_nl("> \\box");
- print_int(cur_val);
- print_char('=');
- if (box(cur_val) == null)
- tprint("void");
- else
- show_box(box(cur_val));
- break;
- case show_code:
- /* Show the current meaning of a token, then |goto common_ending| */
- get_token();
- if (interaction == error_stop_mode)
- wake_up_terminal();
- tprint_nl("> ");
- if (cur_cs != 0) {
- sprint_cs(cur_cs);
- print_char('=');
- }
- print_meaning();
- goto COMMON_ENDING;
- break;
- /* Cases for |show_whatever| */
- case show_groups:
- begin_diagnostic();
- show_save_groups();
- break;
- case show_ifs:
- begin_diagnostic();
- tprint_nl("");
- print_ln();
- if (cond_ptr == null) {
- tprint_nl("### ");
- tprint("no active conditionals");
- } else {
- p = cond_ptr;
- n = 0;
- do {
- incr(n);
- p = vlink(p);
- } while (p != null);
- p = cond_ptr;
- t = cur_if;
- l = if_line;
- m = if_limit;
- do {
- tprint_nl("### level ");
- print_int(n);
- tprint(": ");
- print_cmd_chr(if_test_cmd, t);
- if (m == fi_code)
- tprint_esc("else");
- print_if_line(l);
- decr(n);
- t = if_limit_subtype(p);
- l = if_line_field(p);
- m = if_limit_type(p);
- p = vlink(p);
- } while (p != null);
- }
- break;
- default:
- /* Show the current value of some parameter or register,
- then |goto common_ending| */
- p = the_toks();
- if (interaction == error_stop_mode)
- wake_up_terminal();
- tprint_nl("> ");
- token_show(temp_token_head);
- flush_list(token_link(temp_token_head));
- goto COMMON_ENDING;
- break;
- }
- /* Complete a potentially long \.{\\show} command */
- end_diagnostic(true);
- print_err("OK");
- if (selector == term_and_log) {
- if (tracing_online_par <= 0) {
- selector = term_only;
- tprint(" (see the transcript file)");
- selector = term_and_log;
- }
- }
- COMMON_ENDING:
- if (interaction < error_stop_mode) {
- help0();
- decr(error_count);
- } else if (tracing_online_par > 0) {
- help3("This isn't an error message; I'm just \\showing something.",
- "Type `I\\show...' to show more (e.g., \\show\\cs,",
- "\\showthe\\count10, \\showbox255, \\showlists).");
- } else {
- help5("This isn't an error message; I'm just \\showing something.",
- "Type `I\\show...' to show more (e.g., \\show\\cs,",
- "\\showthe\\count10, \\showbox255, \\showlists).",
- "And type `I\\tracingonline=1\\show...' to show boxes and",
- "lists on your terminal as well as in the transcript file.");
- }
- error();
-}
-
-@ @c
-void initialize(void)
-{ /* this procedure gets things started properly */
- int k; /* index into |mem|, |eqtb|, etc. */
- /* Initialize whatever \TeX\ might access */
- /* Set initial values of key variables */
- initialize_errors();
- initialize_arithmetic();
- max_used_attr = -1;
- attr_list_cache = cache_disabled;
- initialize_nesting();
-
- /* Start a new current page */
- page_contents = empty;
- page_tail = page_head;
-#if 0
- vlink(page_head) = null;
-#endif
- last_glue = max_halfword;
- last_penalty = 0;
- last_kern = 0;
- last_node_type = -1;
- page_depth = 0;
- page_max_depth = 0;
-
- initialize_equivalents();
- no_new_control_sequence = true; /* new identifiers are usually forbidden */
- init_primitives();
-
- mag_set = 0;
- initialize_marks();
- initialize_read();
-
- static_pdf = init_pdf_struct(static_pdf); /* should be init_backend() */
-
- format_ident = 0;
- format_name = get_nullstr();
- initialize_directions();
- initialize_write_files();
- seconds_and_micros(epochseconds, microseconds);
- initialize_start_time(static_pdf);
-
- edit_name_start = 0;
- stop_at_space = true;
-
- if (ini_version) {
- /* Initialize table entries (done by \.{INITEX} only) */
-
- init_node_mem(500);
- initialize_tokens();
- /* Initialize the special list heads and constant nodes */
- initialize_alignments();
- initialize_buildpage();
-
- initialize_active();
-
- set_eq_type(undefined_control_sequence, undefined_cs_cmd);
- set_equiv(undefined_control_sequence, null);
- set_eq_level(undefined_control_sequence, level_zero);
- for (k = null_cs; k <= (eqtb_top - 1); k++)
- eqtb[k] = eqtb[undefined_control_sequence];
- set_equiv(glue_base, zero_glue);
- set_eq_level(glue_base, level_one);
- set_eq_type(glue_base, glue_ref_cmd);
- for (k = glue_base + 1; k <= local_base - 1; k++) {
- eqtb[k] = eqtb[glue_base];
- }
- par_shape_par_ptr = null;
- set_eq_type(par_shape_loc, shape_ref_cmd);
- set_eq_level(par_shape_loc, level_one);
- for (k = etex_pen_base; k <= (etex_pens - 1); k++)
- eqtb[k] = eqtb[par_shape_loc];
- for (k = output_routine_loc; k <= toks_base + biggest_reg; k++)
- eqtb[k] = eqtb[undefined_control_sequence];
- box(0) = null;
- set_eq_type(box_base, box_ref_cmd);
- set_eq_level(box_base, level_one);
- for (k = box_base + 1; k <= (box_base + biggest_reg); k++)
- eqtb[k] = eqtb[box_base];
- cur_font_par = null_font;
- set_eq_type(cur_font_loc, data_cmd);
- set_eq_level(cur_font_loc, level_one);
- set_equiv(cat_code_base, 0);
- set_eq_type(cat_code_base, data_cmd);
- set_eq_level(cat_code_base, level_one);
- eqtb[internal_math_param_base] = eqtb[cat_code_base];
- eqtb[lc_code_base] = eqtb[cat_code_base];
- eqtb[uc_code_base] = eqtb[cat_code_base];
- eqtb[sf_code_base] = eqtb[cat_code_base];
- eqtb[math_code_base] = eqtb[cat_code_base];
- cat_code_table_par = 0;
- initialize_math_codes();
- initialize_text_codes();
- initex_cat_codes(0);
- for (k = '0'; k <= '9'; k++)
- set_math_code(k, math_use_current_family_code, 0, k, level_one);
- for (k = 'A'; k <= 'Z'; k++) {
- set_math_code(k, math_use_current_family_code, 1, k, level_one);
- set_math_code((k + 32), math_use_current_family_code, 1, (k + 32), level_one);
- set_lc_code(k, k + 32, level_one);
- set_lc_code(k + 32, k + 32, level_one);
- set_uc_code(k, k, level_one);
- set_uc_code(k + 32, k, level_one);
- set_sf_code(k, 999, level_one);
- }
- for (k = int_base; k <= attribute_base - 1; k++)
- eqtb[k].cint = 0;
- for (k = attribute_base; k <= del_code_base - 1; k++)
- eqtb[k].cint = UNUSED_ATTRIBUTE;
- mag_par = 1000;
- tolerance_par = 10000;
- hang_after_par = 1;
- max_dead_cycles_par = 25;
- escape_char_par = '\\';
- end_line_char_par = carriage_return;
- set_del_code('.', 0, 0, 0, 0, level_one); /* this null delimiter is used in error recovery */
- ex_hyphen_char_par = '-';
- output_box_par = 255;
- for (k = dimen_base; k <= eqtb_size; k++)
- eqtb[k].cint = 0;
- page_left_offset_par = one_inch;
- page_top_offset_par = one_inch;
- page_right_offset_par = one_inch;
- page_bottom_offset_par = one_inch;
- ini_init_primitives();
- hash_used = frozen_control_sequence; /* nothing is used */
- hash_high = 0;
- cs_count = 0;
- set_eq_type(frozen_dont_expand, dont_expand_cmd);
- cs_text(frozen_dont_expand) = maketexstring("notexpanded:");
- set_eq_type(frozen_primitive, ignore_spaces_cmd);
- set_equiv(frozen_primitive, 1);
- set_eq_level(frozen_primitive, level_one);
- cs_text(frozen_primitive) = maketexstring("primitive");
- create_null_font();
- font_bytes = 0;
- px_dimen_par = one_bp;
- math_eqno_gap_step_par = 1000 ;
- cs_text(frozen_protection) = maketexstring("inaccessible");
- format_ident = maketexstring(" (INITEX)");
- cs_text(end_write) = maketexstring("endwrite");
- set_eq_level(end_write, level_one);
- set_eq_type(end_write, outer_call_cmd);
- set_equiv(end_write, null);
-
- }
- synctexoffset = int_base + synctex_code;
-
-}
+% maincontrol.w
+%
+% Copyright 2009-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
+
+#include "ptexlib.h"
+#include "lua/luatex-api.h"
+
+@ @c
+#define mode mode_par
+#define tail tail_par
+#define head head_par
+#define dir_save dirs_par
+
+@ We come now to the |main_control| routine, which contains the master
+switch that causes all the various pieces of \TeX\ to do their things,
+in the right order.
+
+In a sense, this is the grand climax of the program: It applies all the
+tools that we have worked so hard to construct. In another sense, this is
+the messiest part of the program: It necessarily refers to other pieces
+of code all over the place, so that a person can't fully understand what is
+going on without paging back and forth to be reminded of conventions that
+are defined elsewhere. We are now at the hub of the web, the central nervous
+system that touches most of the other parts and ties them together.
+@^brain@>
+
+The structure of |main_control| itself is quite simple. There's a label
+called |big_switch|, at which point the next token of input is fetched
+using |get_x_token|. Then the program branches at high speed into one of
+about 100 possible directions, based on the value of the current
+mode and the newly fetched command code; the sum |abs(mode)+cur_cmd|
+indicates what to do next. For example, the case `|vmode+letter|' arises
+when a letter occurs in vertical mode (or internal vertical mode); this
+case leads to instructions that initialize a new paragraph and enter
+horizontal mode.
+
+The big |case| statement that contains this multiway switch has been labeled
+|reswitch|, so that the program can |goto reswitch| when the next token
+has already been fetched. Most of the cases are quite short; they call
+an ``action procedure'' that does the work for that case, and then they
+either |goto reswitch| or they ``fall through'' to the end of the |case|
+statement, which returns control back to |big_switch|. Thus, |main_control|
+is not an extremely large procedure, in spite of the multiplicity of things
+it must do; it is small enough to be handled by PASCAL compilers that put
+severe restrictions on procedure size.
+@!@^action procedure@>
+
+One case is singled out for special treatment, because it accounts for most
+of \TeX's activities in typical applications. The process of reading simple
+text and converting it into |char_node| records, while looking for ligatures
+and kerns, is part of \TeX's ``inner loop''; the whole program runs
+efficiently when its inner loop is fast, so this part has been written
+with particular care.
+
+We leave the |space_factor| unchanged if |sf_code(cur_chr)=0|; otherwise we
+set it equal to |sf_code(cur_chr)|, except that it should never change
+from a value less than 1000 to a value exceeding 1000. The most common
+case is |sf_code(cur_chr)=1000|, so we want that case to be fast.
+
+@c
+void adjust_space_factor(void)
+{
+ halfword s = get_sf_code(cur_chr);
+ if (s == 1000) {
+ space_factor_par = 1000;
+ } else if (s < 1000) {
+ if (s > 0)
+ space_factor_par = s;
+ } else if (space_factor_par < 1000) {
+ space_factor_par = 1000;
+ } else {
+ space_factor_par = s;
+ }
+}
+
+@ From Knuth: ``Having |font_glue| allocated for each text font saves
+both time and memory.'' That may be true, but it also punches through
+the API wall for fonts, so I removed that -- Taco. But a bit of caching
+is very welcome, which is why I need to have the next two globals:
+
+@ To handle the execution state of |main_control|'s eternal loop,
+an extra global variable is used, along with a macro to define
+its values.
+
+@c
+#define goto_next 0
+#define goto_skip_token 1
+#define goto_return 2
+
+static int main_control_state;
+
+@* Main control helpers.
+
+Here are all the functions that are called from |main_control| that
+are not already defined elsewhere. For the moment, this list simply
+in the order that the appear in |init_main_control|, below.
+
+@
+@c
+static void run_char_num (void) {
+ scan_char_num();
+ cur_chr = cur_val;
+ adjust_space_factor();
+ tail_append(new_char(cur_font_par, cur_chr));
+}
+
+static void run_char (void) {
+ adjust_space_factor();
+ tail_append(new_char(cur_font_par, cur_chr));
+}
+
+@
+The occurrence of blank spaces is almost part of \TeX's inner loop,
+since we usually encounter about one space for every five non-blank characters.
+Therefore |main_control| gives second-highest priority to ordinary spaces.
+
+When a glue parameter like \.{\\spaceskip} is set to `\.{0pt}', we will
+see to it later that the corresponding glue specification is precisely
+|zero_glue|, not merely a pointer to some specification that happens
+to be full of zeroes. Therefore it is simple to test whether a glue parameter
+is zero or~not.
+
+@c
+static void run_app_space (void) {
+ halfword p; /* was a global temp_ptr */
+ int method = disable_space_par ;
+ if (method == 1) {
+ /* don't inject anything, not even zero skip */
+ } else if (method == 2) {
+ p = new_glue(zero_glue);
+ couple_nodes(tail,p);
+ tail = p;
+ } else if ((abs(mode) + cur_cmd == hmode + spacer_cmd) && (!(space_factor_par == 1000))) {
+ app_space();
+ } else {
+ /* Append a normal inter-word space to the current list */
+ if (glue_is_zero(space_skip_par)) {
+ /* Find the glue specification for text spaces in the current font */
+ p = new_glue(zero_glue);
+ width(p) = space(cur_font_par);
+ stretch(p) = space_stretch(cur_font_par);
+ shrink(p) = space_shrink(cur_font_par);
+
+ } else {
+ p = new_param_glue(space_skip_code);
+ }
+ /* so from now we have a subtype with spaces: */
+ subtype(p) = space_skip_code + 1 ;
+ couple_nodes(tail,p);
+ tail = p;
+ }
+}
+
+@ Append a |boundary_node|
+@c
+static void run_boundary (void) {
+ halfword n ;
+ n = new_node(boundary_node,cur_chr);
+ if ((cur_chr == 1) || (cur_chr == 2) ) {
+ /* user boundary or protrusion boundary */
+ scan_int();
+ boundary_value(n) = cur_val;
+ }
+ couple_nodes(tail, n);
+ tail = n;
+}
+
+@ @c
+static void run_char_ghost (void) {
+ int t;
+ t = cur_chr;
+ get_x_token();
+ if ((cur_cmd == letter_cmd) || (cur_cmd == other_char_cmd)
+ || (cur_cmd == char_given_cmd) || (cur_cmd == char_num_cmd)) {
+ halfword p = new_glyph(get_cur_font(), cur_chr);
+ if (t == 0) {
+ set_is_leftghost(p);
+ } else {
+ set_is_rightghost(p);
+ }
+ tail_append(p);
+ }
+}
+
+@ @c
+static void run_relax (void) {
+ return;
+}
+
+@ |ignore_spaces| is a special case: after it has acted, |get_x_token| has already
+fetched the next token from the input, so that operation in |main_control|
+should be skipped.
+
+@c
+static void run_ignore_spaces (void) {
+ if (cur_chr == 0) {
+ /* Get the next non-blank non-call... */
+ do {
+ get_x_token();
+ } while (cur_cmd == spacer_cmd);
+ main_control_state = goto_skip_token;
+ } else {
+ int t = scanner_status;
+ scanner_status = normal;
+ get_next();
+ scanner_status = t;
+ cur_cs = prim_lookup(cs_text(cur_cs));
+ if (cur_cs != undefined_primitive) {
+ cur_cmd = get_prim_eq_type(cur_cs);
+ cur_chr = get_prim_equiv(cur_cs);
+ cur_tok = (cur_cmd * STRING_OFFSET) + cur_chr;
+ main_control_state = goto_skip_token;
+ }
+ }
+}
+
+@ |stop| is the second special case. We want |main_control| to return to its caller
+if there is nothing left to do.
+
+@c
+static void run_stop (void) {
+ if (its_all_over())
+ main_control_state= goto_return; /* this is the only way out */
+}
+
+@ @c
+static void run_non_math_math (void) {
+ back_input();
+ new_graf(true);
+}
+
+@ @c
+static void run_math_char_num (void) {
+ mathcodeval mval; /* to build up an argument to |set_math_char| */
+ if (cur_chr == 0)
+ mval = scan_mathchar(tex_mathcode);
+ else if (cur_chr == 1)
+ mval = scan_mathchar(umath_mathcode);
+ else
+ mval = scan_mathchar(umathnum_mathcode);
+ math_char_in_text(mval);
+}
+
+@ @c
+static void run_math_given (void) {
+ mathcodeval mval; /* to build up an argument to |set_math_char| */
+ mval = mathchar_from_integer(cur_chr, tex_mathcode);
+ math_char_in_text(mval);
+}
+
+static void run_xmath_given (void) {
+ mathcodeval mval; /* to build up an argument to |set_math_char| */
+ mval = mathchar_from_integer(cur_chr, umath_mathcode);
+ math_char_in_text(mval);
+}
+
+@ The most important parts of |main_control| are concerned with \TeX's
+chief mission of box-making. We need to control the activities that put
+entries on vlists and hlists, as well as the activities that convert
+those lists into boxes. All of the necessary machinery has already been
+developed; it remains for us to ``push the buttons'' at the right times.
+
+As an introduction to these routines, let's consider one of the simplest
+cases: What happens when `\.{\\hrule}' occurs in vertical mode, or
+`\.{\\vrule}' in horizontal mode or math mode? The code in |main_control|
+is short, since the |scan_rule_spec| routine already does most of what is
+required; thus, there is no need for a special action procedure.
+
+Note that baselineskip calculations are disabled after a rule in vertical
+mode, by setting |prev_depth:=ignore_depth|.
+
+@c
+static void run_rule (void) {
+ tail_append(scan_rule_spec());
+ if (abs(mode) == vmode)
+ prev_depth_par = ignore_depth;
+ else if (abs(mode) == hmode)
+ space_factor_par = 1000;
+}
+
+@
+Many of the actions related to box-making are triggered by the appearance
+of braces in the input. For example, when the user says `\.{\\hbox}
+\.{to} \.{100pt\{$\langle\,\hbox{hlist}\,\rangle$\}}' in vertical mode,
+the information about the box size (100pt, |exactly|) is put onto |save_stack|
+with a level boundary word just above it, and |cur_group:=adjusted_hbox_group|;
+\TeX\ enters restricted horizontal mode to process the hlist. The right
+brace eventually causes |save_stack| to be restored to its former state,
+at which time the information about the box size (100pt, |exactly|) is
+available once again; a box is packaged and we leave restricted horizontal
+mode, appending the new box to the current list of the enclosing mode
+(in this case to the current list of vertical mode), followed by any
+vertical adjustments that were removed from the box by |hpack|.
+
+The next few sections of the program are therefore concerned with the
+treatment of left and right curly braces.
+
+If a left brace occurs in the middle of a page or paragraph, it simply
+introduces a new level of grouping, and the matching right brace will not have
+such a drastic effect. Such grouping affects neither the mode nor the
+current list.
+
+@c
+static void run_left_brace (void) {
+ new_save_level(simple_group);
+ eq_word_define(int_base + no_local_whatsits_code, 0);
+ eq_word_define(int_base + no_local_dirs_code, 0);
+}
+
+static void run_begin_group (void) {
+ new_save_level(semi_simple_group);
+ eq_word_define(int_base + no_local_whatsits_code, 0);
+ eq_word_define(int_base + no_local_dirs_code, 0);
+}
+
+static void run_end_group (void) {
+ if (cur_group == semi_simple_group) {
+ fixup_directions();
+ } else {
+ off_save();
+ }
+}
+
+@ Constructions that require a box are started by calling |scan_box| with
+a specified context code. The |scan_box| routine verifies
+that a |make_box| command comes next and then it calls |begin_box|.
+
+@c
+static void run_move (void) {
+ int t = cur_chr;
+ scan_normal_dimen();
+ if (t == 0)
+ scan_box(cur_val);
+ else
+ scan_box(-cur_val);
+}
+
+@ @c
+static void run_leader_ship (void) {
+ scan_box(leader_flag - a_leaders + cur_chr);
+}
+
+@ @c
+static void run_make_box (void) {
+ begin_box(0);
+}
+
+@ @c
+static void run_box_dir (void) {
+ scan_register_num();
+ cur_box = box(cur_val);
+ scan_optional_equals();
+ scan_direction();
+ if (cur_box != null)
+ box_dir(cur_box) = cur_val;
+}
+
+@ There is a really small patch to add a new primitive called
+\.{\\quitvmode}. In vertical modes, it is identical to \.{\\indent},
+but in horizontal and math modes it is really a no-op (as opposed to
+\.{\\indent}, which executes the |indent_in_hmode| procedure).
+
+A paragraph begins when horizontal-mode material occurs in vertical mode,
+or when the paragraph is explicitly started by `\.{\\quitvmode}',
+`\.{\\indent}' or `\.{\\noindent}'.
+
+@c
+static void run_start_par_vmode (void) {
+ new_graf((cur_chr > 0));
+}
+
+@ @c
+static void run_start_par (void) {
+ if (cur_chr != 2)
+ indent_in_hmode();
+}
+
+@ @c
+static void run_new_graf (void) {
+ back_input();
+ new_graf(true);
+}
+
+@ A paragraph ends when a |par_end| command is sensed, or when we are in
+horizontal mode when reaching the right brace of vertical-mode routines
+like \.{\\vbox}, \.{\\insert}, or \.{\\output}.
+
+@c
+static void run_par_end_vmode (void) {
+ normal_paragraph();
+ if (mode > 0) {
+ checked_page_filter(vmode_par);
+ build_page();
+ }
+}
+
+@ @c
+static void run_par_end_hmode (void) {
+ if (align_state < 0)
+ off_save(); /* this tries to recover from an alignment that didn't end properly */
+ end_graf(bottom_level); /* this takes us to the enclosing mode, if |mode>0| */
+ if (mode == vmode) {
+ checked_page_filter(hmode_par);
+ build_page();
+ }
+}
+
+@ @c
+static void append_italic_correction_mmode (void) {
+ tail_append(new_kern(0)); /* what subtype to use */
+}
+
+@ @c
+static void run_local_box (void) {
+ append_local_box(cur_chr);
+}
+
+@ @c
+static void run_halign_mmode (void) {
+ if (privileged()) {
+ if (cur_group == math_shift_group)
+ init_align();
+ else
+ off_save();
+ }
+}
+
+@ @c
+static void run_eq_no (void) {
+ if (privileged()) {
+ if (cur_group == math_shift_group)
+ start_eq_no();
+ else
+ off_save();
+ }
+}
+
+@ @c
+static void run_letter_mmode (void) {
+ set_math_char(get_math_code(cur_chr));
+}
+
+@ @c
+static void run_char_num_mmode (void) {
+ scan_char_num();
+ cur_chr = cur_val;
+ set_math_char(get_math_code(cur_chr));
+}
+
+@ @c
+static void run_math_char_num_mmode (void) {
+ mathcodeval mval; /* to build up an argument to |set_math_char| */
+ if (cur_chr == 0)
+ mval = scan_mathchar(tex_mathcode);
+ else if (cur_chr == 1)
+ mval = scan_mathchar(umath_mathcode);
+ else
+ mval = scan_mathchar(umathnum_mathcode);
+ set_math_char(mval);
+}
+
+@ @c
+static void run_math_given_mmode (void) {
+ mathcodeval mval; /* to build up an argument to |set_math_char| */
+ mval = mathchar_from_integer(cur_chr, tex_mathcode);
+ set_math_char(mval);
+}
+
+static void run_xmath_given_mmode (void) {
+ mathcodeval mval; /* to build up an argument to |set_math_char| */
+ mval = mathchar_from_integer(cur_chr, umath_mathcode);
+ set_math_char(mval);
+}
+
+@ @c
+static void run_delim_num (void) {
+ mathcodeval mval; /* to build up an argument to |set_math_char| */
+ if (cur_chr == 0)
+ mval = scan_delimiter_as_mathchar(tex_mathcode);
+ else
+ mval = scan_delimiter_as_mathchar(umath_mathcode);
+ set_math_char(mval);
+
+}
+
+@ @c
+static void run_vcenter (void) {
+ scan_spec(vcenter_group);
+ normal_paragraph();
+ push_nest();
+ mode = -vmode;
+ prev_depth_par = ignore_depth;
+ if (every_vbox_par != null)
+ begin_token_list(every_vbox_par, every_vbox_text);
+}
+
+@ @c
+static void run_math_style (void) {
+ tail_append(new_style((small_number) cur_chr));
+}
+
+@ @c
+static void run_non_script (void) {
+ tail_append(new_glue(zero_glue));
+ subtype(tail) = cond_math_glue;
+}
+
+@ @c
+static void run_math_choice (void) {
+ if (cur_chr == 0)
+ append_choices();
+ else
+ setup_math_style();
+}
+
+@ @c
+static void run_math_shift (void) {
+ if (cur_group == math_shift_group)
+ after_math();
+ else
+ off_save();
+}
+
+@ @c
+static void run_after_assignment (void) {
+ get_token();
+ after_token = cur_tok;
+}
+
+@ @c
+static void run_after_group (void) {
+ get_token();
+ save_for_after(cur_tok);
+}
+
+@ @c
+static void run_extension (void) {
+ do_extension(0);
+}
+
+static void run_normal (void) {
+{
+ switch (cur_chr) {
+ case save_pos_code:
+ new_whatsit(save_pos_node);
+ break;
+ case save_cat_code_table_code:
+ scan_int();
+ if ((cur_val < 0) || (cur_val > 0x7FFF)) {
+ print_err("Invalid \\catcode table");
+ help1("All \\catcode table ids must be between 0 and 0x7FFF");
+ error();
+ } else {
+ if (cur_val == cat_code_table_par) {
+ print_err("Invalid \\catcode table");
+ help1("You cannot overwrite the current \\catcode table");
+ error();
+ } else {
+ copy_cat_codes(cat_code_table_par, cur_val);
+ }
+ }
+ break;
+ case init_cat_code_table_code:
+ scan_int();
+ if ((cur_val < 0) || (cur_val > 0x7FFF)) {
+ print_err("Invalid \\catcode table");
+ help1("All \\catcode table ids must be between 0 and 0x7FFF");
+ error();
+ } else {
+ if (cur_val == cat_code_table_par) {
+ print_err("Invalid \\catcode table");
+ help1("You cannot overwrite the current \\catcode table");
+ error();
+ } else {
+ initex_cat_codes(cur_val);
+ }
+ }
+ break;
+ case set_random_seed_code:
+ /* Negative random seed values are silently converted to positive ones */
+ scan_int();
+ if (cur_val < 0)
+ negate(cur_val);
+ random_seed = cur_val;
+ init_randoms(random_seed);
+ break;
+ case late_lua_code:
+ new_whatsit(late_lua_node); /* type == normal */
+ late_lua_name(tail) = scan_lua_state();
+ (void) scan_toks(false, false);
+ late_lua_data(tail) = def_ref;
+ break;
+ case expand_font_code:
+ read_expand_font();
+ break;
+ default:
+ confusion("int1");
+ break;
+ }
+ }
+}
+
+/*
+ this is experimental and not used for production, only for testing and writing
+ macros (some options stay)
+
+*/
+
+#define mathoption_set_int(A) \
+ scan_int(); \
+ word_define(mathoption_int_base+A, cur_val);
+
+static void run_option(void) {
+ int a = 0 ;
+ switch (cur_chr) {
+ case math_option_code:
+ if (scan_keyword("old")) {
+ mathoption_set_int(c_mathoption_old_code);
+ } else if (scan_keyword("noitaliccompensation")) {
+ mathoption_set_int(c_mathoption_no_italic_compensation_code);
+ } else if (scan_keyword("nocharitalic")) {
+ mathoption_set_int(c_mathoption_no_char_italic_code);
+ } else if (scan_keyword("useoldfractionscaling")) {
+ mathoption_set_int(c_mathoption_use_old_fraction_scaling_code);
+ } else if (scan_keyword("umathcodemeaning")) {
+ mathoption_set_int(c_mathoption_umathcode_meaning_code);
+ } else {
+ normal_warning("mathoption","unknown key");
+ }
+ break;
+ default:
+ /* harmless */
+ break;
+ }
+}
+
+@ For mode-independent commands, the following macro is useful.
+
+Also, there is a list of cases where the user has probably gotten into or out of math
+mode by mistake. \TeX\ will insert a dollar sign and rescan the current token, and
+it makes sense ot have a macro for that as well.
+
+@c
+#define any_mode(A,B) jump_table[vmode+(A)]=B; jump_table[hmode+(A)]=B; jump_table[mmode+(A)]=B
+#define non_math(A,B) jump_table[vmode+(A)]=B; jump_table[hmode+(A)]=B;
+
+
+@ The |main_control| uses a jump table, and |init_main_control| sets that table up.
+@c
+typedef void (*main_control_function) (void);
+main_control_function *jump_table;
+
+static void init_main_control (void) {
+ jump_table = xmalloc((mmode+max_command_cmd+1) * sizeof(main_control_function)) ;
+
+ jump_table[hmode + char_num_cmd] = run_char_num;
+ jump_table[hmode + letter_cmd] = run_char;
+ jump_table[hmode + other_char_cmd] = run_char;
+ jump_table[hmode + char_given_cmd] = run_char;
+ jump_table[hmode + spacer_cmd] = run_app_space;
+ jump_table[hmode + ex_space_cmd] = run_app_space;
+ jump_table[mmode + ex_space_cmd] = run_app_space;
+ jump_table[hmode + boundary_cmd] = run_boundary;
+ jump_table[hmode + char_ghost_cmd] = run_char_ghost;
+ jump_table[mmode + char_ghost_cmd] = run_char_ghost;
+ any_mode(relax_cmd, run_relax);
+ jump_table[vmode + spacer_cmd] = run_relax;
+ jump_table[mmode + spacer_cmd] = run_relax;
+ jump_table[mmode + boundary_cmd] = run_relax;
+ any_mode(ignore_spaces_cmd,run_ignore_spaces);
+ jump_table[vmode + stop_cmd] = run_stop;
+ jump_table[vmode + math_char_num_cmd] = run_non_math_math;
+ jump_table[vmode + math_given_cmd] = run_non_math_math;
+ jump_table[vmode + xmath_given_cmd] = run_non_math_math;
+ jump_table[hmode + math_char_num_cmd] = run_math_char_num;
+ jump_table[hmode + math_given_cmd] = run_math_given;
+ jump_table[hmode + xmath_given_cmd] = run_xmath_given;
+
+ jump_table[vmode + vmove_cmd] = report_illegal_case;
+ jump_table[hmode + hmove_cmd] = report_illegal_case;
+ jump_table[mmode + hmove_cmd] = report_illegal_case;
+ any_mode(last_item_cmd, report_illegal_case);
+ jump_table[vmode + vadjust_cmd] = report_illegal_case;
+ jump_table[vmode + ital_corr_cmd] = report_illegal_case;
+ non_math(eq_no_cmd,report_illegal_case);
+ any_mode(mac_param_cmd,report_illegal_case);
+
+ non_math(sup_mark_cmd, insert_dollar_sign);
+ non_math(sub_mark_cmd, insert_dollar_sign);
+ non_math(super_sub_script_cmd, insert_dollar_sign);
+ non_math(math_comp_cmd, insert_dollar_sign);
+ non_math(delim_num_cmd, insert_dollar_sign);
+ non_math(left_right_cmd, insert_dollar_sign);
+ non_math(above_cmd, insert_dollar_sign);
+ non_math(radical_cmd, insert_dollar_sign);
+ non_math(math_style_cmd, insert_dollar_sign);
+ non_math(math_choice_cmd, insert_dollar_sign);
+ non_math(vcenter_cmd, insert_dollar_sign);
+ non_math(non_script_cmd, insert_dollar_sign);
+ non_math(mkern_cmd, insert_dollar_sign);
+ non_math(limit_switch_cmd, insert_dollar_sign);
+ non_math(mskip_cmd, insert_dollar_sign);
+ non_math(math_accent_cmd, insert_dollar_sign);
+ jump_table[mmode + endv_cmd] = insert_dollar_sign;
+ jump_table[mmode + par_end_cmd] = insert_dollar_sign_par_end;
+ jump_table[mmode + stop_cmd] = insert_dollar_sign;
+ jump_table[mmode + vskip_cmd] = insert_dollar_sign;
+ jump_table[mmode + un_vbox_cmd] = insert_dollar_sign;
+ jump_table[mmode + valign_cmd] = insert_dollar_sign;
+ jump_table[mmode + hrule_cmd] = insert_dollar_sign;
+ jump_table[mmode + no_hrule_cmd] = insert_dollar_sign;
+ jump_table[vmode + hrule_cmd] = run_rule;
+ jump_table[vmode + no_hrule_cmd] = run_rule;
+ jump_table[hmode + vrule_cmd] = run_rule;
+ jump_table[hmode + no_vrule_cmd] = run_rule;
+ jump_table[mmode + vrule_cmd] = run_rule;
+ jump_table[mmode + no_vrule_cmd] = run_rule;
+ jump_table[vmode + vskip_cmd] = append_glue;
+ jump_table[hmode + hskip_cmd] = append_glue;
+ jump_table[mmode + hskip_cmd] = append_glue;
+ jump_table[mmode + mskip_cmd] = append_glue;
+ any_mode(kern_cmd, append_kern);
+ jump_table[mmode + mkern_cmd] = append_kern;
+ non_math(left_brace_cmd, run_left_brace);
+ any_mode(begin_group_cmd,run_begin_group);
+ any_mode(end_group_cmd, run_end_group);
+ any_mode(right_brace_cmd, handle_right_brace);
+ jump_table[vmode + hmove_cmd] = run_move;
+ jump_table[hmode + vmove_cmd] = run_move;
+ jump_table[mmode + vmove_cmd] = run_move;
+ any_mode(leader_ship_cmd, run_leader_ship);
+ any_mode(make_box_cmd, run_make_box);
+ any_mode(assign_box_dir_cmd, run_box_dir);
+ jump_table[vmode + start_par_cmd] = run_start_par_vmode;
+ jump_table[hmode + start_par_cmd] = run_start_par;
+ jump_table[mmode + start_par_cmd] = run_start_par;
+ jump_table[vmode + letter_cmd] = run_new_graf;
+ jump_table[vmode + other_char_cmd] = run_new_graf;
+ jump_table[vmode + char_num_cmd] = run_new_graf;
+ jump_table[vmode + char_given_cmd] = run_new_graf;
+ jump_table[vmode + char_ghost_cmd] = run_new_graf;
+ jump_table[vmode + math_shift_cmd] = run_new_graf;
+ jump_table[vmode + math_shift_cs_cmd] = run_new_graf;
+ jump_table[vmode + un_hbox_cmd] = run_new_graf;
+ jump_table[vmode + vrule_cmd] = run_new_graf;
+ jump_table[vmode + no_vrule_cmd] = run_new_graf;
+ jump_table[vmode + accent_cmd] = run_new_graf;
+ jump_table[vmode + discretionary_cmd] = run_new_graf;
+ jump_table[vmode + hskip_cmd] = run_new_graf;
+ jump_table[vmode + valign_cmd] = run_new_graf;
+ jump_table[vmode + ex_space_cmd] = run_new_graf;
+ jump_table[vmode + boundary_cmd] = run_new_graf;
+ jump_table[vmode + par_end_cmd] = run_par_end_vmode;
+ jump_table[hmode + par_end_cmd] = run_par_end_hmode;
+ jump_table[hmode + stop_cmd] = head_for_vmode;
+ jump_table[hmode + vskip_cmd] = head_for_vmode;
+ jump_table[hmode + hrule_cmd] = head_for_vmode;
+ jump_table[hmode + no_hrule_cmd] = head_for_vmode;
+ jump_table[hmode + un_vbox_cmd] = head_for_vmode;
+ jump_table[hmode + halign_cmd] = head_for_vmode;
+ any_mode(insert_cmd,begin_insert_or_adjust);
+ jump_table[hmode + vadjust_cmd] = begin_insert_or_adjust;
+ jump_table[mmode + vadjust_cmd] = begin_insert_or_adjust;
+ any_mode(mark_cmd, handle_mark);
+ any_mode(break_penalty_cmd, append_penalty);
+ any_mode(remove_item_cmd, delete_last);
+ jump_table[vmode + un_vbox_cmd] = unpackage;
+ jump_table[hmode + un_hbox_cmd] = unpackage;
+ jump_table[mmode + un_hbox_cmd] = unpackage;
+ jump_table[hmode + ital_corr_cmd] = append_italic_correction;
+ jump_table[mmode + ital_corr_cmd] = append_italic_correction_mmode;
+ jump_table[hmode + discretionary_cmd] = append_discretionary;
+ jump_table[mmode + discretionary_cmd] = append_discretionary;
+ any_mode(assign_local_box_cmd, run_local_box);
+ jump_table[hmode + accent_cmd] = make_accent;
+ any_mode(car_ret_cmd,align_error);
+ any_mode(tab_mark_cmd,align_error);
+ any_mode(no_align_cmd,no_align_error);
+ any_mode(omit_cmd, omit_error);
+ jump_table[vmode + halign_cmd] = init_align;
+ jump_table[hmode + valign_cmd] = init_align;
+ jump_table[mmode + halign_cmd] = run_halign_mmode;
+ jump_table[vmode + endv_cmd] = do_endv;
+ jump_table[hmode + endv_cmd] = do_endv;
+ any_mode(end_cs_name_cmd, cs_error);
+ jump_table[hmode + math_shift_cmd] = init_math;
+ jump_table[hmode + math_shift_cs_cmd] = init_math;
+ jump_table[mmode + eq_no_cmd] = run_eq_no;
+ jump_table[mmode + left_brace_cmd] = math_left_brace;
+ jump_table[mmode + letter_cmd] = run_letter_mmode;
+ jump_table[mmode + other_char_cmd] = run_letter_mmode;
+ jump_table[mmode + char_given_cmd] = run_letter_mmode;
+ jump_table[mmode + char_num_cmd] = run_char_num_mmode;
+ jump_table[mmode + math_char_num_cmd] = run_math_char_num_mmode;
+ jump_table[mmode + math_given_cmd] = run_math_given_mmode;
+ jump_table[mmode + xmath_given_cmd] = run_xmath_given_mmode;
+ jump_table[mmode + delim_num_cmd] = run_delim_num;
+ jump_table[mmode + math_comp_cmd] = math_math_comp;
+ jump_table[mmode + limit_switch_cmd] = math_limit_switch;
+ jump_table[mmode + radical_cmd] = math_radical;
+ jump_table[mmode + accent_cmd] = math_ac;
+ jump_table[mmode + math_accent_cmd] = math_ac;
+ jump_table[mmode + vcenter_cmd] = run_vcenter;
+ jump_table[mmode + math_style_cmd] = run_math_style;
+ jump_table[mmode + non_script_cmd] = run_non_script;
+ jump_table[mmode + math_choice_cmd] = run_math_choice;
+ jump_table[mmode + above_cmd] = math_fraction;
+ jump_table[mmode + sub_mark_cmd] = sub_sup;
+ jump_table[mmode + sup_mark_cmd] = sub_sup;
+ jump_table[mmode + super_sub_script_cmd] = sub_sup;
+ jump_table[mmode + left_right_cmd] = math_left_right;
+ jump_table[mmode + math_shift_cmd] = run_math_shift;
+ jump_table[mmode + math_shift_cs_cmd] = run_math_shift;
+ any_mode(toks_register_cmd, prefixed_command);
+ any_mode(assign_toks_cmd, prefixed_command);
+ any_mode(assign_int_cmd, prefixed_command);
+ any_mode(assign_attr_cmd, prefixed_command);
+ any_mode(assign_dir_cmd, prefixed_command);
+ any_mode(assign_dimen_cmd, prefixed_command);
+ any_mode(assign_glue_cmd, prefixed_command);
+ any_mode(assign_mu_glue_cmd, prefixed_command);
+ any_mode(assign_font_dimen_cmd, prefixed_command);
+ any_mode(assign_font_int_cmd, prefixed_command);
+ any_mode(set_aux_cmd, prefixed_command);
+ any_mode(set_prev_graf_cmd, prefixed_command);
+ any_mode(set_page_dimen_cmd, prefixed_command);
+ any_mode(set_page_int_cmd, prefixed_command);
+ any_mode(set_box_dimen_cmd, prefixed_command);
+ any_mode(set_tex_shape_cmd, prefixed_command);
+ any_mode(set_etex_shape_cmd, prefixed_command);
+ any_mode(def_char_code_cmd, prefixed_command);
+ any_mode(def_del_code_cmd, prefixed_command);
+ any_mode(extdef_math_code_cmd, prefixed_command);
+ any_mode(extdef_del_code_cmd, prefixed_command);
+ any_mode(def_family_cmd, prefixed_command);
+ any_mode(set_math_param_cmd, prefixed_command);
+ any_mode(set_font_cmd, prefixed_command);
+ any_mode(def_font_cmd, prefixed_command);
+ any_mode(letterspace_font_cmd, prefixed_command);
+ any_mode(copy_font_cmd, prefixed_command);
+ any_mode(set_font_id_cmd, prefixed_command);
+ any_mode(register_cmd, prefixed_command);
+ any_mode(advance_cmd, prefixed_command);
+ any_mode(multiply_cmd, prefixed_command);
+ any_mode(divide_cmd, prefixed_command);
+ any_mode(prefix_cmd, prefixed_command);
+ any_mode(let_cmd, prefixed_command);
+ any_mode(shorthand_def_cmd, prefixed_command);
+ any_mode(read_to_cs_cmd, prefixed_command);
+ any_mode(def_cmd, prefixed_command);
+ any_mode(set_box_cmd, prefixed_command);
+ any_mode(hyph_data_cmd, prefixed_command);
+ any_mode(set_interaction_cmd, prefixed_command);
+ any_mode(after_assignment_cmd,run_after_assignment);
+ any_mode(after_group_cmd,run_after_group);
+ any_mode(in_stream_cmd,open_or_close_in);
+ any_mode(message_cmd,issue_message);
+ any_mode(case_shift_cmd, shift_case);
+ any_mode(xray_cmd, show_whatever);
+ any_mode(normal_cmd, run_normal);
+ any_mode(extension_cmd, run_extension);
+ any_mode(option_cmd, run_option);
+}
+
+@ And here is |main_control| itself. It is quite short nowadays.
+
+@c
+void main_control(void)
+{
+ main_control_state = goto_next;
+ init_main_control () ;
+
+ if (equiv(every_job_loc) != null)
+ begin_token_list(equiv(every_job_loc), every_job_text);
+
+ while (1) {
+ if (main_control_state == goto_skip_token)
+ main_control_state = goto_next; /* reset */
+ else
+ get_x_token();
+
+ /* Give diagnostic information, if requested */
+ /* When a new token has just been fetched at |big_switch|, we have an
+ ideal place to monitor \TeX's activity. */
+ if (interrupt != 0 && OK_to_interrupt) {
+ back_input();
+ check_interrupt();
+ continue;
+ }
+ if (tracing_commands_par > 0)
+ show_cur_cmd_chr();
+
+ (jump_table[(abs(mode) + cur_cmd)])(); /* run the command */
+
+ if (main_control_state == goto_return) {
+ return;
+ }
+ }
+ return; /* not reached */
+}
+
+@ @c
+void app_space(void)
+{ /* handle spaces when |space_factor<>1000| */
+ halfword q; /* glue node */
+ if ((space_factor_par >= 2000) && (! glue_is_zero(xspace_skip_par))) {
+ q = new_param_glue(xspace_skip_code);
+ /* so from now we have a subtype with spaces: */
+ subtype(q) = xspace_skip_code + 1;
+ } else {
+ if (!glue_is_zero(space_skip_par)) {
+ q = new_glue(space_skip_par);
+ } else {
+ q = new_glue(zero_glue);
+ width(q) = space(cur_font_par);
+ stretch(q) = space_stretch(cur_font_par);
+ shrink(q) = space_shrink(cur_font_par);
+ }
+ /* Modify the glue specification in |q| according to the space factor */
+ if (space_factor_par >= 2000)
+ width(q) = width(q) + extra_space(cur_font_par);
+ stretch(q) = xn_over_d(stretch(q), space_factor_par, 1000);
+ shrink(q) = xn_over_d(shrink(q), 1000, space_factor_par);
+
+ /* so from now we have a subtype with spaces: */
+ subtype(q) = space_skip_code + 1;
+ }
+ couple_nodes(tail, q);
+ tail = q;
+}
+
+@ @c
+void insert_dollar_sign(void)
+{
+ back_input();
+ cur_tok = math_shift_token + '$';
+ print_err("Missing $ inserted");
+ help2("I've inserted a begin-math/end-math symbol since I think",
+ "you left one out. Proceed, with fingers crossed.");
+ ins_error();
+}
+
+@ We can silently ignore \.{\\par}s in a math formula.
+
+@c
+void insert_dollar_sign_par_end(void)
+{
+ if (!suppress_mathpar_error_par) {
+ insert_dollar_sign() ;
+ }
+}
+
+@ The `|you_cant|' procedure prints a line saying that the current command
+is illegal in the current mode; it identifies these things symbolically.
+
+@c
+void you_cant(void)
+{
+ print_err("You can't use `");
+ print_cmd_chr((quarterword) cur_cmd, cur_chr);
+ print_in_mode(mode);
+}
+
+@
+When erroneous situations arise, \TeX\ usually issues an error message
+specific to the particular error. For example, `\.{\\noalign}' should
+not appear in any mode, since it is recognized by the |align_peek| routine
+in all of its legitimate appearances; a special error message is given
+when `\.{\\noalign}' occurs elsewhere. But sometimes the most appropriate
+error message is simply that the user is not allowed to do what he or she
+has attempted. For example, `\.{\\moveleft}' is allowed only in vertical mode,
+and `\.{\\lower}' only in non-vertical modes. Such cases are enumerated
+here and in the other sections referred to under `See also \dots.'
+
+@c
+void report_illegal_case(void)
+{
+ you_cant();
+ help4("Sorry, but I'm not programmed to handle this case;",
+ "I'll just pretend that you didn''t ask for it.",
+ "If you're in the wrong mode, you might be able to",
+ "return to the right one by typing `I}' or `I$' or `I\\par'.");
+ error();
+}
+
+@ Some operations are allowed only in privileged modes, i.e., in cases
+that |mode>0|. The |privileged| function is used to detect violations
+of this rule; it issues an error message and returns |false| if the
+current |mode| is negative.
+
+@c
+boolean privileged(void)
+{
+ if (mode > 0) {
+ return true;
+ } else {
+ report_illegal_case();
+ return false;
+ }
+}
+
+@ We don't want to leave |main_control| immediately when a |stop| command
+is sensed, because it may be necessary to invoke an \.{\\output} routine
+several times before things really grind to a halt. (The output routine
+might even say `\.{\\gdef\\end\{...\}}', to prolong the life of the job.)
+Therefore |its_all_over| is |true| only when the current page
+and contribution list are empty, and when the last output was not a
+``dead cycle.''
+
+@c
+boolean its_all_over(void)
+{ /* do this when \.{\\end} or \.{\\dump} occurs */
+ if (privileged()) {
+ if ((page_head == page_tail) && (head == tail) && (dead_cycles == 0)) {
+ return true;
+ }
+ back_input(); /* we will try to end again after ejecting residual material */
+ tail_append(new_null_box());
+ width(tail) = hsize_par;
+ tail_append(new_glue(fill_glue));
+ tail_append(new_penalty(-010000000000));
+ normal_page_filter(end);
+ build_page(); /* append \.{\\hbox to \\hsize\{\}\\vfill\\penalty-'10000000000} */
+ }
+ return false;
+}
+
+
+@ The |hskip| and |vskip| command codes are used for control sequences
+like \.{\\hss} and \.{\\vfil} as well as for \.{\\hskip} and \.{\\vskip}.
+The difference is in the value of |cur_chr|.
+
+All the work relating to glue creation has been relegated to the
+following subroutine. It does not call |build_page|, because it is
+used in at least one place where that would be a mistake.
+
+@c
+void append_glue(void)
+{
+ int s = cur_chr;
+ switch (s) {
+ case fil_code:
+ cur_val = new_glue(fil_glue);
+ break;
+ case fill_code:
+ cur_val = new_glue(fill_glue);
+ break;
+ case ss_code:
+ cur_val = new_glue(ss_glue);
+ break;
+ case fil_neg_code:
+ cur_val = new_glue(fil_neg_glue);
+ break;
+ case skip_code:
+ scan_glue(glue_val_level);
+ break;
+ case mskip_code:
+ scan_glue(mu_val_level);
+ break;
+ }
+ /* now |cur_val| points to the glue specification */
+ tail_append(new_glue(cur_val));
+ flush_node(cur_val);
+ if (s > skip_code) {
+ subtype(tail) = mu_glue;
+ }
+}
+
+@ @c
+void append_kern(void)
+{
+ int s; /* |subtype| of the kern node */
+ s = cur_chr;
+ scan_dimen((s == mu_glue), false, false);
+ tail_append(new_kern(cur_val));
+ subtype(tail) = (quarterword) s;
+}
+
+@ We have to deal with errors in which braces and such things are not
+properly nested. Sometimes the user makes an error of commission by
+inserting an extra symbol, but sometimes the user makes an error of omission.
+\TeX\ can't always tell one from the other, so it makes a guess and tries
+to avoid getting into a loop.
+
+The |off_save| routine is called when the current group code is wrong. It tries
+to insert something into the user's input that will help clean off
+the top level.
+
+@c
+void off_save(void)
+{
+ halfword p, q; /* inserted token */
+ if (cur_group == bottom_level) {
+ /* Drop current token and complain that it was unmatched */
+ print_err("Extra ");
+ print_cmd_chr((quarterword) cur_cmd, cur_chr);
+ help1("Things are pretty mixed up, but I think the worst is over.");
+ error();
+
+ } else {
+ back_input();
+ p = get_avail();
+ set_token_link(temp_token_head, p);
+ print_err("Missing ");
+ /* Prepare to insert a token that matches |cur_group|, and print what it is */
+ /* At this point, |link(temp_token_head)=p|, a pointer to an empty one-word node. */
+ switch (cur_group) {
+ case semi_simple_group:
+ set_token_info(p, cs_token_flag + frozen_end_group);
+ tprint_esc("endgroup");
+ break;
+ case math_shift_group:
+ set_token_info(p, math_shift_token + '$');
+ print_char('$');
+ break;
+ case math_left_group:
+ set_token_info(p, cs_token_flag + frozen_right);
+ q = get_avail();
+ set_token_link(p, q);
+ p = token_link(p);
+ set_token_info(p, other_token + '.');
+ tprint_esc("right.");
+ break;
+ default:
+ set_token_info(p, right_brace_token + '}');
+ print_char('}');
+ break;
+ }
+ tprint(" inserted");
+ ins_list(token_link(temp_token_head));
+ help5("I've inserted something that you may have forgotten.",
+ "(See the <inserted text> above.)",
+ "With luck, this will get me unwedged. But if you",
+ "really didn't forget anything, try typing `2' now; then",
+ "my insertion and my current dilemma will both disappear.");
+ error();
+ }
+}
+
+@ The routine for a |right_brace| character branches into many subcases,
+since a variety of things may happen, depending on |cur_group|. Some
+types of groups are not supposed to be ended by a right brace; error
+messages are given in hopes of pinpointing the problem. Most branches
+of this routine will be filled in later, when we are ready to understand
+them; meanwhile, we must prepare ourselves to deal with such errors.
+
+@c
+void handle_right_brace(void)
+{
+ halfword p, q; /* for short-term use */
+ scaled d; /* holds |split_max_depth| in |insert_group| */
+ int f; /* holds |floating_penalty| in |insert_group| */
+ p = null;
+ switch (cur_group) {
+ case simple_group:
+ fixup_directions();
+ break;
+ case bottom_level:
+ print_err("Too many }'s");
+ help2("You've closed more groups than you opened.",
+ "Such booboos are generally harmless, so keep going.");
+ error();
+ break;
+ case semi_simple_group:
+ case math_shift_group:
+ case math_left_group:
+ extra_right_brace();
+ break;
+ case hbox_group:
+ /* When the right brace occurs at the end of an \.{\\hbox} or \.{\\vbox} or
+ \.{\\vtop} construction, the |package| routine comes into action. We might
+ also have to finish a paragraph that hasn't ended. */
+ package(0);
+ break;
+ case adjusted_hbox_group:
+ adjust_tail = adjust_head;
+ pre_adjust_tail = pre_adjust_head;
+ package(0);
+ break;
+ case vbox_group:
+ end_graf(vbox_group);
+ package(0);
+ break;
+ case vtop_group:
+ end_graf(vtop_group);
+ package(vtop_code);
+ break;
+ case insert_group:
+ end_graf(insert_group);
+ q = new_glue(split_top_skip_par);
+ d = split_max_depth_par;
+ f = floating_penalty_par;
+ unsave();
+ save_ptr--;
+ /* now |saved_value(0)| is the insertion number, or the |vadjust| subtype */
+ p = vpack(vlink(head), 0, additional, -1);
+ pop_nest();
+ if (saved_type(0) == saved_insert) {
+ tail_append(new_node(ins_node, saved_value(0)));
+ height(tail) = height(p) + depth(p);
+ ins_ptr(tail) = list_ptr(p);
+ split_top_ptr(tail) = q;
+ depth(tail) = d;
+ float_cost(tail) = f;
+ } else if (saved_type(0) == saved_adjust) {
+ tail_append(new_node(adjust_node, saved_value(0)));
+ adjust_ptr(tail) = list_ptr(p);
+ flush_node(q);
+ } else {
+ confusion("insert_group");
+ }
+ list_ptr(p) = null;
+ flush_node(p);
+ if (nest_ptr == 0) {
+ checked_page_filter(insert);
+ build_page();
+ }
+ break;
+ case output_group:
+ /* this is needed in case the \.{\\output} executes a \.{\\textdir} command. */
+ if (dir_level(text_dir_ptr) == cur_level) {
+ /* DIR: Remove from |text_dir_ptr| */
+ halfword text_dir_tmp = vlink(text_dir_ptr);
+ flush_node(text_dir_ptr);
+ text_dir_ptr = text_dir_tmp;
+ }
+ resume_after_output();
+ break;
+ case disc_group:
+ build_discretionary();
+ break;
+ case local_box_group:
+ build_local_box();
+ break;
+ case align_group:
+ back_input();
+ cur_tok = cs_token_flag + frozen_cr;
+ print_err("Missing \\cr inserted");
+ help1("I'm guessing that you meant to end an alignment here.");
+ ins_error();
+ break;
+ case no_align_group:
+ end_graf(no_align_group);
+ unsave();
+ align_peek();
+ break;
+ case vcenter_group:
+ end_graf(vcenter_group);
+ finish_vcenter();
+ break;
+ case math_choice_group:
+ build_choices();
+ break;
+ case math_group:
+ close_math_group(p);
+ break;
+ default:
+ confusion("rightbrace");
+ break;
+ }
+}
+
+@ @c
+void extra_right_brace(void)
+{
+ print_err("Extra }, or forgotten ");
+ switch (cur_group) {
+ case semi_simple_group:
+ tprint_esc("endgroup");
+ break;
+ case math_shift_group:
+ print_char('$');
+ break;
+ case math_left_group:
+ tprint_esc("right");
+ break;
+ }
+ help5("I've deleted a group-closing symbol because it seems to be",
+ "spurious, as in `$x}$'. But perhaps the } is legitimate and",
+ "you forgot something else, as in `\\hbox{$x}'. In such cases",
+ "the way to recover is to insert both the forgotten and the",
+ "deleted material, e.g., by typing `I$}'.");
+ error();
+ incr(align_state);
+}
+
+@ Here is where we clear the parameters that are supposed to revert to their
+default values after every paragraph and when internal vertical mode is entered.
+
+@c
+void normal_paragraph(void)
+{
+ if (looseness_par != 0)
+ eq_word_define(int_base + looseness_code, 0);
+ if (hang_indent_par != 0)
+ eq_word_define(dimen_base + hang_indent_code, 0);
+ if (hang_after_par != 1)
+ eq_word_define(int_base + hang_after_code, 1);
+ if (par_shape_par_ptr != null)
+ eq_define(par_shape_loc, shape_ref_cmd, null);
+ if (inter_line_penalties_par_ptr != null)
+ eq_define(inter_line_penalties_loc, shape_ref_cmd, null);
+ if (shape_mode_par > 0)
+ eq_word_define(dimen_base + shape_mode_code, 0);
+}
+
+@ The global variable |cur_box| will point to a newly-made box. If the box
+is void, we will have |cur_box=null|. Otherwise we will have
+|type(cur_box)=hlist_node| or |vlist_node| or |rule_node|; the |rule_node|
+case can occur only with leaders.
+
+@c
+halfword cur_box; /* box to be placed into its context */
+
+@ The |box_end| procedure does the right thing with |cur_box|, if
+|box_context| represents the context as explained above.
+
+@c
+void box_end(int box_context)
+{
+ if (box_context < box_flag) {
+ /* Append box |cur_box| to the current list, shifted by |box_context| */
+ /*
+ The global variable |adjust_tail| will be non-null if and only if the
+ current box might include adjustments that should be appended to the
+ current vertical list.
+ */
+ if (cur_box != null) {
+ shift_amount(cur_box) = box_context;
+ if (abs(mode) == vmode) {
+ if (pre_adjust_tail != null) {
+ if (pre_adjust_head != pre_adjust_tail)
+ append_list(pre_adjust_head, pre_adjust_tail);
+ pre_adjust_tail = null;
+ }
+ append_to_vlist(cur_box,lua_key_index(box));
+ if (adjust_tail != null) {
+ if (adjust_head != adjust_tail)
+ append_list(adjust_head, adjust_tail);
+ adjust_tail = null;
+ }
+ if (mode > 0) {
+ checked_page_filter(box);
+ build_page();
+ }
+ } else {
+ if (abs(mode) == hmode)
+ space_factor_par = 1000;
+ else
+ cur_box = new_sub_box(cur_box);
+ couple_nodes(tail, cur_box);
+ tail = cur_box;
+ }
+ }
+ } else if (box_context < ship_out_flag) {
+ /* Store |cur_box| in a box register */
+ if (box_context < global_box_flag)
+ eq_define(box_base + box_context - box_flag, box_ref_cmd, cur_box);
+ else
+ geq_define(box_base + box_context - global_box_flag, box_ref_cmd, cur_box);
+ } else if (cur_box != null) {
+ if (box_context > ship_out_flag) {
+ /* Append a new leader node that uses |cur_box| */
+ /* Get the next non-blank non-relax... */
+ do {
+ get_x_token();
+ } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
+ if (((cur_cmd == hskip_cmd) && (abs(mode) != vmode)) ||
+ ((cur_cmd == vskip_cmd) && (abs(mode) == vmode))) {
+ append_glue();
+ subtype(tail) = (quarterword) (box_context - (leader_flag - a_leaders));
+ leader_ptr(tail) = cur_box;
+ } else {
+ print_err("Leaders not followed by proper glue");
+ help3
+ ("You should say `\\leaders <box or rule><hskip or vskip>'.",
+ "I found the <box or rule>, but there's no suitable",
+ "<hskip or vskip>, so I'm ignoring these leaders.");
+ back_error();
+ flush_node_list(cur_box);
+ }
+ } else {
+ ship_out(static_pdf, cur_box, SHIPPING_PAGE);
+ }
+ }
+}
+
+@ the next input should specify a box or perhaps a rule
+
+@c
+void scan_box(int box_context)
+{
+ /* Get the next non-blank non-relax... */
+ do {
+ get_x_token();
+ } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
+ if (cur_cmd == make_box_cmd) {
+ begin_box(box_context);
+ } else if ((box_context >= leader_flag) &&
+ ((cur_cmd == hrule_cmd) || (cur_cmd == vrule_cmd) ||
+ (cur_cmd == no_hrule_cmd) || (cur_cmd == no_vrule_cmd))) {
+ cur_box = scan_rule_spec();
+ box_end(box_context);
+ } else {
+ print_err("A <box> was supposed to be here");
+ help3("I was expecting to see \\hbox or \\vbox or \\copy or \\box or",
+ "something like that. So you might find something missing in",
+ "your output. But keep trying; you can fix this later.");
+ back_error();
+ }
+}
+
+@ @c
+void new_graf(boolean indented)
+{
+ halfword p, q, dir_graf_tmp;
+ halfword dir_rover;
+ prev_graf_par = 0;
+ if ((mode == vmode) || (head != tail)) {
+ tail_append(new_param_glue(par_skip_code));
+ }
+ push_nest();
+ mode = hmode;
+ space_factor_par = 1000;
+ /* LOCAL: Add local paragraph node */
+ tail_append(make_local_par_node(new_graf_par_code));
+ if (indented) {
+ p = new_null_box();
+ box_dir(p) = par_direction_par;
+ width(p) = par_indent_par;
+ subtype(p) = indent_list;
+ q = tail;
+ tail_append(p);
+ } else {
+ q = tail;
+ }
+ dir_rover = text_dir_ptr;
+ while (dir_rover != null) {
+ if ((vlink(dir_rover) != null) || (dir_dir(dir_rover) != par_direction_par)) {
+ dir_graf_tmp = new_dir(dir_dir(dir_rover));
+ try_couple_nodes(dir_graf_tmp,vlink(q));
+ couple_nodes(q,dir_graf_tmp);
+ }
+ dir_rover = vlink(dir_rover);
+ }
+ q = head;
+ while (vlink(q) != null)
+ q = vlink(q);
+ tail = q;
+ if (every_par_par != null)
+ begin_token_list(every_par_par, every_par_text);
+ if (nest_ptr == 1) {
+ checked_page_filter(new_graf);
+ build_page(); /* put |par_skip| glue on current page */
+ }
+}
+
+@ @c
+void indent_in_hmode(void)
+{
+ halfword p;
+ if (cur_chr > 0) { /* \.{\\indent} */
+ p = new_null_box();
+ width(p) = par_indent_par;
+ if (abs(mode) == hmode)
+ space_factor_par = 1000;
+ else
+ p = new_sub_box(p);
+ tail_append(p);
+ }
+}
+
+@ @c
+void head_for_vmode(void)
+{
+ if (mode < 0) {
+ if ((cur_cmd != hrule_cmd) && (cur_cmd != no_hrule_cmd)) {
+ off_save();
+ } else {
+ print_err("You can't use `\\hrule' here except with leaders");
+ help2("To put a horizontal rule in an hbox or an alignment,",
+ "you should use \\leaders or \\hrulefill (see The TeXbook).");
+ error();
+ }
+ } else {
+ back_input();
+ cur_tok = par_token;
+ back_input();
+ token_type = inserted;
+ }
+}
+
+@ TODO (BUG?): |dir_save| would have been set by |line_break| by means
+of |post_line_break|, but this is not done right now, as it introduces
+pretty heavy memory leaks. This means the current code is probably
+wrong in some way that relates to in-paragraph displays.
+
+@c
+void end_graf(int line_break_context)
+{
+ if (mode == hmode) {
+ if ((head == tail) || (vlink(head) == tail)) {
+ if (vlink(head) == tail)
+ flush_node(vlink(head));
+ pop_nest(); /* null paragraphs are ignored, all contain a |local_paragraph| node */
+ } else {
+ line_break(false, line_break_context);
+ }
+ if (dir_save != null) {
+ flush_node_list(dir_save);
+ dir_save = null;
+ }
+ normal_paragraph();
+ error_count = 0;
+ }
+}
+
+@ @c
+void begin_insert_or_adjust(void)
+{
+ if (cur_cmd != vadjust_cmd) {
+ scan_register_num();
+ if (cur_val == output_box_par) {
+ print_err("You can't \\insert");
+ print_int(output_box_par);
+ help1("I'm changing to \\insert0; box \\outputbox is special.");
+ error();
+ cur_val = 0;
+ }
+ set_saved_record(0, saved_insert, 0, cur_val);
+ } else if (scan_keyword("pre")) {
+ set_saved_record(0, saved_adjust, 0, 1);
+ } else {
+ set_saved_record(0, saved_adjust, 0, 0);
+ }
+ save_ptr++;
+ new_save_level(insert_group);
+ scan_left_brace();
+ normal_paragraph();
+ push_nest();
+ mode = -vmode;
+ prev_depth_par = ignore_depth;
+}
+
+@ I (TH)'ve renamed the |make_mark| procedure to this, because if the
+current chr code is 1, then the actual command was \.{\\clearmarks},
+which does not generate a mark node but instead destroys the current
+mark tokenlists.
+
+@c
+void handle_mark(void)
+{
+ halfword p; /* new node */
+ halfword c; /* the mark class */
+ if (cur_chr == clear_marks_code) {
+ scan_mark_num();
+ c = cur_val;
+ delete_top_mark(c);
+ delete_bot_mark(c);
+ delete_first_mark(c);
+ delete_split_first_mark(c);
+ delete_split_bot_mark(c);
+ } else {
+ if (cur_chr == 0) {
+ c = 0;
+ } else {
+ scan_mark_num();
+ c = cur_val;
+ if (c > biggest_used_mark)
+ biggest_used_mark = c;
+ }
+ p = scan_toks(false, true);
+ p = new_node(mark_node, 0); /* the |subtype| is not used */
+ mark_class(p) = c;
+ mark_ptr(p) = def_ref;
+ couple_nodes(tail, p);
+ tail = p;
+ }
+}
+
+@ @c
+void append_penalty(void)
+{
+ scan_int();
+ tail_append(new_penalty(cur_val));
+ if (mode == vmode) {
+ checked_page_filter(penalty);
+ build_page();
+ }
+}
+
+@ When |delete_last| is called, |cur_chr| is the |type| of node that
+will be deleted, if present.
+
+The |remove_item| command removes a penalty, kern, or glue node if it
+appears at the tail of the current list, using a brute-force linear scan.
+Like \.{\\lastbox}, this command is not allowed in vertical mode (except
+internal vertical mode), since the current list in vertical mode is sent
+to the page builder. But if we happen to be able to implement it in
+vertical mode, we do.
+
+@c
+void delete_last(void)
+{
+ halfword p, q; /* run through the current list */
+ if ((mode == vmode) && (tail == head)) {
+ /* Apologize for inability to do the operation now,
+ unless \.{\\unskip} follows non-glue */
+ if ((cur_chr != glue_node) || (last_glue != max_halfword)) {
+ you_cant();
+ if (cur_chr == kern_node) {
+ help2
+ ("Sorry...I usually can't take things from the current page.",
+ "Try `I\\kern-\\lastkern' instead.");
+ } else if (cur_chr != glue_node) {
+ help2
+ ("Sorry...I usually can't take things from the current page.",
+ "Perhaps you can make the output routine do it.");
+ } else {
+ help2
+ ("Sorry...I usually can't take things from the current page.",
+ "Try `I\\vskip-\\lastskip' instead.");
+ }
+ error();
+ }
+ } else {
+ /* todo: clean this up */
+ if (!is_char_node(tail)) {
+ if (type(tail) == cur_chr) {
+ q = head;
+ do {
+ p = q;
+ if (!is_char_node(q)) {
+ if (type(q) == disc_node) {
+ if (p == tail)
+ return;
+ }
+ }
+ q = vlink(p);
+ } while (q != tail);
+ vlink(p) = null;
+ flush_node_list(tail);
+ tail = p;
+ }
+ }
+ }
+}
+
+@ @c
+void unpackage(void)
+{
+ halfword p; /* the box */
+ halfword r; /* to remove marginal kern nodes */
+ int c; /* should we copy? */
+ halfword s; /* for varmem assignment */
+ if (cur_chr > copy_code) {
+ /* Handle saved items and |goto done| */
+ try_couple_nodes(tail, disc_ptr[cur_chr]);
+ disc_ptr[cur_chr] = null;
+ goto DONE;
+ }
+ c = cur_chr;
+ scan_register_num();
+ p = box(cur_val);
+ if (p == null)
+ return;
+ if ((abs(mode) == mmode)
+ || ((abs(mode) == vmode) && (type(p) != vlist_node))
+ || ((abs(mode) == hmode) && (type(p) != hlist_node))) {
+ print_err("Incompatible list can't be unboxed");
+ help3("Sorry, Pandora. (You sneaky devil.)",
+ "I refuse to unbox an \\hbox in vertical mode or vice versa.",
+ "And I can't open any boxes in math mode.");
+ error();
+ return;
+ }
+ if (c == copy_code) {
+ s = copy_node_list(list_ptr(p));
+ try_couple_nodes(tail,s);
+ } else {
+ try_couple_nodes(tail,list_ptr(p));
+ box(cur_val) = null;
+ list_ptr(p) = null;
+ flush_node(p);
+ }
+ DONE:
+ while (vlink(tail) != null) {
+ r = vlink(tail);
+ if (!is_char_node(r) && (type(r) == margin_kern_node)) {
+ try_couple_nodes(tail,vlink(r));
+ flush_node(r);
+ }
+ tail = vlink(tail);
+ }
+}
+
+@
+Italic corrections are converted to kern nodes when the |ital_corr| command
+follows a character. In math mode the same effect is achieved by appending
+a kern of zero here, since italic corrections are supplied later.
+
+@c
+void append_italic_correction(void)
+{
+ halfword p; /* |char_node| at the tail of the current list */
+ internal_font_number f; /* the font in the |char_node| */
+ if (tail != head) {
+ if (is_char_node(tail))
+ p = tail;
+ else
+ return;
+ f = font(p);
+ tail_append(new_kern(char_italic(f, character(p))));
+ subtype(tail) = italic_kern;
+ }
+}
+
+@ @c
+void append_local_box(int kind)
+{
+ incr(save_ptr);
+ set_saved_record(-1, saved_boxtype, 0, kind);
+ new_save_level(local_box_group);
+ scan_left_brace();
+ push_nest();
+ mode = -hmode;
+ space_factor_par = 1000;
+}
+
+@ Discretionary nodes are easy in the common case `\.{\\-}', but in the
+general case we must process three braces full of items.
+
+The space factor does not change when we append a discretionary node,
+but it starts out as 1000 in the subsidiary lists.
+
+@c
+void append_discretionary(void)
+{
+ int c;
+ tail_append(new_disc());
+ subtype(tail) = (quarterword) cur_chr;
+ if (cur_chr == explicit_disc) {
+ /* \- */
+ c = get_pre_hyphen_char(cur_lang_par);
+ if (c != 0) {
+ vlink(pre_break(tail)) = new_char(equiv(cur_font_loc), c);
+ alink(vlink(pre_break(tail))) = pre_break(tail);
+ tlink(pre_break(tail)) = vlink(pre_break(tail));
+ }
+ c = get_post_hyphen_char(cur_lang_par);
+ if (c != 0) {
+ vlink(post_break(tail)) = new_char(equiv(cur_font_loc), c);
+ alink(vlink(post_break(tail))) = post_break(tail);
+ tlink(post_break(tail)) = vlink(post_break(tail));
+ }
+ disc_penalty(tail) = ex_hyphen_penalty_par;
+ } else {
+ /* \discretionary */
+ if (scan_keyword("penalty")) {
+ scan_int();
+ disc_penalty(tail) = cur_val;
+ }
+ incr(save_ptr);
+ set_saved_record(-1, saved_disc, 0, 0);
+ new_save_level(disc_group);
+ scan_left_brace();
+ push_nest();
+ mode = -hmode;
+ space_factor_par = 1000;
+ /* already preset: disc_penalty(tail) = hyphen_penalty_par; */
+ }
+}
+
+@ The test for |p != null| ensures that empty \.{\\localleftbox} and
+ \.{\\localrightbox} commands are not applied.
+
+@c
+void build_local_box(void)
+{
+ halfword p;
+ int kind;
+ unsave();
+ assert(saved_type(-1) == saved_boxtype);
+ kind = saved_value(-1);
+ decr(save_ptr);
+ p = vlink(head);
+ pop_nest();
+ if (p != null)
+ p = hpack(p, 0, additional, -1);
+ if (kind == 0)
+ eq_define(local_left_box_base, box_ref_cmd, p);
+ else
+ eq_define(local_right_box_base, box_ref_cmd, p);
+ if (abs(mode) == hmode) {
+ /* LOCAL: Add local paragraph node */
+ tail_append(make_local_par_node(local_box_par_code));
+ }
+ eq_word_define(int_base + no_local_whatsits_code, no_local_whatsits_par + 1);
+}
+
+@ The three discretionary lists are constructed somewhat as if they were
+hboxes. A~subroutine called |build_discretionary| handles the transitions.
+(This is sort of fun.)
+
+@c
+void build_discretionary(void)
+{
+ halfword p, q; /* for link manipulation */
+ int n; /* length of discretionary list */
+ unsave();
+ /* Prune the current list, if necessary, until it contains only
+ |char_node|, |kern_node|, |hlist_node|, |vlist_node| and
+ |rule_node| items; set |n| to the length of the list,
+ and set |q| to the lists tail */
+ /* During this loop, |p=vlink(q)| and there are |n| items preceding |p|. */
+ q = head;
+ p = vlink(q);
+ n = 0;
+ while (p != null) {
+ if (!is_char_node(p) && type(p) > rule_node && type(p) != kern_node) {
+ print_err("Improper discretionary list");
+ help1("Discretionary lists must contain only boxes and kerns.");
+ error();
+ begin_diagnostic();
+ tprint_nl("The following discretionary sublist has been deleted:");
+ show_box(p);
+ end_diagnostic(true);
+ flush_node_list(p);
+ vlink(q) = null;
+ break;
+ }
+ alink(p) = q;
+ q = p;
+ p = vlink(q);
+ incr(n);
+ }
+
+ p = vlink(head);
+ pop_nest();
+ assert(saved_type(-1) == saved_disc);
+ switch (saved_value(-1)) {
+ case 0:
+ if (n > 0) {
+ vlink(pre_break(tail)) = p;
+ alink(p) = pre_break(tail);
+ tlink(pre_break(tail)) = q;
+ }
+ break;
+ case 1:
+ if (n > 0) {
+ vlink(post_break(tail)) = p;
+ alink(p) = post_break(tail);
+ tlink(post_break(tail)) = q;
+ }
+ break;
+ case 2:
+ /* Attach list |p| to the current list, and record its length;
+ then finish up and |return| */
+ if ((n > 0) && (abs(mode) == mmode)) {
+ print_err("Illegal math \\discretionary");
+ help2("Sorry: The third part of a discretionary break must be",
+ "empty, in math formulas. I had to delete your third part.");
+ flush_node_list(p);
+ error();
+ } else {
+ if (n > 0) {
+ vlink(no_break(tail)) = p;
+ alink(p) = no_break(tail);
+ tlink(no_break(tail)) = q;
+ }
+ }
+ decr(save_ptr);
+ return;
+ break;
+ } /* there are no other cases */
+ set_saved_record(-1, saved_disc, 0, (saved_value(-1) + 1));
+ new_save_level(disc_group);
+ scan_left_brace();
+ push_nest();
+ mode = -hmode;
+ space_factor_par = 1000;
+}
+
+@ The positioning of accents is straightforward but tedious. Given an accent
+of width |a|, designed for characters of height |x| and slant |s|;
+and given a character of width |w|, height |h|, and slant |t|: We will shift
+the accent down by |x-h|, and we will insert kern nodes that have the effect of
+centering the accent over the character and shifting the accent to the
+right by $\delta={1\over2}(w-a)+h\cdot t-x\cdot s$. If either character is
+absent from the font, we will simply use the other, without shifting.
+
+@c
+void make_accent(void)
+{
+ double s, t; /* amount of slant */
+ halfword p, q, r; /* character, box, and kern nodes */
+ internal_font_number f; /* relevant font */
+ scaled a, h, x, w, delta; /* heights and widths, as explained above */
+ scan_char_num();
+ f = equiv(cur_font_loc);
+ p = new_glyph(f, cur_val);
+ if (p != null) {
+ x = x_height(f);
+ s = float_cast(slant(f)) / float_constant(65536); /* real division */
+ a = glyph_width(p);
+ do_assignments();
+ /* Create a character node |q| for the next character,
+ but set |q:=null| if problems arise */
+ q = null;
+ f = equiv(cur_font_loc);
+ if ((cur_cmd == letter_cmd) ||
+ (cur_cmd == other_char_cmd) || (cur_cmd == char_given_cmd)) {
+ q = new_glyph(f, cur_chr);
+ } else if (cur_cmd == char_num_cmd) {
+ scan_char_num();
+ q = new_glyph(f, cur_val);
+ } else {
+ back_input();
+ }
+
+ if (q != null) {
+ /* Append the accent with appropriate kerns, then set |p:=q| */
+ /* The kern nodes appended here must be distinguished from other kerns, lest
+ they be wiped away by the hyphenation algorithm or by a previous line break.
+
+ The two kerns are computed with (machine-dependent) |real| arithmetic, but
+ their sum is machine-independent; the net effect is machine-independent,
+ because the user cannot remove these nodes nor access them via \.{\\lastkern}.
+ */
+ t = float_cast(slant(f)) / float_constant(65536); /* real division */
+ w = glyph_width(q);
+ h = glyph_height(q);
+ if (h != x) { /* the accent must be shifted up or down */
+ p = hpack(p, 0, additional, -1);
+ shift_amount(p) = x - h;
+ }
+ delta = round(float_cast(w - a) / float_constant(2) + h * t - x * s); /* real multiplication */
+ r = new_kern(delta);
+ subtype(r) = accent_kern;
+ couple_nodes(tail, r);
+ couple_nodes(r, p);
+ tail = new_kern(-a - delta);
+ subtype(tail) = accent_kern;
+ couple_nodes(p, tail);
+ p = q;
+
+ }
+ couple_nodes(tail, p);
+ tail = p;
+ space_factor_par = 1000;
+ }
+}
+
+@ When `\.{\\cr}' or `\.{\\span}' or a tab mark comes through the scanner
+into |main_control|, it might be that the user has foolishly inserted
+one of them into something that has nothing to do with alignment. But it is
+far more likely that a left brace or right brace has been omitted, since
+|get_next| takes actions appropriate to alignment only when `\.{\\cr}'
+or `\.{\\span}' or tab marks occur with |align_state=0|. The following
+program attempts to make an appropriate recovery.
+
+@c
+void align_error(void)
+{
+ if (abs(align_state) > 2) {
+ /* Express consternation over the fact that no alignment is in progress */
+ print_err("Misplaced ");
+ print_cmd_chr((quarterword) cur_cmd, cur_chr);
+ if (cur_tok == tab_token + '&') {
+ help6("I can't figure out why you would want to use a tab mark",
+ "here. If you just want an ampersand, the remedy is",
+ "simple: Just type `I\\&' now. But if some right brace",
+ "up above has ended a previous alignment prematurely,",
+ "you're probably due for more error messages, and you",
+ "might try typing `S' now just to see what is salvageable.");
+ } else {
+ help5("I can't figure out why you would want to use a tab mark",
+ "or \\cr or \\span just now. If something like a right brace",
+ "up above has ended a previous alignment prematurely,",
+ "you're probably due for more error messages, and you",
+ "might try typing `S' now just to see what is salvageable.");
+ }
+ error();
+
+ } else {
+ back_input();
+ if (align_state < 0) {
+ print_err("Missing { inserted");
+ incr(align_state);
+ cur_tok = left_brace_token + '{';
+ } else {
+ print_err("Missing } inserted");
+ decr(align_state);
+ cur_tok = right_brace_token + '}';
+ }
+ help3("I've put in what seems to be necessary to fix",
+ "the current column of the current alignment.",
+ "Try to go on, since this might almost work.");
+ ins_error();
+ }
+}
+
+@ The help messages here contain a little white lie, since \.{\\noalign}
+and \.{\\omit} are allowed also after `\.{\\noalign\{...\}}'.
+
+@c
+void no_align_error(void)
+{
+ print_err("Misplaced \\noalign");
+ help2("I expect to see \\noalign only after the \\cr of",
+ "an alignment. Proceed, and I'll ignore this case.");
+ error();
+}
+
+void omit_error(void)
+{
+ print_err("Misplaced \\omit");
+ help2("I expect to see \\omit only after tab marks or the \\cr of",
+ "an alignment. Proceed, and I'll ignore this case.");
+ error();
+}
+
+@ We've now covered most of the abuses of \.{\\halign} and \.{\\valign}.
+Let's take a look at what happens when they are used correctly.
+
+An |align_group| code is supposed to remain on the |save_stack|
+during an entire alignment, until |fin_align| removes it.
+
+A devious user might force an |endv| command to occur just about anywhere;
+we must defeat such hacks.
+
+@c
+void do_endv(void)
+{
+ base_ptr = input_ptr;
+ input_stack[base_ptr] = cur_input;
+ while ((input_stack[base_ptr].index_field != v_template) &&
+ (input_stack[base_ptr].loc_field == null) &&
+ (input_stack[base_ptr].state_field == token_list))
+ decr(base_ptr);
+ if ((input_stack[base_ptr].index_field != v_template) ||
+ (input_stack[base_ptr].loc_field != null) ||
+ (input_stack[base_ptr].state_field != token_list))
+ fatal_error("(interwoven alignment preambles are not allowed)");
+ /*.interwoven alignment preambles... */
+ if (cur_group == align_group) {
+ end_graf(align_group);
+ if (fin_col())
+ fin_row();
+ } else {
+ off_save();
+ }
+}
+
+@ Finally, \.{\\endcsname} is not supposed to get through to |main_control|.
+
+@c
+void cs_error(void)
+{
+ print_err("Extra \\endcsname");
+ help1("I'm ignoring this, since I wasn't doing a \\csname.");
+ error();
+}
+
+@
+ Assignments to values in |eqtb| can be global or local. Furthermore, a
+ control sequence can be defined to be `\.{\\long}', `\.{\\protected}',
+ or `\.{\\outer}', and it might or might not be expanded. The prefixes
+ `\.{\\global}', `\.{\\long}', `\.{\\protected}',
+ and `\.{\\outer}' can occur in any order. Therefore we assign binary numeric
+ codes, making it possible to accumulate the union of all specified prefixes
+ by adding the corresponding codes. (PASCAL's |set| operations could also
+ have been used.)
+
+ Every prefix, and every command code that might or might not be prefixed,
+ calls the action procedure |prefixed_command|. This routine accumulates
+ a sequence of prefixes until coming to a non-prefix, then it carries out
+ the command.
+
+@ If the user says, e.g., `\.{\\global\\global}', the redundancy is
+silently accepted.
+
+
+@ The different types of code values have different legal ranges; the
+following program is careful to check each case properly.
+
+@c
+#define check_def_code(A) do { \
+ if (((cur_val<0)&&(p<(A)))||(cur_val>n)) { \
+ print_err("Invalid code ("); \
+ print_int(cur_val); \
+ if (p<(A)) \
+ tprint("), should be in the range 0.."); \
+ else \
+ tprint("), should be at most "); \
+ print_int(n); \
+ help1("I'm going to use 0 instead of that illegal code value."); \
+ error(); \
+ cur_val=0; \
+ } \
+} while (0)
+
+@ @c
+/*
+halfword swap_hang_indent(halfword indentation, halfword shape_mode) {
+ if (shape_mode == 1 || shape_mode == 3 || shape_mode == -1 || shape_mode == -3) {
+ return negate(indentation);
+ } else {
+ return indentation;
+ }
+}
+
+halfword swap_parshape_indent(halfword indentation, halfword width, halfword shape_mode) {
+ if (shape_mode == 2 || shape_mode == 3 || shape_mode == -2 || shape_mode == -3) {
+ return hsize_par - width - indentation;
+ } else {
+ return indentation;
+ }
+}
+
+*/
+
+void prefixed_command(void)
+{
+ int a; /* accumulated prefix codes so far */
+ internal_font_number f; /* identifies a font */
+ halfword j; /* index into a \.{\\parshape} specification */
+ halfword p, q; /* for temporary short-term use */
+ int n; /* ditto */
+ boolean e, check_glue; /* should a definition be expanded? or was \.{\\let} not done? */
+ mathcodeval mval; /* for handling of \.{\\mathchardef}s */
+ a = 0;
+ while (cur_cmd == prefix_cmd) {
+ if (!odd(a / cur_chr))
+ a = a + cur_chr;
+ /* Get the next non-blank non-relax... */
+ do {
+ get_x_token();
+ } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
+
+ if (cur_cmd <= max_non_prefixed_command) {
+ /* Discard erroneous prefixes and |return| */
+ print_err("You can't use a prefix with `");
+ print_cmd_chr((quarterword) cur_cmd, cur_chr);
+ print_char('\'');
+ help2
+ ("I'll pretend you didn't say \\long or \\outer or \\global or",
+ "\\protected.");
+ back_error();
+ return;
+ }
+ if (tracing_commands_par > 2)
+ show_cur_cmd_chr();
+ }
+ /* Discard the prefixes \.{\\long} and \.{\\outer} if they are irrelevant */
+ if (a >= 8) {
+ j = protected_token;
+ a = a - 8;
+ } else {
+ j = 0;
+ }
+ if ((cur_cmd != def_cmd) && ((a % 4 != 0) || (j != 0))) {
+ print_err("You can't use `\\long' or `\\outer' or `\\protected' with `");
+ print_cmd_chr((quarterword) cur_cmd, cur_chr);
+ print_char('\'');
+ help1("I'll pretend you didn't say \\long or \\outer or \\protected here.");
+ error();
+ }
+ /* Adjust for the setting of \.{\\globaldefs} */
+ if (global_defs_par != 0) {
+ if (global_defs_par < 0) {
+ if (is_global(a))
+ a = a - 4;
+ } else {
+ if (!is_global(a))
+ a = a + 4;
+ }
+ }
+ switch (cur_cmd) {
+ case set_font_cmd:
+ /* Here's an example of the way many of the following routines operate.
+ (Unfortunately, they aren't all as simple as this.) */
+ define(cur_font_loc, data_cmd, cur_chr);
+ break;
+ case def_cmd:
+ /* When a |def| command has been scanned,
+ |cur_chr| is odd if the definition is supposed to be global, and
+ |cur_chr>=2| if the definition is supposed to be expanded. */
+
+ if (odd(cur_chr) && !is_global(a) && (global_defs_par >= 0))
+ a = a + 4;
+ e = (cur_chr >= 2);
+ get_r_token();
+ p = cur_cs;
+ q = scan_toks(true, e);
+ if (j != 0) {
+ q = get_avail();
+ set_token_info(q, j);
+ set_token_link(q, token_link(def_ref));
+ set_token_link(def_ref, q);
+ }
+ define(p, call_cmd + (a % 4), def_ref);
+ break;
+ case let_cmd:
+ n = cur_chr;
+ if (n == normal) {
+ get_r_token();
+ p = cur_cs;
+ do {
+ get_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_tok == other_token + '=') {
+ get_token();
+ if (cur_cmd == spacer_cmd)
+ get_token();
+ }
+ } else if (n == normal + 1) {
+ /* futurelet */
+ get_r_token();
+ p = cur_cs;
+ get_token();
+ q = cur_tok;
+ get_token();
+ back_input();
+ cur_tok = q;
+ /* look ahead, then back up */
+ /* note that |back_input| doesn't affect |cur_cmd|, |cur_chr| */
+ back_input();
+ } else {
+ /* letcharcode */
+ scan_int();
+ if (cur_val > 0) {
+ cur_cs = active_to_cs(cur_val, true);
+ set_token_info(cur_cs, cur_cs + cs_token_flag);
+ p = cur_cs;
+ do {
+ get_token();
+ } while (cur_cmd == spacer_cmd);
+ if (cur_tok == other_token + '=') {
+ get_token();
+ if (cur_cmd == spacer_cmd)
+ get_token();
+ }
+ } else {
+ p = null;
+ tex_error("invalid number for \\letcharcode",NULL);
+ }
+ }
+ if (cur_cmd >= call_cmd)
+ add_token_ref(cur_chr);
+ define(p, cur_cmd, cur_chr);
+ break;
+ case shorthand_def_cmd:
+ /* We temporarily define |p| to be |relax|, so that an occurrence of |p|
+ while scanning the definition will simply stop the scanning instead of
+ producing an ``undefined control sequence'' error or expanding the
+ previous meaning. This allows, for instance, `\.{\\chardef\\foo=123\\foo}'.
+ */
+ n = cur_chr;
+ get_r_token();
+ p = cur_cs;
+ define(p, relax_cmd, too_big_char);
+ scan_optional_equals();
+ switch (n) {
+ case char_def_code:
+ scan_char_num();
+ define(p, char_given_cmd, cur_val);
+ break;
+ case math_char_def_code:
+ mval = scan_mathchar(tex_mathcode);
+ if (math_umathcode_meaning_par == 1) {
+ cur_val = (mval.class_value + (8 * mval.family_value)) * (65536 * 32) + mval.character_value;
+ define(p, xmath_given_cmd, cur_val);
+ } else {
+ cur_val = (mval.class_value * 16 + mval.family_value) * 256 + mval.character_value;
+ define(p, math_given_cmd, cur_val);
+ }
+ break;
+ case xmath_char_def_code:
+ mval = scan_mathchar(umath_mathcode);
+ cur_val = (mval.class_value + (8 * mval.family_value)) * (65536 * 32) + mval.character_value;
+ define(p, xmath_given_cmd, cur_val);
+ break;
+ case umath_char_def_code:
+ mval = scan_mathchar(umathnum_mathcode);
+ cur_val = (mval.class_value + (8 * mval.family_value)) * (65536 * 32) + mval.character_value;
+ define(p, xmath_given_cmd, cur_val);
+ break;
+ default:
+ scan_register_num();
+ switch (n) {
+ case count_def_code:
+ define(p, assign_int_cmd, count_base + cur_val);
+ break;
+ case attribute_def_code:
+ define(p, assign_attr_cmd, attribute_base + cur_val);
+ break;
+ case dimen_def_code:
+ define(p, assign_dimen_cmd, scaled_base + cur_val);
+ break;
+ case skip_def_code:
+ define(p, assign_glue_cmd, skip_base + cur_val);
+ break;
+ case mu_skip_def_code:
+ define(p, assign_mu_glue_cmd, mu_skip_base + cur_val);
+ break;
+ case toks_def_code:
+ define(p, assign_toks_cmd, toks_base + cur_val);
+ break;
+ default:
+ confusion("shorthand_def");
+ break;
+ }
+ break;
+ }
+ break;
+ case read_to_cs_cmd:
+ j = cur_chr;
+ scan_int();
+ n = cur_val;
+ if (!scan_keyword("to")) {
+ print_err("Missing `to' inserted");
+ help2("You should have said `\\read<number> to \\cs'.",
+ "I'm going to look for the \\cs now.");
+ error();
+ }
+ get_r_token();
+ p = cur_cs;
+ read_toks(n, p, j);
+ define(p, call_cmd, cur_val);
+ break;
+ case toks_register_cmd:
+ case assign_toks_cmd:
+ /* The token-list parameters, \.{\\output} and \.{\\everypar}, etc., receive
+ their values in the following way. (For safety's sake, we place an
+ enclosing pair of braces around an \.{\\output} list.) */
+ q = cur_cs;
+ if (cur_cmd == toks_register_cmd) {
+ scan_register_num();
+ p = toks_base + cur_val;
+ } else {
+ p = cur_chr; /* |p=every_par_loc| or |output_routine_loc| or \dots */
+ }
+ scan_optional_equals();
+ /* Get the next non-blank non-relax non-call token */
+ do {
+ get_x_token();
+ } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
+
+ if (cur_cmd != left_brace_cmd) {
+ /* If the right-hand side is a token parameter
+ or token register, finish the assignment and |goto done| */
+ if (cur_cmd == toks_register_cmd) {
+ scan_register_num();
+ cur_cmd = assign_toks_cmd;
+ cur_chr = toks_base + cur_val;
+ }
+ if (cur_cmd == assign_toks_cmd) {
+ q = equiv(cur_chr);
+ if (q == null) {
+ define(p, undefined_cs_cmd, null);
+ } else {
+ add_token_ref(q);
+ define(p, call_cmd, q);
+ }
+ goto DONE;
+ }
+ }
+ back_input();
+ cur_cs = q;
+ q = scan_toks(false, false);
+ if (token_link(def_ref) == null) { /* empty list: revert to the default */
+ define(p, undefined_cs_cmd, null);
+ free_avail(def_ref);
+ } else {
+ if (p == output_routine_loc) { /* enclose in curlies */
+ p = get_avail();
+ set_token_link(q, p);
+ p = output_routine_loc;
+ q = token_link(q);
+ set_token_info(q, right_brace_token + '}');
+ q = get_avail();
+ set_token_info(q, left_brace_token + '{');
+ set_token_link(q, token_link(def_ref));
+ set_token_link(def_ref, q);
+ }
+ define(p, call_cmd, def_ref);
+ }
+ break;
+ case assign_int_cmd:
+ /* Similar routines are used to assign values to the numeric parameters. */
+ p = cur_chr;
+ scan_optional_equals();
+ scan_int();
+ assign_internal_value(a, p, cur_val);
+ break;
+ case assign_attr_cmd:
+ p = cur_chr;
+ scan_optional_equals();
+ scan_int();
+ if ((p - attribute_base) > max_used_attr)
+ max_used_attr = (p - attribute_base);
+ attr_list_cache = cache_disabled;
+ word_define(p, cur_val);
+ break;
+ case assign_dir_cmd:
+ /* DIR: Assign direction codes */
+ scan_direction();
+ switch (cur_chr) {
+ case int_base + page_direction_code:
+ eq_word_define(int_base + page_direction_code, cur_val);
+ break;
+ case int_base + body_direction_code:
+ eq_word_define(int_base + body_direction_code, cur_val);
+ break;
+ case int_base + par_direction_code:
+ eq_word_define(int_base + par_direction_code, cur_val);
+ break;
+ case int_base + math_direction_code:
+ eq_word_define(int_base + math_direction_code, cur_val);
+ break;
+ case int_base + text_direction_code:
+ case int_base + line_direction_code:
+ /*
+ pre version 0.97 this was a commented section because various tests hint that this
+ is unnecessary and sometimes even produces weird results, like:
+
+ (\hbox{\textdir TRT ABC\textdir TLT DEF}))
+
+ becomes
+
+ (DEFCBA)
+
+ in the output when we use
+
+ tail_append(new_dir(text_direction_par)
+
+ but when we append the reverse of the current it goes better
+
+ */
+ check_glue = (cur_chr == (int_base + line_direction_code));
+ if (check_glue) {
+ cur_chr = int_base + text_direction_code ;
+ }
+ if (abs(mode) == hmode) {
+ if (no_local_dirs_par > 0) {
+ /* tail is non zero but we test anyway */
+ if (check_glue && (tail != null && type(tail) == glue_node)) {
+ halfword prev = alink(tail);
+ halfword dirn = new_dir(text_direction_par - dir_swap);
+ couple_nodes(prev,dirn);
+ couple_nodes(dirn,tail);
+ } else {
+ tail_append(new_dir(text_direction_par - dir_swap));
+ }
+ } else {
+ /* what is the use of nolocaldirs .. maybe we should get rid of it */
+ }
+ update_text_dir_ptr(cur_val);
+ tail_append(new_dir(cur_val));
+ dir_level(tail) = cur_level;
+ } else {
+ update_text_dir_ptr(cur_val);
+ }
+ /* original:
+
+ // if ((no_local_dirs_par > 0) && (abs(mode) == hmode)) {
+ // // tail_append(new_dir(text_direction_par) // kind of wrong
+ // tail_append(new_dir(text_direction_par - dir_swap)); // better
+ // }
+
+ update_text_dir_ptr(cur_val);
+ if (abs(mode) == hmode) {
+ tail_append(new_dir(cur_val));
+ dir_level(tail) = cur_level;
+ }
+ */
+ eq_word_define(int_base + text_direction_code, cur_val);
+ eq_word_define(int_base + no_local_dirs_code, no_local_dirs_par + 1);
+ break;
+ }
+ break;
+ case assign_dimen_cmd:
+ p = cur_chr;
+ scan_optional_equals();
+ scan_normal_dimen();
+ assign_internal_value(a, p, cur_val);
+ break;
+ case assign_glue_cmd:
+ case assign_mu_glue_cmd:
+ p = cur_chr;
+ n = cur_cmd;
+ scan_optional_equals();
+ if (n == assign_mu_glue_cmd)
+ scan_glue(mu_val_level);
+ else
+ scan_glue(glue_val_level);
+ define(p, glue_ref_cmd, cur_val);
+ break;
+ case def_char_code_cmd:
+ case def_del_code_cmd:
+ /* Let |n| be the largest legal code value, based on |cur_chr| */
+ if (cur_chr == cat_code_base)
+ n = max_char_code;
+ else if (cur_chr == sf_code_base)
+ n = 077777;
+ else
+ n = biggest_char;
+
+ p = cur_chr;
+ if (cur_chr == math_code_base) {
+ if (is_global(a))
+ cur_val1 = level_one;
+ else
+ cur_val1 = cur_level;
+ scan_extdef_math_code(cur_val1, tex_mathcode);
+ } else if (cur_chr == lc_code_base) {
+ scan_char_num();
+ p = cur_val;
+ scan_optional_equals();
+ scan_int();
+ check_def_code(lc_code_base);
+ define_lc_code(p, cur_val);
+ } else if (cur_chr == uc_code_base) {
+ scan_char_num();
+ p = cur_val;
+ scan_optional_equals();
+ scan_int();
+ check_def_code(uc_code_base);
+ define_uc_code(p, cur_val);
+ } else if (cur_chr == sf_code_base) {
+ scan_char_num();
+ p = cur_val;
+ scan_optional_equals();
+ scan_int();
+ check_def_code(sf_code_base);
+ define_sf_code(p, cur_val);
+ } else if (cur_chr == cat_code_base) {
+ scan_char_num();
+ p = cur_val;
+ scan_optional_equals();
+ scan_int();
+ check_def_code(cat_code_base);
+ define_cat_code(p, cur_val);
+ } else if (cur_chr == del_code_base) {
+ if (is_global(a))
+ cur_val1 = level_one;
+ else
+ cur_val1 = cur_level;
+ scan_extdef_del_code(cur_val1, tex_mathcode);
+ }
+ break;
+ case extdef_math_code_cmd:
+ case extdef_del_code_cmd:
+ if (is_global(a))
+ cur_val1 = level_one;
+ else
+ cur_val1 = cur_level;
+ if (cur_chr == math_code_base)
+ scan_extdef_math_code(cur_val1, umath_mathcode);
+ else if (cur_chr == math_code_base + 1)
+ scan_extdef_math_code(cur_val1, umathnum_mathcode);
+ else if (cur_chr == del_code_base)
+ scan_extdef_del_code(cur_val1, umath_mathcode);
+ else if (cur_chr == del_code_base + 1)
+ scan_extdef_del_code(cur_val1, umathnum_mathcode);
+ break;
+ case def_family_cmd:
+ p = cur_chr;
+ scan_math_family_int();
+ cur_val1 = cur_val;
+ scan_optional_equals();
+ scan_font_ident();
+ define_fam_fnt(cur_val1, p, cur_val);
+ break;
+ case set_math_param_cmd:
+ p = cur_chr;
+ get_token();
+ if (cur_cmd != math_style_cmd) {
+ print_err("Missing math style, treated as \\displaystyle");
+ help1
+ ("A style should have been here; I inserted `\\displaystyle'.");
+ cur_val1 = display_style;
+ back_error();
+ } else {
+ cur_val1 = cur_chr;
+ }
+ scan_optional_equals();
+ if (p < math_param_first_mu_glue) {
+ if (p == math_param_radical_degree_raise)
+ scan_int();
+ else
+ scan_dimen(false, false, false);
+ } else {
+ scan_glue(mu_val_level);
+ if (cur_val == thin_mu_skip_par)
+ cur_val = thin_mu_skip_code;
+ else if (cur_val == med_mu_skip_par)
+ cur_val = med_mu_skip_code;
+ else if (cur_val == thick_mu_skip_par)
+ cur_val = thick_mu_skip_code;
+ }
+ define_math_param(p, cur_val1, cur_val);
+ break;
+ case register_cmd:
+ case advance_cmd:
+ case multiply_cmd:
+ case divide_cmd:
+ do_register_command(a);
+ break;
+ case set_box_cmd:
+ /* The processing of boxes is somewhat different, because we may need
+ to scan and create an entire box before we actually change the value
+ of the old one. */
+ scan_register_num();
+ if (is_global(a))
+ n = global_box_flag + cur_val;
+ else
+ n = box_flag + cur_val;
+ scan_optional_equals();
+ if (set_box_allowed) {
+ scan_box(n);
+ } else {
+ print_err("Improper \\setbox");
+ help2("Sorry, \\setbox is not allowed after \\halign in a display,",
+ "or between \\accent and an accented character.");
+ error();
+ }
+ break;
+ case set_aux_cmd:
+ /* The |space_factor| or |prev_depth| settings are changed when a |set_aux|
+ command is sensed. Similarly, |prev_graf| is changed in the presence of
+ |set_prev_graf|, and |dead_cycles| or |insert_penalties| in the presence of
+ |set_page_int|. These definitions are always global. */
+ alter_aux();
+ break;
+ case set_prev_graf_cmd:
+ alter_prev_graf();
+ break;
+ case set_page_dimen_cmd:
+ alter_page_so_far();
+ break;
+ case set_page_int_cmd:
+ alter_integer();
+ break;
+ case set_box_dimen_cmd:
+ /* When some dimension of a box register is changed, the change isn't exactly
+ global; but \TeX\ does not look at the \.{\\global} switch. */
+ alter_box_dimen();
+ break;
+ case set_tex_shape_cmd:
+ q = cur_chr;
+ scan_optional_equals();
+ scan_int();
+ n = cur_val;
+ if (n <= 0) {
+ p = null;
+ } else {
+ p = new_node(shape_node, 2 * (n + 1) + 1);
+ vinfo(p + 1) = n;
+ for (j = 1; j <= n; j++) {
+ scan_normal_dimen();
+ varmem[p + 2 * j].cint = cur_val; /* indentation */
+ scan_normal_dimen();
+ varmem[p + 2 * j + 1].cint = cur_val; /* width */
+ }
+ }
+ define(q, shape_ref_cmd, p);
+ break;
+ case set_etex_shape_cmd:
+ q = cur_chr;
+ scan_optional_equals();
+ scan_int();
+ n = cur_val;
+ if (n <= 0) {
+ p = null;
+ } else {
+ n = (cur_val / 2) + 1;
+ p = new_node(shape_node, 2 * n + 1 + 1);
+ vinfo(p + 1) = n;
+ n = cur_val;
+ varmem[p + 2].cint = n; /* number of penalties */
+ for (j = p + 3; j <= p + n + 2; j++) {
+ scan_int();
+ varmem[j].cint = cur_val; /* penalty values */
+ }
+ if (!odd(n))
+ varmem[p + n + 3].cint = 0; /* unused */
+ }
+ define(q, shape_ref_cmd, p);
+ break;
+ case hyph_data_cmd:
+ /* All of \TeX's parameters are kept in |eqtb| except the font information,
+ the interaction mode, and the hyphenation tables; these are strictly global.
+ */
+ switch (cur_chr) {
+ case 0:
+ new_hyph_exceptions();
+ break;
+ case 1:
+ new_patterns();
+ break;
+ case 2:
+ new_pre_hyphen_char();
+ break;
+ case 3:
+ new_post_hyphen_char();
+ break;
+ case 4:
+ new_pre_exhyphen_char();
+ break;
+ case 5:
+ new_post_exhyphen_char();
+ break;
+ case 6:
+ new_hyphenation_min();
+ break;
+ case 7:
+ new_hj_code();
+ break;
+ }
+ break;
+ case assign_font_dimen_cmd:
+ set_font_dimen();
+ break;
+ case assign_font_int_cmd:
+ n = cur_chr;
+ scan_font_ident();
+ f = cur_val;
+ if (n == no_lig_code) {
+ set_no_ligatures(f);
+ } else if (n < lp_code_base) {
+ scan_optional_equals();
+ scan_int();
+ if (n == 0)
+ set_hyphen_char(f, cur_val);
+ else
+ set_skew_char(f, cur_val);
+ } else {
+ scan_char_num();
+ p = cur_val;
+ scan_optional_equals();
+ scan_int();
+ switch (n) {
+ case lp_code_base:
+ set_lp_code(f, p, cur_val);
+ break;
+ case rp_code_base:
+ set_rp_code(f, p, cur_val);
+ break;
+ case ef_code_base:
+ set_ef_code(f, p, cur_val);
+ break;
+ case tag_code:
+ set_tag_code(f, p, cur_val);
+ break;
+ }
+ }
+ break;
+ case def_font_cmd:
+ /* Here is where the information for a new font gets loaded. */
+ tex_def_font((small_number) a);
+ break;
+ case letterspace_font_cmd:
+ new_letterspaced_font((small_number) a);
+ break;
+ case copy_font_cmd:
+ make_font_copy((small_number) a);
+ break;
+ case set_font_id_cmd:
+ scan_int();
+ if (is_valid_font(cur_val))
+ zset_cur_font(cur_val);
+ break ;
+ case set_interaction_cmd:
+ new_interaction();
+ break;
+ default:
+ confusion("prefix");
+ break;
+ } /* end of Assignments cases */
+ DONE:
+ /* Insert a token saved by \.{\\afterassignment}, if any */
+ if (after_token != 0) {
+ cur_tok = after_token;
+ back_input();
+ after_token = 0;
+ }
+}
+
+@ @c
+void fixup_directions(void)
+{
+ int temp_no_whatsits = no_local_whatsits_par;
+ int temp_no_dirs = no_local_dirs_par;
+ int temporary_dir = text_direction_par;
+ if (dir_level(text_dir_ptr) == cur_level) {
+ /* DIR: Remove from |text_dir_ptr| */
+ halfword text_dir_tmp = vlink(text_dir_ptr);
+ flush_node(text_dir_ptr);
+ text_dir_ptr = text_dir_tmp;
+ }
+ unsave();
+ if (abs(mode) == hmode) {
+ if (temp_no_dirs != 0) {
+ /* DIR: Add local dir node */
+ tail_append(new_dir(text_direction_par));
+ dir_dir(tail) = temporary_dir - dir_swap;
+ }
+ if (temp_no_whatsits != 0) {
+ /* LOCAL: Add local paragraph node */
+ tail_append(make_local_par_node(hmode_par_par_code));
+ }
+ }
+}
+
+@ When a control sequence is to be defined, by \.{\\def} or \.{\\let} or
+something similar, the |get_r_token| routine will substitute a special
+control sequence for a token that is not redefinable.
+
+@c
+void get_r_token(void)
+{
+ RESTART:
+ do {
+ get_token();
+ } while (cur_tok == space_token);
+ if ((cur_cs == 0) || (cur_cs > eqtb_top) ||
+ ((cur_cs > frozen_control_sequence) && (cur_cs <= eqtb_size))) {
+ print_err("Missing control sequence inserted");
+ help5("Please don't say `\\def cs{...}', say `\\def\\cs{...}'.",
+ "I've inserted an inaccessible control sequence so that your",
+ "definition will be completed without mixing me up too badly.",
+ "You can recover graciously from this error, if you're",
+ "careful; see exercise 27.2 in The TeXbook.");
+ if (cur_cs == 0)
+ back_input();
+ cur_tok = cs_token_flag + frozen_protection;
+ ins_error();
+ goto RESTART;
+ }
+}
+
+@ @c
+void assign_internal_value(int a, halfword p, int val)
+{
+ halfword n;
+ if ((p >= int_base) && (p < attribute_base)) {
+ switch ((p - int_base)) {
+ case cat_code_table_code:
+ if (valid_catcode_table(val)) {
+ if (val != cat_code_table_par)
+ word_define(p, val);
+ } else {
+ print_err("Invalid \\catcode table");
+ help2
+ ("You can only switch to a \\catcode table that is initialized",
+ "using \\savecatcodetable or \\initcatcodetable, or to table 0");
+ error();
+ }
+ break;
+ case output_box_code:
+ if ((val > 65535) | (val < 0)) {
+ print_err("Invalid \\outputbox");
+ help1
+ ("The value for \\outputbox has to be between 0 and 65535.");
+ error();
+ } else {
+ word_define(p, val);
+ }
+ break;
+ case new_line_char_code:
+ if (val > 127) {
+ print_err("Invalid \\newlinechar");
+ help2
+ ("The value for \\newlinechar has to be no higher than 127.",
+ "Your invalid assignment will be ignored.");
+ error();
+ } else {
+ word_define(p, val);
+ }
+ break;
+ case end_line_char_code:
+ if (val > 127) {
+ print_err("Invalid \\endlinechar");
+ help2
+ ("The value for \\endlinechar has to be no higher than 127.",
+ "Your invalid assignment will be ignored.");
+ error();
+ } else {
+ word_define(p, val);
+ }
+ break;
+ case language_code:
+ if (val < 0) {
+ word_define(int_base + cur_lang_code, -1);
+ word_define(p, -1);
+ } else if (val > 16383) {
+ print_err("Invalid \\language");
+ help2
+ ("The absolute value for \\language has to be no higher than 16383.",
+ "Your invalid assignment will be ignored.");
+ error();
+ } else {
+ word_define(int_base + cur_lang_code, val);
+ word_define(p, val);
+ }
+ break;
+ default:
+ word_define(p, val);
+ break;
+ }
+ /* If we are defining subparagraph penalty levels while we are
+ in hmode, then we put out a whatsit immediately, otherwise
+ we leave it alone. This mechanism might not be sufficiently
+ powerful, and some other algorithm, searching down the stack,
+ might be necessary. Good first step. */
+ if ((abs(mode) == hmode) &&
+ ((p == (int_base + local_inter_line_penalty_code)) ||
+ (p == (int_base + local_broken_penalty_code)))) {
+ /* LOCAL: Add local paragraph node */
+ tail_append(make_local_par_node(penalty_par_code));
+ eq_word_define(int_base + no_local_whatsits_code, no_local_whatsits_par + 1);
+ }
+ } else if ((p >= dimen_base) && (p <= eqtb_size)) {
+ if (p == (dimen_base + page_left_offset_code)) {
+ n = val - one_true_inch;
+ word_define(dimen_base + h_offset_code, n);
+ } else if (p == (dimen_base + h_offset_code)) {
+ n = val + one_true_inch;
+ word_define(dimen_base + page_left_offset_code, n);
+ } else if (p == (dimen_base + page_top_offset_code)) {
+ n = val - one_true_inch;
+ word_define(dimen_base + v_offset_code, n);
+ } else if (p == (dimen_base + v_offset_code)) {
+ n = val + one_true_inch;
+ word_define(dimen_base + page_top_offset_code, n);
+ }
+ word_define(p, val);
+ } else if ((p >= local_base) && (p < toks_base)) { /* internal locals */
+ define(p, call_cmd, val);
+ } else {
+ confusion("assign internal value");
+ }
+}
+
+@ We use the fact that |register<advance<multiply<divide|
+
+Compute the register location |l| and its type |p|; but |return| if invalid
+Here we use the fact that the consecutive codes |int_val..mu_val| and
+|assign_int..assign_mu_glue| correspond to each other nicely.
+
+@c
+void do_register_command(int a)
+{
+ int p;
+ halfword q = cur_cmd;
+ halfword l = 0;
+ if (q != register_cmd) {
+ get_x_token();
+ if ((cur_cmd >= assign_int_cmd) && (cur_cmd <= assign_mu_glue_cmd)) {
+ l = cur_chr;
+ p = cur_cmd - assign_int_cmd;
+ goto FOUND;
+ }
+ if (cur_cmd != register_cmd) {
+ print_err("You can't use `");
+ print_cmd_chr((quarterword) cur_cmd, cur_chr);
+ tprint("' after ");
+ print_cmd_chr((quarterword) q, 0);
+ help1("I'm forgetting what you said and not changing anything.");
+ error();
+ return;
+ }
+ }
+ p = cur_chr;
+ scan_register_num();
+ if (p == int_val_level)
+ l = cur_val + count_base;
+ else if (p == attr_val_level)
+ l = cur_val + attribute_base;
+ else if (p == dimen_val_level)
+ l = cur_val + scaled_base;
+ else if (p == glue_val_level)
+ l = cur_val + skip_base;
+ else if (p == mu_val_level)
+ l = cur_val + mu_skip_base;
+ FOUND:
+ if (q == register_cmd) {
+ scan_optional_equals();
+ } else if (scan_keyword("by")) {
+ /* optional `\.{by}' */
+ }
+ arith_error = false;
+ if (q < multiply_cmd) {
+ /* Compute result of |register| or |advance|, put it in |cur_val| */
+ if (p < glue_val_level) {
+ if ((p == int_val_level) || (p == attr_val_level))
+ scan_int();
+ else
+ scan_normal_dimen();
+ if (q == advance_cmd)
+ cur_val = cur_val + eqtb[l].cint;
+ } else {
+ /* we can probably save a copy */
+ scan_glue(p);
+ if (q == advance_cmd) {
+ /* Compute the sum of two glue specs */
+ halfword r = equiv(l);
+ q = new_spec(cur_val);
+ flush_node(cur_val);
+ width(q) = width(q) + width(r);
+ if (stretch(q) == 0) {
+ stretch_order(q) = normal;
+ }
+ if (stretch_order(q) == stretch_order(r)) {
+ stretch(q) = stretch(q) + stretch(r);
+ } else if ((stretch_order(q) < stretch_order(r)) && (stretch(r) != 0)) {
+ stretch(q) = stretch(r);
+ stretch_order(q) = stretch_order(r);
+ }
+ if (shrink(q) == 0) {
+ shrink_order(q) = normal;
+ }
+ if (shrink_order(q) == shrink_order(r)) {
+ shrink(q) = shrink(q) + shrink(r);
+ } else if ((shrink_order(q) < shrink_order(r)) && (shrink(r) != 0)) {
+ shrink(q) = shrink(r);
+ shrink_order(q) = shrink_order(r);
+ }
+ cur_val = q;
+ }
+ }
+ } else {
+ /* Compute result of |multiply| or |divide|, put it in |cur_val| */
+ scan_int();
+ if (p < glue_val_level) {
+ if (q == multiply_cmd) {
+ if ((p == int_val_level) || (p == attr_val_level)) {
+ cur_val = mult_integers(eqtb[l].cint, cur_val);
+ } else {
+ cur_val = nx_plus_y(eqtb[l].cint, cur_val, 0);
+ }
+ } else {
+ cur_val = x_over_n(eqtb[l].cint, cur_val);
+ }
+ } else {
+ halfword s = equiv(l);
+ halfword r = new_spec(s);
+ if (q == multiply_cmd) {
+ width(r) = nx_plus_y(width(s), cur_val, 0);
+ stretch(r) = nx_plus_y(stretch(s), cur_val, 0);
+ shrink(r) = nx_plus_y(shrink(s), cur_val, 0);
+ } else {
+ width(r) = x_over_n(width(s), cur_val);
+ stretch(r) = x_over_n(stretch(s), cur_val);
+ shrink(r) = x_over_n(shrink(s), cur_val);
+ }
+ cur_val = r;
+ }
+ }
+ if (arith_error) {
+ print_err("Arithmetic overflow");
+ help2("I can't carry out that multiplication or division,",
+ "since the result is out of range.");
+ if (p >= glue_val_level)
+ flush_node(cur_val);
+ error();
+ return;
+ }
+ if (p < glue_val_level) {
+ if (p == attr_val_level) {
+ if ((l - attribute_base) > max_used_attr)
+ max_used_attr = (l - attribute_base);
+ attr_list_cache = cache_disabled;
+ }
+ if ((p == int_val_level) || (p == dimen_val_level))
+ assign_internal_value(a, l, cur_val);
+ else
+ word_define(l, cur_val);
+ } else {
+ define(l, glue_ref_cmd, cur_val);
+ }
+}
+
+@ @c
+void alter_aux(void)
+{
+ halfword c; /* |hmode| or |vmode| */
+ if (cur_chr != abs(mode)) {
+ report_illegal_case();
+ } else {
+ c = cur_chr;
+ scan_optional_equals();
+ if (c == vmode) {
+ scan_normal_dimen();
+ prev_depth_par = cur_val;
+ } else {
+ scan_int();
+ if ((cur_val <= 0) || (cur_val > 32767)) {
+ print_err("Bad space factor");
+ help1("I allow only values in the range 1..32767 here.");
+ int_error(cur_val);
+ } else {
+ space_factor_par = cur_val;
+ }
+ }
+ }
+}
+
+@ @c
+void alter_prev_graf(void)
+{
+ int p; /* index into |nest| */
+ p = nest_ptr;
+ while (abs(nest[p].mode_field) != vmode)
+ decr(p);
+ scan_optional_equals();
+ scan_int();
+ if (cur_val < 0) {
+ print_err("Bad \\prevgraf");
+ help1("I allow only nonnegative values here.");
+ int_error(cur_val);
+ } else {
+ nest[p].pg_field = cur_val;
+ }
+}
+
+@ @c
+void alter_page_so_far(void)
+{
+ int c; /* index into |page_so_far| */
+ c = cur_chr;
+ scan_optional_equals();
+ scan_normal_dimen();
+ page_so_far[c] = cur_val;
+}
+
+@ @c
+void alter_integer(void)
+{
+ int c; /* 0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc. */
+ c = cur_chr;
+ scan_optional_equals();
+ scan_int();
+ if (c == 0) {
+ dead_cycles = cur_val;
+ } else if (c == 2) {
+ if ((cur_val < batch_mode) || (cur_val > error_stop_mode)) {
+ print_err("Bad interaction mode");
+ help2("Modes are 0=batch, 1=nonstop, 2=scroll, and",
+ "3=errorstop. Proceed, and I'll ignore this case.");
+ int_error(cur_val);
+ } else {
+ cur_chr = cur_val;
+ new_interaction();
+ }
+ } else {
+ insert_penalties = cur_val;
+ }
+}
+
+@ @c
+void alter_box_dimen(void)
+{
+ int c; /* |width_offset| or |height_offset| or |depth_offset| */
+ int b; /* box number */
+ c = cur_chr;
+ scan_register_num();
+ b = cur_val;
+ scan_optional_equals();
+ scan_normal_dimen();
+ if (box(b) != null)
+ varmem[box(b) + c].cint = cur_val;
+}
+
+@ @c
+void new_interaction(void)
+{
+ print_ln();
+ interaction = cur_chr;
+ if (interaction == batch_mode)
+ kpse_make_tex_discard_errors = 1;
+ else
+ kpse_make_tex_discard_errors = 0;
+ fixup_selector(log_opened_global);
+}
+
+@ The \.{\\afterassignment} command puts a token into the global
+variable |after_token|. This global variable is examined just after
+every assignment has been performed.
+
+@c
+halfword after_token; /* zero, or a saved token */
+
+@ Here is a procedure that might be called `Get the next non-blank non-relax
+non-call non-assignment token'.
+
+@c
+void do_assignments(void)
+{
+ while (true) {
+ /* Get the next non-blank non-relax... */
+ do {
+ get_x_token();
+ } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
+ if (cur_cmd <= max_non_prefixed_command)
+ return;
+ set_box_allowed = false;
+ prefixed_command();
+ set_box_allowed = true;
+ }
+}
+
+@ @c
+void open_or_close_in(void)
+{
+ int c; /* 1 for \.{\\openin}, 0 for \.{\\closein} */
+ int n; /* stream number */
+ char *fn;
+ c = cur_chr;
+ scan_four_bit_int();
+ n = cur_val;
+ if (read_open[n] != closed) {
+ lua_a_close_in(read_file[n], (n + 1));
+ read_open[n] = closed;
+ }
+ if (c != 0) {
+ scan_optional_equals();
+ do {
+ get_x_token();
+ } while ((cur_cmd == spacer_cmd) || (cur_cmd == relax_cmd));
+ back_input();
+ if (cur_cmd != left_brace_cmd) {
+ scan_file_name(); /* set |cur_name| to desired file name */
+ if (cur_ext == get_nullstr())
+ cur_ext = maketexstring(".tex");
+ } else {
+ scan_file_name_toks();
+ }
+ fn = pack_file_name(cur_name, cur_area, cur_ext);
+ if (lua_a_open_in(&(read_file[n]), fn, (n + 1))) {
+ read_open[n] = just_open;
+ }
+ }
+}
+
+@ @c
+boolean long_help_seen; /* has the long \.{\\errmessage} help been used? */
+
+void issue_message(void)
+{
+ int old_setting; /* holds |selector| setting */
+ int c; /* identifies \.{\\message} and \.{\\errmessage} */
+ str_number s; /* the message */
+ c = cur_chr;
+ (void) scan_toks(false, true);
+ old_setting = selector;
+ selector = new_string;
+ token_show(def_ref);
+ selector = old_setting;
+ flush_list(def_ref);
+ str_room(1);
+ s = make_string();
+ if (c == 0) {
+ /* Print string |s| on the terminal */
+ if (term_offset + (int) str_length(s) > max_print_line - 2)
+ print_ln();
+ else if ((term_offset > 0) || (file_offset > 0))
+ print_char(' ');
+ print(s);
+ update_terminal();
+
+ } else {
+ /* Print string |s| as an error message */
+ /* If \.{\\errmessage} occurs often in |scroll_mode|, without user-defined
+ \.{\\errhelp}, we don't want to give a long help message each time. So we
+ give a verbose explanation only once. */
+ print_err("");
+ print(s);
+ if (err_help_par != null) {
+ use_err_help = true;
+ } else if (long_help_seen) {
+ help1("(That was another \\errmessage.)");
+ } else {
+ if (interaction < error_stop_mode)
+ long_help_seen = true;
+ help4("This error message was generated by an \\errmessage",
+ "command, so I can't give any explicit help.",
+ "Pretend that you're Hercule Poirot: Examine all clues,",
+ "and deduce the truth by order and method.");
+ }
+ error();
+ use_err_help = false;
+
+ }
+ flush_str(s);
+}
+
+@ The |error| routine calls on |give_err_help| if help is requested from
+the |err_help| parameter.
+
+@c
+void give_err_help(void)
+{
+ token_show(err_help_par);
+}
+
+@ The \.{\\uppercase} and \.{\\lowercase} commands are implemented by
+building a token list and then changing the cases of the letters in it.
+
+@c
+void shift_case(void)
+{
+ halfword b; /* |lc_code_base| or |uc_code_base| */
+ halfword p; /* runs through the token list */
+ halfword t; /* token */
+ halfword c; /* character code */
+ halfword i; /* inbetween */
+ b = cur_chr;
+ p = scan_toks(false, false);
+ p = token_link(def_ref);
+ while (p != null) {
+ /* Change the case of the token in |p|, if a change is appropriate */
+ /*
+ When the case of a |chr_code| changes, we don't change the |cmd|.
+ We also change active characters.
+ */
+ t = token_info(p);
+ if (t < cs_token_flag) {
+ c = t % STRING_OFFSET;
+ if (b == uc_code_base)
+ i = get_uc_code(c);
+ else
+ i = get_lc_code(c);
+ if (i != 0)
+ set_token_info(p, t - c + i);
+ } else if (is_active_cs(cs_text(t - cs_token_flag))) {
+ c = active_cs_value(cs_text(t - cs_token_flag));
+ if (b == uc_code_base)
+ i = get_uc_code(c);
+ else
+ i = get_lc_code(c);
+ if (i != 0)
+ set_token_info(p, active_to_cs(i, true) + cs_token_flag);
+ }
+ p = token_link(p);
+ }
+ back_list(token_link(def_ref));
+ free_avail(def_ref); /* omit reference count */
+}
+
+@ We come finally to the last pieces missing from |main_control|, namely the
+`\.{\\show}' commands that are useful when debugging.
+
+@c
+void show_whatever(void)
+{
+ halfword p; /* tail of a token list to show */
+ int t; /* type of conditional being shown */
+ int m; /* upper bound on |fi_or_else| codes */
+ int l; /* line where that conditional began */
+ int n; /* level of \.{\\if...\\fi} nesting */
+ switch (cur_chr) {
+ case show_lists:
+ begin_diagnostic();
+ show_activities();
+ break;
+ case show_box_code:
+ /* Show the current contents of a box */
+ scan_register_num();
+ begin_diagnostic();
+ tprint_nl("> \\box");
+ print_int(cur_val);
+ print_char('=');
+ if (box(cur_val) == null)
+ tprint("void");
+ else
+ show_box(box(cur_val));
+ break;
+ case show_code:
+ /* Show the current meaning of a token, then |goto common_ending| */
+ get_token();
+ if (interaction == error_stop_mode)
+ wake_up_terminal();
+ tprint_nl("> ");
+ if (cur_cs != 0) {
+ sprint_cs(cur_cs);
+ print_char('=');
+ }
+ print_meaning();
+ goto COMMON_ENDING;
+ break;
+ /* Cases for |show_whatever| */
+ case show_groups:
+ begin_diagnostic();
+ show_save_groups();
+ break;
+ case show_ifs:
+ begin_diagnostic();
+ tprint_nl("");
+ print_ln();
+ if (cond_ptr == null) {
+ tprint_nl("### ");
+ tprint("no active conditionals");
+ } else {
+ p = cond_ptr;
+ n = 0;
+ do {
+ incr(n);
+ p = vlink(p);
+ } while (p != null);
+ p = cond_ptr;
+ t = cur_if;
+ l = if_line;
+ m = if_limit;
+ do {
+ tprint_nl("### level ");
+ print_int(n);
+ tprint(": ");
+ print_cmd_chr(if_test_cmd, t);
+ if (m == fi_code)
+ tprint_esc("else");
+ print_if_line(l);
+ decr(n);
+ t = if_limit_subtype(p);
+ l = if_line_field(p);
+ m = if_limit_type(p);
+ p = vlink(p);
+ } while (p != null);
+ }
+ break;
+ default:
+ /* Show the current value of some parameter or register,
+ then |goto common_ending| */
+ p = the_toks();
+ if (interaction == error_stop_mode)
+ wake_up_terminal();
+ tprint_nl("> ");
+ token_show(temp_token_head);
+ flush_list(token_link(temp_token_head));
+ goto COMMON_ENDING;
+ break;
+ }
+ /* Complete a potentially long \.{\\show} command */
+ end_diagnostic(true);
+ print_err("OK");
+ if (selector == term_and_log) {
+ if (tracing_online_par <= 0) {
+ selector = term_only;
+ tprint(" (see the transcript file)");
+ selector = term_and_log;
+ }
+ }
+ COMMON_ENDING:
+ if (interaction < error_stop_mode) {
+ help0();
+ decr(error_count);
+ } else if (tracing_online_par > 0) {
+ help3("This isn't an error message; I'm just \\showing something.",
+ "Type `I\\show...' to show more (e.g., \\show\\cs,",
+ "\\showthe\\count10, \\showbox255, \\showlists).");
+ } else {
+ help5("This isn't an error message; I'm just \\showing something.",
+ "Type `I\\show...' to show more (e.g., \\show\\cs,",
+ "\\showthe\\count10, \\showbox255, \\showlists).",
+ "And type `I\\tracingonline=1\\show...' to show boxes and",
+ "lists on your terminal as well as in the transcript file.");
+ }
+ error();
+}
+
+@ @c
+void initialize(void)
+{ /* this procedure gets things started properly */
+ int k; /* index into |mem|, |eqtb|, etc. */
+ /* Initialize whatever \TeX\ might access */
+ /* Set initial values of key variables */
+ initialize_errors();
+ initialize_arithmetic();
+ max_used_attr = -1;
+ attr_list_cache = cache_disabled;
+ initialize_nesting();
+
+ /* Start a new current page */
+ page_contents = empty;
+ page_tail = page_head;
+#if 0
+ vlink(page_head) = null;
+#endif
+ last_glue = max_halfword;
+ last_penalty = 0;
+ last_kern = 0;
+ last_node_type = -1;
+ page_depth = 0;
+ page_max_depth = 0;
+
+ initialize_equivalents();
+ no_new_control_sequence = true; /* new identifiers are usually forbidden */
+ init_primitives();
+
+ mag_set = 0;
+ initialize_marks();
+ initialize_read();
+
+ static_pdf = init_pdf_struct(static_pdf); /* should be init_backend() */
+
+ format_ident = 0;
+ format_name = get_nullstr();
+ initialize_directions();
+ initialize_write_files();
+ seconds_and_micros(epochseconds, microseconds);
+ initialize_start_time(static_pdf);
+
+ edit_name_start = 0;
+ stop_at_space = true;
+
+ if (ini_version) {
+ /* Initialize table entries (done by \.{INITEX} only) */
+
+ init_node_mem(500);
+ initialize_tokens();
+ /* Initialize the special list heads and constant nodes */
+ initialize_alignments();
+ initialize_buildpage();
+
+ initialize_active();
+
+ set_eq_type(undefined_control_sequence, undefined_cs_cmd);
+ set_equiv(undefined_control_sequence, null);
+ set_eq_level(undefined_control_sequence, level_zero);
+ for (k = null_cs; k <= (eqtb_top - 1); k++)
+ eqtb[k] = eqtb[undefined_control_sequence];
+ set_equiv(glue_base, zero_glue);
+ set_eq_level(glue_base, level_one);
+ set_eq_type(glue_base, glue_ref_cmd);
+ for (k = glue_base + 1; k <= local_base - 1; k++) {
+ eqtb[k] = eqtb[glue_base];
+ }
+ par_shape_par_ptr = null;
+ set_eq_type(par_shape_loc, shape_ref_cmd);
+ set_eq_level(par_shape_loc, level_one);
+ for (k = etex_pen_base; k <= (etex_pens - 1); k++)
+ eqtb[k] = eqtb[par_shape_loc];
+ for (k = output_routine_loc; k <= toks_base + biggest_reg; k++)
+ eqtb[k] = eqtb[undefined_control_sequence];
+ box(0) = null;
+ set_eq_type(box_base, box_ref_cmd);
+ set_eq_level(box_base, level_one);
+ for (k = box_base + 1; k <= (box_base + biggest_reg); k++)
+ eqtb[k] = eqtb[box_base];
+ cur_font_par = null_font;
+ set_eq_type(cur_font_loc, data_cmd);
+ set_eq_level(cur_font_loc, level_one);
+ set_equiv(cat_code_base, 0);
+ set_eq_type(cat_code_base, data_cmd);
+ set_eq_level(cat_code_base, level_one);
+ eqtb[internal_math_param_base] = eqtb[cat_code_base];
+ eqtb[lc_code_base] = eqtb[cat_code_base];
+ eqtb[uc_code_base] = eqtb[cat_code_base];
+ eqtb[sf_code_base] = eqtb[cat_code_base];
+ eqtb[math_code_base] = eqtb[cat_code_base];
+ cat_code_table_par = 0;
+ initialize_math_codes();
+ initialize_text_codes();
+ initex_cat_codes(0);
+ for (k = '0'; k <= '9'; k++)
+ set_math_code(k, math_use_current_family_code, 0, k, level_one);
+ for (k = 'A'; k <= 'Z'; k++) {
+ set_math_code(k, math_use_current_family_code, 1, k, level_one);
+ set_math_code((k + 32), math_use_current_family_code, 1, (k + 32), level_one);
+ set_lc_code(k, k + 32, level_one);
+ set_lc_code(k + 32, k + 32, level_one);
+ set_uc_code(k, k, level_one);
+ set_uc_code(k + 32, k, level_one);
+ set_sf_code(k, 999, level_one);
+ }
+ for (k = int_base; k <= attribute_base - 1; k++)
+ eqtb[k].cint = 0;
+ for (k = attribute_base; k <= del_code_base - 1; k++)
+ eqtb[k].cint = UNUSED_ATTRIBUTE;
+ mag_par = 1000;
+ tolerance_par = 10000;
+ hang_after_par = 1;
+ max_dead_cycles_par = 25;
+ math_pre_display_gap_factor_par = 2000;
+ escape_char_par = '\\';
+ end_line_char_par = carriage_return;
+ set_del_code('.', 0, 0, 0, 0, level_one); /* this null delimiter is used in error recovery */
+ ex_hyphen_char_par = '-';
+ output_box_par = 255;
+ for (k = dimen_base; k <= eqtb_size; k++)
+ eqtb[k].cint = 0;
+ page_left_offset_par = one_inch;
+ page_top_offset_par = one_inch;
+ page_right_offset_par = one_inch;
+ page_bottom_offset_par = one_inch;
+ ini_init_primitives();
+ hash_used = frozen_control_sequence; /* nothing is used */
+ hash_high = 0;
+ cs_count = 0;
+ set_eq_type(frozen_dont_expand, dont_expand_cmd);
+ cs_text(frozen_dont_expand) = maketexstring("notexpanded:");
+ set_eq_type(frozen_primitive, ignore_spaces_cmd);
+ set_equiv(frozen_primitive, 1);
+ set_eq_level(frozen_primitive, level_one);
+ cs_text(frozen_primitive) = maketexstring("primitive");
+ create_null_font();
+ font_bytes = 0;
+ px_dimen_par = one_bp;
+ math_eqno_gap_step_par = 1000 ;
+ cs_text(frozen_protection) = maketexstring("inaccessible");
+ format_ident = maketexstring(" (INITEX)");
+ cs_text(end_write) = maketexstring("endwrite");
+ set_eq_level(end_write, level_one);
+ set_eq_type(end_write, outer_call_cmd);
+ set_equiv(end_write, null);
+
+ }
+ synctexoffset = int_base + synctex_code;
+
+}
diff --git a/Build/source/texk/web2c/luatexdir/tex/texmath.w b/Build/source/texk/web2c/luatexdir/tex/texmath.w
index 16911bc4a6c..769fbe8dd35 100644
--- a/Build/source/texk/web2c/luatexdir/tex/texmath.w
+++ b/Build/source/texk/web2c/luatexdir/tex/texmath.w
@@ -1,2569 +1,2569 @@
-% texmath.w
-%
-% Copyright 2008-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
-#include "ptexlib.h"
-
-@ @c
-#define mode mode_par
-#define tail tail_par
-#define head head_par
-#define dir_save dirs_par
-
-/*
-
- \mathdisplayskipmode
-
- tex normally always inserts before and only after when larger than zero
-
- 0 = normal tex
- 1 = always
- 2 = non-zero
- 3 = ignore
-
-*/
-
-@ TODO: not sure if this is the right order
-@c
-#define back_error(A,B) do { \
- OK_to_interrupt=false; \
- back_input(); \
- OK_to_interrupt=true; \
- tex_error(A,B); \
- } while (0)
-
-@ @c
-int scan_math(pointer, int);
-int scan_math_style(pointer, int);
-pointer fin_mlist(pointer);
-
-@ When \TeX\ reads a formula that is enclosed between \.\$'s, it constructs an
-{\sl mlist}, which is essentially a tree structure representing that
-formula. An mlist is a linear sequence of items, but we can regard it as
-a tree structure because mlists can appear within mlists. For example, many
-of the entries can be subscripted or superscripted, and such ``scripts''
-are mlists in their own right.
-
-An entire formula is parsed into such a tree before any of the actual
-typesetting is done, because the current style of type is usually not
-known until the formula has been fully scanned. For example, when the
-formula `\.{\$a+b \\over c+d\$}' is being read, there is no way to tell
-that `\.{a+b}' will be in script size until `\.{\\over}' has appeared.
-
-During the scanning process, each element of the mlist being built is
-classified as a relation, a binary operator, an open parenthesis, etc.,
-or as a construct like `\.{\\sqrt}' that must be built up. This classification
-appears in the mlist data structure.
-
-After a formula has been fully scanned, the mlist is converted to an hlist
-so that it can be incorporated into the surrounding text. This conversion is
-controlled by a recursive procedure that decides all of the appropriate
-styles by a ``top-down'' process starting at the outermost level and working
-in towards the subformulas. The formula is ultimately pasted together using
-combinations of horizontal and vertical boxes, with glue and penalty nodes
-inserted as necessary.
-
-An mlist is represented internally as a linked list consisting chiefly
-of ``noads'' (pronounced ``no-adds''), to distinguish them from the somewhat
-similar ``nodes'' in hlists and vlists. Certain kinds of ordinary nodes are
-allowed to appear in mlists together with the noads; \TeX\ tells the difference
-by means of the |type| field, since a noad's |type| is always greater than
-that of a node. An mlist does not contain character nodes, hlist nodes, vlist
-nodes, math nodes or unset nodes; in particular, each mlist item appears in the
-variable-size part of |mem|, so the |type| field is always present.
-
-Each noad is five or more words long. The first word contains the
-|type| and |subtype| and |link| fields that are already so familiar to
-us; the second contains the attribute list pointer, and the third,
-fourth an fifth words are called the noad's |nucleus|, |subscr|, and
-|supscr| fields. (This use of a combined attribute list is temporary.
-Eventually, each of fields need their own list)
-
-Consider, for example, the simple formula `\.{\$x\^2\$}', which would be
-parsed into an mlist containing a single element called an |ord_noad|.
-The |nucleus| of this noad is a representation of `\.x', the |subscr| is
-empty, and the |supscr| is a representation of `\.2'.
-
-The |nucleus|, |subscr|, and |supscr| fields are further broken into
-subfields. If |p| points to a noad, and if |q| is one of its principal
-fields (e.g., |q=subscr(p)|), |q=null| indicates a field with no value (the
-corresponding attribute of noad |p| is not present). Otherwise, there are
-several possibilities for the subfields, depending on the |type| of |q|.
-
-\yskip\hang|type(q)=math_char_node| means that |math_fam(q)| refers to one of
-the sixteen font families, and |character(q)| is the number of a character
-within a font of that family, as in a character node.
-
-\yskip\hang|type(q)=math_text_char_node| is similar, but the character is
-unsubscripted and unsuperscripted and it is followed immediately by another
-character from the same font. (This |type| setting appears only
-briefly during the processing; it is used to suppress unwanted italic
-corrections.)
-
-\yskip\hang|type(q)=sub_box_node| means that |math_list(q)| points to a box
-node (either an |hlist_node| or a |vlist_node|) that should be used as the
-value of the field. The |shift_amount| in the subsidiary box node is the
-amount by which that box will be shifted downward.
-
-\yskip\hang|type(q)=sub_mlist_node| means that |math_list(q)| points to
-an mlist; the mlist must be converted to an hlist in order to obtain
-the value of this field.
-
-\yskip\noindent In the latter case, we might have |math_list(q)=null|. This
-is not the same as |q=null|; for example, `\.{\$P\_\{\}\$}'
-and `\.{\$P\$}' produce different results (the former will not have the
-``italic correction'' added to the width of |P|, but the ``script skip''
-will be added).
-
-@c
-static void unsave_math(void)
-{
- unsave();
- decr(save_ptr);
- flush_node_list(text_dir_ptr);
- assert(saved_type(0) == saved_textdir);
- text_dir_ptr = saved_value(0);
-}
-
-@ Sometimes it is necessary to destroy an mlist. The following
-subroutine empties the current list, assuming that |abs(mode)=mmode|.
-
-@c
-void flush_math(void)
-{
- flush_node_list(vlink(head));
- flush_node_list(incompleat_noad_par);
- vlink(head) = null;
- tail = head;
- incompleat_noad_par = null;
-}
-
-@ Before we can do anything in math mode, we need fonts.
-
-@c
-#define MATHFONTSTACK 8
-#define MATHFONTDEFAULT 0 /* == nullfont */
-
-static sa_tree math_fam_head = NULL;
-
-@ @c
-int fam_fnt(int fam_id, int size_id)
-{
- int n = fam_id + (256 * size_id);
- return (int) get_sa_item(math_fam_head, n).int_value;
-}
-
-void def_fam_fnt(int fam_id, int size_id, int f, int lvl)
-{
- int n = fam_id + (256 * size_id);
- sa_tree_item sa_value = { 0 };
- sa_value.int_value = f;
- set_sa_item(math_fam_head, n, sa_value, lvl);
- fixup_math_parameters(fam_id, size_id, f, lvl);
- if (tracing_assigns_par > 1) {
- begin_diagnostic();
- tprint("{assigning");
- print_char(' ');
- print_cmd_chr(def_family_cmd, size_id);
- print_int(fam_id);
- print_char('=');
- print_font_identifier(fam_fnt(fam_id, size_id));
- print_char('}');
- end_diagnostic(false);
- }
-}
-
-@ @c
-static void unsave_math_fam_data(int gl)
-{
- sa_stack_item st;
- if (math_fam_head->stack == NULL)
- return;
- while (math_fam_head->stack_ptr > 0 &&
- abs(math_fam_head->stack[math_fam_head->stack_ptr].level)
- >= (int) gl) {
- st = math_fam_head->stack[math_fam_head->stack_ptr];
- if (st.level > 0) {
- rawset_sa_item(math_fam_head, st.code, st.value);
- /* now do a trace message, if requested */
- if (tracing_restores_par > 1) {
- int size_id = st.code / 256;
- int fam_id = st.code % 256;
- begin_diagnostic();
- tprint("{restoring");
- print_char(' ');
- print_cmd_chr(def_family_cmd, size_id);
- print_int(fam_id);
- print_char('=');
- print_font_identifier(fam_fnt(fam_id, size_id));
- print_char('}');
- end_diagnostic(false);
- }
- }
- (math_fam_head->stack_ptr)--;
- }
-}
-
-@ and parameters
-
-@c
-#define MATHPARAMSTACK 8
-#define MATHPARAMDEFAULT undefined_math_parameter
-
-static sa_tree math_param_head = NULL;
-
-@ @c
-void def_math_param(int param_id, int style_id, scaled value, int lvl)
-{
- int n = param_id + (256 * style_id);
- sa_tree_item sa_value = { 0 };
- sa_value.int_value = (int) value;
- set_sa_item(math_param_head, n, sa_value, lvl);
- if (tracing_assigns_par > 1) {
- begin_diagnostic();
- tprint("{assigning");
- print_char(' ');
- print_cmd_chr(set_math_param_cmd, param_id);
- print_cmd_chr(math_style_cmd, style_id);
- print_char('=');
- print_int(value);
- print_char('}');
- end_diagnostic(false);
- }
-}
-
-scaled get_math_param(int param_id, int style_id)
-{
- int n = param_id + (256 * style_id);
- return (scaled) get_sa_item(math_param_head, n).int_value;
-}
-
-@ @c
-static void unsave_math_param_data(int gl)
-{
- sa_stack_item st;
- if (math_param_head->stack == NULL)
- return;
- while (math_param_head->stack_ptr > 0 &&
- abs(math_param_head->stack[math_param_head->stack_ptr].level)
- >= (int) gl) {
- st = math_param_head->stack[math_param_head->stack_ptr];
- if (st.level > 0) {
- rawset_sa_item(math_param_head, st.code, st.value);
- /* now do a trace message, if requested */
- if (tracing_restores_par > 1) {
- int param_id = st.code % 256;
- int style_id = st.code / 256;
- begin_diagnostic();
- tprint("{restoring");
- print_char(' ');
- print_cmd_chr(set_math_param_cmd, param_id);
- print_cmd_chr(math_style_cmd, style_id);
- print_char('=');
- print_int(get_math_param(param_id, style_id));
- print_char('}');
- end_diagnostic(false);
- }
- }
- (math_param_head->stack_ptr)--;
- }
-}
-
-@ saving and unsaving of both
-
-@c
-void unsave_math_data(int gl)
-{
- unsave_math_fam_data(gl);
- unsave_math_param_data(gl);
-}
-
-@ Dumping and undumping
-@c
-void dump_math_data(void)
-{
- sa_tree_item sa_value = { 0 };
- if (math_fam_head == NULL) {
- sa_value.int_value = MATHFONTDEFAULT;
- math_fam_head = new_sa_tree(MATHFONTSTACK, 1, sa_value);
- }
- dump_sa_tree(math_fam_head, "mathfonts");
- if (math_param_head == NULL) {
- sa_value.int_value = MATHPARAMDEFAULT;
- math_param_head = new_sa_tree(MATHPARAMSTACK, 1, sa_value);
- }
- dump_sa_tree(math_param_head, "mathparameters");
-}
-
-void undump_math_data(void)
-{
- math_fam_head = undump_sa_tree("mathfonts");
- math_param_head = undump_sa_tree("mathparameters");
-}
-
-@ @c
-void initialize_math(void)
-{
- sa_tree_item sa_value = { 0 };
- if (math_fam_head == NULL) {
- sa_value.int_value = MATHFONTDEFAULT;
- math_fam_head = new_sa_tree(MATHFONTSTACK, 1, sa_value);
- }
- if (math_param_head == NULL) {
- sa_value.int_value = MATHPARAMDEFAULT;
- math_param_head = new_sa_tree(MATHPARAMSTACK, 1, sa_value);
- initialize_math_spacing();
- }
- return;
-}
-
-@ Each portion of a formula is classified as Ord, Op, Bin, Rel, Ope,
-Clo, Pun, or Inn, for purposes of spacing and line breaking. An
-|ord_noad|, |op_noad|, |bin_noad|, |rel_noad|, |open_noad|, |close_noad|,
-|punct_noad|, or |inner_noad| is used to represent portions of the various
-types. For example, an `\.=' sign in a formula leads to the creation of a
-|rel_noad| whose |nucleus| field is a representation of an equals sign
-(usually |fam=0|, |character=075|). A formula preceded by \.{\\mathrel}
-also results in a |rel_noad|. When a |rel_noad| is followed by an
-|op_noad|, say, and possibly separated by one or more ordinary nodes (not
-noads), \TeX\ will insert a penalty node (with the current |rel_penalty|)
-just after the formula that corresponds to the |rel_noad|, unless there
-already was a penalty immediately following; and a ``thick space'' will be
-inserted just before the formula that corresponds to the |op_noad|.
-
-A noad of type |ord_noad|, |op_noad|, \dots, |inner_noad| usually
-has a |subtype=normal|. The only exception is that an |op_noad| might
-have |subtype=limits| or |no_limits|, if the normal positioning of
-limits has been overridden for this operator.
-
-A |radical_noad| also has a |left_delimiter| field, which usually
-represents a square root sign.
-
-A |fraction_noad| has a |right_delimiter| field as well as a |left_delimiter|.
-
-Delimiter fields have four subfields
-called |small_fam|, |small_char|, |large_fam|, |large_char|. These subfields
-represent variable-size delimiters by giving the ``small'' and ``large''
-starting characters, as explained in Chapter~17 of {\sl The \TeX book}.
-@:TeXbook}{\sl The \TeX book@>
-
-A |fraction_noad| is actually quite different from all other noads.
-It has |thickness|, |denominator|, and |numerator| fields instead of
-|nucleus|, |subscr|, and |supscr|. The |thickness| is a scaled value
-that tells how thick to make a fraction rule; however, the special
-value |default_code| is used to stand for the
-|default_rule_thickness| of the current size. The |numerator| and
-|denominator| point to mlists that define a fraction; we always have
-$$\hbox{|type(numerator)=type(denominator)=sub_mlist|}.$$ The
-|left_delimiter| and |right_delimiter| fields specify delimiters that will
-be placed at the left and right of the fraction. In this way, a
-|fraction_noad| is able to represent all of \TeX's operators \.{\\over},
-\.{\\atop}, \.{\\above}, \.{\\overwithdelims}, \.{\\atopwithdelims}, and
- \.{\\abovewithdelims}.
-
-@ The |new_noad| function creates an |ord_noad| that is completely null
-
-@c
-pointer new_noad(void)
-{
- pointer p;
- p = new_node(simple_noad, ord_noad_type);
- /* all noad fields are zero after this */
- return p;
-}
-
-@ @c
-pointer new_sub_box(pointer curbox)
-{
- pointer p, q;
- p = new_noad();
- q = new_node(sub_box_node, 0);
- nucleus(p) = q;
- math_list(nucleus(p)) = curbox;
- return p;
-}
-
-@ A few more kinds of noads will complete the set: An |under_noad| has its
-nucleus underlined; an |over_noad| has it overlined. An |accent_noad| places
-an accent over its nucleus; the accent character appears as
-|math_fam(accent_chr(p))| and |math_character(accent_chr(p))|. A |vcenter_noad|
-centers its nucleus vertically with respect to the axis of the formula;
-in such noads we always have |type(nucleus(p))=sub_box|.
-
-And finally, we have the |fence_noad| type, to implement
-\TeX's \.{\\left} and \.{\\right} as well as eTeX's \.{\\middle}.
-The |nucleus| of such noads is
-replaced by a |delimiter| field; thus, for example, `\.{\\left(}' produces
-a |fence_noad| such that |delimiter(p)| holds the family and character
-codes for all left parentheses. A |fence_noad| of subtype |left_noad_side|
-never appears in an mlist except as the first element, and a |fence_noad|
-with subtype |right_noad_side| never appears in an mlist
-except as the last element; furthermore, we either have both a |left_noad_side|
-and a |right_noad_side|, or neither one is present.
-
-@ Math formulas can also contain instructions like \.{\\textstyle} that
-override \TeX's normal style rules. A |style_node| is inserted into the
-data structure to record such instructions; it is three words long, so it
-is considered a node instead of a noad. The |subtype| is either |display_style|
-or |text_style| or |script_style| or |script_script_style|. The
-second and third words of a |style_node| are not used, but they are
-present because a |choice_node| is converted to a |style_node|.
-
-\TeX\ uses even numbers 0, 2, 4, 6 to encode the basic styles
-|display_style|, \dots, |script_script_style|, and adds~1 to get the
-``cramped'' versions of these styles. This gives a numerical order that
-is backwards from the convention of Appendix~G in {\sl The \TeX book\/};
-i.e., a smaller style has a larger numerical value.
-@:TeXbook}{\sl The \TeX book@>
-
-@c
-const char *math_style_names[] = {
- "display", "crampeddisplay",
- "text", "crampedtext",
- "script", "crampedscript",
- "scriptscript", "crampedscriptscript",
- NULL
-};
-
-const char *math_param_names[] = {
- "quad", "axis", "operatorsize",
- "overbarkern", "overbarrule", "overbarvgap",
- "underbarkern", "underbarrule", "underbarvgap",
- "radicalkern", "radicalrule", "radicalvgap",
- "radicaldegreebefore", "radicaldegreeafter", "radicaldegreeraise",
- "stackvgap", "stacknumup", "stackdenomdown",
- "fractionrule", "fractionnumvgap", "fractionnumup",
- "fractiondenomvgap", "fractiondenomdown", "fractiondelsize",
- "limitabovevgap", "limitabovebgap", "limitabovekern",
- "limitbelowvgap", "limitbelowbgap", "limitbelowkern",
- "nolimitsubfactor", "nolimitsupfactor", /* bonus */
- "underdelimitervgap", "underdelimiterbgap",
- "overdelimitervgap", "overdelimiterbgap",
- "subshiftdrop", "supshiftdrop", "subshiftdown",
- "subsupshiftdown", "subtopmax", "supshiftup",
- "supbottommin", "supsubbottommax", "subsupvgap",
- "spaceafterscript", "connectoroverlapmin",
- "ordordspacing", "ordopspacing", "ordbinspacing", "ordrelspacing",
- "ordopenspacing", "ordclosespacing", "ordpunctspacing", "ordinnerspacing",
- "opordspacing", "opopspacing", "opbinspacing", "oprelspacing",
- "opopenspacing", "opclosespacing", "oppunctspacing", "opinnerspacing",
- "binordspacing", "binopspacing", "binbinspacing", "binrelspacing",
- "binopenspacing", "binclosespacing", "binpunctspacing", "bininnerspacing",
- "relordspacing", "relopspacing", "relbinspacing", "relrelspacing",
- "relopenspacing", "relclosespacing", "relpunctspacing", "relinnerspacing",
- "openordspacing", "openopspacing", "openbinspacing", "openrelspacing",
- "openopenspacing", "openclosespacing", "openpunctspacing",
- "openinnerspacing",
- "closeordspacing", "closeopspacing", "closebinspacing", "closerelspacing",
- "closeopenspacing", "closeclosespacing", "closepunctspacing",
- "closeinnerspacing",
- "punctordspacing", "punctopspacing", "punctbinspacing", "punctrelspacing",
- "punctopenspacing", "punctclosespacing", "punctpunctspacing",
- "punctinnerspacing",
- "innerordspacing", "inneropspacing", "innerbinspacing", "innerrelspacing",
- "inneropenspacing", "innerclosespacing", "innerpunctspacing",
- "innerinnerspacing",
- NULL
-};
-
-@ @c
-pointer new_style(small_number s)
-{ /* create a style node */
- m_style = s;
- return new_node(style_node, s);
-}
-
-@ Finally, the \.{\\mathchoice} primitive creates a |choice_node|, which
-has special subfields |display_mlist|, |text_mlist|, |script_mlist|,
-and |script_script_mlist| pointing to the mlists for each style.
-
-@c
-static pointer new_choice(void)
-{ /* create a choice node */
- return new_node(choice_node, 0); /* the |subtype| is not used */
-}
-
-@ Let's consider now the previously unwritten part of |show_node_list|
-that displays the things that can only be present in mlists; this
-program illustrates how to access the data structures just defined.
-
-In the context of the following program, |p| points to a node or noad that
-should be displayed, and the current string contains the ``recursion history''
-that leads to this point. The recursion history consists of a dot for each
-outer level in which |p| is subsidiary to some node, or in which |p| is
-subsidiary to the |nucleus| field of some noad; the dot is replaced by
-`\.\_' or `\.\^' or `\./' or `\.\\' if |p| is descended from the |subscr|
-or |supscr| or |denominator| or |numerator| fields of noads. For example,
-the current string would be `\.{.\^.\_/}' if |p| points to the |ord_noad| for
-|x| in the (ridiculous) formula
-`\.{\$\\sqrt\{a\^\{\\mathinner\{b\_\{c\\over x+y\}\}\}\}\$}'.
-
-@c
-void display_normal_noad(pointer p); /* forward */
-void display_fence_noad(pointer p); /* forward */
-void display_fraction_noad(pointer p); /* forward */
-
-void show_math_node(pointer p)
-{
- switch (type(p)) {
- case style_node:
- print_cmd_chr(math_style_cmd, subtype(p));
- break;
- case choice_node:
- tprint_esc("mathchoice");
- append_char('D');
- show_node_list(display_mlist(p));
- flush_char();
- append_char('T');
- show_node_list(text_mlist(p));
- flush_char();
- append_char('S');
- show_node_list(script_mlist(p));
- flush_char();
- append_char('s');
- show_node_list(script_script_mlist(p));
- flush_char();
- break;
- case simple_noad:
- case radical_noad:
- case accent_noad:
- display_normal_noad(p);
- break;
- case fence_noad:
- display_fence_noad(p);
- break;
- case fraction_noad:
- display_fraction_noad(p);
- break;
- default:
- tprint("Unknown node type!");
- break;
- }
-}
-
-@ Here are some simple routines used in the display of noads.
-
-@c
-static void print_fam_and_char(pointer p)
-{ /* prints family and character */
- tprint_esc("fam");
- print_int(math_fam(p));
- print_char(' ');
- print(math_character(p));
-}
-
-@ @c
-static void print_delimiter(pointer p)
-{
- int a;
- if (delimiteroptionset(p)) {
- tprint(" [ ");
- if (delimiteraxis(p))
- tprint("axis ");
- if (delimiternoaxis(p))
- tprint("noaxis ");
- if (delimiterexact(p))
- tprint("exact ");
- tprint("]");
- }
- if (delimiterheight(p)) {
- tprint("height=");
- print_scaled(delimiterheight(p));
- tprint(" ");
- }
- if (delimiterdepth(p)) {
- tprint("depth=");
- print_scaled(delimiterdepth(p));
- tprint(" ");
- }
- if (delimiterclass(p)) {
- tprint("class=");
- print_int(delimiterclass(p));
- tprint(" ");
- }
- if (small_fam(p) < 0) {
- print_int(-1); /* this should never happen */
- } else if (small_fam(p) < 16 && large_fam(p) < 16 &&
- small_char(p) < 256 && large_char(p) < 256) {
- /* traditional tex style */
- a = small_fam(p) * 256 + small_char(p);
- a = a * 0x1000 + large_fam(p) * 256 + large_char(p);
- print_hex(a);
- } else if ((large_fam(p) == 0 && large_char(p) == 0) ||
- small_char(p) > 65535 || large_char(p) > 65535) {
- /* modern xetex/luatex style */
- print_hex(small_fam(p));
- print_hex(small_char(p));
- }
-}
-
-@ The next subroutine will descend to another level of recursion when a
-subsidiary mlist needs to be displayed. The parameter |c| indicates what
-character is to become part of the recursion history. An empty mlist is
-distinguished from a missing field, because these are not equivalent
-(as explained above).
-@^recursion@>
-
-@c
-static void print_subsidiary_data(pointer p, ASCII_code c)
-{ /* display a noad field */
- if ((int) cur_length >= depth_threshold) {
- if (p != null)
- tprint(" []");
- } else {
- append_char(c); /* include |c| in the recursion history */
- if (p != null) {
- switch (type(p)) {
- case math_char_node:
- print_ln();
- print_current_string();
- print_fam_and_char(p);
- break;
- case sub_box_node:
- show_node_list(math_list(p));
- break;
- case sub_mlist_node:
- if (math_list(p) == null) {
- print_ln();
- print_current_string();
- tprint("{}");
- } else {
- show_node_list(math_list(p));
- }
- break;
- }
- }
- flush_char(); /* remove |c| from the recursion history */
- }
-}
-
-@ @c
-void display_normal_noad(pointer p)
-{
- switch (type(p)) {
- case simple_noad:
- switch (subtype(p)) {
- case ord_noad_type:
- tprint_esc("mathord");
- break;
- case op_noad_type_normal:
- case op_noad_type_limits:
- case op_noad_type_no_limits:
- tprint_esc("mathop");
- if (subtype(p) == op_noad_type_limits)
- tprint_esc("limits");
- else if (subtype(p) == op_noad_type_no_limits)
- tprint_esc("nolimits");
- break;
- case bin_noad_type:
- tprint_esc("mathbin");
- break;
- case rel_noad_type:
- tprint_esc("mathrel");
- break;
- case open_noad_type:
- tprint_esc("mathopen");
- break;
- case close_noad_type:
- tprint_esc("mathclose");
- break;
- case punct_noad_type:
- tprint_esc("mathpunct");
- break;
- case inner_noad_type:
- tprint_esc("mathinner");
- break;
- case over_noad_type:
- tprint_esc("overline");
- break;
- case under_noad_type:
- tprint_esc("underline");
- break;
- case vcenter_noad_type:
- tprint_esc("vcenter");
- break;
- default:
- tprint("<unknown noad type!>");
- break;
- }
- break;
- case radical_noad:
- if (subtype(p) == 6)
- tprint_esc("Udelimiterover");
- else if (subtype(p) == 5)
- tprint_esc("Udelimiterunder");
- else if (subtype(p) == 4)
- tprint_esc("Uoverdelimiter");
- else if (subtype(p) == 3)
- tprint_esc("Uunderdelimiter");
- else if (subtype(p) == 2)
- tprint_esc("Uroot");
- else
- tprint_esc("radical");
- print_delimiter(left_delimiter(p));
- if (degree(p) != null) {
- print_subsidiary_data(degree(p), '/');
- }
- if (radicalwidth(p)) {
- tprint("width=");
- print_scaled(radicalwidth(p));
- tprint(" ");
- }
- if (radicaloptionset(p)) {
- tprint(" [ ");
- if (radicalexact(p))
- tprint("exact ");
- if (radicalleft(p))
- tprint("left ");
- if (radicalmiddle(p))
- tprint("middle ");
- if (radicalright(p))
- tprint("right ");
- tprint("]");
- }
- break;
- case accent_noad:
- if (top_accent_chr(p) != null) {
- if (bot_accent_chr(p) != null) {
- tprint_esc("Umathaccent both");
- } else {
- tprint_esc("Umathaccent");
- }
- } else if (bot_accent_chr(p) != null) {
- tprint_esc("Umathaccent bottom");
- } else {
- tprint_esc("Umathaccent overlay");
- }
- if (accentfraction(p)) {
- tprint(" fraction=");
- print_int(accentfraction(p));
- tprint(" ");
- }
- switch (subtype(p)) {
- case 0:
- if (top_accent_chr(p) != null) {
- if (bot_accent_chr(p) != null) {
- print_fam_and_char(top_accent_chr(p));
- print_fam_and_char(bot_accent_chr(p));
- } else {
- print_fam_and_char(top_accent_chr(p));
- }
- } else if (bot_accent_chr(p) != null) {
- print_fam_and_char(bot_accent_chr(p));
- } else {
- print_fam_and_char(overlay_accent_chr(p));
- }
- break;
- case 1:
- if (top_accent_chr(p) != null) {
- tprint(" fixed ");
- print_fam_and_char(top_accent_chr(p));
- if (bot_accent_chr(p) != null) {
- print_fam_and_char(bot_accent_chr(p));
- }
- } else {
- confusion("display_accent_noad");
- }
- break;
- case 2:
- if (bot_accent_chr(p) != null) {
- if (top_accent_chr(p) != null) {
- print_fam_and_char(top_accent_chr(p));
- }
- tprint(" fixed ");
- print_fam_and_char(bot_accent_chr(p));
- } else{
- confusion("display_accent_noad");
- }
- break;
- case 3:
- if (top_accent_chr(p) != null && bot_accent_chr(p) != null) {
- tprint(" fixed ");
- print_fam_and_char(top_accent_chr(p));
- tprint(" fixed ");
- print_fam_and_char(bot_accent_chr(p));
- } else {
- confusion("display_accent_noad");
- }
- break;
- }
- break;
- }
- print_subsidiary_data(nucleus(p), '.');
- print_subsidiary_data(supscr(p), '^');
- print_subsidiary_data(subscr(p), '_');
-}
-
-@ @c
-void display_fence_noad(pointer p)
-{
- if (subtype(p) == right_noad_side)
- tprint_esc("right");
- else if (subtype(p) == left_noad_side)
- tprint_esc("left");
- else
- tprint_esc("middle");
- print_delimiter(delimiter(p));
-}
-
-@ @c
-void display_fraction_noad(pointer p)
-{
- tprint_esc("fraction, thickness ");
- if (thickness(p) == default_code)
- tprint("= default");
- else
- print_scaled(thickness(p));
- if ((left_delimiter(p) != null) &&
- ((small_fam(left_delimiter(p)) != 0) ||
- (small_char(left_delimiter(p)) != 0) ||
- (large_fam(left_delimiter(p)) != 0) ||
- (large_char(left_delimiter(p)) != 0))) {
- tprint(", left-delimiter ");
- print_delimiter(left_delimiter(p));
- }
- if ((right_delimiter(p) != null) &&
- ((small_fam(right_delimiter(p)) != 0) ||
- (small_char(right_delimiter(p)) != 0) ||
- (large_fam(right_delimiter(p)) != 0) ||
- (large_char(right_delimiter(p)) != 0))) {
- tprint(", right-delimiter ");
- print_delimiter(right_delimiter(p));
- }
- print_subsidiary_data(numerator(p), '\\');
- print_subsidiary_data(denominator(p), '/');
-}
-
-@ The routines that \TeX\ uses to create mlists are similar to those we have
-just seen for the generation of hlists and vlists. But it is necessary to
-make ``noads'' as well as nodes, so the reader should review the
-discussion of math mode data structures before trying to make sense out of
-the following program.
-
-Here is a little routine that needs to be done whenever a subformula
-is about to be processed. The parameter is a code like |math_group|.
-
-@c
-static void new_save_level_math(group_code c)
-{
- set_saved_record(0, saved_textdir, 0, text_dir_ptr);
- text_dir_ptr = new_dir(math_direction_par);
- incr(save_ptr);
- new_save_level(c);
- eq_word_define(int_base + body_direction_code, math_direction_par);
- eq_word_define(int_base + par_direction_code, math_direction_par);
- eq_word_define(int_base + text_direction_code, math_direction_par);
-}
-
-@ @c
-static void push_math(group_code c, int mstyle)
-{
- if (math_direction_par != text_direction_par)
- dir_math_save = true;
- push_nest();
- mode = -mmode;
- incompleat_noad_par = null;
- m_style = mstyle;
- new_save_level_math(c);
-}
-
-@ @c
-static void enter_ordinary_math(void)
-{
- push_math(math_shift_group, text_style);
- eq_word_define(int_base + cur_fam_code, -1);
- if (every_math_par != null)
- begin_token_list(every_math_par, every_math_text);
-}
-
-@ @c
-void enter_display_math(void);
-
-@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
-|math_shift| character) is scanned. We must check to see whether this
-`\.\$' is immediately followed by another, in case display math mode is
-called for.
-
-@c
-void init_math(void)
-{
- if (cur_cmd == math_shift_cmd) {
- get_token(); /* |get_x_token| would fail on \.{\\ifmmode}\thinspace! */
- if ((cur_cmd == math_shift_cmd) && (mode > 0)) {
- enter_display_math();
- } else {
- back_input();
- enter_ordinary_math();
- }
- } else if (cur_cmd == math_shift_cs_cmd && cur_chr == display_style && (mode > 0)) {
- enter_display_math();
- } else if (cur_cmd == math_shift_cs_cmd && cur_chr == text_style) {
- enter_ordinary_math();
- } else {
- you_cant();
- }
-}
-
-@ We get into ordinary math mode from display math mode when `\.{\\eqno}' or
-`\.{\\leqno}' appears. In such cases |cur_chr| will be 0 or~1, respectively;
-the value of |cur_chr| is placed onto |save_stack| for safe keeping.
-
-@ When \TeX\ is in display math mode, |cur_group=math_shift_group|,
-so it is not necessary for the |start_eq_no| procedure to test for
-this condition.
-
-@c
-void start_eq_no(void)
-{
- set_saved_record(0, saved_eqno, 0, cur_chr);
- incr(save_ptr);
- enter_ordinary_math();
-}
-
-@ Subformulas of math formulas cause a new level of math mode to be entered,
-on the semantic nest as well as the save stack. These subformulas arise in
-several ways: (1)~A left brace by itself indicates the beginning of a
-subformula that will be put into a box, thereby freezing its glue and
-preventing line breaks. (2)~A subscript or superscript is treated as a
-subformula if it is not a single character; the same applies to
-the nucleus of things like \.{\\underline}. (3)~The \.{\\left} primitive
-initiates a subformula that will be terminated by a matching \.{\\right}.
-The group codes placed on |save_stack| in these three cases are
-|math_group|, |math_group|, and |math_left_group|, respectively.
-
-Here is the code that handles case (1); the other cases are not quite as
-trivial, so we shall consider them later.
-
-@c
-void math_left_brace(void)
-{
- pointer q;
- tail_append(new_noad());
- q = new_node(math_char_node, 0);
- nucleus(tail) = q;
- back_input();
- (void) scan_math(nucleus(tail), m_style);
-}
-
-@ If the inline directions of \.{\\pardir} and \.{\\mathdir} are
-opposite, then this function will return true. Discovering that fact
-is somewhat odd because it needs traversal of the |save_stack|.
-The occurance of displayed equations is weird enough that this is
-probably still better than having yet another field in the |input_stack|
-structures.
-
-None of this makes much sense if the inline direction of either one of
-\.{\\pardir} or \.{\\mathdir} is vertical, but in that case the current
-math machinery is ill suited anyway so I do not bother to test that.
-
-@c
-static boolean math_and_text_reversed_p(void)
-{
- int i = save_ptr - 1;
- while (save_type(i) != level_boundary)
- i--;
- while (i < save_ptr) {
- if (save_type(i) == restore_old_value &&
- save_value(i) == int_base + par_direction_code) {
- if (textdir_opposite(math_direction_par, save_value(i - 1)))
- return true;
- }
- i++;
- }
- return false;
-}
-
-@ When we enter display math mode, we need to call |line_break| to
-process the partial paragraph that has just been interrupted by the
-display. Then we can set the proper values of |display_width| and
-|display_indent| and |pre_display_size|.
-
-@c
-void enter_display_math(void)
-{
- scaled w; /* new or partial |pre_display_size| */
- scaled l; /* new |display_width| */
- scaled s; /* new |display_indent| */
- pointer p;
- int n; /* scope of paragraph shape specification */
- if (head == tail || /* `\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}' */
- (vlink(head) == tail && /* the 2nd of \.{\$\${ }\$\$} \.{\$\${ }\$\$} */
- type(tail) == local_par_node && vlink(tail) == null)) {
- if (vlink(head) == tail) {
- /* bug \#270: |resume_after_display| inserts a |local_par_node|, but if
- there is another display immediately following, we have to get rid
- of that node */
- flush_node(tail);
- }
- pop_nest();
- w = -max_dimen;
- } else {
- line_break(true, math_shift_group);
- w = actual_box_width(just_box, (2 * quad(get_cur_font())));
- }
- /* now we are in vertical mode, working on the list that will contain the display */
- /* A displayed equation is considered to be three lines long, so we
- calculate the length and offset of line number |prev_graf+2|. */
- if (par_shape_par_ptr == null) {
- if ((hang_indent_par != 0) && (((hang_after_par >= 0) && (prev_graf_par + 2 > hang_after_par)) || (prev_graf_par + 1 < -hang_after_par))) {
- halfword used_hang_indent = swap_hang_indent(hang_indent_par);
- l = hsize_par - abs(used_hang_indent);
- if (used_hang_indent > 0)
- s = used_hang_indent;
- else
- s = 0;
- } else {
- l = hsize_par;
- s = 0;
- }
- } else {
- n = vinfo(par_shape_par_ptr + 1);
- if (prev_graf_par + 2 >= n)
- p = par_shape_par_ptr + 2 * n + 1;
- else
- p = par_shape_par_ptr + 2 * (prev_graf_par + 2) + 1;
- s = varmem[(p - 1)].cint;
- l = varmem[p].cint;
- s = swap_parshape_indent(s,l);
- }
-
- push_math(math_shift_group, display_style);
- mode = mmode;
- eq_word_define(int_base + cur_fam_code, -1);
- eq_word_define(dimen_base + pre_display_size_code, w);
- eq_word_define(dimen_base + display_width_code, l);
- eq_word_define(dimen_base + display_indent_code, s);
- eq_word_define(int_base + pre_display_direction_code, (math_and_text_reversed_p() ? -1 : 0));
- if (every_display_par != null)
- begin_token_list(every_display_par, every_display_text);
- if (nest_ptr == 1) {
- checked_page_filter(before_display);
- build_page();
- }
-}
-
-@ The next routine parses all variations of a delimiter code. The |extcode|
- tells what syntax form to use (\TeX, XeTeX, XeTeXnum, ...) , the
- |doclass| tells whether or not read a math class also (for \.{\\delimiter} c.s.).
- (the class is passed on for conversion to \.{\\mathchar}).
-
-@c
-static delcodeval do_scan_extdef_del_code(int extcode, boolean doclass)
-{
- const char *hlp[] = {
- "I'm going to use 0 instead of that illegal code value.",
- NULL
- };
- delcodeval d;
- int mcls = 0, msfam = 0, mschr = 0, mlfam = 0, mlchr = 0;
- if (extcode == tex_mathcode) { /* \.{\\delcode}, this is the easiest */
- scan_int();
- /* "MFCCFCC or "FCCFCC */
- if (doclass) {
- mcls = (cur_val / 0x1000000);
- cur_val = (cur_val & 0xFFFFFF);
- }
- if (cur_val > 0xFFFFFF) {
- tex_error("Invalid delimiter code", hlp);
- cur_val = 0;
- }
- msfam = (cur_val / 0x100000);
- mschr = (cur_val % 0x100000) / 0x1000;
- mlfam = (cur_val & 0xFFF) / 0x100;
- mlchr = (cur_val % 0x100);
- } else if (extcode == umath_mathcode) { /* \.{\\Udelcode} */
- /* <0-7>,<0-0xFF>,<0-0x10FFFF> or <0-0xFF>,<0-0x10FFFF> */
- if (doclass) {
- scan_int();
- mcls = cur_val;
- }
- scan_int();
- msfam = cur_val;
- scan_char_num();
- mschr = cur_val;
- if (msfam < 0 || msfam > 255) {
- tex_error("Invalid delimiter code", hlp);
- msfam = 0;
- mschr = 0;
- }
- mlfam = 0;
- mlchr = 0;
- } else if (extcode == umathnum_mathcode) { /* \.{\\Udelcodenum} */
- /* "FF<21bits> */
- /* the largest numeric value is $2^29-1$, but
- the top of bit 21 can't be used as it contains invalid USV's
- */
- if (doclass) { /* such a primitive doesn't exist */
- confusion("umathnum_mathcode");
- }
- scan_int();
- msfam = (cur_val / 0x200000);
- mschr = cur_val & 0x1FFFFF;
- if (msfam < 0 || msfam > 255 || mschr > 0x10FFFF) {
- tex_error("Invalid delimiter code", hlp);
- msfam = 0;
- mschr = 0;
- }
- mlfam = 0;
- mlchr = 0;
- } else {
- /* something's gone wrong */
- confusion("unknown_extcode");
- }
- d.class_value = mcls;
- d.small_family_value = msfam;
- d.small_character_value = mschr;
- d.large_family_value = mlfam;
- d.large_character_value = mlchr;
- return d;
-}
-
-@ @c
-void scan_extdef_del_code(int level, int extcode)
-{
- delcodeval d;
- int p;
- scan_char_num();
- p = cur_val;
- scan_optional_equals();
- d = do_scan_extdef_del_code(extcode, false);
- set_del_code(p, d.small_family_value, d.small_character_value,
- d.large_family_value, d.large_character_value,
- (quarterword) (level));
-}
-
-@ @c
-mathcodeval scan_mathchar(int extcode)
-{
- char errstr[255] = { 0 };
- const char *hlp[] = {
- "I'm going to use 0 instead of that illegal code value.",
- NULL
- };
- mathcodeval d;
- int mcls = 0, mfam = 0, mchr = 0;
- if (extcode == tex_mathcode) { /* \.{\\mathcode} */
- /* "TFCC */
- scan_int();
- if (cur_val > 0x8000) {
- /*
- tex_error("Invalid math code", hlp);
- cur_val = 0;
- */
- /* needed for latex: fallback to umathnum_mathcode */
- mfam = (cur_val / 0x200000) & 0x7FF;
- mcls = mfam % 0x08;
- mfam = mfam / 0x08;
- mchr = cur_val & 0x1FFFFF;
- if (mchr > 0x10FFFF) {
- tex_error("Invalid math code during > 0x8000 mathcode fallback", hlp);
- mcls = 0;
- mfam = 0;
- mchr = 0;
- }
- } else {
- if (cur_val < 0) {
- snprintf(errstr, 255, "Bad mathchar (%d)", (int)cur_val);
- tex_error(errstr, hlp);
- cur_val = 0;
- }
- mcls = (cur_val / 0x1000);
- mfam = ((cur_val % 0x1000) / 0x100);
- mchr = (cur_val % 0x100);
- }
- } else if (extcode == umath_mathcode) {
- /* <0-0x7> <0-0xFF> <0-0x10FFFF> */
- scan_int();
- mcls = cur_val;
- scan_int();
- mfam = cur_val;
- scan_char_num();
- mchr = cur_val;
- if (mcls < 0 || mcls > 7 || mfam > 255) {
- tex_error("Invalid math code", hlp);
- mchr = 0;
- mfam = 0;
- mcls = 0;
- }
- } else if (extcode == umathnum_mathcode) {
- /* "FFT<21bits> */
- /* the largest numeric value is $2^32-1$, but
- the top of bit 21 can't be used as it contains invalid USV's
- */
- /* Note: |scan_int| won't accept families 128-255 because these use bit 32 */
- scan_int();
- mfam = (cur_val / 0x200000) & 0x7FF;
- mcls = mfam % 0x08;
- mfam = mfam / 0x08;
- mchr = cur_val & 0x1FFFFF;
- if (mchr > 0x10FFFF) {
- tex_error("Invalid math code", hlp);
- mcls = 0;
- mfam = 0;
- mchr = 0;
- }
- } else {
- /* something's gone wrong */
- confusion("unknown_extcode");
- }
- d.class_value = mcls;
- d.family_value = mfam;
- d.character_value = mchr;
- return d;
-}
-
-@ @c
-void scan_extdef_math_code(int level, int extcode)
-{
- mathcodeval d;
- int p;
- scan_char_num();
- p = cur_val;
- scan_optional_equals();
- d = scan_mathchar(extcode);
- set_math_code(p, d.class_value,
- d.family_value, d.character_value, (quarterword) (level));
-}
-
-@ this reads in a delcode when actually a mathcode is needed
-@c
-mathcodeval scan_delimiter_as_mathchar(int extcode)
-{
- delcodeval dval;
- mathcodeval mval;
- dval = do_scan_extdef_del_code(extcode, true);
- mval.class_value = dval.class_value;
- mval.family_value = dval.small_family_value;
- mval.character_value = dval.small_character_value;
- return mval;
-}
-
-@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad
-are broken down into subfields called |type| and either |math_list| or
-|(math_fam,math_character)|. The job of |scan_math| is to figure out
-what to place in one of these principal fields; it looks at the
-subformula that comes next in the input, and places an encoding of
-that subformula into a given word of |mem|.
-
-@c
-#define get_next_nb_nr() do { get_x_token(); } while (cur_cmd==spacer_cmd||cur_cmd==relax_cmd)
-
-int scan_math_style(pointer p, int mstyle)
-{
- get_next_nb_nr();
- back_input();
- scan_left_brace();
- set_saved_record(0, saved_math, 0, p);
- incr(save_ptr);
- push_math(math_group, mstyle);
- return 1;
-}
-
-int scan_math(pointer p, int mstyle)
-{
- /* label restart,reswitch,exit; */
- mathcodeval mval = { 0, 0, 0 };
- assert(p != null);
- RESTART:
- get_next_nb_nr();
- RESWITCH:
- switch (cur_cmd) {
- case letter_cmd:
- case other_char_cmd:
- case char_given_cmd:
- mval = get_math_code(cur_chr);
- if (mval.class_value == 8) {
- /* An active character that is an |outer_call| is allowed here */
- cur_cs = active_to_cs(cur_chr, true);
- cur_cmd = eq_type(cur_cs);
- cur_chr = equiv(cur_cs);
- x_token();
- back_input();
- goto RESTART;
- }
- break;
- case char_num_cmd:
- scan_char_num();
- cur_chr = cur_val;
- cur_cmd = char_given_cmd;
- goto RESWITCH;
- break;
- case math_char_num_cmd:
- if (cur_chr == 0)
- mval = scan_mathchar(tex_mathcode);
- else if (cur_chr == 1)
- mval = scan_mathchar(umath_mathcode);
- else if (cur_chr == 2)
- mval = scan_mathchar(umathnum_mathcode);
- else
- confusion("scan_math");
- break;
- case math_given_cmd:
- mval = mathchar_from_integer(cur_chr, tex_mathcode);
- break;
- case xmath_given_cmd:
- mval = mathchar_from_integer(cur_chr, umath_mathcode);
- break;
- case delim_num_cmd:
- if (cur_chr == 0)
- mval = scan_delimiter_as_mathchar(tex_mathcode);
- else if (cur_chr == 1)
- mval = scan_delimiter_as_mathchar(umath_mathcode);
- else
- confusion("scan_math");
- break;
- default:
- /* The pointer |p| is placed on |save_stack| while a complex subformula
- is being scanned. */
- back_input();
- scan_left_brace();
- set_saved_record(0, saved_math, 0, p);
- incr(save_ptr);
- push_math(math_group, mstyle);
- return 1;
- }
- type(p) = math_char_node;
- math_character(p) = mval.character_value;
- if ((mval.class_value == math_use_current_family_code) && cur_fam_par_in_range)
- math_fam(p) = cur_fam_par;
- else
- math_fam(p) = mval.family_value;
- return 0;
-}
-
-@ The |set_math_char| procedure creates a new noad appropriate to a given
-math code, and appends it to the current mlist. However, if the math code
-is sufficiently large, the |cur_chr| is treated as an active character and
-nothing is appended.
-
-@c
-void set_math_char(mathcodeval mval)
-{
- pointer p; /* the new noad */
- if (mval.class_value == 8) {
- /* An active character that is an |outer_call| is allowed here */
- cur_cs = active_to_cs(cur_chr, true);
- cur_cmd = eq_type(cur_cs);
- cur_chr = equiv(cur_cs);
- x_token();
- back_input();
- } else {
- pointer q;
- p = new_noad();
- q = new_node(math_char_node, 0);
- nucleus(p) = q;
- math_character(nucleus(p)) = mval.character_value;
- math_fam(nucleus(p)) = mval.family_value;
- if (mval.class_value == math_use_current_family_code) {
- if (cur_fam_par_in_range)
- math_fam(nucleus(p)) = cur_fam_par;
- subtype(p) = ord_noad_type;
- } else {
- switch (mval.class_value) {
- /* *INDENT-OFF* */
- case 0: subtype(p) = ord_noad_type; break;
- case 1: subtype(p) = op_noad_type_normal; break;
- case 2: subtype(p) = bin_noad_type; break;
- case 3: subtype(p) = rel_noad_type; break;
- case 4: subtype(p) = open_noad_type; break;
- case 5: subtype(p) = close_noad_type; break;
- case 6: subtype(p) = punct_noad_type; break;
- /* *INDENT-ON* */
- }
- }
- vlink(tail) = p;
- tail = p;
- }
-}
-
-@ The |math_char_in_text| procedure creates a new node representing a math char
-in text code, and appends it to the current list. However, if the math code
-is sufficiently large, the |cur_chr| is treated as an active character and
-nothing is appended.
-
-@c
-void math_char_in_text(mathcodeval mval)
-{
- pointer p; /* the new node */
- if (mval.class_value == 8) {
- /* An active character that is an |outer_call| is allowed here */
- cur_cs = active_to_cs(cur_chr, true);
- cur_cmd = eq_type(cur_cs);
- cur_chr = equiv(cur_cs);
- x_token();
- back_input();
- } else {
- p = new_char(fam_fnt(mval.family_value, text_size), mval.character_value);
- vlink(tail) = p;
- tail = p;
- }
-}
-
-@ @c
-void math_math_comp(void)
-{
- pointer q;
- tail_append(new_noad());
- subtype(tail) = (quarterword) cur_chr;
- q = new_node(math_char_node, 0);
- nucleus(tail) = q;
- if (cur_chr == over_noad_type)
- (void) scan_math(nucleus(tail), cramped_style(m_style));
- else
- (void) scan_math(nucleus(tail), m_style);
-}
-
-@ @c
-void math_limit_switch(void)
-{
- const char *hlp[] = {
- "I'm ignoring this misplaced \\limits or \\nolimits command.",
- NULL
- };
- if (head != tail) {
- if (type(tail) == simple_noad &&
- (subtype(tail) == op_noad_type_normal ||
- subtype(tail) == op_noad_type_limits ||
- subtype(tail) == op_noad_type_no_limits)) {
- subtype(tail) = (quarterword) cur_chr;
- return;
- }
- }
- tex_error("Limit controls must follow a math operator", hlp);
-}
-
-@ Delimiter fields of noads are filled in by the |scan_delimiter| routine.
-The first parameter of this procedure is the |mem| address where the
-delimiter is to be placed; the second tells if this delimiter follows
-\.{\\radical} or not.
-
-@c
-static void scan_delimiter(pointer p, int r)
-{
- delcodeval dval = { 0, 0, 0, 0, 0 };
- if (r == tex_mathcode) { /* \.{\\radical} */
- dval = do_scan_extdef_del_code(tex_mathcode, true);
- } else if (r == umath_mathcode) { /* \.{\\Uradical} */
- dval = do_scan_extdef_del_code(umath_mathcode, false);
- } else if (r == no_mathcode) {
- get_next_nb_nr();
- switch (cur_cmd) {
- case letter_cmd:
- case other_char_cmd:
- dval = get_del_code(cur_chr);
- break;
- case delim_num_cmd:
- if (cur_chr == 0) /* \.{\\delimiter} */
- dval = do_scan_extdef_del_code(tex_mathcode, true);
- else if (cur_chr == 1) /* \.{\\Udelimiter} */
- dval = do_scan_extdef_del_code(umath_mathcode, true);
- else
- confusion("scan_delimiter1");
- break;
- default:
- dval.small_family_value = -1;
- break;
- }
- } else {
- confusion("scan_delimiter2");
- }
- if (p == null)
- return;
- if (dval.small_family_value < 0) {
- const char *hlp[] = {
- "I was expecting to see something like `(' or `\\{' or",
- "`\\}' here. If you typed, e.g., `{' instead of `\\{', you",
- "should probably delete the `{' by typing `1' now, so that",
- "braces don't get unbalanced. Otherwise just proceed",
- "Acceptable delimiters are characters whose \\delcode is",
- "nonnegative, or you can use `\\delimiter <delimiter code>'.",
- NULL
- };
- back_error("Missing delimiter (. inserted)", hlp);
- small_fam(p) = 0;
- small_char(p) = 0;
- large_fam(p) = 0;
- large_char(p) = 0;
- } else {
- small_fam(p) = dval.small_family_value;
- small_char(p) = dval.small_character_value;
- large_fam(p) = dval.large_family_value;
- large_char(p) = dval.large_character_value;
- }
- return;
-}
-
-@ @c
-void math_radical(void)
-{
- halfword q;
- int chr_code = cur_chr;
- halfword options = 0;
- tail_append(new_node(radical_noad, chr_code));
- q = new_node(delim_node, 0);
- left_delimiter(tail) = q;
- while (1) {
- if (scan_keyword("width")) {
- scan_dimen(false,false,false);
- radicalwidth(tail) = cur_val ;
- } else if (scan_keyword("left")) {
- options = options | noad_option_left ;
- } else if (scan_keyword("middle")) {
- options = options | noad_option_middle ;
- } else if (scan_keyword("right")) {
- options = options | noad_option_right ;
- } else {
- break;
- }
- }
- radicaloptions(tail) = options;
- if (chr_code == 0) /* \.{\\radical} */
- scan_delimiter(left_delimiter(tail), tex_mathcode);
- else if (chr_code == 1) /* \.{\\Uradical} */
- scan_delimiter(left_delimiter(tail), umath_mathcode);
- else if (chr_code == 2) /* \.{\\Uroot} */
- scan_delimiter(left_delimiter(tail), umath_mathcode);
- else if (chr_code == 3) /* \.{\\Uunderdelimiter} */
- scan_delimiter(left_delimiter(tail), umath_mathcode);
- else if (chr_code == 4) /* \.{\\Uoverdelimiter} */
- scan_delimiter(left_delimiter(tail), umath_mathcode);
- else if (chr_code == 5) /* \.{\\Udelimiterunder} */
- scan_delimiter(left_delimiter(tail), umath_mathcode);
- else if (chr_code == 6) /* \.{\\Udelimiterover} */
- scan_delimiter(left_delimiter(tail), umath_mathcode);
- else if (chr_code == 7) /* \.{\\Uhextensible} */
- scan_delimiter(left_delimiter(tail), umath_mathcode);
- else
- confusion("math_radical");
- if (chr_code == 7) {
- q = new_node(sub_box_node, 0); /* type will change */
- nucleus(tail) = q;
- return;
- } else if (chr_code == 2) {
- /* the trick with the |vlink(q)| is used by |scan_math|
- to decide whether it needs to go on */
- q = new_node(math_char_node, 0);
- vlink(q) = tail;
- degree(tail) = q;
- if (!scan_math(degree(tail), sup_sup_style(m_style))) {
- vlink(degree(tail)) = null;
- q = new_node(math_char_node, 0);
- nucleus(tail) = q;
- (void) scan_math(nucleus(tail), cramped_style(m_style));
- }
- } else {
- q = new_node(math_char_node, 0);
- nucleus(tail) = q;
- (void) scan_math(nucleus(tail), cramped_style(m_style));
- }
-}
-
-@ @c
-void math_ac(void)
-{
- halfword q;
- mathcodeval t = { 0, 0, 0 };
- mathcodeval b = { 0, 0, 0 };
- mathcodeval o = { 0, 0, 0 };
- if (cur_cmd == accent_cmd) {
- const char *hlp[] = {
- "I'm changing \\accent to \\mathaccent here; wish me luck.",
- "(Accents are not the same in formulas as they are in text.)",
- NULL
- };
- tex_error("Please use \\mathaccent for accents in math mode", hlp);
- }
- tail_append(new_node(accent_noad, 0));
- if (cur_chr == 0) { /* \.{\\mathaccent} */
- t = scan_mathchar(tex_mathcode);
- } else if (cur_chr == 1) { /* \.{\\Umathaccent} */
- if (scan_keyword("fixed")) {
- /* top */
- subtype(tail) = 1;
- t = scan_mathchar(umath_mathcode);
- } else if (scan_keyword("both")) {
- /* top bottom */
- if (scan_keyword("fixed")) {
- subtype(tail) = 1;
- }
- t = scan_mathchar(umath_mathcode);
- if (scan_keyword("fixed")) {
- subtype(tail) += 2;
- }
- b = scan_mathchar(umath_mathcode);
- } else if (scan_keyword("bottom")) {
- /* bottom */
- if (scan_keyword("fixed")) {
- subtype(tail) = 2;
- }
- b = scan_mathchar(umath_mathcode);
- } else if (scan_keyword("top")) {
- /* top */
- if (scan_keyword("fixed")) {
- subtype(tail) = 1;
- }
- t = scan_mathchar(umath_mathcode);
- } else if (scan_keyword("overlay")) {
- /* overlay */
- if (scan_keyword("fixed")) {
- subtype(tail) = 1;
- }
- o = scan_mathchar(umath_mathcode);
- } else {
- /* top */
- t = scan_mathchar(umath_mathcode);
- }
- if (scan_keyword("fraction")) {
- scan_int();
- accentfraction(tail) = cur_val;
- }
- } else {
- confusion("mathaccent");
- }
- if (!(t.character_value == 0 && t.family_value == 0)) {
- q = new_node(math_char_node, 0);
- top_accent_chr(tail) = q;
- math_character(top_accent_chr(tail)) = t.character_value;
- if ((t.class_value == math_use_current_family_code) && cur_fam_par_in_range)
- math_fam(top_accent_chr(tail)) = cur_fam_par;
- else
- math_fam(top_accent_chr(tail)) = t.family_value;
- }
- if (!(b.character_value == 0 && b.family_value == 0)) {
- q = new_node(math_char_node, 0);
- bot_accent_chr(tail) = q;
- math_character(bot_accent_chr(tail)) = b.character_value;
- if ((b.class_value == math_use_current_family_code) && cur_fam_par_in_range)
- math_fam(bot_accent_chr(tail)) = cur_fam_par;
- else
- math_fam(bot_accent_chr(tail)) = b.family_value;
- }
- if (!(o.character_value == 0 && o.family_value == 0)) {
- q = new_node(math_char_node, 0);
- overlay_accent_chr(tail) = q;
- math_character(overlay_accent_chr(tail)) = o.character_value;
- if ((o.class_value == math_use_current_family_code) && cur_fam_par_in_range)
- math_fam(overlay_accent_chr(tail)) = cur_fam_par;
- else
- math_fam(overlay_accent_chr(tail)) = o.family_value;
- }
- q = new_node(math_char_node, 0);
- nucleus(tail) = q;
- (void) scan_math(nucleus(tail), cramped_style(m_style));
-}
-
-@ @c
-pointer math_vcenter_group(pointer p)
-{
- pointer q, r;
- q = new_noad();
- subtype(q) = vcenter_noad_type;
- r = new_node(sub_box_node, 0);
- nucleus(q) = r;
- math_list(nucleus(q)) = p;
- return q;
-}
-
-@ The routine that scans the four mlists of a \.{\\mathchoice} is very
-much like the routine that builds discretionary nodes.
-
-@c
-void append_choices(void)
-{
- tail_append(new_choice());
- incr(save_ptr);
- set_saved_record(-1, saved_choices, 0, 0);
- push_math(math_choice_group, display_style);
- scan_left_brace();
-}
-
-@ @c
-void build_choices(void)
-{
- pointer p; /* the current mlist */
- int prev_style;
- prev_style = m_style;
- unsave_math();
- p = fin_mlist(null);
- assert(saved_type(-1) == saved_choices);
- switch (saved_value(-1)) {
- case 0:
- display_mlist(tail) = p;
- break;
- case 1:
- text_mlist(tail) = p;
- break;
- case 2:
- script_mlist(tail) = p;
- break;
- case 3:
- script_script_mlist(tail) = p;
- decr(save_ptr);
- return;
- break;
- } /* there are no other cases */
- set_saved_record(-1, saved_choices, 0, (saved_value(-1) + 1));
- push_math(math_choice_group, (prev_style + 2));
- scan_left_brace();
-}
-
-@ Subscripts and superscripts are attached to the previous nucleus by the
-action procedure called |sub_sup|.
-
-@c
-void sub_sup(void)
-{
- pointer q;
- if (tail == head || (!scripts_allowed(tail))) {
- tail_append(new_noad());
- q = new_node(sub_mlist_node, 0);
- nucleus(tail) = q;
- }
- if (cur_cmd == sup_mark_cmd || cur_chr == sup_mark_cmd) { /* |super_sub_script| */
- if (supscr(tail) != null) {
- const char *hlp[] = {
- "I treat `x^1^2' essentially like `x^1{}^2'.", NULL
- };
- tail_append(new_noad());
- q = new_node(sub_mlist_node, 0);
- nucleus(tail) = q;
- tex_error("Double superscript", hlp);
- }
- q = new_node(math_char_node, 0);
- supscr(tail) = q;
- (void) scan_math(supscr(tail), sup_style(m_style));
- } else if (cur_cmd == sub_mark_cmd || cur_chr == sub_mark_cmd) {
- if (subscr(tail) != null) {
- const char *hlp[] = {
- "I treat `x_1_2' essentially like `x_1{}_2'.", NULL
- };
- tail_append(new_noad());
- q = new_node(sub_mlist_node, 0);
- nucleus(tail) = q;
- tex_error("Double subscript", hlp);
- }
- q = new_node(math_char_node, 0);
- subscr(tail) = q;
- (void) scan_math(subscr(tail), sub_style(m_style));
- }
-}
-
-@ An operation like `\.{\\over}' causes the current mlist to go into a
-state of suspended animation: |incompleat_noad| points to a |fraction_noad|
-that contains the mlist-so-far as its numerator, while the denominator
-is yet to come. Finally when the mlist is finished, the denominator will
-go into the incompleat fraction noad, and that noad will become the
-whole formula, unless it is surrounded by `\.{\\left}' and `\.{\\right}'
-delimiters.
-
-@c
-void math_fraction(void)
-{
- halfword c; /* the type of generalized fraction we are scanning */
- pointer q;
- halfword options = 0;
- halfword temp_value;
- c = cur_chr;
- if (incompleat_noad_par != null) {
- const char *hlp[] = {
- "I'm ignoring this fraction specification, since I don't",
- "know whether a construction like `x \\over y \\over z'",
- "means `{x \\over y} \\over z' or `x \\over {y \\over z}'.",
- NULL
- };
- if (c >= delimited_code) {
- scan_delimiter(null, no_mathcode);
- scan_delimiter(null, no_mathcode);
- }
- if ((c % delimited_code) == above_code)
- scan_normal_dimen();
- tex_error("Ambiguous; you need another { and }", hlp);
- } else {
- incompleat_noad_par = new_node(fraction_noad, 0);
- temp_value = new_node(sub_mlist_node, 0);
- numerator(incompleat_noad_par) = temp_value;
- math_list(numerator(incompleat_noad_par)) = vlink(head);
- vlink(head) = null;
- tail = head;
- m_style = cramped_style(m_style);
-
- if ((c % delimited_code) == skewed_code) {
- q = new_node(delim_node, 0);
- middle_delimiter(incompleat_noad_par) = q;
- scan_delimiter(middle_delimiter(incompleat_noad_par), no_mathcode);
- }
- if (c >= delimited_code) {
- q = new_node(delim_node, 0);
- left_delimiter(incompleat_noad_par) = q;
- q = new_node(delim_node, 0);
- right_delimiter(incompleat_noad_par) = q;
- scan_delimiter(left_delimiter(incompleat_noad_par), no_mathcode);
- scan_delimiter(right_delimiter(incompleat_noad_par), no_mathcode);
- }
- switch (c % delimited_code) {
- case above_code:
- while (1) {
- if (scan_keyword("exact")) {
- options = options | noad_option_exact ;
- } else {
- break;
- }
- }
- fractionoptions(incompleat_noad_par) = options;
- scan_normal_dimen();
- thickness(incompleat_noad_par) = cur_val;
- break;
- case over_code:
- thickness(incompleat_noad_par) = default_code;
- break;
- case atop_code:
- thickness(incompleat_noad_par) = 0;
- break;
- case skewed_code:
- while (1) {
- if (scan_keyword("exact")) {
- options = options | noad_option_exact ;
- } else if (scan_keyword("noaxis")) {
- options = options | noad_option_no_axis ;
- } else {
- break;
- }
- }
- fractionoptions(incompleat_noad_par) = options;
- thickness(incompleat_noad_par) = 0;
- break;
- }
- }
-}
-
-@ At the end of a math formula or subformula, the |fin_mlist| routine is
-called upon to return a pointer to the newly completed mlist, and to
-pop the nest back to the enclosing semantic level. The parameter to
-|fin_mlist|, if not null, points to a |fence_noad| that ends the
-current mlist; this |fence_noad| has not yet been appended.
-
-@c
-pointer fin_mlist(pointer p)
-{
- pointer q; /* the mlist to return */
- if (incompleat_noad_par != null) {
- if (denominator(incompleat_noad_par) != null) {
- type(denominator(incompleat_noad_par)) = sub_mlist_node;
- } else {
- q = new_node(sub_mlist_node, 0);
- denominator(incompleat_noad_par) = q;
- }
- math_list(denominator(incompleat_noad_par)) = vlink(head);
- if (p == null) {
- q = incompleat_noad_par;
- } else {
- q = math_list(numerator(incompleat_noad_par));
- if ((type(q) != fence_noad) || (subtype(q) != left_noad_side)
- || (delim_par == null))
- confusion("right"); /* this can't happen */
- math_list(numerator(incompleat_noad_par)) = vlink(delim_par);
- vlink(delim_par) = incompleat_noad_par;
- vlink(incompleat_noad_par) = p;
- }
- } else {
- vlink(tail) = p;
- q = vlink(head);
- }
- pop_nest();
- return q;
-}
-
-@ Now at last we're ready to see what happens when a right brace occurs
-in a math formula. Two special cases are simplified here: Braces are effectively
-removed when they surround a single Ord without sub/superscripts, or when they
-surround an accent that is the nucleus of an Ord atom.
-
-@c
-void close_math_group(pointer p)
-{
- int old_style = m_style;
- unsave_math();
-
- decr(save_ptr);
- assert(saved_type(0) == saved_math);
- type(saved_value(0)) = sub_mlist_node;
- p = fin_mlist(null);
- math_list(saved_value(0)) = p;
- if (p != null) {
- if (vlink(p) == null) {
- if (type(p) == simple_noad && subtype(p) == ord_noad_type) {
- if (subscr(p) == null && supscr(p) == null) {
- type(saved_value(0)) = type(nucleus(p));
- if (type(nucleus(p)) == math_char_node) {
- math_fam(saved_value(0)) = math_fam(nucleus(p));
- math_character(saved_value(0)) =
- math_character(nucleus(p));
- } else {
- math_list(saved_value(0)) = math_list(nucleus(p));
- math_list(nucleus(p)) = null;
- }
- delete_attribute_ref(node_attr(saved_value(0)));
- node_attr(saved_value(0)) = node_attr(nucleus(p));
- node_attr(nucleus(p)) = null;
- flush_node(p);
- }
- } else if (type(p) == accent_noad) {
- if (saved_value(0) == nucleus(tail)) {
- if (type(tail) == simple_noad
- && subtype(tail) == ord_noad_type) {
- pointer q = head;
- while (vlink(q) != tail)
- q = vlink(q);
- vlink(q) = p;
- nucleus(tail) = null;
- subscr(tail) = null;
- supscr(tail) = null;
- delete_attribute_ref(node_attr(p));
- node_attr(p) = node_attr(tail);
- node_attr(tail) = null;
- flush_node(tail);
- tail = p;
- }
- }
- }
- }
- }
- if (vlink(saved_value(0)) > 0) {
- pointer q;
- q = new_node(math_char_node, 0);
- nucleus(vlink(saved_value(0))) = q;
- vlink(saved_value(0)) = null;
- saved_value(0) = q;
- (void) scan_math(saved_value(0), old_style);
- /* restart */
- }
-}
-
-@ We have dealt with all constructions of math mode except `\.{\\left}' and
-`\.{\\right}', so the picture is completed by the following sections of
-the program. The |middle| feature of eTeX allows one ore several \.{\\middle}
-delimiters to appear between \.{\\left} and \.{\\right}.
-
-@c
-void math_left_right(void)
-{
- halfword t; /* |left_noad_side| .. |right_noad_side| */
- pointer p; /* new noad */
- pointer q; /* resulting mlist */
- pointer r; /* temporary */
- halfword ht = 0;
- halfword dp = 0;
- halfword options = 0;
- halfword type = -1 ;
- t = cur_chr;
-
- if (t > 10) {
- /* we have \Uleft \Uright \Umiddle */
- t = t - 10;
- while (1) {
- if (scan_keyword("height")) {
- scan_dimen(false,false,false);
- ht = cur_val ;
- } else if (scan_keyword("depth")) {
- scan_dimen(false,false,false);
- dp = cur_val ;
- } else if (scan_keyword("axis")) {
- options = options | noad_option_axis ;
- } else if (scan_keyword("noaxis")) {
- options = options | noad_option_no_axis ;
- } else if (scan_keyword("exact")) {
- options = options | noad_option_exact ;
- } else if (scan_keyword("class")) {
- scan_int();
- type = cur_val ;
- } else {
- break;
- }
- }
- }
-
- if ((t != no_noad_side) && (t != left_noad_side) && (cur_group != math_left_group)) {
- if (cur_group == math_shift_group) {
- scan_delimiter(null, no_mathcode);
- if (t == middle_noad_side) {
- const char *hlp[] = {
- "I'm ignoring a \\middle that had no matching \\left.",
- NULL
- };
- tex_error("Extra \\middle", hlp);
- } else {
- const char *hlp[] = {
- "I'm ignoring a \\right that had no matching \\left.",
- NULL
- };
- tex_error("Extra \\right", hlp);
- }
- } else {
- off_save();
- }
- } else {
- p = new_noad();
- type(p) = fence_noad;
- subtype(p) = (quarterword) t;
- r = new_node(delim_node, 0);
- delimiter(p) = r;
-
- delimiterheight(p) = ht;
- delimiterdepth(p) = dp;
- delimiteroptions(p) = options;
- delimiterclass(p) = type;
- delimiteritalic(p) = 0;
-
- scan_delimiter(delimiter(p), no_mathcode);
-
- if (t == no_noad_side) {
- tail_append(new_noad());
- subtype(tail) = inner_noad_type;
- r = new_node(sub_mlist_node, 0);
- nucleus(tail) = r;
- math_list(nucleus(tail)) = p;
- return ;
- }
-
- if (t == left_noad_side) {
- q = p;
- } else {
- q = fin_mlist(p);
- unsave_math();
- }
- if (t != right_noad_side) {
- push_math(math_left_group, m_style);
- vlink(head) = q;
- tail = p;
- delim_par = p;
- } else {
- tail_append(new_noad());
- subtype(tail) = inner_noad_type;
- r = new_node(sub_mlist_node, 0);
- nucleus(tail) = r;
- math_list(nucleus(tail)) = q;
- }
- }
-}
-
-@ \TeX\ gets to the following part of the program when
-the first `\.\$' ending a display has been scanned.
-
-@c
-static void check_second_math_shift(void)
-{
- get_x_token();
- if (cur_cmd != math_shift_cmd) {
- const char *hlp[] = {
- "The `$' that I just saw supposedly matches a previous `$$'.",
- "So I shall assume that you typed `$$' both times.",
- NULL
- };
- back_error("Display math should end with $$", hlp);
- }
-}
-
-static void check_display_math_end(void)
-{
- if (cur_chr != cramped_display_style) {
- const char *hlp[] = {
- "I shall assume that you typed that.",
- NULL
- };
- tex_error("Display math should end with \\Ustopdisplaymath", hlp);
- }
-}
-
-static void check_inline_math_end(void)
-{
- if (cur_chr != cramped_text_style) {
- const char *hlp[] = {
- "I shall assume that you typed that.",
- NULL
- };
- tex_error("Inline math should end with \\Ustopmath", hlp);
- }
-}
-
-@ @c
-static void resume_after_display(void)
-{
- if (cur_group != math_shift_group)
- confusion("display");
- unsave_math();
- prev_graf_par = prev_graf_par + 3;
- push_nest();
- mode = hmode;
- space_factor_par = 1000;
- /* this needs to be intercepted in the display math start ! */
- tail_append(make_local_par_node(penalty_par_code));
- get_x_token();
- if (cur_cmd != spacer_cmd)
- back_input();
- if (nest_ptr == 1) {
- normal_page_filter(after_display);
- build_page();
- }
-}
-
-@ The fussiest part of math mode processing occurs when a displayed formula is
-being centered and placed with an optional equation number.
-
-At this time we are in vertical mode (or internal vertical mode).
-
- |p| points to the mlist for the formula.
- |a| is either |null| or it points to a box containing the equation number.
- |l| is true if there was an \.{\\leqno}/ (so |a| is a horizontal box).
-
-@c
-#define inject_display_skip_before(g) \
- switch (display_skip_mode_par) { \
- case 0 : /* normal tex */ \
- tail_append(new_param_glue(g)); \
- break;\
- case 1 : /* always */ \
- tail_append(new_param_glue(g)); \
- break; \
- case 2 : /* non-zero */ \
- if (g != 0 && ! glue_is_zero(glue_par(g))) \
- tail_append(new_param_glue(g)); \
- break; \
- case 3: /* ignore */ \
- break; \
- }
-
-#define inject_display_skip_after(g) \
- switch (display_skip_mode_par) { \
- case 0 : /* normal tex */ \
- if (g != 0 && glue_is_positive(glue_par(g))) \
- tail_append(new_param_glue(g)); \
- break; \
- case 1 : /* always */ \
- tail_append(new_param_glue(g)); \
- break; \
- case 2 : /* non-zero */ \
- if (g != 0 && ! glue_is_zero(glue_par(g))) \
- tail_append(new_param_glue(g)); \
- break; \
- case 3: /* ignore */ \
- break; \
- }
-
-static void finish_displayed_math(boolean l, pointer eqno_box, pointer p)
-{
- pointer eq_box; /* box containing the equation */
- scaled eq_w; /* width of the equation */
- scaled line_w; /* width of the line */
- scaled eqno_w; /* width of equation number */
- scaled eqno_w2; /* width of equation number plus space to separate from equation */
- scaled line_s; /* move the line right this much */
- scaled d; /* displacement of equation in the line */
- small_number g1, g2; /* glue parameter codes for before and after */
- pointer r,s; /* kern nodes used to position the display */
- pointer t; /* tail of adjustment list */
- pointer pre_t; /* tail of pre-adjustment list */
- boolean swap_dir; /* true if the math and surrounding text dirs are opposed */
- scaled eqno_width;
- swap_dir = (pre_display_direction_par < 0 ? true : false );
- if (eqno_box != null && swap_dir)
- l = !l;
- adjust_tail = adjust_head;
- pre_adjust_tail = pre_adjust_head;
- eq_box = hpack(p, 0, additional, -1);
- subtype(eq_box) = equation_list; /* new */
- build_attribute_list(eq_box);
- p = list_ptr(eq_box);
- t = adjust_tail;
- adjust_tail = null;
- pre_t = pre_adjust_tail;
- pre_adjust_tail = null;
- eq_w = width(eq_box);
- line_w = display_width_par;
- line_s = display_indent_par;
- if (eqno_box == null) {
- eqno_w = 0;
- eqno_width = 0;
- eqno_w2 = 0;
- } else {
- eqno_w = width(eqno_box);
- eqno_width = eqno_w;
- eqno_w2 = eqno_w + round_xn_over_d(math_eqno_gap_step_par, get_math_quad_style(text_style), 1000);
- subtype(eqno_box) = equation_number_list; /* new */
- /* build_attribute_list(eqno_box); */ /* probably already set */
- }
- if (eq_w + eqno_w2 > line_w) {
- /* The user can force the equation number to go on a separate line
- by causing its width to be zero. */
- if ((eqno_w != 0) && ((eq_w - total_shrink[normal] + eqno_w2 <= line_w)
- || (total_shrink[sfi] != 0)
- || (total_shrink[fil] != 0)
- || (total_shrink[fill] != 0)
- || (total_shrink[filll] != 0))) {
- list_ptr(eq_box) = null;
- flush_node(eq_box);
- eq_box = hpack(p, line_w - eqno_w2, exactly, -1);
- subtype(eq_box) = equation_list; /* new */
- build_attribute_list(eq_box);
- } else {
- eqno_w = 0;
- if (eq_w > line_w) {
- list_ptr(eq_box) = null;
- flush_node(eq_box);
- eq_box = hpack(p, line_w, exactly, -1);
- subtype(eq_box) = equation_list; /* new */
- build_attribute_list(eq_box);
- }
- }
- eq_w = width(eq_box);
- }
- /* We try first to center the display without regard to the existence of
- the equation number. If that would make it too close (where ``too close''
- means that the space between display and equation number is less than the
- width of the equation number), we either center it in the remaining space
- or move it as far from the equation number as possible. The latter alternative
- is taken only if the display begins with glue, since we assume that the
- user put glue there to control the spacing precisely.
- */
- d = half(line_w - eq_w);
- if ((eqno_w > 0) && (d < 2 * eqno_w)) { /* too close */
- d = half(line_w - eq_w - eqno_w);
- if (p != null)
- if (!is_char_node(p))
- if (type(p) == glue_node)
- d = 0;
- }
-
- tail_append(new_penalty(pre_display_penalty_par));
- if ((d + line_s <= pre_display_size_par) || l) { /* not enough clearance */
- g1 = above_display_skip_code;
- g2 = below_display_skip_code;
- } else {
- g1 = above_display_short_skip_code;
- g2 = below_display_short_skip_code;
- }
-
- /* If the equation number is set on a line by itself, either before or
- after the formula, we append an infinite penalty so that no page break will
- separate the display from its number; and we use the same size and
- displacement for all three potential lines of the display, even though
- `\.{\\parshape}' may specify them differently.
- */
- /* \.{\\leqno} on a forced single line due to |width=0| */
- /* it follows that |type(a)=hlist_node| */
-
- if (eqno_box && l && (eqno_w == 0)) {
- /* if (math_direction_par==dir_TLT) { */
- shift_amount(eqno_box) = 0;
- /* } else { */
- /* } */
- append_to_vlist(eqno_box,lua_key_index(equation_number));
- tail_append(new_penalty(inf_penalty));
- } else {
- inject_display_skip_before(g1);
- }
-
- if (eqno_w != 0) {
- r = new_kern(line_w - eq_w - eqno_w - d);
- if (l) {
- if (swap_dir) {
- if (math_direction_par==dir_TLT) {
- /* TRT + TLT + \eqno, (swap_dir=true, math_direction_par=TLT, l=true) */
-#ifdef DEBUG
- fprintf(stderr, "\nDEBUG: CASE 1\n");
-#endif
- s = new_kern(width(r) + eqno_w);
- try_couple_nodes(eqno_box,r);
- try_couple_nodes(r,eq_box);
- try_couple_nodes(eq_box,s);
- } else {
- /* TLT + TRT + \eqno, (swap_dir=true, math_direction_par=TRT, l=true) */
-#ifdef DEBUG
- fprintf(stderr, "\nDEBUG: CASE 2\n");
-#endif
- try_couple_nodes(eqno_box,r);
- try_couple_nodes(r,eq_box);
- }
- } else {
- if (math_direction_par==dir_TLT) {
- /* TLT + TLT + \leqno, (swap_dir=false, math_direction_par=TLT, l=true) */ /* OK */
-#ifdef DEBUG
- fprintf(stderr, "\nDEBUG: CASE 3\n");
-#endif
- s = new_kern(width(r) + eqno_w);
- } else {
- /* TRT + TRT + \leqno, (swap_dir=false, math_direction_par=TRT, l=true) */
-#ifdef DEBUG
- fprintf(stderr, "\nDEBUG: CASE 4\n");
-#endif
- s = new_kern(width(r));
- }
- try_couple_nodes(eqno_box,r);
- try_couple_nodes(r,eq_box);
- try_couple_nodes(eq_box,s);
- }
- eq_box = eqno_box;
- } else {
- if (swap_dir) {
- if (math_direction_par==dir_TLT) {
- /* TRT + TLT + \leqno, (swap_dir=true, math_direction_par=TLT, l=false) */
-#ifdef DEBUG
- fprintf(stderr, "\nDEBUG: CASE 5\n");
-#endif
- } else {
- /* TLT + TRT + \leqno, (swap_dir=true, math_direction_par=TRT, l=false) */
-#ifdef DEBUG
- fprintf(stderr, "\nDEBUG: CASE 6\n");
-#endif
- }
- try_couple_nodes(eq_box,r);
- try_couple_nodes(r,eqno_box);
- } else {
- if (math_direction_par==dir_TLT) {
- /* TLT + TLT + \eqno, (swap_dir=false, math_direction_par=TLT, l=false) */ /* OK */
-#ifdef DEBUG
- fprintf(stderr, "\nDEBUG: CASE 7\n");
-#endif
- s = new_kern(d);
- } else {
- /* TRT + TRT + \eqno, (swap_dir=false, math_direction_par=TRT, l=false) */
-#ifdef DEBUG
- fprintf(stderr, "\nDEBUG: CASE 8\n");
-#endif
- s = new_kern(width(r) + eqno_w);
- }
- try_couple_nodes(s,eq_box);
- try_couple_nodes(eq_box,r);
- try_couple_nodes(r,eqno_box);
- eq_box = s;
- }
- }
- eq_box = hpack(eq_box, 0, additional, -1);
- subtype(eq_box) = equation_list; /* new */
- build_attribute_list(eq_box);
- shift_amount(eq_box) = line_s;
- } else {
- shift_amount(eq_box) = line_s + d;
- }
-/* check for prev: */
- append_to_vlist(eq_box,lua_key_index(equation));
-
- if ((eqno_box != null) && (eqno_w == 0) && !l) {
- tail_append(new_penalty(inf_penalty));
- /* if (math_direction_par==dir_TLT) { */
- shift_amount(eqno_box) = line_s + line_w - eqno_width ;
- /* } else { */
- /* } */
- append_to_vlist(eqno_box,lua_key_index(equation_number));
- g2 = 0;
- }
- if (t != adjust_head) { /* migrating material comes after equation number */
- vlink(tail) = vlink(adjust_head);
- /* needs testing */
- alink(adjust_tail) = alink(tail);
- tail = t;
- }
- if (pre_t != pre_adjust_head) {
- vlink(tail) = vlink(pre_adjust_head);
- /* needs testing */
- alink(pre_adjust_tail) = alink(tail);
- tail = pre_t;
- }
- tail_append(new_penalty(post_display_penalty_par));
- inject_display_skip_after(g2);
- resume_after_display();
-}
-
-@ @c
-void after_math(void)
-{
- int m; /* |mmode| or |-mmode| */
- pointer p; /* the formula */
- pointer a = null; /* box containing equation number */
- boolean l = false; /* `\.{\\leqno}' instead of `\.{\\eqno}' */
- m = mode;
- p = fin_mlist(null); /* this pops the nest */
- if (cur_cmd == math_shift_cs_cmd &&
- (cur_chr == text_style || cur_chr == display_style)) {
- you_cant();
- }
- if (mode == -m) { /* end of equation number */
- if (cur_cmd == math_shift_cmd) {
- check_second_math_shift();
- } else {
- check_display_math_end();
- }
- run_mlist_to_hlist(p, false, text_style);
- a = hpack(vlink(temp_head), 0, additional, -1);
- build_attribute_list(a);
- unsave_math();
- decr(save_ptr); /* now |cur_group=math_shift_group| */
- assert(saved_type(0) == saved_eqno);
- if (saved_value(0) == 1)
- l = true;
- m = mode;
- p = fin_mlist(null);
-
- }
- if (m < 0) {
- /* The |unsave| is done after everything else here; hence an appearance of
- `\.{\\mathsurround}' inside of `\.{\$...\$}' affects the spacing at these
- particular \.\$'s. This is consistent with the conventions of
- `\.{\$\$...\$\$}', since `\.{\\abovedisplayskip}' inside a display affects the
- space above that display.
- */
- if (cur_cmd == math_shift_cs_cmd) {
- check_inline_math_end();
- }
- tail_append(new_math(math_surround_par, before));
- /* begin mathskip code */
- switch (math_skip_mode) {
- case 0 :
- /* obey mathsurround when zero glue */
- if (! glue_is_zero(math_skip_par)) {
- copy_glue_values(tail,math_skip_par);
- surround(tail) = 0;
- }
- break ;
- case 1 :
- /* always left */
- case 3 :
- /* always both */
- case 6 :
- /* only when skip */
- copy_glue_values(tail,math_skip_par);
- surround(tail) = 0;
- break ;
- case 2 :
- /* only right */
- surround(tail) = 0;
- break ;
- case 4 :
- /* ignore, obey marthsurround */
- break ;
- case 5:
- /* all spacing disabled */
- surround(tail) = 0;
- break ;
- }
- /* end mathskip code */
- if (dir_math_save) {
- tail_append(new_dir(math_direction_par));
- }
- run_mlist_to_hlist(p, (mode > 0), text_style);
- vlink(tail) = vlink(temp_head);
- while (vlink(tail) != null) {
- tail = vlink(tail);
- }
- if (dir_math_save) {
- tail_append(new_dir(math_direction_par - dir_swap));
- }
- dir_math_save = false;
- tail_append(new_math(math_surround_par, after));
- /* begin mathskip code */
- switch (math_skip_mode) {
- case 0 :
- /* obey mathsurround when zero glue */
- if (! glue_is_zero(math_skip_par)) {
- copy_glue_values(tail,math_skip_par);
- surround(tail) = 0;
- }
- break ;
- case 2 :
- /* always right */
- case 3 :
- /* always both */
- case 6 :
- /* only when skip */
- copy_glue_values(tail,math_skip_par);
- surround(tail) = 0;
- break ;
- case 1 :
- /* only left */
- surround(tail) = 0;
- break ;
- case 4 :
- /* ignore, obey marthsurround */
- break ;
- case 5:
- /* all spacing disabled */
- surround(tail) = 0;
- break ;
- }
- /* end mathskip code */
- space_factor_par = 1000;
- unsave_math();
- } else {
- if (a == null) {
- if (cur_cmd == math_shift_cmd) {
- check_second_math_shift();
- } else {
- check_display_math_end();
- }
- }
- run_mlist_to_hlist(p, false, display_style);
- finish_displayed_math(l, a, vlink(temp_head));
- }
-}
-
-@ When \.{\\halign} appears in a display, the alignment routines operate
-essentially as they do in vertical mode. Then the following program is
-activated, with |p| and |q| pointing to the beginning and end of the
-resulting list, and with |aux_save| holding the |prev_depth| value.
-
-@c
-void finish_display_alignment(pointer p, pointer q, halfword saved_prevdepth)
-{
- do_assignments();
- if (cur_cmd == math_shift_cmd) {
- check_second_math_shift();
- } else {
- check_display_math_end();
- }
- pop_nest();
- tail_append(new_penalty(pre_display_penalty_par));
- inject_display_skip_before(above_display_skip_code);
- vlink(tail) = p;
- if (p != null)
- tail = q;
- tail_append(new_penalty(post_display_penalty_par));
- inject_display_skip_after(below_display_skip_code);
- cur_list.prev_depth_field = saved_prevdepth;
- resume_after_display();
-}
-
-@ Interface to \.{\\Umath} and \.{\\mathstyle}
-
-@c
-void setup_math_style(void)
-{
- pointer q;
- tail_append(new_noad());
- q = new_node(math_char_node, 0);
- nucleus(tail) = q;
- (void) scan_math_style(nucleus(tail), num_style(m_style));
-}
-
-@ @c
-void print_math_style(void)
-{
- if (abs(mode) == mmode)
- print_int(m_style);
- else
- print_int(-1);
-}
+% texmath.w
+%
+% Copyright 2008-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
+#include "ptexlib.h"
+
+@ @c
+#define mode mode_par
+#define tail tail_par
+#define head head_par
+#define dir_save dirs_par
+
+/*
+
+ \mathdisplayskipmode
+
+ tex normally always inserts before and only after when larger than zero
+
+ 0 = normal tex
+ 1 = always
+ 2 = non-zero
+ 3 = ignore
+
+*/
+
+@ TODO: not sure if this is the right order
+@c
+#define back_error(A,B) do { \
+ OK_to_interrupt=false; \
+ back_input(); \
+ OK_to_interrupt=true; \
+ tex_error(A,B); \
+ } while (0)
+
+@ @c
+int scan_math(pointer, int);
+int scan_math_style(pointer, int);
+pointer fin_mlist(pointer);
+
+@ When \TeX\ reads a formula that is enclosed between \.\$'s, it constructs an
+{\sl mlist}, which is essentially a tree structure representing that
+formula. An mlist is a linear sequence of items, but we can regard it as
+a tree structure because mlists can appear within mlists. For example, many
+of the entries can be subscripted or superscripted, and such ``scripts''
+are mlists in their own right.
+
+An entire formula is parsed into such a tree before any of the actual
+typesetting is done, because the current style of type is usually not
+known until the formula has been fully scanned. For example, when the
+formula `\.{\$a+b \\over c+d\$}' is being read, there is no way to tell
+that `\.{a+b}' will be in script size until `\.{\\over}' has appeared.
+
+During the scanning process, each element of the mlist being built is
+classified as a relation, a binary operator, an open parenthesis, etc.,
+or as a construct like `\.{\\sqrt}' that must be built up. This classification
+appears in the mlist data structure.
+
+After a formula has been fully scanned, the mlist is converted to an hlist
+so that it can be incorporated into the surrounding text. This conversion is
+controlled by a recursive procedure that decides all of the appropriate
+styles by a ``top-down'' process starting at the outermost level and working
+in towards the subformulas. The formula is ultimately pasted together using
+combinations of horizontal and vertical boxes, with glue and penalty nodes
+inserted as necessary.
+
+An mlist is represented internally as a linked list consisting chiefly
+of ``noads'' (pronounced ``no-adds''), to distinguish them from the somewhat
+similar ``nodes'' in hlists and vlists. Certain kinds of ordinary nodes are
+allowed to appear in mlists together with the noads; \TeX\ tells the difference
+by means of the |type| field, since a noad's |type| is always greater than
+that of a node. An mlist does not contain character nodes, hlist nodes, vlist
+nodes, math nodes or unset nodes; in particular, each mlist item appears in the
+variable-size part of |mem|, so the |type| field is always present.
+
+Each noad is five or more words long. The first word contains the
+|type| and |subtype| and |link| fields that are already so familiar to
+us; the second contains the attribute list pointer, and the third,
+fourth an fifth words are called the noad's |nucleus|, |subscr|, and
+|supscr| fields. (This use of a combined attribute list is temporary.
+Eventually, each of fields need their own list)
+
+Consider, for example, the simple formula `\.{\$x\^2\$}', which would be
+parsed into an mlist containing a single element called an |ord_noad|.
+The |nucleus| of this noad is a representation of `\.x', the |subscr| is
+empty, and the |supscr| is a representation of `\.2'.
+
+The |nucleus|, |subscr|, and |supscr| fields are further broken into
+subfields. If |p| points to a noad, and if |q| is one of its principal
+fields (e.g., |q=subscr(p)|), |q=null| indicates a field with no value (the
+corresponding attribute of noad |p| is not present). Otherwise, there are
+several possibilities for the subfields, depending on the |type| of |q|.
+
+\yskip\hang|type(q)=math_char_node| means that |math_fam(q)| refers to one of
+the sixteen font families, and |character(q)| is the number of a character
+within a font of that family, as in a character node.
+
+\yskip\hang|type(q)=math_text_char_node| is similar, but the character is
+unsubscripted and unsuperscripted and it is followed immediately by another
+character from the same font. (This |type| setting appears only
+briefly during the processing; it is used to suppress unwanted italic
+corrections.)
+
+\yskip\hang|type(q)=sub_box_node| means that |math_list(q)| points to a box
+node (either an |hlist_node| or a |vlist_node|) that should be used as the
+value of the field. The |shift_amount| in the subsidiary box node is the
+amount by which that box will be shifted downward.
+
+\yskip\hang|type(q)=sub_mlist_node| means that |math_list(q)| points to
+an mlist; the mlist must be converted to an hlist in order to obtain
+the value of this field.
+
+\yskip\noindent In the latter case, we might have |math_list(q)=null|. This
+is not the same as |q=null|; for example, `\.{\$P\_\{\}\$}'
+and `\.{\$P\$}' produce different results (the former will not have the
+``italic correction'' added to the width of |P|, but the ``script skip''
+will be added).
+
+@c
+static void unsave_math(void)
+{
+ unsave();
+ decr(save_ptr);
+ flush_node_list(text_dir_ptr);
+ assert(saved_type(0) == saved_textdir);
+ text_dir_ptr = saved_value(0);
+}
+
+@ Sometimes it is necessary to destroy an mlist. The following
+subroutine empties the current list, assuming that |abs(mode)=mmode|.
+
+@c
+void flush_math(void)
+{
+ flush_node_list(vlink(head));
+ flush_node_list(incompleat_noad_par);
+ vlink(head) = null;
+ tail = head;
+ incompleat_noad_par = null;
+}
+
+@ Before we can do anything in math mode, we need fonts.
+
+@c
+#define MATHFONTSTACK 8
+#define MATHFONTDEFAULT 0 /* == nullfont */
+
+static sa_tree math_fam_head = NULL;
+
+@ @c
+int fam_fnt(int fam_id, int size_id)
+{
+ int n = fam_id + (256 * size_id);
+ return (int) get_sa_item(math_fam_head, n).int_value;
+}
+
+void def_fam_fnt(int fam_id, int size_id, int f, int lvl)
+{
+ int n = fam_id + (256 * size_id);
+ sa_tree_item sa_value = { 0 };
+ sa_value.int_value = f;
+ set_sa_item(math_fam_head, n, sa_value, lvl);
+ fixup_math_parameters(fam_id, size_id, f, lvl);
+ if (tracing_assigns_par > 1) {
+ begin_diagnostic();
+ tprint("{assigning");
+ print_char(' ');
+ print_cmd_chr(def_family_cmd, size_id);
+ print_int(fam_id);
+ print_char('=');
+ print_font_identifier(fam_fnt(fam_id, size_id));
+ print_char('}');
+ end_diagnostic(false);
+ }
+}
+
+@ @c
+static void unsave_math_fam_data(int gl)
+{
+ sa_stack_item st;
+ if (math_fam_head->stack == NULL)
+ return;
+ while (math_fam_head->stack_ptr > 0 &&
+ abs(math_fam_head->stack[math_fam_head->stack_ptr].level)
+ >= (int) gl) {
+ st = math_fam_head->stack[math_fam_head->stack_ptr];
+ if (st.level > 0) {
+ rawset_sa_item(math_fam_head, st.code, st.value);
+ /* now do a trace message, if requested */
+ if (tracing_restores_par > 1) {
+ int size_id = st.code / 256;
+ int fam_id = st.code % 256;
+ begin_diagnostic();
+ tprint("{restoring");
+ print_char(' ');
+ print_cmd_chr(def_family_cmd, size_id);
+ print_int(fam_id);
+ print_char('=');
+ print_font_identifier(fam_fnt(fam_id, size_id));
+ print_char('}');
+ end_diagnostic(false);
+ }
+ }
+ (math_fam_head->stack_ptr)--;
+ }
+}
+
+@ and parameters
+
+@c
+#define MATHPARAMSTACK 8
+#define MATHPARAMDEFAULT undefined_math_parameter
+
+static sa_tree math_param_head = NULL;
+
+@ @c
+void def_math_param(int param_id, int style_id, scaled value, int lvl)
+{
+ int n = param_id + (256 * style_id);
+ sa_tree_item sa_value = { 0 };
+ sa_value.int_value = (int) value;
+ set_sa_item(math_param_head, n, sa_value, lvl);
+ if (tracing_assigns_par > 1) {
+ begin_diagnostic();
+ tprint("{assigning");
+ print_char(' ');
+ print_cmd_chr(set_math_param_cmd, param_id);
+ print_cmd_chr(math_style_cmd, style_id);
+ print_char('=');
+ print_int(value);
+ print_char('}');
+ end_diagnostic(false);
+ }
+}
+
+scaled get_math_param(int param_id, int style_id)
+{
+ int n = param_id + (256 * style_id);
+ return (scaled) get_sa_item(math_param_head, n).int_value;
+}
+
+@ @c
+static void unsave_math_param_data(int gl)
+{
+ sa_stack_item st;
+ if (math_param_head->stack == NULL)
+ return;
+ while (math_param_head->stack_ptr > 0 &&
+ abs(math_param_head->stack[math_param_head->stack_ptr].level)
+ >= (int) gl) {
+ st = math_param_head->stack[math_param_head->stack_ptr];
+ if (st.level > 0) {
+ rawset_sa_item(math_param_head, st.code, st.value);
+ /* now do a trace message, if requested */
+ if (tracing_restores_par > 1) {
+ int param_id = st.code % 256;
+ int style_id = st.code / 256;
+ begin_diagnostic();
+ tprint("{restoring");
+ print_char(' ');
+ print_cmd_chr(set_math_param_cmd, param_id);
+ print_cmd_chr(math_style_cmd, style_id);
+ print_char('=');
+ print_int(get_math_param(param_id, style_id));
+ print_char('}');
+ end_diagnostic(false);
+ }
+ }
+ (math_param_head->stack_ptr)--;
+ }
+}
+
+@ saving and unsaving of both
+
+@c
+void unsave_math_data(int gl)
+{
+ unsave_math_fam_data(gl);
+ unsave_math_param_data(gl);
+}
+
+@ Dumping and undumping
+@c
+void dump_math_data(void)
+{
+ sa_tree_item sa_value = { 0 };
+ if (math_fam_head == NULL) {
+ sa_value.int_value = MATHFONTDEFAULT;
+ math_fam_head = new_sa_tree(MATHFONTSTACK, 1, sa_value);
+ }
+ dump_sa_tree(math_fam_head, "mathfonts");
+ if (math_param_head == NULL) {
+ sa_value.int_value = MATHPARAMDEFAULT;
+ math_param_head = new_sa_tree(MATHPARAMSTACK, 1, sa_value);
+ }
+ dump_sa_tree(math_param_head, "mathparameters");
+}
+
+void undump_math_data(void)
+{
+ math_fam_head = undump_sa_tree("mathfonts");
+ math_param_head = undump_sa_tree("mathparameters");
+}
+
+@ @c
+void initialize_math(void)
+{
+ sa_tree_item sa_value = { 0 };
+ if (math_fam_head == NULL) {
+ sa_value.int_value = MATHFONTDEFAULT;
+ math_fam_head = new_sa_tree(MATHFONTSTACK, 1, sa_value);
+ }
+ if (math_param_head == NULL) {
+ sa_value.int_value = MATHPARAMDEFAULT;
+ math_param_head = new_sa_tree(MATHPARAMSTACK, 1, sa_value);
+ initialize_math_spacing();
+ }
+ return;
+}
+
+@ Each portion of a formula is classified as Ord, Op, Bin, Rel, Ope,
+Clo, Pun, or Inn, for purposes of spacing and line breaking. An
+|ord_noad|, |op_noad|, |bin_noad|, |rel_noad|, |open_noad|, |close_noad|,
+|punct_noad|, or |inner_noad| is used to represent portions of the various
+types. For example, an `\.=' sign in a formula leads to the creation of a
+|rel_noad| whose |nucleus| field is a representation of an equals sign
+(usually |fam=0|, |character=075|). A formula preceded by \.{\\mathrel}
+also results in a |rel_noad|. When a |rel_noad| is followed by an
+|op_noad|, say, and possibly separated by one or more ordinary nodes (not
+noads), \TeX\ will insert a penalty node (with the current |rel_penalty|)
+just after the formula that corresponds to the |rel_noad|, unless there
+already was a penalty immediately following; and a ``thick space'' will be
+inserted just before the formula that corresponds to the |op_noad|.
+
+A noad of type |ord_noad|, |op_noad|, \dots, |inner_noad| usually
+has a |subtype=normal|. The only exception is that an |op_noad| might
+have |subtype=limits| or |no_limits|, if the normal positioning of
+limits has been overridden for this operator.
+
+A |radical_noad| also has a |left_delimiter| field, which usually
+represents a square root sign.
+
+A |fraction_noad| has a |right_delimiter| field as well as a |left_delimiter|.
+
+Delimiter fields have four subfields
+called |small_fam|, |small_char|, |large_fam|, |large_char|. These subfields
+represent variable-size delimiters by giving the ``small'' and ``large''
+starting characters, as explained in Chapter~17 of {\sl The \TeX book}.
+@:TeXbook}{\sl The \TeX book@>
+
+A |fraction_noad| is actually quite different from all other noads.
+It has |thickness|, |denominator|, and |numerator| fields instead of
+|nucleus|, |subscr|, and |supscr|. The |thickness| is a scaled value
+that tells how thick to make a fraction rule; however, the special
+value |default_code| is used to stand for the
+|default_rule_thickness| of the current size. The |numerator| and
+|denominator| point to mlists that define a fraction; we always have
+$$\hbox{|type(numerator)=type(denominator)=sub_mlist|}.$$ The
+|left_delimiter| and |right_delimiter| fields specify delimiters that will
+be placed at the left and right of the fraction. In this way, a
+|fraction_noad| is able to represent all of \TeX's operators \.{\\over},
+\.{\\atop}, \.{\\above}, \.{\\overwithdelims}, \.{\\atopwithdelims}, and
+ \.{\\abovewithdelims}.
+
+@ The |new_noad| function creates an |ord_noad| that is completely null
+
+@c
+pointer new_noad(void)
+{
+ pointer p;
+ p = new_node(simple_noad, ord_noad_type);
+ /* all noad fields are zero after this */
+ return p;
+}
+
+@ @c
+pointer new_sub_box(pointer curbox)
+{
+ pointer p, q;
+ p = new_noad();
+ q = new_node(sub_box_node, 0);
+ nucleus(p) = q;
+ math_list(nucleus(p)) = curbox;
+ return p;
+}
+
+@ A few more kinds of noads will complete the set: An |under_noad| has its
+nucleus underlined; an |over_noad| has it overlined. An |accent_noad| places
+an accent over its nucleus; the accent character appears as
+|math_fam(accent_chr(p))| and |math_character(accent_chr(p))|. A |vcenter_noad|
+centers its nucleus vertically with respect to the axis of the formula;
+in such noads we always have |type(nucleus(p))=sub_box|.
+
+And finally, we have the |fence_noad| type, to implement
+\TeX's \.{\\left} and \.{\\right} as well as eTeX's \.{\\middle}.
+The |nucleus| of such noads is
+replaced by a |delimiter| field; thus, for example, `\.{\\left(}' produces
+a |fence_noad| such that |delimiter(p)| holds the family and character
+codes for all left parentheses. A |fence_noad| of subtype |left_noad_side|
+never appears in an mlist except as the first element, and a |fence_noad|
+with subtype |right_noad_side| never appears in an mlist
+except as the last element; furthermore, we either have both a |left_noad_side|
+and a |right_noad_side|, or neither one is present.
+
+@ Math formulas can also contain instructions like \.{\\textstyle} that
+override \TeX's normal style rules. A |style_node| is inserted into the
+data structure to record such instructions; it is three words long, so it
+is considered a node instead of a noad. The |subtype| is either |display_style|
+or |text_style| or |script_style| or |script_script_style|. The
+second and third words of a |style_node| are not used, but they are
+present because a |choice_node| is converted to a |style_node|.
+
+\TeX\ uses even numbers 0, 2, 4, 6 to encode the basic styles
+|display_style|, \dots, |script_script_style|, and adds~1 to get the
+``cramped'' versions of these styles. This gives a numerical order that
+is backwards from the convention of Appendix~G in {\sl The \TeX book\/};
+i.e., a smaller style has a larger numerical value.
+@:TeXbook}{\sl The \TeX book@>
+
+@c
+const char *math_style_names[] = {
+ "display", "crampeddisplay",
+ "text", "crampedtext",
+ "script", "crampedscript",
+ "scriptscript", "crampedscriptscript",
+ NULL
+};
+
+const char *math_param_names[] = {
+ "quad", "axis", "operatorsize",
+ "overbarkern", "overbarrule", "overbarvgap",
+ "underbarkern", "underbarrule", "underbarvgap",
+ "radicalkern", "radicalrule", "radicalvgap",
+ "radicaldegreebefore", "radicaldegreeafter", "radicaldegreeraise",
+ "stackvgap", "stacknumup", "stackdenomdown",
+ "fractionrule", "fractionnumvgap", "fractionnumup",
+ "fractiondenomvgap", "fractiondenomdown", "fractiondelsize",
+ "limitabovevgap", "limitabovebgap", "limitabovekern",
+ "limitbelowvgap", "limitbelowbgap", "limitbelowkern",
+ "nolimitsubfactor", "nolimitsupfactor", /* bonus */
+ "underdelimitervgap", "underdelimiterbgap",
+ "overdelimitervgap", "overdelimiterbgap",
+ "subshiftdrop", "supshiftdrop", "subshiftdown",
+ "subsupshiftdown", "subtopmax", "supshiftup",
+ "supbottommin", "supsubbottommax", "subsupvgap",
+ "spaceafterscript", "connectoroverlapmin",
+ "ordordspacing", "ordopspacing", "ordbinspacing", "ordrelspacing",
+ "ordopenspacing", "ordclosespacing", "ordpunctspacing", "ordinnerspacing",
+ "opordspacing", "opopspacing", "opbinspacing", "oprelspacing",
+ "opopenspacing", "opclosespacing", "oppunctspacing", "opinnerspacing",
+ "binordspacing", "binopspacing", "binbinspacing", "binrelspacing",
+ "binopenspacing", "binclosespacing", "binpunctspacing", "bininnerspacing",
+ "relordspacing", "relopspacing", "relbinspacing", "relrelspacing",
+ "relopenspacing", "relclosespacing", "relpunctspacing", "relinnerspacing",
+ "openordspacing", "openopspacing", "openbinspacing", "openrelspacing",
+ "openopenspacing", "openclosespacing", "openpunctspacing",
+ "openinnerspacing",
+ "closeordspacing", "closeopspacing", "closebinspacing", "closerelspacing",
+ "closeopenspacing", "closeclosespacing", "closepunctspacing",
+ "closeinnerspacing",
+ "punctordspacing", "punctopspacing", "punctbinspacing", "punctrelspacing",
+ "punctopenspacing", "punctclosespacing", "punctpunctspacing",
+ "punctinnerspacing",
+ "innerordspacing", "inneropspacing", "innerbinspacing", "innerrelspacing",
+ "inneropenspacing", "innerclosespacing", "innerpunctspacing",
+ "innerinnerspacing",
+ NULL
+};
+
+@ @c
+pointer new_style(small_number s)
+{ /* create a style node */
+ m_style = s;
+ return new_node(style_node, s);
+}
+
+@ Finally, the \.{\\mathchoice} primitive creates a |choice_node|, which
+has special subfields |display_mlist|, |text_mlist|, |script_mlist|,
+and |script_script_mlist| pointing to the mlists for each style.
+
+@c
+static pointer new_choice(void)
+{ /* create a choice node */
+ return new_node(choice_node, 0); /* the |subtype| is not used */
+}
+
+@ Let's consider now the previously unwritten part of |show_node_list|
+that displays the things that can only be present in mlists; this
+program illustrates how to access the data structures just defined.
+
+In the context of the following program, |p| points to a node or noad that
+should be displayed, and the current string contains the ``recursion history''
+that leads to this point. The recursion history consists of a dot for each
+outer level in which |p| is subsidiary to some node, or in which |p| is
+subsidiary to the |nucleus| field of some noad; the dot is replaced by
+`\.\_' or `\.\^' or `\./' or `\.\\' if |p| is descended from the |subscr|
+or |supscr| or |denominator| or |numerator| fields of noads. For example,
+the current string would be `\.{.\^.\_/}' if |p| points to the |ord_noad| for
+|x| in the (ridiculous) formula
+`\.{\$\\sqrt\{a\^\{\\mathinner\{b\_\{c\\over x+y\}\}\}\}\$}'.
+
+@c
+void display_normal_noad(pointer p); /* forward */
+void display_fence_noad(pointer p); /* forward */
+void display_fraction_noad(pointer p); /* forward */
+
+void show_math_node(pointer p)
+{
+ switch (type(p)) {
+ case style_node:
+ print_cmd_chr(math_style_cmd, subtype(p));
+ break;
+ case choice_node:
+ tprint_esc("mathchoice");
+ append_char('D');
+ show_node_list(display_mlist(p));
+ flush_char();
+ append_char('T');
+ show_node_list(text_mlist(p));
+ flush_char();
+ append_char('S');
+ show_node_list(script_mlist(p));
+ flush_char();
+ append_char('s');
+ show_node_list(script_script_mlist(p));
+ flush_char();
+ break;
+ case simple_noad:
+ case radical_noad:
+ case accent_noad:
+ display_normal_noad(p);
+ break;
+ case fence_noad:
+ display_fence_noad(p);
+ break;
+ case fraction_noad:
+ display_fraction_noad(p);
+ break;
+ default:
+ tprint("Unknown node type!");
+ break;
+ }
+}
+
+@ Here are some simple routines used in the display of noads.
+
+@c
+static void print_fam_and_char(pointer p)
+{ /* prints family and character */
+ tprint_esc("fam");
+ print_int(math_fam(p));
+ print_char(' ');
+ print(math_character(p));
+}
+
+@ @c
+static void print_delimiter(pointer p)
+{
+ int a;
+ if (delimiteroptionset(p)) {
+ tprint(" [ ");
+ if (delimiteraxis(p))
+ tprint("axis ");
+ if (delimiternoaxis(p))
+ tprint("noaxis ");
+ if (delimiterexact(p))
+ tprint("exact ");
+ tprint("]");
+ }
+ if (delimiterheight(p)) {
+ tprint("height=");
+ print_scaled(delimiterheight(p));
+ tprint(" ");
+ }
+ if (delimiterdepth(p)) {
+ tprint("depth=");
+ print_scaled(delimiterdepth(p));
+ tprint(" ");
+ }
+ if (delimiterclass(p)) {
+ tprint("class=");
+ print_int(delimiterclass(p));
+ tprint(" ");
+ }
+ if (small_fam(p) < 0) {
+ print_int(-1); /* this should never happen */
+ } else if (small_fam(p) < 16 && large_fam(p) < 16 &&
+ small_char(p) < 256 && large_char(p) < 256) {
+ /* traditional tex style */
+ a = small_fam(p) * 256 + small_char(p);
+ a = a * 0x1000 + large_fam(p) * 256 + large_char(p);
+ print_hex(a);
+ } else if ((large_fam(p) == 0 && large_char(p) == 0) ||
+ small_char(p) > 65535 || large_char(p) > 65535) {
+ /* modern xetex/luatex style */
+ print_hex(small_fam(p));
+ print_hex(small_char(p));
+ }
+}
+
+@ The next subroutine will descend to another level of recursion when a
+subsidiary mlist needs to be displayed. The parameter |c| indicates what
+character is to become part of the recursion history. An empty mlist is
+distinguished from a missing field, because these are not equivalent
+(as explained above).
+@^recursion@>
+
+@c
+static void print_subsidiary_data(pointer p, ASCII_code c)
+{ /* display a noad field */
+ if ((int) cur_length >= depth_threshold) {
+ if (p != null)
+ tprint(" []");
+ } else {
+ append_char(c); /* include |c| in the recursion history */
+ if (p != null) {
+ switch (type(p)) {
+ case math_char_node:
+ print_ln();
+ print_current_string();
+ print_fam_and_char(p);
+ break;
+ case sub_box_node:
+ show_node_list(math_list(p));
+ break;
+ case sub_mlist_node:
+ if (math_list(p) == null) {
+ print_ln();
+ print_current_string();
+ tprint("{}");
+ } else {
+ show_node_list(math_list(p));
+ }
+ break;
+ }
+ }
+ flush_char(); /* remove |c| from the recursion history */
+ }
+}
+
+@ @c
+void display_normal_noad(pointer p)
+{
+ switch (type(p)) {
+ case simple_noad:
+ switch (subtype(p)) {
+ case ord_noad_type:
+ tprint_esc("mathord");
+ break;
+ case op_noad_type_normal:
+ case op_noad_type_limits:
+ case op_noad_type_no_limits:
+ tprint_esc("mathop");
+ if (subtype(p) == op_noad_type_limits)
+ tprint_esc("limits");
+ else if (subtype(p) == op_noad_type_no_limits)
+ tprint_esc("nolimits");
+ break;
+ case bin_noad_type:
+ tprint_esc("mathbin");
+ break;
+ case rel_noad_type:
+ tprint_esc("mathrel");
+ break;
+ case open_noad_type:
+ tprint_esc("mathopen");
+ break;
+ case close_noad_type:
+ tprint_esc("mathclose");
+ break;
+ case punct_noad_type:
+ tprint_esc("mathpunct");
+ break;
+ case inner_noad_type:
+ tprint_esc("mathinner");
+ break;
+ case over_noad_type:
+ tprint_esc("overline");
+ break;
+ case under_noad_type:
+ tprint_esc("underline");
+ break;
+ case vcenter_noad_type:
+ tprint_esc("vcenter");
+ break;
+ default:
+ tprint("<unknown noad type!>");
+ break;
+ }
+ break;
+ case radical_noad:
+ if (subtype(p) == 6)
+ tprint_esc("Udelimiterover");
+ else if (subtype(p) == 5)
+ tprint_esc("Udelimiterunder");
+ else if (subtype(p) == 4)
+ tprint_esc("Uoverdelimiter");
+ else if (subtype(p) == 3)
+ tprint_esc("Uunderdelimiter");
+ else if (subtype(p) == 2)
+ tprint_esc("Uroot");
+ else
+ tprint_esc("radical");
+ print_delimiter(left_delimiter(p));
+ if (degree(p) != null) {
+ print_subsidiary_data(degree(p), '/');
+ }
+ if (radicalwidth(p)) {
+ tprint("width=");
+ print_scaled(radicalwidth(p));
+ tprint(" ");
+ }
+ if (radicaloptionset(p)) {
+ tprint(" [ ");
+ if (radicalexact(p))
+ tprint("exact ");
+ if (radicalleft(p))
+ tprint("left ");
+ if (radicalmiddle(p))
+ tprint("middle ");
+ if (radicalright(p))
+ tprint("right ");
+ tprint("]");
+ }
+ break;
+ case accent_noad:
+ if (top_accent_chr(p) != null) {
+ if (bot_accent_chr(p) != null) {
+ tprint_esc("Umathaccent both");
+ } else {
+ tprint_esc("Umathaccent");
+ }
+ } else if (bot_accent_chr(p) != null) {
+ tprint_esc("Umathaccent bottom");
+ } else {
+ tprint_esc("Umathaccent overlay");
+ }
+ if (accentfraction(p)) {
+ tprint(" fraction=");
+ print_int(accentfraction(p));
+ tprint(" ");
+ }
+ switch (subtype(p)) {
+ case 0:
+ if (top_accent_chr(p) != null) {
+ if (bot_accent_chr(p) != null) {
+ print_fam_and_char(top_accent_chr(p));
+ print_fam_and_char(bot_accent_chr(p));
+ } else {
+ print_fam_and_char(top_accent_chr(p));
+ }
+ } else if (bot_accent_chr(p) != null) {
+ print_fam_and_char(bot_accent_chr(p));
+ } else {
+ print_fam_and_char(overlay_accent_chr(p));
+ }
+ break;
+ case 1:
+ if (top_accent_chr(p) != null) {
+ tprint(" fixed ");
+ print_fam_and_char(top_accent_chr(p));
+ if (bot_accent_chr(p) != null) {
+ print_fam_and_char(bot_accent_chr(p));
+ }
+ } else {
+ confusion("display_accent_noad");
+ }
+ break;
+ case 2:
+ if (bot_accent_chr(p) != null) {
+ if (top_accent_chr(p) != null) {
+ print_fam_and_char(top_accent_chr(p));
+ }
+ tprint(" fixed ");
+ print_fam_and_char(bot_accent_chr(p));
+ } else{
+ confusion("display_accent_noad");
+ }
+ break;
+ case 3:
+ if (top_accent_chr(p) != null && bot_accent_chr(p) != null) {
+ tprint(" fixed ");
+ print_fam_and_char(top_accent_chr(p));
+ tprint(" fixed ");
+ print_fam_and_char(bot_accent_chr(p));
+ } else {
+ confusion("display_accent_noad");
+ }
+ break;
+ }
+ break;
+ }
+ print_subsidiary_data(nucleus(p), '.');
+ print_subsidiary_data(supscr(p), '^');
+ print_subsidiary_data(subscr(p), '_');
+}
+
+@ @c
+void display_fence_noad(pointer p)
+{
+ if (subtype(p) == right_noad_side)
+ tprint_esc("right");
+ else if (subtype(p) == left_noad_side)
+ tprint_esc("left");
+ else
+ tprint_esc("middle");
+ print_delimiter(delimiter(p));
+}
+
+@ @c
+void display_fraction_noad(pointer p)
+{
+ tprint_esc("fraction, thickness ");
+ if (thickness(p) == default_code)
+ tprint("= default");
+ else
+ print_scaled(thickness(p));
+ if ((left_delimiter(p) != null) &&
+ ((small_fam(left_delimiter(p)) != 0) ||
+ (small_char(left_delimiter(p)) != 0) ||
+ (large_fam(left_delimiter(p)) != 0) ||
+ (large_char(left_delimiter(p)) != 0))) {
+ tprint(", left-delimiter ");
+ print_delimiter(left_delimiter(p));
+ }
+ if ((right_delimiter(p) != null) &&
+ ((small_fam(right_delimiter(p)) != 0) ||
+ (small_char(right_delimiter(p)) != 0) ||
+ (large_fam(right_delimiter(p)) != 0) ||
+ (large_char(right_delimiter(p)) != 0))) {
+ tprint(", right-delimiter ");
+ print_delimiter(right_delimiter(p));
+ }
+ print_subsidiary_data(numerator(p), '\\');
+ print_subsidiary_data(denominator(p), '/');
+}
+
+@ The routines that \TeX\ uses to create mlists are similar to those we have
+just seen for the generation of hlists and vlists. But it is necessary to
+make ``noads'' as well as nodes, so the reader should review the
+discussion of math mode data structures before trying to make sense out of
+the following program.
+
+Here is a little routine that needs to be done whenever a subformula
+is about to be processed. The parameter is a code like |math_group|.
+
+@c
+static void new_save_level_math(group_code c)
+{
+ set_saved_record(0, saved_textdir, 0, text_dir_ptr);
+ text_dir_ptr = new_dir(math_direction_par);
+ incr(save_ptr);
+ new_save_level(c);
+ eq_word_define(int_base + body_direction_code, math_direction_par);
+ eq_word_define(int_base + par_direction_code, math_direction_par);
+ eq_word_define(int_base + text_direction_code, math_direction_par);
+}
+
+@ @c
+static void push_math(group_code c, int mstyle)
+{
+ if (math_direction_par != text_direction_par)
+ dir_math_save = true;
+ push_nest();
+ mode = -mmode;
+ incompleat_noad_par = null;
+ m_style = mstyle;
+ new_save_level_math(c);
+}
+
+@ @c
+static void enter_ordinary_math(void)
+{
+ push_math(math_shift_group, text_style);
+ eq_word_define(int_base + cur_fam_code, -1);
+ if (every_math_par != null)
+ begin_token_list(every_math_par, every_math_text);
+}
+
+@ @c
+void enter_display_math(void);
+
+@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
+|math_shift| character) is scanned. We must check to see whether this
+`\.\$' is immediately followed by another, in case display math mode is
+called for.
+
+@c
+void init_math(void)
+{
+ if (cur_cmd == math_shift_cmd) {
+ get_token(); /* |get_x_token| would fail on \.{\\ifmmode}\thinspace! */
+ if ((cur_cmd == math_shift_cmd) && (mode > 0)) {
+ enter_display_math();
+ } else {
+ back_input();
+ enter_ordinary_math();
+ }
+ } else if (cur_cmd == math_shift_cs_cmd && cur_chr == display_style && (mode > 0)) {
+ enter_display_math();
+ } else if (cur_cmd == math_shift_cs_cmd && cur_chr == text_style) {
+ enter_ordinary_math();
+ } else {
+ you_cant();
+ }
+}
+
+@ We get into ordinary math mode from display math mode when `\.{\\eqno}' or
+`\.{\\leqno}' appears. In such cases |cur_chr| will be 0 or~1, respectively;
+the value of |cur_chr| is placed onto |save_stack| for safe keeping.
+
+@ When \TeX\ is in display math mode, |cur_group=math_shift_group|,
+so it is not necessary for the |start_eq_no| procedure to test for
+this condition.
+
+@c
+void start_eq_no(void)
+{
+ set_saved_record(0, saved_eqno, 0, cur_chr);
+ incr(save_ptr);
+ enter_ordinary_math();
+}
+
+@ Subformulas of math formulas cause a new level of math mode to be entered,
+on the semantic nest as well as the save stack. These subformulas arise in
+several ways: (1)~A left brace by itself indicates the beginning of a
+subformula that will be put into a box, thereby freezing its glue and
+preventing line breaks. (2)~A subscript or superscript is treated as a
+subformula if it is not a single character; the same applies to
+the nucleus of things like \.{\\underline}. (3)~The \.{\\left} primitive
+initiates a subformula that will be terminated by a matching \.{\\right}.
+The group codes placed on |save_stack| in these three cases are
+|math_group|, |math_group|, and |math_left_group|, respectively.
+
+Here is the code that handles case (1); the other cases are not quite as
+trivial, so we shall consider them later.
+
+@c
+void math_left_brace(void)
+{
+ pointer q;
+ tail_append(new_noad());
+ q = new_node(math_char_node, 0);
+ nucleus(tail) = q;
+ back_input();
+ (void) scan_math(nucleus(tail), m_style);
+}
+
+@ If the inline directions of \.{\\pardir} and \.{\\mathdir} are
+opposite, then this function will return true. Discovering that fact
+is somewhat odd because it needs traversal of the |save_stack|.
+The occurance of displayed equations is weird enough that this is
+probably still better than having yet another field in the |input_stack|
+structures.
+
+None of this makes much sense if the inline direction of either one of
+\.{\\pardir} or \.{\\mathdir} is vertical, but in that case the current
+math machinery is ill suited anyway so I do not bother to test that.
+
+@c
+static boolean math_and_text_reversed_p(void)
+{
+ int i = save_ptr - 1;
+ while (save_type(i) != level_boundary)
+ i--;
+ while (i < save_ptr) {
+ if (save_type(i) == restore_old_value &&
+ save_value(i) == int_base + par_direction_code) {
+ if (textdir_opposite(math_direction_par, save_value(i - 1)))
+ return true;
+ }
+ i++;
+ }
+ return false;
+}
+
+@ When we enter display math mode, we need to call |line_break| to
+process the partial paragraph that has just been interrupted by the
+display. Then we can set the proper values of |display_width| and
+|display_indent| and |pre_display_size|.
+
+@c
+void enter_display_math(void)
+{
+ scaled w; /* new or partial |pre_display_size| */
+ scaled l; /* new |display_width| */
+ scaled s; /* new |display_indent| */
+ pointer p;
+ int n; /* scope of paragraph shape specification */
+ if (head == tail || /* `\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}' */
+ (vlink(head) == tail && /* the 2nd of \.{\$\${ }\$\$} \.{\$\${ }\$\$} */
+ type(tail) == local_par_node && vlink(tail) == null)) {
+ if (vlink(head) == tail) {
+ /* bug \#270: |resume_after_display| inserts a |local_par_node|, but if
+ there is another display immediately following, we have to get rid
+ of that node */
+ flush_node(tail);
+ }
+ pop_nest();
+ w = -max_dimen;
+ } else {
+ line_break(true, math_shift_group);
+ w = actual_box_width(just_box, x_over_n(quad(get_cur_font()),1000) * math_pre_display_gap_factor_par);
+ }
+ /* now we are in vertical mode, working on the list that will contain the display */
+ /* A displayed equation is considered to be three lines long, so we
+ calculate the length and offset of line number |prev_graf+2|. */
+ if (par_shape_par_ptr == null) {
+ if ((hang_indent_par != 0) && (((hang_after_par >= 0) && (prev_graf_par + 2 > hang_after_par)) || (prev_graf_par + 1 < -hang_after_par))) {
+ halfword used_hang_indent = swap_hang_indent(hang_indent_par);
+ l = hsize_par - abs(used_hang_indent);
+ if (used_hang_indent > 0)
+ s = used_hang_indent;
+ else
+ s = 0;
+ } else {
+ l = hsize_par;
+ s = 0;
+ }
+ } else {
+ n = vinfo(par_shape_par_ptr + 1);
+ if (prev_graf_par + 2 >= n)
+ p = par_shape_par_ptr + 2 * n + 1;
+ else
+ p = par_shape_par_ptr + 2 * (prev_graf_par + 2) + 1;
+ s = varmem[(p - 1)].cint;
+ l = varmem[p].cint;
+ s = swap_parshape_indent(s,l);
+ }
+
+ push_math(math_shift_group, display_style);
+ mode = mmode;
+ eq_word_define(int_base + cur_fam_code, -1);
+ eq_word_define(dimen_base + pre_display_size_code, w);
+ eq_word_define(dimen_base + display_width_code, l);
+ eq_word_define(dimen_base + display_indent_code, s);
+ eq_word_define(int_base + pre_display_direction_code, (math_and_text_reversed_p() ? -1 : 0));
+ if (every_display_par != null)
+ begin_token_list(every_display_par, every_display_text);
+ if (nest_ptr == 1) {
+ checked_page_filter(before_display);
+ build_page();
+ }
+}
+
+@ The next routine parses all variations of a delimiter code. The |extcode|
+ tells what syntax form to use (\TeX, XeTeX, XeTeXnum, ...) , the
+ |doclass| tells whether or not read a math class also (for \.{\\delimiter} c.s.).
+ (the class is passed on for conversion to \.{\\mathchar}).
+
+@c
+static delcodeval do_scan_extdef_del_code(int extcode, boolean doclass)
+{
+ const char *hlp[] = {
+ "I'm going to use 0 instead of that illegal code value.",
+ NULL
+ };
+ delcodeval d;
+ int mcls = 0, msfam = 0, mschr = 0, mlfam = 0, mlchr = 0;
+ if (extcode == tex_mathcode) { /* \.{\\delcode}, this is the easiest */
+ scan_int();
+ /* "MFCCFCC or "FCCFCC */
+ if (doclass) {
+ mcls = (cur_val / 0x1000000);
+ cur_val = (cur_val & 0xFFFFFF);
+ }
+ if (cur_val > 0xFFFFFF) {
+ tex_error("Invalid delimiter code", hlp);
+ cur_val = 0;
+ }
+ msfam = (cur_val / 0x100000);
+ mschr = (cur_val % 0x100000) / 0x1000;
+ mlfam = (cur_val & 0xFFF) / 0x100;
+ mlchr = (cur_val % 0x100);
+ } else if (extcode == umath_mathcode) { /* \.{\\Udelcode} */
+ /* <0-7>,<0-0xFF>,<0-0x10FFFF> or <0-0xFF>,<0-0x10FFFF> */
+ if (doclass) {
+ scan_int();
+ mcls = cur_val;
+ }
+ scan_int();
+ msfam = cur_val;
+ scan_char_num();
+ mschr = cur_val;
+ if (msfam < 0 || msfam > 255) {
+ tex_error("Invalid delimiter code", hlp);
+ msfam = 0;
+ mschr = 0;
+ }
+ mlfam = 0;
+ mlchr = 0;
+ } else if (extcode == umathnum_mathcode) { /* \.{\\Udelcodenum} */
+ /* "FF<21bits> */
+ /* the largest numeric value is $2^29-1$, but
+ the top of bit 21 can't be used as it contains invalid USV's
+ */
+ if (doclass) { /* such a primitive doesn't exist */
+ confusion("umathnum_mathcode");
+ }
+ scan_int();
+ msfam = (cur_val / 0x200000);
+ mschr = cur_val & 0x1FFFFF;
+ if (msfam < 0 || msfam > 255 || mschr > 0x10FFFF) {
+ tex_error("Invalid delimiter code", hlp);
+ msfam = 0;
+ mschr = 0;
+ }
+ mlfam = 0;
+ mlchr = 0;
+ } else {
+ /* something's gone wrong */
+ confusion("unknown_extcode");
+ }
+ d.class_value = mcls;
+ d.small_family_value = msfam;
+ d.small_character_value = mschr;
+ d.large_family_value = mlfam;
+ d.large_character_value = mlchr;
+ return d;
+}
+
+@ @c
+void scan_extdef_del_code(int level, int extcode)
+{
+ delcodeval d;
+ int p;
+ scan_char_num();
+ p = cur_val;
+ scan_optional_equals();
+ d = do_scan_extdef_del_code(extcode, false);
+ set_del_code(p, d.small_family_value, d.small_character_value,
+ d.large_family_value, d.large_character_value,
+ (quarterword) (level));
+}
+
+@ @c
+mathcodeval scan_mathchar(int extcode)
+{
+ char errstr[255] = { 0 };
+ const char *hlp[] = {
+ "I'm going to use 0 instead of that illegal code value.",
+ NULL
+ };
+ mathcodeval d;
+ int mcls = 0, mfam = 0, mchr = 0;
+ if (extcode == tex_mathcode) { /* \.{\\mathcode} */
+ /* "TFCC */
+ scan_int();
+ if (cur_val > 0x8000) {
+ /*
+ tex_error("Invalid math code", hlp);
+ cur_val = 0;
+ */
+ /* needed for latex: fallback to umathnum_mathcode */
+ mfam = (cur_val / 0x200000) & 0x7FF;
+ mcls = mfam % 0x08;
+ mfam = mfam / 0x08;
+ mchr = cur_val & 0x1FFFFF;
+ if (mchr > 0x10FFFF) {
+ tex_error("Invalid math code during > 0x8000 mathcode fallback", hlp);
+ mcls = 0;
+ mfam = 0;
+ mchr = 0;
+ }
+ } else {
+ if (cur_val < 0) {
+ snprintf(errstr, 255, "Bad mathchar (%d)", (int)cur_val);
+ tex_error(errstr, hlp);
+ cur_val = 0;
+ }
+ mcls = (cur_val / 0x1000);
+ mfam = ((cur_val % 0x1000) / 0x100);
+ mchr = (cur_val % 0x100);
+ }
+ } else if (extcode == umath_mathcode) {
+ /* <0-0x7> <0-0xFF> <0-0x10FFFF> */
+ scan_int();
+ mcls = cur_val;
+ scan_int();
+ mfam = cur_val;
+ scan_char_num();
+ mchr = cur_val;
+ if (mcls < 0 || mcls > 7 || mfam > 255) {
+ tex_error("Invalid math code", hlp);
+ mchr = 0;
+ mfam = 0;
+ mcls = 0;
+ }
+ } else if (extcode == umathnum_mathcode) {
+ /* "FFT<21bits> */
+ /* the largest numeric value is $2^32-1$, but
+ the top of bit 21 can't be used as it contains invalid USV's
+ */
+ /* Note: |scan_int| won't accept families 128-255 because these use bit 32 */
+ scan_int();
+ mfam = (cur_val / 0x200000) & 0x7FF;
+ mcls = mfam % 0x08;
+ mfam = mfam / 0x08;
+ mchr = cur_val & 0x1FFFFF;
+ if (mchr > 0x10FFFF) {
+ tex_error("Invalid math code", hlp);
+ mcls = 0;
+ mfam = 0;
+ mchr = 0;
+ }
+ } else {
+ /* something's gone wrong */
+ confusion("unknown_extcode");
+ }
+ d.class_value = mcls;
+ d.family_value = mfam;
+ d.character_value = mchr;
+ return d;
+}
+
+@ @c
+void scan_extdef_math_code(int level, int extcode)
+{
+ mathcodeval d;
+ int p;
+ scan_char_num();
+ p = cur_val;
+ scan_optional_equals();
+ d = scan_mathchar(extcode);
+ set_math_code(p, d.class_value,
+ d.family_value, d.character_value, (quarterword) (level));
+}
+
+@ this reads in a delcode when actually a mathcode is needed
+@c
+mathcodeval scan_delimiter_as_mathchar(int extcode)
+{
+ delcodeval dval;
+ mathcodeval mval;
+ dval = do_scan_extdef_del_code(extcode, true);
+ mval.class_value = dval.class_value;
+ mval.family_value = dval.small_family_value;
+ mval.character_value = dval.small_character_value;
+ return mval;
+}
+
+@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad
+are broken down into subfields called |type| and either |math_list| or
+|(math_fam,math_character)|. The job of |scan_math| is to figure out
+what to place in one of these principal fields; it looks at the
+subformula that comes next in the input, and places an encoding of
+that subformula into a given word of |mem|.
+
+@c
+#define get_next_nb_nr() do { get_x_token(); } while (cur_cmd==spacer_cmd||cur_cmd==relax_cmd)
+
+int scan_math_style(pointer p, int mstyle)
+{
+ get_next_nb_nr();
+ back_input();
+ scan_left_brace();
+ set_saved_record(0, saved_math, 0, p);
+ incr(save_ptr);
+ push_math(math_group, mstyle);
+ return 1;
+}
+
+int scan_math(pointer p, int mstyle)
+{
+ /* label restart,reswitch,exit; */
+ mathcodeval mval = { 0, 0, 0 };
+ assert(p != null);
+ RESTART:
+ get_next_nb_nr();
+ RESWITCH:
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ case char_given_cmd:
+ mval = get_math_code(cur_chr);
+ if (mval.class_value == 8) {
+ /* An active character that is an |outer_call| is allowed here */
+ cur_cs = active_to_cs(cur_chr, true);
+ cur_cmd = eq_type(cur_cs);
+ cur_chr = equiv(cur_cs);
+ x_token();
+ back_input();
+ goto RESTART;
+ }
+ break;
+ case char_num_cmd:
+ scan_char_num();
+ cur_chr = cur_val;
+ cur_cmd = char_given_cmd;
+ goto RESWITCH;
+ break;
+ case math_char_num_cmd:
+ if (cur_chr == 0)
+ mval = scan_mathchar(tex_mathcode);
+ else if (cur_chr == 1)
+ mval = scan_mathchar(umath_mathcode);
+ else if (cur_chr == 2)
+ mval = scan_mathchar(umathnum_mathcode);
+ else
+ confusion("scan_math");
+ break;
+ case math_given_cmd:
+ mval = mathchar_from_integer(cur_chr, tex_mathcode);
+ break;
+ case xmath_given_cmd:
+ mval = mathchar_from_integer(cur_chr, umath_mathcode);
+ break;
+ case delim_num_cmd:
+ if (cur_chr == 0)
+ mval = scan_delimiter_as_mathchar(tex_mathcode);
+ else if (cur_chr == 1)
+ mval = scan_delimiter_as_mathchar(umath_mathcode);
+ else
+ confusion("scan_math");
+ break;
+ default:
+ /* The pointer |p| is placed on |save_stack| while a complex subformula
+ is being scanned. */
+ back_input();
+ scan_left_brace();
+ set_saved_record(0, saved_math, 0, p);
+ incr(save_ptr);
+ push_math(math_group, mstyle);
+ return 1;
+ }
+ type(p) = math_char_node;
+ math_character(p) = mval.character_value;
+ if ((mval.class_value == math_use_current_family_code) && cur_fam_par_in_range)
+ math_fam(p) = cur_fam_par;
+ else
+ math_fam(p) = mval.family_value;
+ return 0;
+}
+
+@ The |set_math_char| procedure creates a new noad appropriate to a given
+math code, and appends it to the current mlist. However, if the math code
+is sufficiently large, the |cur_chr| is treated as an active character and
+nothing is appended.
+
+@c
+void set_math_char(mathcodeval mval)
+{
+ pointer p; /* the new noad */
+ if (mval.class_value == 8) {
+ /* An active character that is an |outer_call| is allowed here */
+ cur_cs = active_to_cs(cur_chr, true);
+ cur_cmd = eq_type(cur_cs);
+ cur_chr = equiv(cur_cs);
+ x_token();
+ back_input();
+ } else {
+ pointer q;
+ p = new_noad();
+ q = new_node(math_char_node, 0);
+ nucleus(p) = q;
+ math_character(nucleus(p)) = mval.character_value;
+ math_fam(nucleus(p)) = mval.family_value;
+ if (mval.class_value == math_use_current_family_code) {
+ if (cur_fam_par_in_range)
+ math_fam(nucleus(p)) = cur_fam_par;
+ subtype(p) = ord_noad_type;
+ } else {
+ switch (mval.class_value) {
+ /* *INDENT-OFF* */
+ case 0: subtype(p) = ord_noad_type; break;
+ case 1: subtype(p) = op_noad_type_normal; break;
+ case 2: subtype(p) = bin_noad_type; break;
+ case 3: subtype(p) = rel_noad_type; break;
+ case 4: subtype(p) = open_noad_type; break;
+ case 5: subtype(p) = close_noad_type; break;
+ case 6: subtype(p) = punct_noad_type; break;
+ /* *INDENT-ON* */
+ }
+ }
+ vlink(tail) = p;
+ tail = p;
+ }
+}
+
+@ The |math_char_in_text| procedure creates a new node representing a math char
+in text code, and appends it to the current list. However, if the math code
+is sufficiently large, the |cur_chr| is treated as an active character and
+nothing is appended.
+
+@c
+void math_char_in_text(mathcodeval mval)
+{
+ pointer p; /* the new node */
+ if (mval.class_value == 8) {
+ /* An active character that is an |outer_call| is allowed here */
+ cur_cs = active_to_cs(cur_chr, true);
+ cur_cmd = eq_type(cur_cs);
+ cur_chr = equiv(cur_cs);
+ x_token();
+ back_input();
+ } else {
+ p = new_char(fam_fnt(mval.family_value, text_size), mval.character_value);
+ vlink(tail) = p;
+ tail = p;
+ }
+}
+
+@ @c
+void math_math_comp(void)
+{
+ pointer q;
+ tail_append(new_noad());
+ subtype(tail) = (quarterword) cur_chr;
+ q = new_node(math_char_node, 0);
+ nucleus(tail) = q;
+ if (cur_chr == over_noad_type)
+ (void) scan_math(nucleus(tail), cramped_style(m_style));
+ else
+ (void) scan_math(nucleus(tail), m_style);
+}
+
+@ @c
+void math_limit_switch(void)
+{
+ const char *hlp[] = {
+ "I'm ignoring this misplaced \\limits or \\nolimits command.",
+ NULL
+ };
+ if (head != tail) {
+ if (type(tail) == simple_noad &&
+ (subtype(tail) == op_noad_type_normal ||
+ subtype(tail) == op_noad_type_limits ||
+ subtype(tail) == op_noad_type_no_limits)) {
+ subtype(tail) = (quarterword) cur_chr;
+ return;
+ }
+ }
+ tex_error("Limit controls must follow a math operator", hlp);
+}
+
+@ Delimiter fields of noads are filled in by the |scan_delimiter| routine.
+The first parameter of this procedure is the |mem| address where the
+delimiter is to be placed; the second tells if this delimiter follows
+\.{\\radical} or not.
+
+@c
+static void scan_delimiter(pointer p, int r)
+{
+ delcodeval dval = { 0, 0, 0, 0, 0 };
+ if (r == tex_mathcode) { /* \.{\\radical} */
+ dval = do_scan_extdef_del_code(tex_mathcode, true);
+ } else if (r == umath_mathcode) { /* \.{\\Uradical} */
+ dval = do_scan_extdef_del_code(umath_mathcode, false);
+ } else if (r == no_mathcode) {
+ get_next_nb_nr();
+ switch (cur_cmd) {
+ case letter_cmd:
+ case other_char_cmd:
+ dval = get_del_code(cur_chr);
+ break;
+ case delim_num_cmd:
+ if (cur_chr == 0) /* \.{\\delimiter} */
+ dval = do_scan_extdef_del_code(tex_mathcode, true);
+ else if (cur_chr == 1) /* \.{\\Udelimiter} */
+ dval = do_scan_extdef_del_code(umath_mathcode, true);
+ else
+ confusion("scan_delimiter1");
+ break;
+ default:
+ dval.small_family_value = -1;
+ break;
+ }
+ } else {
+ confusion("scan_delimiter2");
+ }
+ if (p == null)
+ return;
+ if (dval.small_family_value < 0) {
+ const char *hlp[] = {
+ "I was expecting to see something like `(' or `\\{' or",
+ "`\\}' here. If you typed, e.g., `{' instead of `\\{', you",
+ "should probably delete the `{' by typing `1' now, so that",
+ "braces don't get unbalanced. Otherwise just proceed",
+ "Acceptable delimiters are characters whose \\delcode is",
+ "nonnegative, or you can use `\\delimiter <delimiter code>'.",
+ NULL
+ };
+ back_error("Missing delimiter (. inserted)", hlp);
+ small_fam(p) = 0;
+ small_char(p) = 0;
+ large_fam(p) = 0;
+ large_char(p) = 0;
+ } else {
+ small_fam(p) = dval.small_family_value;
+ small_char(p) = dval.small_character_value;
+ large_fam(p) = dval.large_family_value;
+ large_char(p) = dval.large_character_value;
+ }
+ return;
+}
+
+@ @c
+void math_radical(void)
+{
+ halfword q;
+ int chr_code = cur_chr;
+ halfword options = 0;
+ tail_append(new_node(radical_noad, chr_code));
+ q = new_node(delim_node, 0);
+ left_delimiter(tail) = q;
+ while (1) {
+ if (scan_keyword("width")) {
+ scan_dimen(false,false,false);
+ radicalwidth(tail) = cur_val ;
+ } else if (scan_keyword("left")) {
+ options = options | noad_option_left ;
+ } else if (scan_keyword("middle")) {
+ options = options | noad_option_middle ;
+ } else if (scan_keyword("right")) {
+ options = options | noad_option_right ;
+ } else {
+ break;
+ }
+ }
+ radicaloptions(tail) = options;
+ if (chr_code == 0) /* \.{\\radical} */
+ scan_delimiter(left_delimiter(tail), tex_mathcode);
+ else if (chr_code == 1) /* \.{\\Uradical} */
+ scan_delimiter(left_delimiter(tail), umath_mathcode);
+ else if (chr_code == 2) /* \.{\\Uroot} */
+ scan_delimiter(left_delimiter(tail), umath_mathcode);
+ else if (chr_code == 3) /* \.{\\Uunderdelimiter} */
+ scan_delimiter(left_delimiter(tail), umath_mathcode);
+ else if (chr_code == 4) /* \.{\\Uoverdelimiter} */
+ scan_delimiter(left_delimiter(tail), umath_mathcode);
+ else if (chr_code == 5) /* \.{\\Udelimiterunder} */
+ scan_delimiter(left_delimiter(tail), umath_mathcode);
+ else if (chr_code == 6) /* \.{\\Udelimiterover} */
+ scan_delimiter(left_delimiter(tail), umath_mathcode);
+ else if (chr_code == 7) /* \.{\\Uhextensible} */
+ scan_delimiter(left_delimiter(tail), umath_mathcode);
+ else
+ confusion("math_radical");
+ if (chr_code == 7) {
+ q = new_node(sub_box_node, 0); /* type will change */
+ nucleus(tail) = q;
+ return;
+ } else if (chr_code == 2) {
+ /* the trick with the |vlink(q)| is used by |scan_math|
+ to decide whether it needs to go on */
+ q = new_node(math_char_node, 0);
+ vlink(q) = tail;
+ degree(tail) = q;
+ if (!scan_math(degree(tail), sup_sup_style(m_style))) {
+ vlink(degree(tail)) = null;
+ q = new_node(math_char_node, 0);
+ nucleus(tail) = q;
+ (void) scan_math(nucleus(tail), cramped_style(m_style));
+ }
+ } else {
+ q = new_node(math_char_node, 0);
+ nucleus(tail) = q;
+ (void) scan_math(nucleus(tail), cramped_style(m_style));
+ }
+}
+
+@ @c
+void math_ac(void)
+{
+ halfword q;
+ mathcodeval t = { 0, 0, 0 };
+ mathcodeval b = { 0, 0, 0 };
+ mathcodeval o = { 0, 0, 0 };
+ if (cur_cmd == accent_cmd) {
+ const char *hlp[] = {
+ "I'm changing \\accent to \\mathaccent here; wish me luck.",
+ "(Accents are not the same in formulas as they are in text.)",
+ NULL
+ };
+ tex_error("Please use \\mathaccent for accents in math mode", hlp);
+ }
+ tail_append(new_node(accent_noad, 0));
+ if (cur_chr == 0) { /* \.{\\mathaccent} */
+ t = scan_mathchar(tex_mathcode);
+ } else if (cur_chr == 1) { /* \.{\\Umathaccent} */
+ if (scan_keyword("fixed")) {
+ /* top */
+ subtype(tail) = 1;
+ t = scan_mathchar(umath_mathcode);
+ } else if (scan_keyword("both")) {
+ /* top bottom */
+ if (scan_keyword("fixed")) {
+ subtype(tail) = 1;
+ }
+ t = scan_mathchar(umath_mathcode);
+ if (scan_keyword("fixed")) {
+ subtype(tail) += 2;
+ }
+ b = scan_mathchar(umath_mathcode);
+ } else if (scan_keyword("bottom")) {
+ /* bottom */
+ if (scan_keyword("fixed")) {
+ subtype(tail) = 2;
+ }
+ b = scan_mathchar(umath_mathcode);
+ } else if (scan_keyword("top")) {
+ /* top */
+ if (scan_keyword("fixed")) {
+ subtype(tail) = 1;
+ }
+ t = scan_mathchar(umath_mathcode);
+ } else if (scan_keyword("overlay")) {
+ /* overlay */
+ if (scan_keyword("fixed")) {
+ subtype(tail) = 1;
+ }
+ o = scan_mathchar(umath_mathcode);
+ } else {
+ /* top */
+ t = scan_mathchar(umath_mathcode);
+ }
+ if (scan_keyword("fraction")) {
+ scan_int();
+ accentfraction(tail) = cur_val;
+ }
+ } else {
+ confusion("mathaccent");
+ }
+ if (!(t.character_value == 0 && t.family_value == 0)) {
+ q = new_node(math_char_node, 0);
+ top_accent_chr(tail) = q;
+ math_character(top_accent_chr(tail)) = t.character_value;
+ if ((t.class_value == math_use_current_family_code) && cur_fam_par_in_range)
+ math_fam(top_accent_chr(tail)) = cur_fam_par;
+ else
+ math_fam(top_accent_chr(tail)) = t.family_value;
+ }
+ if (!(b.character_value == 0 && b.family_value == 0)) {
+ q = new_node(math_char_node, 0);
+ bot_accent_chr(tail) = q;
+ math_character(bot_accent_chr(tail)) = b.character_value;
+ if ((b.class_value == math_use_current_family_code) && cur_fam_par_in_range)
+ math_fam(bot_accent_chr(tail)) = cur_fam_par;
+ else
+ math_fam(bot_accent_chr(tail)) = b.family_value;
+ }
+ if (!(o.character_value == 0 && o.family_value == 0)) {
+ q = new_node(math_char_node, 0);
+ overlay_accent_chr(tail) = q;
+ math_character(overlay_accent_chr(tail)) = o.character_value;
+ if ((o.class_value == math_use_current_family_code) && cur_fam_par_in_range)
+ math_fam(overlay_accent_chr(tail)) = cur_fam_par;
+ else
+ math_fam(overlay_accent_chr(tail)) = o.family_value;
+ }
+ q = new_node(math_char_node, 0);
+ nucleus(tail) = q;
+ (void) scan_math(nucleus(tail), cramped_style(m_style));
+}
+
+@ @c
+pointer math_vcenter_group(pointer p)
+{
+ pointer q, r;
+ q = new_noad();
+ subtype(q) = vcenter_noad_type;
+ r = new_node(sub_box_node, 0);
+ nucleus(q) = r;
+ math_list(nucleus(q)) = p;
+ return q;
+}
+
+@ The routine that scans the four mlists of a \.{\\mathchoice} is very
+much like the routine that builds discretionary nodes.
+
+@c
+void append_choices(void)
+{
+ tail_append(new_choice());
+ incr(save_ptr);
+ set_saved_record(-1, saved_choices, 0, 0);
+ push_math(math_choice_group, display_style);
+ scan_left_brace();
+}
+
+@ @c
+void build_choices(void)
+{
+ pointer p; /* the current mlist */
+ int prev_style;
+ prev_style = m_style;
+ unsave_math();
+ p = fin_mlist(null);
+ assert(saved_type(-1) == saved_choices);
+ switch (saved_value(-1)) {
+ case 0:
+ display_mlist(tail) = p;
+ break;
+ case 1:
+ text_mlist(tail) = p;
+ break;
+ case 2:
+ script_mlist(tail) = p;
+ break;
+ case 3:
+ script_script_mlist(tail) = p;
+ decr(save_ptr);
+ return;
+ break;
+ } /* there are no other cases */
+ set_saved_record(-1, saved_choices, 0, (saved_value(-1) + 1));
+ push_math(math_choice_group, (prev_style + 2));
+ scan_left_brace();
+}
+
+@ Subscripts and superscripts are attached to the previous nucleus by the
+action procedure called |sub_sup|.
+
+@c
+void sub_sup(void)
+{
+ pointer q;
+ if (tail == head || (!scripts_allowed(tail))) {
+ tail_append(new_noad());
+ q = new_node(sub_mlist_node, 0);
+ nucleus(tail) = q;
+ }
+ if (cur_cmd == sup_mark_cmd || cur_chr == sup_mark_cmd) { /* |super_sub_script| */
+ if (supscr(tail) != null) {
+ const char *hlp[] = {
+ "I treat `x^1^2' essentially like `x^1{}^2'.", NULL
+ };
+ tail_append(new_noad());
+ q = new_node(sub_mlist_node, 0);
+ nucleus(tail) = q;
+ tex_error("Double superscript", hlp);
+ }
+ q = new_node(math_char_node, 0);
+ supscr(tail) = q;
+ (void) scan_math(supscr(tail), sup_style(m_style));
+ } else if (cur_cmd == sub_mark_cmd || cur_chr == sub_mark_cmd) {
+ if (subscr(tail) != null) {
+ const char *hlp[] = {
+ "I treat `x_1_2' essentially like `x_1{}_2'.", NULL
+ };
+ tail_append(new_noad());
+ q = new_node(sub_mlist_node, 0);
+ nucleus(tail) = q;
+ tex_error("Double subscript", hlp);
+ }
+ q = new_node(math_char_node, 0);
+ subscr(tail) = q;
+ (void) scan_math(subscr(tail), sub_style(m_style));
+ }
+}
+
+@ An operation like `\.{\\over}' causes the current mlist to go into a
+state of suspended animation: |incompleat_noad| points to a |fraction_noad|
+that contains the mlist-so-far as its numerator, while the denominator
+is yet to come. Finally when the mlist is finished, the denominator will
+go into the incompleat fraction noad, and that noad will become the
+whole formula, unless it is surrounded by `\.{\\left}' and `\.{\\right}'
+delimiters.
+
+@c
+void math_fraction(void)
+{
+ halfword c; /* the type of generalized fraction we are scanning */
+ pointer q;
+ halfword options = 0;
+ halfword temp_value;
+ c = cur_chr;
+ if (incompleat_noad_par != null) {
+ const char *hlp[] = {
+ "I'm ignoring this fraction specification, since I don't",
+ "know whether a construction like `x \\over y \\over z'",
+ "means `{x \\over y} \\over z' or `x \\over {y \\over z}'.",
+ NULL
+ };
+ if (c >= delimited_code) {
+ scan_delimiter(null, no_mathcode);
+ scan_delimiter(null, no_mathcode);
+ }
+ if ((c % delimited_code) == above_code)
+ scan_normal_dimen();
+ tex_error("Ambiguous; you need another { and }", hlp);
+ } else {
+ incompleat_noad_par = new_node(fraction_noad, 0);
+ temp_value = new_node(sub_mlist_node, 0);
+ numerator(incompleat_noad_par) = temp_value;
+ math_list(numerator(incompleat_noad_par)) = vlink(head);
+ vlink(head) = null;
+ tail = head;
+ m_style = cramped_style(m_style);
+
+ if ((c % delimited_code) == skewed_code) {
+ q = new_node(delim_node, 0);
+ middle_delimiter(incompleat_noad_par) = q;
+ scan_delimiter(middle_delimiter(incompleat_noad_par), no_mathcode);
+ }
+ if (c >= delimited_code) {
+ q = new_node(delim_node, 0);
+ left_delimiter(incompleat_noad_par) = q;
+ q = new_node(delim_node, 0);
+ right_delimiter(incompleat_noad_par) = q;
+ scan_delimiter(left_delimiter(incompleat_noad_par), no_mathcode);
+ scan_delimiter(right_delimiter(incompleat_noad_par), no_mathcode);
+ }
+ switch (c % delimited_code) {
+ case above_code:
+ while (1) {
+ if (scan_keyword("exact")) {
+ options = options | noad_option_exact ;
+ } else {
+ break;
+ }
+ }
+ fractionoptions(incompleat_noad_par) = options;
+ scan_normal_dimen();
+ thickness(incompleat_noad_par) = cur_val;
+ break;
+ case over_code:
+ thickness(incompleat_noad_par) = default_code;
+ break;
+ case atop_code:
+ thickness(incompleat_noad_par) = 0;
+ break;
+ case skewed_code:
+ while (1) {
+ if (scan_keyword("exact")) {
+ options = options | noad_option_exact ;
+ } else if (scan_keyword("noaxis")) {
+ options = options | noad_option_no_axis ;
+ } else {
+ break;
+ }
+ }
+ fractionoptions(incompleat_noad_par) = options;
+ thickness(incompleat_noad_par) = 0;
+ break;
+ }
+ }
+}
+
+@ At the end of a math formula or subformula, the |fin_mlist| routine is
+called upon to return a pointer to the newly completed mlist, and to
+pop the nest back to the enclosing semantic level. The parameter to
+|fin_mlist|, if not null, points to a |fence_noad| that ends the
+current mlist; this |fence_noad| has not yet been appended.
+
+@c
+pointer fin_mlist(pointer p)
+{
+ pointer q; /* the mlist to return */
+ if (incompleat_noad_par != null) {
+ if (denominator(incompleat_noad_par) != null) {
+ type(denominator(incompleat_noad_par)) = sub_mlist_node;
+ } else {
+ q = new_node(sub_mlist_node, 0);
+ denominator(incompleat_noad_par) = q;
+ }
+ math_list(denominator(incompleat_noad_par)) = vlink(head);
+ if (p == null) {
+ q = incompleat_noad_par;
+ } else {
+ q = math_list(numerator(incompleat_noad_par));
+ if ((type(q) != fence_noad) || (subtype(q) != left_noad_side)
+ || (delim_par == null))
+ confusion("right"); /* this can't happen */
+ math_list(numerator(incompleat_noad_par)) = vlink(delim_par);
+ vlink(delim_par) = incompleat_noad_par;
+ vlink(incompleat_noad_par) = p;
+ }
+ } else {
+ vlink(tail) = p;
+ q = vlink(head);
+ }
+ pop_nest();
+ return q;
+}
+
+@ Now at last we're ready to see what happens when a right brace occurs
+in a math formula. Two special cases are simplified here: Braces are effectively
+removed when they surround a single Ord without sub/superscripts, or when they
+surround an accent that is the nucleus of an Ord atom.
+
+@c
+void close_math_group(pointer p)
+{
+ int old_style = m_style;
+ unsave_math();
+
+ decr(save_ptr);
+ assert(saved_type(0) == saved_math);
+ type(saved_value(0)) = sub_mlist_node;
+ p = fin_mlist(null);
+ math_list(saved_value(0)) = p;
+ if (p != null) {
+ if (vlink(p) == null) {
+ if (type(p) == simple_noad && subtype(p) == ord_noad_type) {
+ if (subscr(p) == null && supscr(p) == null) {
+ type(saved_value(0)) = type(nucleus(p));
+ if (type(nucleus(p)) == math_char_node) {
+ math_fam(saved_value(0)) = math_fam(nucleus(p));
+ math_character(saved_value(0)) =
+ math_character(nucleus(p));
+ } else {
+ math_list(saved_value(0)) = math_list(nucleus(p));
+ math_list(nucleus(p)) = null;
+ }
+ delete_attribute_ref(node_attr(saved_value(0)));
+ node_attr(saved_value(0)) = node_attr(nucleus(p));
+ node_attr(nucleus(p)) = null;
+ flush_node(p);
+ }
+ } else if (type(p) == accent_noad) {
+ if (saved_value(0) == nucleus(tail)) {
+ if (type(tail) == simple_noad
+ && subtype(tail) == ord_noad_type) {
+ pointer q = head;
+ while (vlink(q) != tail)
+ q = vlink(q);
+ vlink(q) = p;
+ nucleus(tail) = null;
+ subscr(tail) = null;
+ supscr(tail) = null;
+ delete_attribute_ref(node_attr(p));
+ node_attr(p) = node_attr(tail);
+ node_attr(tail) = null;
+ flush_node(tail);
+ tail = p;
+ }
+ }
+ }
+ }
+ }
+ if (vlink(saved_value(0)) > 0) {
+ pointer q;
+ q = new_node(math_char_node, 0);
+ nucleus(vlink(saved_value(0))) = q;
+ vlink(saved_value(0)) = null;
+ saved_value(0) = q;
+ (void) scan_math(saved_value(0), old_style);
+ /* restart */
+ }
+}
+
+@ We have dealt with all constructions of math mode except `\.{\\left}' and
+`\.{\\right}', so the picture is completed by the following sections of
+the program. The |middle| feature of eTeX allows one ore several \.{\\middle}
+delimiters to appear between \.{\\left} and \.{\\right}.
+
+@c
+void math_left_right(void)
+{
+ halfword t; /* |left_noad_side| .. |right_noad_side| */
+ pointer p; /* new noad */
+ pointer q; /* resulting mlist */
+ pointer r; /* temporary */
+ halfword ht = 0;
+ halfword dp = 0;
+ halfword options = 0;
+ halfword type = -1 ;
+ t = cur_chr;
+
+ if (t > 10) {
+ /* we have \Uleft \Uright \Umiddle */
+ t = t - 10;
+ while (1) {
+ if (scan_keyword("height")) {
+ scan_dimen(false,false,false);
+ ht = cur_val ;
+ } else if (scan_keyword("depth")) {
+ scan_dimen(false,false,false);
+ dp = cur_val ;
+ } else if (scan_keyword("axis")) {
+ options = options | noad_option_axis ;
+ } else if (scan_keyword("noaxis")) {
+ options = options | noad_option_no_axis ;
+ } else if (scan_keyword("exact")) {
+ options = options | noad_option_exact ;
+ } else if (scan_keyword("class")) {
+ scan_int();
+ type = cur_val ;
+ } else {
+ break;
+ }
+ }
+ }
+
+ if ((t != no_noad_side) && (t != left_noad_side) && (cur_group != math_left_group)) {
+ if (cur_group == math_shift_group) {
+ scan_delimiter(null, no_mathcode);
+ if (t == middle_noad_side) {
+ const char *hlp[] = {
+ "I'm ignoring a \\middle that had no matching \\left.",
+ NULL
+ };
+ tex_error("Extra \\middle", hlp);
+ } else {
+ const char *hlp[] = {
+ "I'm ignoring a \\right that had no matching \\left.",
+ NULL
+ };
+ tex_error("Extra \\right", hlp);
+ }
+ } else {
+ off_save();
+ }
+ } else {
+ p = new_noad();
+ type(p) = fence_noad;
+ subtype(p) = (quarterword) t;
+ r = new_node(delim_node, 0);
+ delimiter(p) = r;
+
+ delimiterheight(p) = ht;
+ delimiterdepth(p) = dp;
+ delimiteroptions(p) = options;
+ delimiterclass(p) = type;
+ delimiteritalic(p) = 0;
+
+ scan_delimiter(delimiter(p), no_mathcode);
+
+ if (t == no_noad_side) {
+ tail_append(new_noad());
+ subtype(tail) = inner_noad_type;
+ r = new_node(sub_mlist_node, 0);
+ nucleus(tail) = r;
+ math_list(nucleus(tail)) = p;
+ return ;
+ }
+
+ if (t == left_noad_side) {
+ q = p;
+ } else {
+ q = fin_mlist(p);
+ unsave_math();
+ }
+ if (t != right_noad_side) {
+ push_math(math_left_group, m_style);
+ vlink(head) = q;
+ tail = p;
+ delim_par = p;
+ } else {
+ tail_append(new_noad());
+ subtype(tail) = inner_noad_type;
+ r = new_node(sub_mlist_node, 0);
+ nucleus(tail) = r;
+ math_list(nucleus(tail)) = q;
+ }
+ }
+}
+
+@ \TeX\ gets to the following part of the program when
+the first `\.\$' ending a display has been scanned.
+
+@c
+static void check_second_math_shift(void)
+{
+ get_x_token();
+ if (cur_cmd != math_shift_cmd) {
+ const char *hlp[] = {
+ "The `$' that I just saw supposedly matches a previous `$$'.",
+ "So I shall assume that you typed `$$' both times.",
+ NULL
+ };
+ back_error("Display math should end with $$", hlp);
+ }
+}
+
+static void check_display_math_end(void)
+{
+ if (cur_chr != cramped_display_style) {
+ const char *hlp[] = {
+ "I shall assume that you typed that.",
+ NULL
+ };
+ tex_error("Display math should end with \\Ustopdisplaymath", hlp);
+ }
+}
+
+static void check_inline_math_end(void)
+{
+ if (cur_chr != cramped_text_style) {
+ const char *hlp[] = {
+ "I shall assume that you typed that.",
+ NULL
+ };
+ tex_error("Inline math should end with \\Ustopmath", hlp);
+ }
+}
+
+@ @c
+static void resume_after_display(void)
+{
+ if (cur_group != math_shift_group)
+ confusion("display");
+ unsave_math();
+ prev_graf_par = prev_graf_par + 3;
+ push_nest();
+ mode = hmode;
+ space_factor_par = 1000;
+ /* this needs to be intercepted in the display math start ! */
+ tail_append(make_local_par_node(penalty_par_code));
+ get_x_token();
+ if (cur_cmd != spacer_cmd)
+ back_input();
+ if (nest_ptr == 1) {
+ normal_page_filter(after_display);
+ build_page();
+ }
+}
+
+@ The fussiest part of math mode processing occurs when a displayed formula is
+being centered and placed with an optional equation number.
+
+At this time we are in vertical mode (or internal vertical mode).
+
+ |p| points to the mlist for the formula.
+ |a| is either |null| or it points to a box containing the equation number.
+ |l| is true if there was an \.{\\leqno}/ (so |a| is a horizontal box).
+
+@c
+#define inject_display_skip_before(g) \
+ switch (display_skip_mode_par) { \
+ case 0 : /* normal tex */ \
+ tail_append(new_param_glue(g)); \
+ break;\
+ case 1 : /* always */ \
+ tail_append(new_param_glue(g)); \
+ break; \
+ case 2 : /* non-zero */ \
+ if (g != 0 && ! glue_is_zero(glue_par(g))) \
+ tail_append(new_param_glue(g)); \
+ break; \
+ case 3: /* ignore */ \
+ break; \
+ }
+
+#define inject_display_skip_after(g) \
+ switch (display_skip_mode_par) { \
+ case 0 : /* normal tex */ \
+ if (g != 0 && glue_is_positive(glue_par(g))) \
+ tail_append(new_param_glue(g)); \
+ break; \
+ case 1 : /* always */ \
+ tail_append(new_param_glue(g)); \
+ break; \
+ case 2 : /* non-zero */ \
+ if (g != 0 && ! glue_is_zero(glue_par(g))) \
+ tail_append(new_param_glue(g)); \
+ break; \
+ case 3: /* ignore */ \
+ break; \
+ }
+
+static void finish_displayed_math(boolean l, pointer eqno_box, pointer p)
+{
+ pointer eq_box; /* box containing the equation */
+ scaled eq_w; /* width of the equation */
+ scaled line_w; /* width of the line */
+ scaled eqno_w; /* width of equation number */
+ scaled eqno_w2; /* width of equation number plus space to separate from equation */
+ scaled line_s; /* move the line right this much */
+ scaled d; /* displacement of equation in the line */
+ small_number g1, g2; /* glue parameter codes for before and after */
+ pointer r,s; /* kern nodes used to position the display */
+ pointer t; /* tail of adjustment list */
+ pointer pre_t; /* tail of pre-adjustment list */
+ boolean swap_dir; /* true if the math and surrounding text dirs are opposed */
+ scaled eqno_width;
+ swap_dir = (pre_display_direction_par < 0 ? true : false );
+ if (eqno_box != null && swap_dir)
+ l = !l;
+ adjust_tail = adjust_head;
+ pre_adjust_tail = pre_adjust_head;
+ eq_box = hpack(p, 0, additional, -1);
+ subtype(eq_box) = equation_list; /* new */
+ build_attribute_list(eq_box);
+ p = list_ptr(eq_box);
+ t = adjust_tail;
+ adjust_tail = null;
+ pre_t = pre_adjust_tail;
+ pre_adjust_tail = null;
+ eq_w = width(eq_box);
+ line_w = display_width_par;
+ line_s = display_indent_par;
+ if (eqno_box == null) {
+ eqno_w = 0;
+ eqno_width = 0;
+ eqno_w2 = 0;
+ } else {
+ eqno_w = width(eqno_box);
+ eqno_width = eqno_w;
+ eqno_w2 = eqno_w + round_xn_over_d(math_eqno_gap_step_par, get_math_quad_style(text_style), 1000);
+ subtype(eqno_box) = equation_number_list; /* new */
+ /* build_attribute_list(eqno_box); */ /* probably already set */
+ }
+ if (eq_w + eqno_w2 > line_w) {
+ /* The user can force the equation number to go on a separate line
+ by causing its width to be zero. */
+ if ((eqno_w != 0) && ((eq_w - total_shrink[normal] + eqno_w2 <= line_w)
+ || (total_shrink[sfi] != 0)
+ || (total_shrink[fil] != 0)
+ || (total_shrink[fill] != 0)
+ || (total_shrink[filll] != 0))) {
+ list_ptr(eq_box) = null;
+ flush_node(eq_box);
+ eq_box = hpack(p, line_w - eqno_w2, exactly, -1);
+ subtype(eq_box) = equation_list; /* new */
+ build_attribute_list(eq_box);
+ } else {
+ eqno_w = 0;
+ if (eq_w > line_w) {
+ list_ptr(eq_box) = null;
+ flush_node(eq_box);
+ eq_box = hpack(p, line_w, exactly, -1);
+ subtype(eq_box) = equation_list; /* new */
+ build_attribute_list(eq_box);
+ }
+ }
+ eq_w = width(eq_box);
+ }
+ /* We try first to center the display without regard to the existence of
+ the equation number. If that would make it too close (where ``too close''
+ means that the space between display and equation number is less than the
+ width of the equation number), we either center it in the remaining space
+ or move it as far from the equation number as possible. The latter alternative
+ is taken only if the display begins with glue, since we assume that the
+ user put glue there to control the spacing precisely.
+ */
+ d = half(line_w - eq_w);
+ if ((eqno_w > 0) && (d < 2 * eqno_w)) { /* too close */
+ d = half(line_w - eq_w - eqno_w);
+ if (p != null)
+ if (!is_char_node(p))
+ if (type(p) == glue_node)
+ d = 0;
+ }
+
+ tail_append(new_penalty(pre_display_penalty_par));
+ if ((d + line_s <= pre_display_size_par) || l) { /* not enough clearance */
+ g1 = above_display_skip_code;
+ g2 = below_display_skip_code;
+ } else {
+ g1 = above_display_short_skip_code;
+ g2 = below_display_short_skip_code;
+ }
+
+ /* If the equation number is set on a line by itself, either before or
+ after the formula, we append an infinite penalty so that no page break will
+ separate the display from its number; and we use the same size and
+ displacement for all three potential lines of the display, even though
+ `\.{\\parshape}' may specify them differently.
+ */
+ /* \.{\\leqno} on a forced single line due to |width=0| */
+ /* it follows that |type(a)=hlist_node| */
+
+ if (eqno_box && l && (eqno_w == 0)) {
+ /* if (math_direction_par==dir_TLT) { */
+ shift_amount(eqno_box) = 0;
+ /* } else { */
+ /* } */
+ append_to_vlist(eqno_box,lua_key_index(equation_number));
+ tail_append(new_penalty(inf_penalty));
+ } else {
+ inject_display_skip_before(g1);
+ }
+
+ if (eqno_w != 0) {
+ r = new_kern(line_w - eq_w - eqno_w - d);
+ if (l) {
+ if (swap_dir) {
+ if (math_direction_par==dir_TLT) {
+ /* TRT + TLT + \eqno, (swap_dir=true, math_direction_par=TLT, l=true) */
+#ifdef DEBUG
+ fprintf(stderr, "\nDEBUG: CASE 1\n");
+#endif
+ s = new_kern(width(r) + eqno_w);
+ try_couple_nodes(eqno_box,r);
+ try_couple_nodes(r,eq_box);
+ try_couple_nodes(eq_box,s);
+ } else {
+ /* TLT + TRT + \eqno, (swap_dir=true, math_direction_par=TRT, l=true) */
+#ifdef DEBUG
+ fprintf(stderr, "\nDEBUG: CASE 2\n");
+#endif
+ try_couple_nodes(eqno_box,r);
+ try_couple_nodes(r,eq_box);
+ }
+ } else {
+ if (math_direction_par==dir_TLT) {
+ /* TLT + TLT + \leqno, (swap_dir=false, math_direction_par=TLT, l=true) */ /* OK */
+#ifdef DEBUG
+ fprintf(stderr, "\nDEBUG: CASE 3\n");
+#endif
+ s = new_kern(width(r) + eqno_w);
+ } else {
+ /* TRT + TRT + \leqno, (swap_dir=false, math_direction_par=TRT, l=true) */
+#ifdef DEBUG
+ fprintf(stderr, "\nDEBUG: CASE 4\n");
+#endif
+ s = new_kern(width(r));
+ }
+ try_couple_nodes(eqno_box,r);
+ try_couple_nodes(r,eq_box);
+ try_couple_nodes(eq_box,s);
+ }
+ eq_box = eqno_box;
+ } else {
+ if (swap_dir) {
+ if (math_direction_par==dir_TLT) {
+ /* TRT + TLT + \leqno, (swap_dir=true, math_direction_par=TLT, l=false) */
+#ifdef DEBUG
+ fprintf(stderr, "\nDEBUG: CASE 5\n");
+#endif
+ } else {
+ /* TLT + TRT + \leqno, (swap_dir=true, math_direction_par=TRT, l=false) */
+#ifdef DEBUG
+ fprintf(stderr, "\nDEBUG: CASE 6\n");
+#endif
+ }
+ try_couple_nodes(eq_box,r);
+ try_couple_nodes(r,eqno_box);
+ } else {
+ if (math_direction_par==dir_TLT) {
+ /* TLT + TLT + \eqno, (swap_dir=false, math_direction_par=TLT, l=false) */ /* OK */
+#ifdef DEBUG
+ fprintf(stderr, "\nDEBUG: CASE 7\n");
+#endif
+ s = new_kern(d);
+ } else {
+ /* TRT + TRT + \eqno, (swap_dir=false, math_direction_par=TRT, l=false) */
+#ifdef DEBUG
+ fprintf(stderr, "\nDEBUG: CASE 8\n");
+#endif
+ s = new_kern(width(r) + eqno_w);
+ }
+ try_couple_nodes(s,eq_box);
+ try_couple_nodes(eq_box,r);
+ try_couple_nodes(r,eqno_box);
+ eq_box = s;
+ }
+ }
+ eq_box = hpack(eq_box, 0, additional, -1);
+ subtype(eq_box) = equation_list; /* new */
+ build_attribute_list(eq_box);
+ shift_amount(eq_box) = line_s;
+ } else {
+ shift_amount(eq_box) = line_s + d;
+ }
+/* check for prev: */
+ append_to_vlist(eq_box,lua_key_index(equation));
+
+ if ((eqno_box != null) && (eqno_w == 0) && !l) {
+ tail_append(new_penalty(inf_penalty));
+ /* if (math_direction_par==dir_TLT) { */
+ shift_amount(eqno_box) = line_s + line_w - eqno_width ;
+ /* } else { */
+ /* } */
+ append_to_vlist(eqno_box,lua_key_index(equation_number));
+ g2 = 0;
+ }
+ if (t != adjust_head) { /* migrating material comes after equation number */
+ vlink(tail) = vlink(adjust_head);
+ /* needs testing */
+ alink(adjust_tail) = alink(tail);
+ tail = t;
+ }
+ if (pre_t != pre_adjust_head) {
+ vlink(tail) = vlink(pre_adjust_head);
+ /* needs testing */
+ alink(pre_adjust_tail) = alink(tail);
+ tail = pre_t;
+ }
+ tail_append(new_penalty(post_display_penalty_par));
+ inject_display_skip_after(g2);
+ resume_after_display();
+}
+
+@ @c
+void after_math(void)
+{
+ int m; /* |mmode| or |-mmode| */
+ pointer p; /* the formula */
+ pointer a = null; /* box containing equation number */
+ boolean l = false; /* `\.{\\leqno}' instead of `\.{\\eqno}' */
+ m = mode;
+ p = fin_mlist(null); /* this pops the nest */
+ if (cur_cmd == math_shift_cs_cmd &&
+ (cur_chr == text_style || cur_chr == display_style)) {
+ you_cant();
+ }
+ if (mode == -m) { /* end of equation number */
+ if (cur_cmd == math_shift_cmd) {
+ check_second_math_shift();
+ } else {
+ check_display_math_end();
+ }
+ run_mlist_to_hlist(p, false, text_style);
+ a = hpack(vlink(temp_head), 0, additional, -1);
+ build_attribute_list(a);
+ unsave_math();
+ decr(save_ptr); /* now |cur_group=math_shift_group| */
+ assert(saved_type(0) == saved_eqno);
+ if (saved_value(0) == 1)
+ l = true;
+ m = mode;
+ p = fin_mlist(null);
+
+ }
+ if (m < 0) {
+ /* The |unsave| is done after everything else here; hence an appearance of
+ `\.{\\mathsurround}' inside of `\.{\$...\$}' affects the spacing at these
+ particular \.\$'s. This is consistent with the conventions of
+ `\.{\$\$...\$\$}', since `\.{\\abovedisplayskip}' inside a display affects the
+ space above that display.
+ */
+ if (cur_cmd == math_shift_cs_cmd) {
+ check_inline_math_end();
+ }
+ tail_append(new_math(math_surround_par, before));
+ /* begin mathskip code */
+ switch (math_skip_mode) {
+ case 0 :
+ /* obey mathsurround when zero glue */
+ if (! glue_is_zero(math_skip_par)) {
+ copy_glue_values(tail,math_skip_par);
+ surround(tail) = 0;
+ }
+ break ;
+ case 1 :
+ /* always left */
+ case 3 :
+ /* always both */
+ case 6 :
+ /* only when skip */
+ copy_glue_values(tail,math_skip_par);
+ surround(tail) = 0;
+ break ;
+ case 2 :
+ /* only right */
+ surround(tail) = 0;
+ break ;
+ case 4 :
+ /* ignore, obey marthsurround */
+ break ;
+ case 5:
+ /* all spacing disabled */
+ surround(tail) = 0;
+ break ;
+ }
+ /* end mathskip code */
+ if (dir_math_save) {
+ tail_append(new_dir(math_direction_par));
+ }
+ run_mlist_to_hlist(p, (mode > 0), text_style);
+ vlink(tail) = vlink(temp_head);
+ while (vlink(tail) != null) {
+ tail = vlink(tail);
+ }
+ if (dir_math_save) {
+ tail_append(new_dir(math_direction_par - dir_swap));
+ }
+ dir_math_save = false;
+ tail_append(new_math(math_surround_par, after));
+ /* begin mathskip code */
+ switch (math_skip_mode) {
+ case 0 :
+ /* obey mathsurround when zero glue */
+ if (! glue_is_zero(math_skip_par)) {
+ copy_glue_values(tail,math_skip_par);
+ surround(tail) = 0;
+ }
+ break ;
+ case 2 :
+ /* always right */
+ case 3 :
+ /* always both */
+ case 6 :
+ /* only when skip */
+ copy_glue_values(tail,math_skip_par);
+ surround(tail) = 0;
+ break ;
+ case 1 :
+ /* only left */
+ surround(tail) = 0;
+ break ;
+ case 4 :
+ /* ignore, obey marthsurround */
+ break ;
+ case 5:
+ /* all spacing disabled */
+ surround(tail) = 0;
+ break ;
+ }
+ /* end mathskip code */
+ space_factor_par = 1000;
+ unsave_math();
+ } else {
+ if (a == null) {
+ if (cur_cmd == math_shift_cmd) {
+ check_second_math_shift();
+ } else {
+ check_display_math_end();
+ }
+ }
+ run_mlist_to_hlist(p, false, display_style);
+ finish_displayed_math(l, a, vlink(temp_head));
+ }
+}
+
+@ When \.{\\halign} appears in a display, the alignment routines operate
+essentially as they do in vertical mode. Then the following program is
+activated, with |p| and |q| pointing to the beginning and end of the
+resulting list, and with |aux_save| holding the |prev_depth| value.
+
+@c
+void finish_display_alignment(pointer p, pointer q, halfword saved_prevdepth)
+{
+ do_assignments();
+ if (cur_cmd == math_shift_cmd) {
+ check_second_math_shift();
+ } else {
+ check_display_math_end();
+ }
+ pop_nest();
+ tail_append(new_penalty(pre_display_penalty_par));
+ inject_display_skip_before(above_display_skip_code);
+ vlink(tail) = p;
+ if (p != null)
+ tail = q;
+ tail_append(new_penalty(post_display_penalty_par));
+ inject_display_skip_after(below_display_skip_code);
+ cur_list.prev_depth_field = saved_prevdepth;
+ resume_after_display();
+}
+
+@ Interface to \.{\\Umath} and \.{\\mathstyle}
+
+@c
+void setup_math_style(void)
+{
+ pointer q;
+ tail_append(new_noad());
+ q = new_node(math_char_node, 0);
+ nucleus(tail) = q;
+ (void) scan_math_style(nucleus(tail), num_style(m_style));
+}
+
+@ @c
+void print_math_style(void)
+{
+ if (abs(mode) == mmode)
+ print_int(m_style);
+ else
+ print_int(-1);
+}
diff --git a/Build/source/texk/web2c/luatexdir/tex/texnodes.w b/Build/source/texk/web2c/luatexdir/tex/texnodes.w
index 17be906c8e6..9ba54f07432 100644
--- a/Build/source/texk/web2c/luatexdir/tex/texnodes.w
+++ b/Build/source/texk/web2c/luatexdir/tex/texnodes.w
@@ -1,3755 +1,3775 @@
-% 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
-
-#include "ptexlib.h"
-#include "lua/luatex-api.h"
-
-/* we can consider less mode sizes: 2 4 6 8 */
-
-@
-This module started out using NDEBUG to trigger checking invalid node usage,
-something that is needed because users can mess up nodes in Lua. At some point
-that code was always enabled so it is now always on but still can be recognized
-as additional code. And as the performance hit is close to zero so disabling
-makes no sense, not even to make it configureable. There is a little more memory
-used but that is neglectable compared to other memory usage.
-
-@c
-#define MAX_CHAIN_SIZE 13 /* why not a bit larger */
-#define CHECK_NODE_USAGE 1 /* this triggers checking */
-
-memory_word *volatile varmem = NULL;
-
-#ifdef CHECK_NODE_USAGE
- 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; /* used in font and lang */
-
-halfword slow_get_node(int s); /* defined below */
-
-#define fake_node 100
-#define fake_node_size 2
-#define fake_node_name "fake"
-
-#define variable_node_size 2
-
-/* core nodes */
-
-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", "index", 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", "penalty", NULL
-};
-const char *node_fields_math[] = {
- "attr", "surround", "width", "stretch", "shrink", "stretch_order", "shrink_order", NULL
-};
-const char *node_fields_glue[] = {
- "attr", "leader", "width", "stretch", "shrink", "stretch_order", "shrink_order", 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_inserting[] = {
- "height", "last_ins_ptr", "best_ins_ptr",
- "width", "stretch", "shrink", "stretch_order", "shrink_order", NULL
-};
-const char *node_fields_splitup[] = {
- "height", "last_ins_ptr", "best_ins_ptr", "broken_ptr", "broken_ins", NULL
-};
-const char *node_fields_attribute[] = {
- "number", "value", NULL
-};
-const char *node_fields_glue_spec[] = {
- "width", "stretch", "shrink", "stretch_order", "shrink_order", NULL
-};
-const char *node_fields_attribute_list[] = {
- NULL
-};
-const char *node_fields_local_par[] = {
- "attr", "pen_inter", "pen_broken", "dir", "box_left", "box_left_width",
- "box_right", "box_right_width", NULL
-};
-const char *node_fields_dir[] = {
- "attr", "dir", "level", NULL
-};
-const char *node_fields_boundary[] = {
- "attr", "value", NULL
-};
-
-/* math nodes */
-
-const char *node_fields_noad[] = {
- "attr", "nucleus", "sub", "sup", NULL
-};
-
-const char *node_fields_style[] = {
- "attr", "style", NULL
-};
-const char *node_fields_choice[] = {
- "attr", "display", "text", "script", "scriptscript", NULL
-};
-const char *node_fields_radical[] = {
- "attr", "nucleus", "sub", "sup", "left", "degree", "width", "options", NULL
-};
-const char *node_fields_fraction[] = {
- "attr", "width", "num", "denom", "left", "right", "middle", "options", NULL
-};
-const char *node_fields_accent[] = {
- "attr", "nucleus", "sub", "sup", "accent", "bot_accent", "top_accent",
- "overlay_accent", "fraction", NULL
-};
-const char *node_fields_fence[] = {
- "attr", "delim", "italic", "height", "depth", "options", "class", 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
-};
-
-/* whatsit nodes */
-
-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_save_pos[] = {
- "attr", NULL
-};
-const char *node_fields_whatsit_late_lua[] = {
- "attr", "reg", "data", "name", "string", NULL
-};
-const char *node_fields_whatsit_user_defined[] = {
- "attr", "user_id", "type", "value", NULL
-};
-
-/* pdf backend whatsit nodes */
-
-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_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_action[] = {
- "action_type", "named_id", "action_id", "file", "new_window", "data", 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_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
-};
-
-/* subtypes */
-
-const char *node_subtypes_glue[] = {
- "userskip", "lineskip", "baselineskip", "parskip", "abovedisplayskip", "belowdisplayskip",
- "abovedisplayshortskip", "belowdisplayshortskip", "leftskip", "rightskip", "topskip",
- "splittopskip", "tabskip", "spaceskip", "xspaceskip", "parfillskip",
- "mathskip", "thinmuskip", "medmuskip", "thickmuskip", NULL
-};
-const char *node_subtypes_mathglue[] = { /* 98+ */
- "conditionalmathskip", "muglue", NULL
-};
-const char *node_subtypes_leader[] = { /* 100+ */
- "leaders", "cleaders", "xleaders", "gleaders", NULL
-};
-const char *node_subtypes_fill[] = {
- "stretch", "fi", "fil", "fill", "filll", NULL
-};
-const char *node_subtypes_boundary[] = {
- "cancel", "user", "protrusion", "word", NULL
-};
-const char *node_subtypes_penalty[] = {
- "userpenalty", NULL
-};
-const char *node_subtypes_kern[] = {
- "fontkern", "userkern", "accentkern", "italiccorrection", NULL
-};
-const char *node_subtypes_rule[] = {
- "normal", "box", "image", "empty", "user", "over", "under", "fraction", "radical", NULL
-};
-const char *node_subtypes_glyph[] = {
- "character", "glyph", "ligature", "ghost", "left", "right", NULL
-};
-const char *node_subtypes_disc[] = {
- "discretionary", "explicit", "automatic", "regular", "first", "second", NULL
-};
-const char *node_subtypes_marginkern[] = {
- "left", "right", NULL
-};
-const char *node_subtypes_list[] = {
- "unknown", "line", "box", "indent", "alignment", "cell", "equation", "equationnumber", NULL
-};
-const char *node_subtypes_adjust[] = {
- "normal", "pre", NULL
-};
-const char *node_subtypes_math[] = {
- "beginmath", "endmath", NULL
-};
-const char *node_subtypes_noad[] = {
- "ord", "opdisplaylimits", "oplimits", "opnolimits", "bin", "rel", "open", "close",
- "punct", "inner", "under", "over", "vcenter", NULL
-};
-const char *node_subtypes_radical[] = {
- "radical", "uradical", "uroot", "uunderdelimiter", "uoverdelimiter", "udelimiterunder",
- "udelimiterover", NULL
-};
-const char *node_subtypes_accent[] = {
- "bothflexible", "fixedtop", "fixedbottom", "fixedboth", NULL,
-};
-const char *node_subtypes_fence[] = {
- "unset", "left", "middle", "right", NULL
-};
-
-node_info node_data[] = { /* the last entry in a row is the etex number */
- { hlist_node, box_node_size, node_fields_list, "hlist", 1 },
- { vlist_node, box_node_size, node_fields_list, "vlist", 2 },
- { rule_node, rule_node_size, node_fields_rule, "rule", 3 },
- { ins_node, ins_node_size, node_fields_insert, "ins", 4 },
- { mark_node, mark_node_size, node_fields_mark, "mark", 5 },
- { adjust_node, adjust_node_size, node_fields_adjust, "adjust", 6 },
- { boundary_node, boundary_node_size, node_fields_boundary, "boundary", -1 },
- { disc_node, disc_node_size, node_fields_disc, "disc", 8 },
- { whatsit_node, -1, NULL, "whatsit", 9 },
- { local_par_node, local_par_size, node_fields_local_par, "local_par", -1 },
- { dir_node, dir_node_size, node_fields_dir, "dir", -1 },
- { math_node, math_node_size, node_fields_math, "math", 10 },
- { glue_node, glue_node_size, node_fields_glue, "glue", 11 },
- { kern_node, kern_node_size, node_fields_kern, "kern", 12 },
- { penalty_node, penalty_node_size, node_fields_penalty, "penalty", 13 },
- { unset_node, box_node_size, node_fields_unset, "unset", 14 },
- { style_node, style_node_size, node_fields_style, "style", 15 },
- { choice_node, style_node_size, node_fields_choice, "choice", 15 },
- { simple_noad, noad_size, node_fields_noad, "noad", 15 },
- { radical_noad, radical_noad_size, node_fields_radical, "radical", 15 },
- { fraction_noad, fraction_noad_size, node_fields_fraction, "fraction", 15 },
- { accent_noad, accent_noad_size, node_fields_accent, "accent", 15 },
- { fence_noad, fence_noad_size, node_fields_fence, "fence", 15 },
- { math_char_node, math_kernel_node_size, node_fields_math_char, "math_char", 15 },
- { sub_box_node, math_kernel_node_size, node_fields_sub_box, "sub_box", 15 },
- { sub_mlist_node, math_kernel_node_size, node_fields_sub_mlist, "sub_mlist", 15 },
- { math_text_char_node, math_kernel_node_size, node_fields_math_text_char, "math_text_char", 15 },
- { delim_node, math_shield_node_size, node_fields_delim, "delim", 15 },
- { margin_kern_node, margin_kern_node_size, node_fields_margin_kern, "margin_kern", -1 },
- { glyph_node, glyph_node_size, node_fields_glyph, "glyph", 0 },
- { align_record_node, box_node_size, NULL, "align_record", -1 },
- { pseudo_file_node, pseudo_file_node_size, NULL, "pseudo_file", -1 },
- { pseudo_line_node, variable_node_size, NULL, "pseudo_line", -1 },
- { inserting_node, page_ins_node_size, node_fields_inserting, "page_insert", -1 },
- { split_up_node, page_ins_node_size, node_fields_splitup, "split_insert", -1 },
- { expr_node, expr_node_size, NULL, "expr_stack", -1 },
- { nesting_node, nesting_node_size, NULL, "nested_list", -1 },
- { span_node, span_node_size, NULL, "span", -1 },
- { attribute_node, attribute_node_size, node_fields_attribute, "attribute", -1 },
- { glue_spec_node, glue_spec_size, node_fields_glue_spec, "glue_spec", -1 },
- { attribute_list_node, attribute_node_size, node_fields_attribute_list, "attribute_list", -1 },
- { temp_node, temp_node_size, NULL, "temp", -1 },
- { align_stack_node, align_stack_node_size, NULL, "align_stack", -1 },
- { movement_node, movement_node_size, NULL, "movement_stack", -1 },
- { if_node, if_node_size, NULL, "if_stack", -1 },
- { unhyphenated_node, active_node_size, NULL, "unhyphenated", -1 },
- { hyphenated_node, active_node_size, NULL, "hyphenated", -1 },
- { delta_node, delta_node_size, NULL, "delta", -1 },
- { passive_node, passive_node_size, NULL, "passive", -1 },
- { shape_node, variable_node_size, NULL, "shape", -1 },
- { -1, -1, NULL, NULL, -1 },
-};
-
-const char *node_subtypes_pdf_destination[] = {
- "xyz", "fit", "fith", "fitv", "fitb", "fitbh", "fitbv", "fitr", NULL
-};
-const char *node_subtypes_pdf_literal[] = {
- "origin", "page", "direct", NULL
-};
-
-node_info whatsit_node_data[] = {
- { open_node, open_node_size, node_fields_whatsit_open, "open", -1 },
- { write_node, write_node_size, node_fields_whatsit_write, "write", -1 },
- { close_node, close_node_size, node_fields_whatsit_close, "close", -1 },
- { special_node, special_node_size, node_fields_whatsit_special, "special", -1 },
- { fake_node, fake_node_size, NULL, fake_node_name, -1 },
- { fake_node, fake_node_size, NULL, fake_node_name, -1 },
- { save_pos_node, save_pos_node_size, node_fields_whatsit_save_pos, "save_pos", -1 },
- { late_lua_node, late_lua_node_size, node_fields_whatsit_late_lua, "late_lua", -1 },
- { user_defined_node, user_defined_node_size, node_fields_whatsit_user_defined, "user_defined", -1 },
- { fake_node, fake_node_size, NULL, fake_node_name, -1 },
- { fake_node, fake_node_size, NULL, fake_node_name, -1 },
- { fake_node, fake_node_size, NULL, fake_node_name, -1 },
- { fake_node, fake_node_size, NULL, fake_node_name, -1 },
- { fake_node, fake_node_size, NULL, fake_node_name, -1 },
- { fake_node, fake_node_size, NULL, fake_node_name, -1 },
- { fake_node, fake_node_size, NULL, fake_node_name, -1 },
- /* here starts the dvi backend section, todo: a separate list */
- /* nothing for dvi */
- /* here starts the pdf backend section, todo: a separate list */
- { pdf_literal_node, write_node_size, node_fields_whatsit_pdf_literal, "pdf_literal", -1 },
- { pdf_refobj_node, pdf_refobj_node_size, node_fields_whatsit_pdf_refobj, "pdf_refobj", -1 },
- { pdf_annot_node, pdf_annot_node_size, node_fields_whatsit_pdf_annot, "pdf_annot", -1 },
- { pdf_start_link_node, pdf_annot_node_size, node_fields_whatsit_pdf_start_link, "pdf_start_link", -1 },
- { pdf_end_link_node, pdf_end_link_node_size, node_fields_whatsit_pdf_end_link, "pdf_end_link", -1 },
- { pdf_dest_node, pdf_dest_node_size, node_fields_whatsit_pdf_dest, "pdf_dest", -1 },
- { pdf_action_node, pdf_action_size, node_fields_whatsit_pdf_action, "pdf_action", -1 },
- { pdf_thread_node, pdf_thread_node_size, node_fields_whatsit_pdf_thread, "pdf_thread", -1 },
- { pdf_start_thread_node, pdf_thread_node_size, node_fields_whatsit_pdf_start_thread, "pdf_start_thread", -1 },
- { pdf_end_thread_node, pdf_end_thread_node_size, node_fields_whatsit_pdf_end_thread, "pdf_end_thread", -1 },
- { pdf_thread_data_node, pdf_thread_node_size, NULL, "pdf_thread_data", -1 },
- { pdf_link_data_node, pdf_annot_node_size, NULL, "pdf_link_data", -1 },
- { pdf_colorstack_node, pdf_colorstack_node_size, node_fields_whatsit_pdf_colorstack, "pdf_colorstack", -1 },
- { pdf_setmatrix_node, pdf_setmatrix_node_size, node_fields_whatsit_pdf_setmatrix, "pdf_setmatrix", -1 },
- { pdf_save_node, pdf_save_node_size, node_fields_whatsit_pdf_save, "pdf_save", -1 },
- { pdf_restore_node, pdf_restore_node_size, node_fields_whatsit_pdf_restore, "pdf_restore", -1 },
- /* done */
- { -1, -1, NULL, NULL, -1 },
-};
-
-#define last_whatsit_node pdf_restore_node
-
-@
-When we copy a node list, there are several possibilities: we do the same as a new node,
-we copy the entry to the table in properties (a reference), we do a deep copy of a table
-in the properties, we create a new table and give it the original one as a metatable.
-After some experiments (that also included timing) with these scenarios I decided that a
-deep copy made no sense, nor did nilling. In the end both the shallow copy and the metatable
-variant were both ok, although the second ons is slower. The most important aspect to keep
-in mind is that references to other nodes in properties no longer can be valid for that
-copy. We could use two tables (one unique and one shared) or metatables but that only
-complicates matters.
-
-When defining a new node, we could already allocate a table but it is rather easy to do
-that at the lua end e.g. using a metatable __index method. That way it is under macro
-package control.
-
-When deleting a node, we could keep the slot (e.g. setting it to false) but it could make
-memory consumption raise unneeded when we have temporary large node lists and after that
-only small lists.
-
-So, in the end this is what we ended up with. For the record, I also experimented with the
-following:
-
-- copy attributes to the properties so that we have fast access at the lua end: in the end
- the overhead is not compensated by speed and convenience, in fact, attributes are not
- that slow when it comes to accessing them
-
-- a bitset in the node but again the gain compared to attributes is neglectable and it also
- demands a pretty string agreement over what bit represents what, and this is unlikely to
- succeed in the tex community (I could use it for font handling, which is cross package,
- but decided that it doesn't pay off
-
-In case one wonders why properties make sense then, well, it is not so much speed that we
-gain, but more convenience: storing all kind of (temporary) data in attributes is no fun and
-this mechanism makes sure that properties are cleaned up when a node is freed. Also, the
-advantage of a more or less global properties table is that we stay at the lua end. An
-alternative is to store a reference in the node itself but that is complicated by the fact
-that the register has some limitations (no numeric keys) and we also don't want to mess with
-it too much.
-
-@c
-int lua_properties_level = 0 ; /* can be private */
-int lua_properties_enabled = 0 ;
-int lua_properties_use_metatable = 0 ;
-
-@
-We keep track of nesting so that we don't oveflow the stack, and, what is more
-important, don't keep resolving the registry index.
-
-@c
-#define lua_properties_push do { \
- if (lua_properties_enabled) { \
- lua_properties_level = lua_properties_level + 1 ; \
- if (lua_properties_level == 1) { \
- lua_get_metatablelua_l(Luas,node_properties); \
- } \
- } \
-} while(0)
-
-#define lua_properties_pop do { \
- if (lua_properties_enabled) { \
- if (lua_properties_level == 1) \
- lua_pop(Luas,1); \
- lua_properties_level = lua_properties_level - 1 ; \
- } \
-} while(0)
-
-/* No setting is needed: */
-
-#define lua_properties_set(target) do { \
-} while(0)
-
-/* Resetting boils down to nilling. */
-
-#define lua_properties_reset(target) do { \
- if (lua_properties_enabled) { \
- if (lua_properties_level == 0) { \
- lua_get_metatablelua_l(Luas,node_properties); \
- lua_pushnil(Luas); \
- lua_rawseti(Luas,-2,target); \
- lua_pop(Luas,1); \
- } else { \
- lua_pushnil(Luas); \
- lua_rawseti(Luas,-2,target); \
- } \
- } \
-} while(0)
-
-/*
- For a moment I considered supporting all kind of data types but in practice
- that makes no sense. So we stick to a cheap shallow copy with as option a
- metatable. Btw, a deep copy would look like this:
-
- static void copy_lua_table(lua_State* L, int index) {
- lua_newtable(L);
- lua_pushnil(L);
- while(lua_next(L, index-1) != 0) {
- lua_pushvalue(L, -2);
- lua_insert(L, -2);
- if (lua_type(L,-1)==LUA_TTABLE)
- copy_lua_table(L,-1);
- lua_settable(L, -4);
- }
- lua_pop(L,1);
- }
-
- #define lua_properties_copy(target, source) do { \
- if (lua_properties_enabled) { \
- lua_pushinteger(Luas,source); \
- lua_rawget(Luas,-2); \
- if (lua_type(Luas,-1)==LUA_TTABLE) { \
- copy_lua_table(Luas,-1); \
- lua_pushinteger(Luas,target); \
- lua_insert(Luas,-2); \
- lua_rawset(Luas,-3); \
- } else { \
- lua_pop(Luas,1); \
- } \
- } \
- } while(0)
-
-*/
-
-/* isn't there a faster way to metatable? */
-
-/*
-
-#define lua_properties_copy(target,source) do { \
- if (lua_properties_enabled) { \
- if (lua_properties_level == 0) { \
- lua_get_metatablelua_l(Luas,node_properties); \
- lua_rawgeti(Luas,-1,source); \
- if (lua_type(Luas,-1)==LUA_TTABLE) { \
- if (lua_properties_use_metatable) { \
- lua_newtable(Luas); \
- lua_insert(Luas,-2); \
- lua_setfield(Luas,-2,"__index"); \
- lua_newtable(Luas); \
- lua_insert(Luas,-2); \
- lua_setmetatable(Luas,-2); \
- } \
- lua_rawseti(Luas,-2,target); \
- } else { \
- lua_pop(Luas,1); \
- } \
- lua_pop(Luas,1); \
- } else { \
- lua_rawgeti(Luas,-1,source); \
- if (lua_type(Luas,-1)==LUA_TTABLE) { \
- if (lua_properties_use_metatable) { \
- lua_newtable(Luas); \
- lua_insert(Luas,-2); \
- lua_setfield(Luas,-2,"__index"); \
- lua_newtable(Luas); \
- lua_insert(Luas,-2); \
- lua_setmetatable(Luas,-2); \
- } \
- lua_rawseti(Luas,-2,target); \
- } else { \
- lua_pop(Luas,1); \
- } \
- } \
- } \
-} while(0)
-
-*/
-
-/*
- A simple testrun on many pages of dumb text shows 1% gain (of course it depends
- on how properties are used but some other tests confirm it).
-*/
-
-#define lua_properties_copy(target,source) do { \
- if (lua_properties_enabled) { \
- if (lua_properties_level == 0) { \
- lua_get_metatablelua_l(Luas,node_properties); \
- lua_rawgeti(Luas,-1,source); \
- if (lua_type(Luas,-1)==LUA_TTABLE) { \
- if (lua_properties_use_metatable) { \
- lua_newtable(Luas); \
- lua_insert(Luas,-2); \
- lua_push_string_by_name(Luas,__index); \
- lua_insert(Luas,-2); \
- lua_rawset(Luas, -3); \
- lua_newtable(Luas); \
- lua_insert(Luas,-2); \
- lua_setmetatable(Luas,-2); \
- } \
- lua_rawseti(Luas,-2,target); \
- } else { \
- lua_pop(Luas,1); \
- } \
- lua_pop(Luas,1); \
- } else { \
- lua_rawgeti(Luas,-1,source); \
- if (lua_type(Luas,-1)==LUA_TTABLE) { \
- if (lua_properties_use_metatable) { \
- lua_newtable(Luas); \
- lua_insert(Luas,-2); \
- lua_push_string_by_name(Luas,__index); \
- lua_insert(Luas,-2); \
- lua_rawset(Luas, -3); \
- lua_newtable(Luas); \
- lua_insert(Luas,-2); \
- lua_setmetatable(Luas,-2); \
- } \
- lua_rawseti(Luas,-2,target); \
- } else { \
- lua_pop(Luas,1); \
- } \
- } \
- } \
-} while(0)
-
-/* Here end the property handlers. */
-
-@ @c
-int valid_node(halfword p)
-{
- if (p > my_prealloc && p < var_mem_max) {
-#ifdef CHECK_NODE_USAGE
- if (varmem_sizes[p] > 0) {
- return 1;
- }
-#else
- return 1;
-#endif
- }
- return 0;
-}
-
-@ @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("node range test failed"); \
- } } 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("node test failed"); \
- } } while (0)
-
-#define check_action_ref(a) { dorangetest(p,a,var_mem_max); }
-#define check_attribute_ref(a) { dorangetest(p,a,var_mem_max); }
-#define check_token_ref(a) { \
- if (type(p) == whatsit_node) { \
- formatted_error("nodes","fuzzy token cleanup in whatsit node with id %i and subtype %i",type(p),subtype(p)); \
- } else { \
- formatted_error("nodes","fuzzy token cleanup in node with id %i",type(p)); \
- } \
-}
-
-#ifdef CHECK_NODE_USAGE
-
-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);
-}
-
-static void node_mem_dump(halfword p)
-{
- halfword r;
- 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)
-{
- if (p > my_prealloc && p < var_mem_max) {
-#ifdef CHECK_NODE_USAGE
- int i;
- if (varmem_sizes[p] == 0) {
- check_static_node_mem();
- for (i = (my_prealloc + 1); i < var_mem_max; i++) {
- if (varmem_sizes[i] > 0) {
- check_node(i);
- }
- }
- test_count++;
- if (type(p) == glyph_node) {
- formatted_error("nodes", "attempt to double-free glyph (%c) node %d, ignored", (int) character(p), (int) p);
- } else {
- formatted_error("nodes", "attempt to double-free %s node %d, ignored", get_node_name(type(p), subtype(p)), (int) p);
- }
- node_mem_dump(p);
- return 1;
- }
-#endif
- } else {
- formatted_error("nodes", "attempt to free an impossible node %d", (int) p);
- return 1;
- }
- return 0;
-}
-
-@ @c
-static int copy_error(halfword p)
-{
- if (p >= 0 && p < var_mem_max) {
-#ifdef CHECK_NODE_USAGE
- if (p > my_prealloc && varmem_sizes[p] == 0) {
- if (type(p) == glyph_node) {
- formatted_warning("nodes", "attempt to copy free glyph (%c) node %d, ignored", (int) character(p), (int) p);
- } else {
- formatted_warning("nodes", "attempt to copy free %s node %d, ignored", get_node_name(type(p), subtype(p)), (int) p);
- }
- return 1;
- }
-#endif
- } else {
- formatted_error("nodes", "attempt to copy an impossible node %d", (int) p);
- return 1;
- }
- return 0;
-}
-
-@ @c
-halfword new_node(int i, int j)
-{
- int s = get_node_size(i, j);
- halfword n = get_node(s);
- /*
- It should be possible to do this memset at |free_node()|.
-
- Both 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 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;
- width(n) = null_flag;
- rule_dir(n) = -1;
- rule_index(n) = 0;
- rule_transform(n) = 0;
- 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 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;
- }
- if (synctex_par) {
- /* 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:
- 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);
- /* lua_properties_set */
- }
- type(n) = (quarterword) i;
- subtype(n) = (quarterword) j;
- return n;
-}
-
-halfword raw_glyph_node(void)
-{
- register halfword 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 = 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);
- /* lua_properties_set */
- 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 */
- register halfword s ;
- lua_properties_push; /* saves stack and time */
- while (p != end) {
- s = copy_node(p);
- if (h == null) {
- h = s;
- } else {
- couple_nodes(q, s);
- }
- q = s;
- p = vlink(p);
- }
- lua_properties_pop; /* saves stack and time */
- return h;
-}
-
-halfword copy_node_list(halfword p)
-{
- return do_copy_node_list(p, null);
-}
-
-#define copy_sub_list(target,source) do { \
- if (source != null) { \
- s = do_copy_node_list(source, null); \
- target = s; \
- } else { \
- target = null; \
- } \
- } while (0)
-
-#define copy_sub_node(target,source) do { \
- if (source != null) { \
- s = copy_node(source); \
- target = s ; \
- } else { \
- target = null; \
- } \
-} while (0)
-
-@ make a dupe of a single node
-
-@c
-static void copy_node_wrapup_core(halfword p, halfword r)
-{
- halfword s ;
- switch (subtype(p)) {
- case write_node:
- case special_node:
- add_token_ref(write_tokens(p));
- break;
- case late_lua_node:
- copy_late_lua(r, p);
- break;
- case user_defined_node:
- switch (user_node_type(p)) {
- case 'a':
- add_node_attr_ref(user_node_value(p));
- break;
- case 'l':
- copy_user_lua(r, p);
- break;
- case 'n':
- s = copy_node_list(user_node_value(p));
- user_node_value(r) = s;
- break;
- case 's':
- /* |add_string_ref(user_node_value(p));| */
- break;
- case 't':
- add_token_ref(user_node_value(p));
- break;
- }
- break;
- default:
- break ;
- }
-}
-
-void copy_node_wrapup_dvi(halfword p, halfword r)
-{
-}
-
-void copy_node_wrapup_pdf(halfword p, halfword r)
-{
- switch(subtype(p)) {
- 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 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;
- default:
- break;
- }
-}
-
-halfword copy_node(const halfword p)
-{
- halfword r; /* current node being fabricated for new list */
- halfword w; /* whatsit subtype */
- halfword t; /* type of node */
- 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;
- }
- t = type(p);
- i = get_node_size(t,subtype(p));
- r = get_node(i);
-
- (void) memcpy((void *) (varmem + r), (void *) (varmem + p), (sizeof(memory_word) * (unsigned) i));
-
- /* possible speedup: */
- /*
- if t == glue_spec) {
- return r;
- }
- */
-
- if (synctex_par) {
- /* handle synctex extension */
- switch (t) {
- 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(t)) {
- add_node_attr_ref(node_attr(p));
- alink(r) = null;
- lua_properties_copy(r,p);
- }
- vlink(r) = null;
-
- switch (t) {
- case glyph_node:
- copy_sub_list(lig_ptr(r),lig_ptr(p)) ;
- break;
- case glue_node:
- copy_sub_list(leader_ptr(r),leader_ptr(p)) ;
- break;
- case hlist_node:
- case vlist_node:
- case unset_node:
- copy_sub_list(list_ptr(r),list_ptr(p)) ;
- 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 math_node:
- break;
- case ins_node:
- copy_sub_list(ins_ptr(r),ins_ptr(p)) ;
- break;
- case margin_kern_node:
- copy_sub_node(margin_char(r),margin_char(p));
- break;
- case mark_node:
- add_token_ref(mark_ptr(p));
- break;
- case adjust_node:
- copy_sub_list(adjust_ptr(r),adjust_ptr(p));
- break;
- case choice_node:
- copy_sub_list(display_mlist(r),display_mlist(p)) ;
- copy_sub_list(text_mlist(r),text_mlist(p)) ;
- copy_sub_list(script_mlist(r),script_mlist(p)) ;
- copy_sub_list(script_script_mlist(r),script_script_mlist(p)) ;
- break;
- case simple_noad:
- copy_sub_list(nucleus(r),nucleus(p)) ;
- copy_sub_list(subscr(r),subscr(p)) ;
- copy_sub_list(supscr(r),supscr(p)) ;
- break;
- case radical_noad:
- copy_sub_list(nucleus(r),nucleus(p)) ;
- copy_sub_list(subscr(r),subscr(p)) ;
- copy_sub_list(supscr(r),supscr(p)) ;
- copy_sub_node(left_delimiter(r),left_delimiter(p)) ;
- copy_sub_list(degree(r),degree(p)) ;
- break;
- case accent_noad:
- copy_sub_list(nucleus(r),nucleus(p)) ;
- copy_sub_list(subscr(r),subscr(p)) ;
- copy_sub_list(supscr(r),supscr(p)) ;
- copy_sub_list(top_accent_chr(r),top_accent_chr(p)) ;
- copy_sub_list(bot_accent_chr(r),bot_accent_chr(p)) ;
- copy_sub_list(overlay_accent_chr(r),overlay_accent_chr(p)) ;
- break;
- case fence_noad:
- copy_sub_node(delimiter(r),delimiter(p)) ;
- break;
- case sub_box_node:
- case sub_mlist_node:
- copy_sub_list(math_list(r),math_list(p)) ;
- break;
- case fraction_noad:
- copy_sub_list(numerator(r),numerator(p)) ;
- copy_sub_list(denominator(r),denominator(p)) ;
- copy_sub_node(left_delimiter(r),left_delimiter(p)) ;
- copy_sub_node(right_delimiter(r),right_delimiter(p)) ;
- break;
- case glue_spec_node:
- case dir_node:
- case local_par_node:
- case boundary_node:
- break;
- case whatsit_node:
- w = subtype(p) ;
- if (w >= backend_first_pdf_whatsit) {
- copy_node_wrapup_pdf(p,r);
- } else if (w >= backend_first_dvi_whatsit) {
- copy_node_wrapup_dvi(p,r);
- } else {
- copy_node_wrapup_core(p,r);
- }
- break;
- }
- return r;
-}
-
-/* x */
-
-#define free_sub_list(source) if (source != null) flush_node_list(source);
-#define free_sub_node(source) if (source != null) flush_node(source);
-
-@ @c
-
-static void flush_node_wrapup_core(halfword p)
-{
- switch (subtype(p)) {
- case open_node:
- case write_node:
- case close_node:
- case save_pos_node:
- break;
- case special_node:
- delete_token_ref(write_tokens(p));
- break;
- case late_lua_node:
- free_late_lua(p);
- break;
- case user_defined_node:
- switch (user_node_type(p)) {
- case 'a':
- delete_attribute_ref(user_node_value(p));
- break;
- case 'd':
- break;
- case 'l':
- free_user_lua(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 't':
- delete_token_ref(user_node_value(p));
- 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;
- }
-}
-
-void flush_node_wrapup_dvi(halfword p)
-{
-}
-
-void flush_node_wrapup_pdf(halfword p)
-{
- switch(subtype(p)) {
- case pdf_save_node:
- case pdf_restore_node:
- case pdf_refobj_node:
- case pdf_end_link_node:
- case pdf_end_thread_node:
- 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 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_action_node:
- if (pdf_action_type(p) == pdf_action_user) {
- delete_token_ref(pdf_action_tokens(p));
- } else {
- if (pdf_action_file(p) != null)
- delete_token_ref(pdf_action_file(p));
- if (pdf_action_type(p) == pdf_action_page)
- delete_token_ref(pdf_action_tokens(p));
- else if (pdf_action_named_id(p) > 0)
- delete_token_ref(pdf_action_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;
- }
-}
-
-void flush_node(halfword p)
-{
- halfword w;
- if (p == null) /* legal, but no-op */
- return;
- if (free_error(p))
- return;
- switch (type(p)) {
- case glyph_node:
- free_sub_list(lig_ptr(p));
- break;
- case glue_node:
- free_sub_list(leader_ptr(p));
- break;
- case hlist_node:
- case vlist_node:
- case unset_node:
- free_sub_list(list_ptr(p));
- break;
- case disc_node:
- /* watch the start at temp node hack */
- free_sub_list(vlink(pre_break(p)));
- free_sub_list(vlink(post_break(p)));
- free_sub_list(vlink(no_break(p)));
- break;
- case rule_node:
- case kern_node:
- case penalty_node:
- case math_node:
- break;
- case glue_spec_node:
- /* this allows free-ing of lua-allocated glue specs */
-//if (valid_node(p)) {
-// free_node(p, subtype(p));
-//}
-// return ;
- break ;
- case dir_node:
- case local_par_node:
- case boundary_node:
- break;
- case whatsit_node:
- w = subtype(p) ;
- if (w >= backend_first_pdf_whatsit) {
- flush_node_wrapup_pdf(p);
- } else if (w >= backend_first_dvi_whatsit) {
- flush_node_wrapup_dvi(p);
- } else {
- flush_node_wrapup_core(p);
- }
- break;
- case ins_node:
- flush_node_list(ins_ptr(p));
- break;
- case margin_kern_node:
- flush_node(margin_char(p));
- break;
- case mark_node:
- delete_token_ref(mark_ptr(p));
- break;
- case adjust_node:
- flush_node_list(adjust_ptr(p));
- break;
- case style_node: /* nothing to do */
- break;
- case choice_node:
- free_sub_list(display_mlist(p));
- free_sub_list(text_mlist(p));
- free_sub_list(script_mlist(p));
- free_sub_list(script_script_mlist(p));
- break;
- case simple_noad:
- free_sub_list(nucleus(p));
- free_sub_list(subscr(p));
- free_sub_list(supscr(p));
- break;
- case radical_noad:
- free_sub_list(nucleus(p));
- free_sub_list(subscr(p));
- free_sub_list(supscr(p));
- free_sub_node(left_delimiter(p));
- free_sub_list(degree(p));
- break;
- case accent_noad:
- free_sub_list(nucleus(p));
- free_sub_list(subscr(p));
- free_sub_list(supscr(p));
- free_sub_list(top_accent_chr(p));
- free_sub_list(bot_accent_chr(p));
- free_sub_list(overlay_accent_chr(p));
- break;
- case fence_noad:
- free_sub_list(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:
- free_sub_list(math_list(p));
- break;
- case fraction_noad:
- free_sub_list(numerator(p));
- free_sub_list(denominator(p));
- free_sub_node(left_delimiter(p));
- free_sub_node(right_delimiter(p));
- break;
- case pseudo_file_node:
- free_sub_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 inserting_node:
- case split_up_node:
- case expr_node:
- case attribute_node:
- case attribute_list_node:
- case temp_node:
- break;
- default:
- formatted_error("nodes","flushing weird node type %d", type(p));
- return;
- }
- if (nodetype_has_attributes(type(p))) {
- delete_attribute_ref(node_attr(p));
- lua_properties_reset(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;
- if (p == null) /* legal, but no-op */
- return;
- if (free_error(p))
- return;
- lua_properties_push; /* saves stack and time */
- while (p != null) {
- register halfword q = vlink(p);
- flush_node(p);
- p = q;
- }
- lua_properties_pop; /* saves stack and time */
-}
-
-@ @c
-static void check_node_wrapup_core(halfword p)
-{
- switch (subtype(p)) {
- /* frontend code */
- case special_node:
- check_token_ref(write_tokens(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("unknown user node type");
- break;
- }
- break;
- case open_node:
- case write_node:
- case close_node:
- case save_pos_node:
- break;
- }
-}
-
-void check_node_wrapup_dvi(halfword p)
-{
-}
-
-void check_node_wrapup_pdf(halfword p)
-{
- switch (subtype(p)) {
- 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 pdf_save_node:
- case pdf_restore_node:
- case pdf_refobj_node:
- case pdf_end_link_node:
- case pdf_end_thread_node:
- break;
- default:
- confusion("wrapup pdf nodes");
- break;
- }
-}
-
-void check_node(halfword p)
-{
- halfword w ;
- switch (type(p)) {
- case glyph_node:
- dorangetest(p, lig_ptr(p), var_mem_max);
- break;
- case glue_node:
- 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);
- break;
- case whatsit_node:
- w = subtype(p) ;
- if (w >= backend_first_pdf_whatsit) {
- check_node_wrapup_pdf(p);
- } else if (w >= backend_first_dvi_whatsit) {
- check_node_wrapup_dvi(p);
- } else {
- check_node_wrapup_core(p);
- }
- break;
- case margin_kern_node:
- check_node(margin_char(p));
- break;
- case math_node:
- 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, top_accent_chr(p), var_mem_max);
- dorangetest(p, bot_accent_chr(p), var_mem_max);
- dorangetest(p, overlay_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 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:
- case dir_node:
- case boundary_node:
- case local_par_node:
- break;
- default:
- fprintf(stdout, "check_node: type is %d\n", type(p));
- */
- }
-}
-
-@ @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 (s < MAX_CHAIN_SIZE) {
- r = free_chain[s];
- if (r != null) {
- free_chain[s] = vlink(r);
-#ifdef CHECK_NODE_USAGE
- 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);
- } else {
- normal_error("nodes","there is a problem in getting a node, case 1");
- return null;
- }
-}
-
-@ @c
-void free_node(halfword p, int s)
-{
- if (p <= my_prealloc) {
- formatted_error("nodes", "node number %d of type %d should not be freed", (int) p, type(p));
- return;
- }
-#ifdef CHECK_NODE_USAGE
- 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;
- }
- /* maintain statistics */
- var_used -= s;
-}
-
-@ @c
-static void free_node_chain(halfword q, int s)
-{
- register halfword p = q;
- while (vlink(p) != null) {
-#ifdef CHECK_NODE_USAGE
- varmem_sizes[p] = 0;
-#endif
- var_used -= s;
- p = vlink(p);
- }
- var_used -= s;
-#ifdef CHECK_NODE_USAGE
- varmem_sizes[p] = 0;
-#endif
- vlink(p) = free_chain[s];
- free_chain[s] = q;
-}
-
-@ At the start of the node memory area we reserve some special nodes,
-for instance frequently used glue specifications. We could as well just
-use new_glue here but for the moment we stick to the traditional approach.
-
-@c
-#define initialize_glue(n,wi,st,sh,sto,sho) \
- vlink(n) = null; \
- type(n) = glue_spec_node; \
- width(n) = wi; \
- stretch(n) = st; \
- shrink(n) = sh; \
- stretch_order(n) = sto; \
- shrink_order(n) = sho;
-
-#define initialize_whatever(n,t) \
- vinfo(n) = 0; \
- type(n) = t; \
- vlink(n) = null; \
- alink(n) = null;
-
-#define initialize_point(n) \
- type(n) = glyph_node; \
- subtype(n) = 0; \
- vlink(n) = null; \
- vinfo(n + 1) = null; \
- alink(n) = null; \
- font(n) = 0; \
- character(n) = '.'; \
- vinfo(n + 3) = 0; \
- vlink(n + 3) = 0; \
- vinfo(n + 4) = 0; \
- vlink(n + 4) = 0;
-
-void init_node_mem(int t)
-{
- my_prealloc = var_mem_stat_max;
-
- 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));
-#ifdef CHECK_NODE_USAGE
- 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 */
-
- initialize_glue(zero_glue,0,0,0,0,0);
- initialize_glue(sfi_glue,0,0,0,sfi,0);
- initialize_glue(fil_glue,0,unity,0,fil,0);
- initialize_glue(fill_glue,0,unity,0,fill,0);
- initialize_glue(ss_glue,0,unity,unity,fil,fil);
- initialize_glue(fil_neg_glue,0,-unity,0,fil,0);
-
- /* initialize node list heads */
-
- initialize_whatever(page_ins_head,temp_node);
- initialize_whatever(contrib_head,temp_node);
- initialize_whatever(page_head,temp_node);
- initialize_whatever(temp_head,temp_node);
- initialize_whatever(hold_head,temp_node);
- initialize_whatever(adjust_head,temp_node);
- initialize_whatever(pre_adjust_head,temp_node);
- initialize_whatever(align_head,temp_node);
-
- initialize_whatever(active,unhyphenated_node);
- initialize_whatever(end_span,span_node);
-
- initialize_point(begin_point);
- initialize_point(end_point);
-}
-
-@ @c
-void dump_node_mem(void)
-{
- dump_int(var_mem_max);
- dump_int(rover);
- dump_things(varmem[0], var_mem_max);
-#ifdef CHECK_NODE_USAGE
- 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);
- undump_things(varmem[0], x);
-#ifdef CHECK_NODE_USAGE
- 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;
- }
-}
-
-@ @c
-halfword slow_get_node(int s)
-{
- register int t;
-
- RETRY:
- t = node_size(rover);
- if (vlink(rover) < var_mem_max && vlink(rover) != 0) {
- if (t > s) {
- /* allocating from the bottom helps decrease page faults */
- register halfword 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;
- }
- if (vlink(rover) < var_mem_max) {
-#ifdef CHECK_NODE_USAGE
- 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 {
- normal_error("nodes","there is a problem in getting a node, case 2");
- return null;
- }
- } else {
- /* attempt to keep the free list small */
- int x;
- 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;
- 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));
-#ifdef CHECK_NODE_USAGE
- 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;
- var_mem_max += x;
- goto RETRY;
- }
- } else {
- normal_error("nodes","there is a problem in getting a node, case 3");
- return null;
- }
-}
-
-@ @c
-char *sprint_node_mem_usage(void)
-{
- char *s;
-#ifdef CHECK_NODE_USAGE
- char *ss;
- int i;
- int b = 0;
- char msg[256];
- int node_counts[last_normal_node + last_whatsit_node + 2] = { 0 };
- s = strdup("");
- 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)]++;
- }
- }
- }
- 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 q = null;
-#ifdef CHECK_NODE_USAGE
- halfword p = null;
- halfword i, j;
- 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;
- }
- }
- /* newline, if needed */
- print_nlp();
-}
-
-/* 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;
- /* not used but nicer in print */
- subtype(r) = 0;
- 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|| attr_list_cache == null) {
- update_attribute_cache();
- if (attr_list_cache == null)
- return;
- }
- attr_list_ref(attr_list_cache)++;
- node_attr(b) = attr_list_cache;
- }
-}
-
-@ @c
-halfword current_attribute_list(void)
-{
- if (max_used_attr >= 0) {
- if (attr_list_cache == cache_disabled) {
- update_attribute_cache();
- }
- return attr_list_cache ;
- }
- return null ;
-}
-
-
-@ @c
-void reassign_attribute(halfword n, halfword new)
-{
- halfword old;
- old = node_attr(n);
- if (new == null) {
- /* there is nothing to assign but we need to check for an old value */
- if (old != null)
- delete_attribute_ref(old); /* also nulls attr field of n */
- } else if (old == null) {
- /* nothing is assigned so we just do that now */
- assign_attribute_ref(n,new);
- } else if (old != new) {
- /* something is assigned so we need to clean up and assign then */
- delete_attribute_ref(old);
- assign_attribute_ref(n,new);
- }
- /* else: same value so there is no need to assign and change the refcount */
- node_attr(n) = new ;
-}
-
-@ @c
-void delete_attribute_ref(halfword b)
-{
- if (b != null) {
- if (type(b) == attribute_list_node){
- attr_list_ref(b)--;
- 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;
- }
- } else {
- normal_error("nodes","trying to delete an attribute reference of a non attribute node");
- }
- }
-}
-
-void reset_node_properties(halfword b)
-{
- if (b != null) {
- lua_properties_reset(b);
- }
-}
-
-@ |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;
- if (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;
- } else {
- normal_error("nodes","trying to set an attribute fails, case 1");
- return null ;
- }
-}
-
-@ @c
-void set_attribute(halfword n, int i, int val)
-{
- register halfword p;
- register int j = 0;
- /* not all nodes can have an attribute list */
- if (!nodetype_has_attributes(type(n)))
- return;
- /* if we have no list, we create one and quit */
- 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;
- }
- /* we check if we have this attribute already and quit if the value stays the same */
- if (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);
- }
- /* j has now the position (if found) .. we assume a sorted list ! */
- p = node_attr(n);
-
- if (attr_list_ref(p) == 0 ) {
- /* the list is invalid i.e. freed already */
- formatted_warning("nodes","node %d has an attribute list that is free already, case 1",(int) n);
- /* the still dangling list gets ref count 1 */
- attr_list_ref(p) = 1;
- } else if (attr_list_ref(p) == 1) {
- /* this can really happen HH-LS */
- if (p == attr_list_cache) {
- /* we can invalidate the cache setting */
- /* attr_list_cache = cache_disabled */
- /* or save the list, as done below */
- p = copy_attribute_list(p);
- node_attr(n) = p;
- /* the copied list gets ref count 1 */
- attr_list_ref(p) = 1;
- }
- } else {
- /* the list is used multiple times so we make a copy */
- p = copy_attribute_list(p);
- /* we decrement the ref count or the original */
- delete_attribute_ref(node_attr(n));
- node_attr(n) = p;
- /* the copied list gets ref count 1 */
- attr_list_ref(p) = 1;
- }
-
-
- /* we go to position j in the list */
- while (j-- > 0)
- p = vlink(p);
- /* if we have a hit we just set the value otherwise we add a new node */
- 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;
- }
- } else {
- normal_error("nodes","trying to set an attribute fails, case 2");
- }
-}
-
-@ @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) {
- formatted_warning("nodes","node %d has an attribute list that is free already, case 2", (int) n);
- return UNUSED_ATTRIBUTE;
- }
- if (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;
- } else {
- normal_error("nodes","trying to unset an attribute fails");
- return null;
- }
-}
-
-@ @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_is_zero(p))
- 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;
- }
-}
-
-@ @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_node_wrapup_core(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 late_lua_node:
- show_late_lua(p);
- break;
- case save_pos_node:
- tprint_esc("savepos");
- 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;
- }
-}
-
-void show_node_wrapup_dvi(int p)
-{
-}
-
-void show_node_wrapup_pdf(int p)
-{
- switch (subtype(p)) {
- 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("colorstack");
- 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 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_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:
- normal_error("pdf backend", "unknown action type for link");
- 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;
- default:
- 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)
-
-#define node_list_display_x(A,B) do { \
- if ((B) != null) { \
- append_char('.'); \
- append_char(A); \
- append_char(' '); \
- show_node_list(B); \
- flush_char(); \
- flush_char(); \
- flush_char(); \
- } \
-} while (0)
-
-/* prints a node list symbolically */
-
-void show_node_list(int p)
-{
- int n = 0; /* the number of items already printed at this level */
- halfword w;
- 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;
- }
- while (p != null) {
- print_ln();
- print_current_string(); /* display the nesting history */
- if (tracing_online_par < -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|; */
- if (subtype(p) == normal_rule) {
- tprint_esc("rule(");
- } else if (subtype(p) == empty_rule) {
- tprint_esc("norule(");
- } else if (subtype(p) == user_rule) {
- tprint_esc("userrule(");
- } else if (subtype(p) == box_rule) {
- tprint_esc("box(");
- } else if (subtype(p) == image_rule) {
- tprint_esc("image(");
- }
- 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 dir_node:
- if (dir_dir(p) < 0) {
- tprint_esc("enddir");
- print_char(' ');
- print_dir(dir_dir(p) + dir_swap);
- } else {
- tprint_esc("begindir");
- print_char(' ');
- print_dir(dir_dir(p));
- }
- break;
- case local_par_node:
- tprint_esc("localpar");
- 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 boundary_node:
- if (subtype(p)==0) {
- tprint_esc("noboundary");
- } else {
- switch (subtype(p)) {
- case 1:
- tprint_esc("boundary");
- break;
- case 2:
- tprint_esc("protrusionboundary");
- break;
- case 3:
- tprint_esc("wordboundary");
- break;
- default:
- tprint_esc("boundary");
- print_char(':');
- print_int(subtype(p));
- break;
- }
- print_char('=');
- print_int(boundary_value(p));
- }
- break;
- case whatsit_node:
- w = subtype(p) ;
- if (w >= backend_first_pdf_whatsit) {
- show_node_wrapup_pdf(p);
- } else if (w >= backend_first_dvi_whatsit) {
- show_node_wrapup_dvi(p);
- } else {
- show_node_wrapup_core(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:
- normal_warning("nodes","weird glue leader subtype ignored");
- }
- tprint("leaders ");
- print_spec(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(p, NULL);
- else
- print_spec(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) == accent_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 (!glue_is_zero(p)) {
- tprint(", glued ");
- print_spec(p, NULL);
- } else if (surround(p) != 0) {
- tprint(", surrounded ");
- print_scaled(surround(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. */
- /* We're not compatible anyway so ...
- tprint_esc("discretionary");
- print_int(disc_penalty(p));
- print_char('|');
- if (vlink(no_break(p)) != null) {
- tprint(" replacing ");
- node_list_display(vlink(no_break(p)));
- }
- node_list_display(vlink(pre_break(p)));
- append_char('|');
- show_node_list(vlink(post_break(p)));
- flush_char();
- */
- tprint_esc("discretionary");
- tprint(" (penalty ");
- print_int(disc_penalty(p));
- print_char(')');
- node_list_display_x('<',vlink(pre_break(p)));
- node_list_display_x('>',vlink(post_break(p)));
- node_list_display_x('=',vlink(no_break(p)));
- 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 (subtype(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 d; /* increment to |v| */
- scaled w = -max_dimen; /* calculated |size| */
- scaled v = shift_amount(r) + base_width; /* |w| plus possible glue amount */
- pointer p = list_ptr(r); /* current node when calculating |pre_display_size| */
- 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:
- /* begin mathskip code */
- if (glue_is_zero(p)) {
- d = surround(p);
- break;
- } else {
- /* fall through */
- }
- /* end mathskip code */
- 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.
- */
- d = width(p);
- if (glue_sign(r) == stretching) {
- if ((glue_order(r) == stretch_order(p)) && (stretch(p) != 0))
- v = max_dimen;
- } else if (glue_sign(r) == shrinking) {
- if ((glue_order(r) == shrink_order(p)) && (shrink(p) != 0))
- v = max_dimen;
- }
- if (subtype(p) >= a_leaders)
- goto FOUND;
- 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;
-}
-
-
-
-@ @c
-int var_used;
-
-@ 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 = new_node(hlist_node, min_quarterword);
- box_dir(p) = text_direction_par;
- 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(int s)
-{
- halfword p = new_node(rule_node,s);
- 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_par, cur_lang_par, left_hyphen_min_par, right_hyphen_min_par);
- 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 = char_width(font(p), character(p));
- return w;
-}
-
-scaled glyph_height(halfword p)
-{
- scaled w = char_height(font(p), character(p)) + y_displace(p);
- if (w < 0)
- w = 0;
- return w;
-}
-
-scaled glyph_depth(halfword p)
-{
- scaled 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 = new_node(disc_node, 0);
- disc_penalty(p) = hyphen_penalty_par;
- 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 = 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 q) /* safeguard for copying a glue node */
-{
- if (q == null) {
- return copy_node(zero_glue);
- } else if (type(q) == glue_spec_node) {
- return copy_node(q);
- } else if (type(q) == glue_node) {
- halfword p = copy_node(zero_glue);
- width(p) = width(q);
- stretch(p) = stretch(q);
- shrink(p) = shrink(q);
- stretch_order(p) = stretch_order(q);
- shrink_order(p) = shrink_order(q);
- return p;
- } else {
- /* alternatively we can issue a warning */
- return copy_node(zero_glue);
- }
-}
-
-@ 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 = new_node(glue_node, n + 1);
- halfword q = glue_par(n);
- width(p) = width(q);
- stretch(p) = stretch(q);
- shrink(p) = shrink(q);
- stretch_order(p) = stretch_order(q);
- shrink_order(p) = shrink_order(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 = new_node(glue_node, normal);
- width(p) = width(q);
- stretch(p) = stretch(q);
- shrink(p) = shrink(q);
- stretch_order(p) = stretch_order(q);
- shrink_order(p) = shrink_order(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 = new_node(glue_node, n + 1);
- halfword q = glue_par(n);
- width(p) = width(q);
- stretch(p) = stretch(q);
- shrink(p) = shrink(q);
- stretch_order(p) = stretch_order(q);
- shrink_order(p) = shrink_order(q);
- 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 = 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 = 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@>
-
-@ This function creates a |local_paragraph| node
-
-@c
-
-halfword make_local_par_node(int mode)
-{
- int callback_id;
- halfword q;
- halfword p = new_node(local_par_node,0);
- local_pen_inter(p) = local_inter_line_penalty_par;
- local_pen_broken(p) = local_broken_penalty_par;
- if (local_left_box_par != null) {
- q = copy_node_list(local_left_box_par);
- local_box_left(p) = q;
- local_box_left_width(p) = width(local_left_box_par);
- }
- if (local_right_box_par != null) {
- q = copy_node_list(local_right_box_par);
- local_box_right(p) = q;
- local_box_right_width(p) = width(local_right_box_par);
- }
- local_par_dir(p) = par_direction_par;
- /* callback with node passed */
- callback_id = callback_defined(insert_local_par_callback);
- if (callback_id > 0) {
- int sfix = lua_gettop(Luas);
- if (!get_callback(Luas, callback_id)) {
- lua_settop(Luas, sfix);
- return p;
- }
- nodelist_to_lua(Luas, p);
- lua_push_local_par_mode(Luas,mode)
- if (lua_pcall(Luas, 2, 0, 0) != 0) { /* 2 arg, 0 result */
- char errmsg[256]; /* temp hack ... we will have a formatted error */
- snprintf(errmsg, 255, "error: %s\n", lua_tostring(Luas, -1));
- errmsg[255]='\0';
- lua_settop(Luas, sfix);
- normal_error("insert_local_par",errmsg); /* to be done */
- return p;
- }
- lua_settop(Luas, sfix);
- }
- /* done */
- return p;
-}
+% 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
+
+#include "ptexlib.h"
+#include "lua/luatex-api.h"
+
+/* we can consider less mode sizes: 2 4 6 8 */
+
+@
+This module started out using NDEBUG to trigger checking invalid node usage,
+something that is needed because users can mess up nodes in Lua. At some point
+that code was always enabled so it is now always on but still can be recognized
+as additional code. And as the performance hit is close to zero so disabling
+makes no sense, not even to make it configureable. There is a little more memory
+used but that is neglectable compared to other memory usage.
+
+@c
+#define MAX_CHAIN_SIZE 13 /* why not a bit larger */
+#define CHECK_NODE_USAGE 1 /* this triggers checking */
+
+memory_word *volatile varmem = NULL;
+
+#ifdef CHECK_NODE_USAGE
+ 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; /* used in font and lang */
+
+halfword slow_get_node(int s); /* defined below */
+
+#define fake_node 100
+#define fake_node_size 2
+#define fake_node_name "fake"
+
+#define variable_node_size 2
+
+/* core nodes */
+
+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", "index", 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", "penalty", NULL
+};
+const char *node_fields_math[] = {
+ "attr", "surround", "width", "stretch", "shrink", "stretch_order", "shrink_order", NULL
+};
+const char *node_fields_glue[] = {
+ "attr", "leader", "width", "stretch", "shrink", "stretch_order", "shrink_order", 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_inserting[] = {
+ "height", "last_ins_ptr", "best_ins_ptr",
+ "width", "stretch", "shrink", "stretch_order", "shrink_order", NULL
+};
+const char *node_fields_splitup[] = {
+ "height", "last_ins_ptr", "best_ins_ptr", "broken_ptr", "broken_ins", NULL
+};
+const char *node_fields_attribute[] = {
+ "number", "value", NULL
+};
+const char *node_fields_glue_spec[] = {
+ "width", "stretch", "shrink", "stretch_order", "shrink_order", NULL
+};
+const char *node_fields_attribute_list[] = {
+ NULL
+};
+const char *node_fields_local_par[] = {
+ "attr", "pen_inter", "pen_broken", "dir", "box_left", "box_left_width",
+ "box_right", "box_right_width", NULL
+};
+const char *node_fields_dir[] = {
+ "attr", "dir", "level", NULL
+};
+const char *node_fields_boundary[] = {
+ "attr", "value", NULL
+};
+
+/* math nodes */
+
+const char *node_fields_noad[] = {
+ "attr", "nucleus", "sub", "sup", NULL
+};
+
+const char *node_fields_style[] = {
+ "attr", "style", NULL
+};
+const char *node_fields_choice[] = {
+ "attr", "display", "text", "script", "scriptscript", NULL
+};
+const char *node_fields_radical[] = {
+ "attr", "nucleus", "sub", "sup", "left", "degree", "width", "options", NULL
+};
+const char *node_fields_fraction[] = {
+ "attr", "width", "num", "denom", "left", "right", "middle", "options", NULL
+};
+const char *node_fields_accent[] = {
+ "attr", "nucleus", "sub", "sup", "accent", "bot_accent", "top_accent",
+ "overlay_accent", "fraction", NULL
+};
+const char *node_fields_fence[] = {
+ "attr", "delim", "italic", "height", "depth", "options", "class", 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
+};
+
+/* whatsit nodes */
+
+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_save_pos[] = {
+ "attr", NULL
+};
+const char *node_fields_whatsit_late_lua[] = {
+ "attr", "reg", "data", "name", "string", NULL
+};
+const char *node_fields_whatsit_user_defined[] = {
+ "attr", "user_id", "type", "value", NULL
+};
+
+/* pdf backend whatsit nodes */
+
+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_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_action[] = {
+ "action_type", "named_id", "action_id", "file", "new_window", "data", 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_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
+};
+
+/* subtypes */
+
+const char *node_subtypes_glue[] = {
+ "userskip", "lineskip", "baselineskip", "parskip", "abovedisplayskip", "belowdisplayskip",
+ "abovedisplayshortskip", "belowdisplayshortskip", "leftskip", "rightskip", "topskip",
+ "splittopskip", "tabskip", "spaceskip", "xspaceskip", "parfillskip",
+ "mathskip", "thinmuskip", "medmuskip", "thickmuskip", NULL
+};
+const char *node_subtypes_mathglue[] = { /* 98+ */
+ "conditionalmathskip", "muglue", NULL
+};
+const char *node_subtypes_leader[] = { /* 100+ */
+ "leaders", "cleaders", "xleaders", "gleaders", NULL
+};
+const char *node_subtypes_fill[] = {
+ "stretch", "fi", "fil", "fill", "filll", NULL
+};
+const char *node_subtypes_boundary[] = {
+ "cancel", "user", "protrusion", "word", NULL
+};
+const char *node_subtypes_penalty[] = {
+ "userpenalty", NULL
+};
+const char *node_subtypes_kern[] = {
+ "fontkern", "userkern", "accentkern", "italiccorrection", NULL
+};
+const char *node_subtypes_rule[] = {
+ "normal", "box", "image", "empty", "user", "over", "under", "fraction", "radical", NULL
+};
+const char *node_subtypes_glyph[] = {
+ "character", "glyph", "ligature", "ghost", "left", "right", NULL
+};
+const char *node_subtypes_disc[] = {
+ "discretionary", "explicit", "automatic", "regular", "first", "second", NULL
+};
+const char *node_subtypes_marginkern[] = {
+ "left", "right", NULL
+};
+const char *node_subtypes_list[] = {
+ "unknown", "line", "box", "indent", "alignment", "cell", "equation", "equationnumber", NULL
+};
+const char *node_subtypes_adjust[] = {
+ "normal", "pre", NULL
+};
+const char *node_subtypes_math[] = {
+ "beginmath", "endmath", NULL
+};
+const char *node_subtypes_noad[] = {
+ "ord", "opdisplaylimits", "oplimits", "opnolimits", "bin", "rel", "open", "close",
+ "punct", "inner", "under", "over", "vcenter", NULL
+};
+const char *node_subtypes_radical[] = {
+ "radical", "uradical", "uroot", "uunderdelimiter", "uoverdelimiter", "udelimiterunder",
+ "udelimiterover", NULL
+};
+const char *node_subtypes_accent[] = {
+ "bothflexible", "fixedtop", "fixedbottom", "fixedboth", NULL,
+};
+const char *node_subtypes_fence[] = {
+ "unset", "left", "middle", "right", NULL
+};
+
+node_info node_data[] = { /* the last entry in a row is the etex number */
+ { hlist_node, box_node_size, node_fields_list, "hlist", 1 },
+ { vlist_node, box_node_size, node_fields_list, "vlist", 2 },
+ { rule_node, rule_node_size, node_fields_rule, "rule", 3 },
+ { ins_node, ins_node_size, node_fields_insert, "ins", 4 },
+ { mark_node, mark_node_size, node_fields_mark, "mark", 5 },
+ { adjust_node, adjust_node_size, node_fields_adjust, "adjust", 6 },
+ { boundary_node, boundary_node_size, node_fields_boundary, "boundary", -1 },
+ { disc_node, disc_node_size, node_fields_disc, "disc", 8 },
+ { whatsit_node, -1, NULL, "whatsit", 9 },
+ { local_par_node, local_par_size, node_fields_local_par, "local_par", -1 },
+ { dir_node, dir_node_size, node_fields_dir, "dir", -1 },
+ { math_node, math_node_size, node_fields_math, "math", 10 },
+ { glue_node, glue_node_size, node_fields_glue, "glue", 11 },
+ { kern_node, kern_node_size, node_fields_kern, "kern", 12 },
+ { penalty_node, penalty_node_size, node_fields_penalty, "penalty", 13 },
+ { unset_node, box_node_size, node_fields_unset, "unset", 14 },
+ { style_node, style_node_size, node_fields_style, "style", 15 },
+ { choice_node, style_node_size, node_fields_choice, "choice", 15 },
+ { simple_noad, noad_size, node_fields_noad, "noad", 15 },
+ { radical_noad, radical_noad_size, node_fields_radical, "radical", 15 },
+ { fraction_noad, fraction_noad_size, node_fields_fraction, "fraction", 15 },
+ { accent_noad, accent_noad_size, node_fields_accent, "accent", 15 },
+ { fence_noad, fence_noad_size, node_fields_fence, "fence", 15 },
+ { math_char_node, math_kernel_node_size, node_fields_math_char, "math_char", 15 },
+ { sub_box_node, math_kernel_node_size, node_fields_sub_box, "sub_box", 15 },
+ { sub_mlist_node, math_kernel_node_size, node_fields_sub_mlist, "sub_mlist", 15 },
+ { math_text_char_node, math_kernel_node_size, node_fields_math_text_char, "math_text_char", 15 },
+ { delim_node, math_shield_node_size, node_fields_delim, "delim", 15 },
+ { margin_kern_node, margin_kern_node_size, node_fields_margin_kern, "margin_kern", -1 },
+ { glyph_node, glyph_node_size, node_fields_glyph, "glyph", 0 },
+ { align_record_node, box_node_size, NULL, "align_record", -1 },
+ { pseudo_file_node, pseudo_file_node_size, NULL, "pseudo_file", -1 },
+ { pseudo_line_node, variable_node_size, NULL, "pseudo_line", -1 },
+ { inserting_node, page_ins_node_size, node_fields_inserting, "page_insert", -1 },
+ { split_up_node, page_ins_node_size, node_fields_splitup, "split_insert", -1 },
+ { expr_node, expr_node_size, NULL, "expr_stack", -1 },
+ { nesting_node, nesting_node_size, NULL, "nested_list", -1 },
+ { span_node, span_node_size, NULL, "span", -1 },
+ { attribute_node, attribute_node_size, node_fields_attribute, "attribute", -1 },
+ { glue_spec_node, glue_spec_size, node_fields_glue_spec, "glue_spec", -1 },
+ { attribute_list_node, attribute_node_size, node_fields_attribute_list, "attribute_list", -1 },
+ { temp_node, temp_node_size, NULL, "temp", -1 },
+ { align_stack_node, align_stack_node_size, NULL, "align_stack", -1 },
+ { movement_node, movement_node_size, NULL, "movement_stack", -1 },
+ { if_node, if_node_size, NULL, "if_stack", -1 },
+ { unhyphenated_node, active_node_size, NULL, "unhyphenated", -1 },
+ { hyphenated_node, active_node_size, NULL, "hyphenated", -1 },
+ { delta_node, delta_node_size, NULL, "delta", -1 },
+ { passive_node, passive_node_size, NULL, "passive", -1 },
+ { shape_node, variable_node_size, NULL, "shape", -1 },
+ { -1, -1, NULL, NULL, -1 },
+};
+
+const char *node_subtypes_pdf_destination[] = {
+ "xyz", "fit", "fith", "fitv", "fitb", "fitbh", "fitbv", "fitr", NULL
+};
+const char *node_subtypes_pdf_literal[] = {
+ "origin", "page", "direct", NULL
+};
+
+node_info whatsit_node_data[] = {
+ { open_node, open_node_size, node_fields_whatsit_open, "open", -1 },
+ { write_node, write_node_size, node_fields_whatsit_write, "write", -1 },
+ { close_node, close_node_size, node_fields_whatsit_close, "close", -1 },
+ { special_node, special_node_size, node_fields_whatsit_special, "special", -1 },
+ { fake_node, fake_node_size, NULL, fake_node_name, -1 },
+ { fake_node, fake_node_size, NULL, fake_node_name, -1 },
+ { save_pos_node, save_pos_node_size, node_fields_whatsit_save_pos, "save_pos", -1 },
+ { late_lua_node, late_lua_node_size, node_fields_whatsit_late_lua, "late_lua", -1 },
+ { user_defined_node, user_defined_node_size, node_fields_whatsit_user_defined, "user_defined", -1 },
+ { fake_node, fake_node_size, NULL, fake_node_name, -1 },
+ { fake_node, fake_node_size, NULL, fake_node_name, -1 },
+ { fake_node, fake_node_size, NULL, fake_node_name, -1 },
+ { fake_node, fake_node_size, NULL, fake_node_name, -1 },
+ { fake_node, fake_node_size, NULL, fake_node_name, -1 },
+ { fake_node, fake_node_size, NULL, fake_node_name, -1 },
+ { fake_node, fake_node_size, NULL, fake_node_name, -1 },
+ /* here starts the dvi backend section, todo: a separate list */
+ /* nothing for dvi */
+ /* here starts the pdf backend section, todo: a separate list */
+ { pdf_literal_node, write_node_size, node_fields_whatsit_pdf_literal, "pdf_literal", -1 },
+ { pdf_refobj_node, pdf_refobj_node_size, node_fields_whatsit_pdf_refobj, "pdf_refobj", -1 },
+ { pdf_annot_node, pdf_annot_node_size, node_fields_whatsit_pdf_annot, "pdf_annot", -1 },
+ { pdf_start_link_node, pdf_annot_node_size, node_fields_whatsit_pdf_start_link, "pdf_start_link", -1 },
+ { pdf_end_link_node, pdf_end_link_node_size, node_fields_whatsit_pdf_end_link, "pdf_end_link", -1 },
+ { pdf_dest_node, pdf_dest_node_size, node_fields_whatsit_pdf_dest, "pdf_dest", -1 },
+ { pdf_action_node, pdf_action_size, node_fields_whatsit_pdf_action, "pdf_action", -1 },
+ { pdf_thread_node, pdf_thread_node_size, node_fields_whatsit_pdf_thread, "pdf_thread", -1 },
+ { pdf_start_thread_node, pdf_thread_node_size, node_fields_whatsit_pdf_start_thread, "pdf_start_thread", -1 },
+ { pdf_end_thread_node, pdf_end_thread_node_size, node_fields_whatsit_pdf_end_thread, "pdf_end_thread", -1 },
+ { pdf_thread_data_node, pdf_thread_node_size, NULL, "pdf_thread_data", -1 },
+ { pdf_link_data_node, pdf_annot_node_size, NULL, "pdf_link_data", -1 },
+ { pdf_colorstack_node, pdf_colorstack_node_size, node_fields_whatsit_pdf_colorstack, "pdf_colorstack", -1 },
+ { pdf_setmatrix_node, pdf_setmatrix_node_size, node_fields_whatsit_pdf_setmatrix, "pdf_setmatrix", -1 },
+ { pdf_save_node, pdf_save_node_size, node_fields_whatsit_pdf_save, "pdf_save", -1 },
+ { pdf_restore_node, pdf_restore_node_size, node_fields_whatsit_pdf_restore, "pdf_restore", -1 },
+ /* done */
+ { -1, -1, NULL, NULL, -1 },
+};
+
+#define last_whatsit_node pdf_restore_node
+
+@
+When we copy a node list, there are several possibilities: we do the same as a new node,
+we copy the entry to the table in properties (a reference), we do a deep copy of a table
+in the properties, we create a new table and give it the original one as a metatable.
+After some experiments (that also included timing) with these scenarios I decided that a
+deep copy made no sense, nor did nilling. In the end both the shallow copy and the metatable
+variant were both ok, although the second ons is slower. The most important aspect to keep
+in mind is that references to other nodes in properties no longer can be valid for that
+copy. We could use two tables (one unique and one shared) or metatables but that only
+complicates matters.
+
+When defining a new node, we could already allocate a table but it is rather easy to do
+that at the lua end e.g. using a metatable __index method. That way it is under macro
+package control.
+
+When deleting a node, we could keep the slot (e.g. setting it to false) but it could make
+memory consumption raise unneeded when we have temporary large node lists and after that
+only small lists.
+
+So, in the end this is what we ended up with. For the record, I also experimented with the
+following:
+
+- copy attributes to the properties so that we have fast access at the lua end: in the end
+ the overhead is not compensated by speed and convenience, in fact, attributes are not
+ that slow when it comes to accessing them
+
+- a bitset in the node but again the gain compared to attributes is neglectable and it also
+ demands a pretty string agreement over what bit represents what, and this is unlikely to
+ succeed in the tex community (I could use it for font handling, which is cross package,
+ but decided that it doesn't pay off
+
+In case one wonders why properties make sense then, well, it is not so much speed that we
+gain, but more convenience: storing all kind of (temporary) data in attributes is no fun and
+this mechanism makes sure that properties are cleaned up when a node is freed. Also, the
+advantage of a more or less global properties table is that we stay at the lua end. An
+alternative is to store a reference in the node itself but that is complicated by the fact
+that the register has some limitations (no numeric keys) and we also don't want to mess with
+it too much.
+
+@c
+int lua_properties_level = 0 ; /* can be private */
+int lua_properties_enabled = 0 ;
+int lua_properties_use_metatable = 0 ;
+
+@
+We keep track of nesting so that we don't oveflow the stack, and, what is more
+important, don't keep resolving the registry index.
+
+@c
+#define lua_properties_push do { \
+ if (lua_properties_enabled) { \
+ lua_properties_level = lua_properties_level + 1 ; \
+ if (lua_properties_level == 1) { \
+ lua_get_metatablelua_l(Luas,node_properties); \
+ } \
+ } \
+} while(0)
+
+#define lua_properties_pop do { \
+ if (lua_properties_enabled) { \
+ if (lua_properties_level == 1) \
+ lua_pop(Luas,1); \
+ lua_properties_level = lua_properties_level - 1 ; \
+ } \
+} while(0)
+
+/* No setting is needed: */
+
+#define lua_properties_set(target) do { \
+} while(0)
+
+/* Resetting boils down to nilling. */
+
+#define lua_properties_reset(target) do { \
+ if (lua_properties_enabled) { \
+ if (lua_properties_level == 0) { \
+ lua_get_metatablelua_l(Luas,node_properties); \
+ lua_pushnil(Luas); \
+ lua_rawseti(Luas,-2,target); \
+ lua_pop(Luas,1); \
+ } else { \
+ lua_pushnil(Luas); \
+ lua_rawseti(Luas,-2,target); \
+ } \
+ } \
+} while(0)
+
+/*
+ For a moment I considered supporting all kind of data types but in practice
+ that makes no sense. So we stick to a cheap shallow copy with as option a
+ metatable. Btw, a deep copy would look like this:
+
+ static void copy_lua_table(lua_State* L, int index) {
+ lua_newtable(L);
+ lua_pushnil(L);
+ while(lua_next(L, index-1) != 0) {
+ lua_pushvalue(L, -2);
+ lua_insert(L, -2);
+ if (lua_type(L,-1)==LUA_TTABLE)
+ copy_lua_table(L,-1);
+ lua_settable(L, -4);
+ }
+ lua_pop(L,1);
+ }
+
+ #define lua_properties_copy(target, source) do { \
+ if (lua_properties_enabled) { \
+ lua_pushinteger(Luas,source); \
+ lua_rawget(Luas,-2); \
+ if (lua_type(Luas,-1)==LUA_TTABLE) { \
+ copy_lua_table(Luas,-1); \
+ lua_pushinteger(Luas,target); \
+ lua_insert(Luas,-2); \
+ lua_rawset(Luas,-3); \
+ } else { \
+ lua_pop(Luas,1); \
+ } \
+ } \
+ } while(0)
+
+*/
+
+/* isn't there a faster way to metatable? */
+
+/*
+
+#define lua_properties_copy(target,source) do { \
+ if (lua_properties_enabled) { \
+ if (lua_properties_level == 0) { \
+ lua_get_metatablelua_l(Luas,node_properties); \
+ lua_rawgeti(Luas,-1,source); \
+ if (lua_type(Luas,-1)==LUA_TTABLE) { \
+ if (lua_properties_use_metatable) { \
+ lua_newtable(Luas); \
+ lua_insert(Luas,-2); \
+ lua_setfield(Luas,-2,"__index"); \
+ lua_newtable(Luas); \
+ lua_insert(Luas,-2); \
+ lua_setmetatable(Luas,-2); \
+ } \
+ lua_rawseti(Luas,-2,target); \
+ } else { \
+ lua_pop(Luas,1); \
+ } \
+ lua_pop(Luas,1); \
+ } else { \
+ lua_rawgeti(Luas,-1,source); \
+ if (lua_type(Luas,-1)==LUA_TTABLE) { \
+ if (lua_properties_use_metatable) { \
+ lua_newtable(Luas); \
+ lua_insert(Luas,-2); \
+ lua_setfield(Luas,-2,"__index"); \
+ lua_newtable(Luas); \
+ lua_insert(Luas,-2); \
+ lua_setmetatable(Luas,-2); \
+ } \
+ lua_rawseti(Luas,-2,target); \
+ } else { \
+ lua_pop(Luas,1); \
+ } \
+ } \
+ } \
+} while(0)
+
+*/
+
+/*
+ A simple testrun on many pages of dumb text shows 1% gain (of course it depends
+ on how properties are used but some other tests confirm it).
+*/
+
+#define lua_properties_copy(target,source) do { \
+ if (lua_properties_enabled) { \
+ if (lua_properties_level == 0) { \
+ lua_get_metatablelua_l(Luas,node_properties); \
+ lua_rawgeti(Luas,-1,source); \
+ if (lua_type(Luas,-1)==LUA_TTABLE) { \
+ if (lua_properties_use_metatable) { \
+ lua_newtable(Luas); \
+ lua_insert(Luas,-2); \
+ lua_push_string_by_name(Luas,__index); \
+ lua_insert(Luas,-2); \
+ lua_rawset(Luas, -3); \
+ lua_newtable(Luas); \
+ lua_insert(Luas,-2); \
+ lua_setmetatable(Luas,-2); \
+ } \
+ lua_rawseti(Luas,-2,target); \
+ } else { \
+ lua_pop(Luas,1); \
+ } \
+ lua_pop(Luas,1); \
+ } else { \
+ lua_rawgeti(Luas,-1,source); \
+ if (lua_type(Luas,-1)==LUA_TTABLE) { \
+ if (lua_properties_use_metatable) { \
+ lua_newtable(Luas); \
+ lua_insert(Luas,-2); \
+ lua_push_string_by_name(Luas,__index); \
+ lua_insert(Luas,-2); \
+ lua_rawset(Luas, -3); \
+ lua_newtable(Luas); \
+ lua_insert(Luas,-2); \
+ lua_setmetatable(Luas,-2); \
+ } \
+ lua_rawseti(Luas,-2,target); \
+ } else { \
+ lua_pop(Luas,1); \
+ } \
+ } \
+ } \
+} while(0)
+
+/* Here end the property handlers. */
+
+@ @c
+int valid_node(halfword p)
+{
+ if (p > my_prealloc && p < var_mem_max) {
+#ifdef CHECK_NODE_USAGE
+ if (varmem_sizes[p] > 0) {
+ return 1;
+ }
+#else
+ return 1;
+#endif
+ }
+ return 0;
+}
+
+@ @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("node range test failed"); \
+ } } 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("node test failed"); \
+ } } while (0)
+
+#define check_action_ref(a) { dorangetest(p,a,var_mem_max); }
+#define check_attribute_ref(a) { dorangetest(p,a,var_mem_max); }
+#define check_token_ref(a) { \
+ if (type(p) == whatsit_node) { \
+ formatted_error("nodes","fuzzy token cleanup in whatsit node with id %i and subtype %i",type(p),subtype(p)); \
+ } else { \
+ formatted_error("nodes","fuzzy token cleanup in node with id %i",type(p)); \
+ } \
+}
+
+#ifdef CHECK_NODE_USAGE
+
+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);
+}
+
+static void node_mem_dump(halfword p)
+{
+ halfword r;
+ 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)
+{
+ if (p > my_prealloc && p < var_mem_max) {
+#ifdef CHECK_NODE_USAGE
+ int i;
+ if (varmem_sizes[p] == 0) {
+ check_static_node_mem();
+ for (i = (my_prealloc + 1); i < var_mem_max; i++) {
+ if (varmem_sizes[i] > 0) {
+ check_node(i);
+ }
+ }
+ test_count++;
+ if (type(p) == glyph_node) {
+ formatted_error("nodes", "attempt to double-free glyph (%c) node %d, ignored", (int) character(p), (int) p);
+ } else {
+ formatted_error("nodes", "attempt to double-free %s node %d, ignored", get_node_name(type(p), subtype(p)), (int) p);
+ }
+ node_mem_dump(p);
+ return 1;
+ }
+#endif
+ } else {
+ formatted_error("nodes", "attempt to free an impossible node %d", (int) p);
+ return 1;
+ }
+ return 0;
+}
+
+@ @c
+static int copy_error(halfword p)
+{
+ if (p >= 0 && p < var_mem_max) {
+#ifdef CHECK_NODE_USAGE
+ if (p > my_prealloc && varmem_sizes[p] == 0) {
+ if (type(p) == glyph_node) {
+ formatted_warning("nodes", "attempt to copy free glyph (%c) node %d, ignored", (int) character(p), (int) p);
+ } else {
+ formatted_warning("nodes", "attempt to copy free %s node %d, ignored", get_node_name(type(p), subtype(p)), (int) p);
+ }
+ return 1;
+ }
+#endif
+ } else {
+ formatted_error("nodes", "attempt to copy an impossible node %d", (int) p);
+ return 1;
+ }
+ return 0;
+}
+
+@ @c
+halfword new_node(int i, int j)
+{
+ int s = get_node_size(i, j);
+ halfword n = get_node(s);
+ /*
+ It should be possible to do this memset at |free_node()|.
+
+ Both 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 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;
+ width(n) = null_flag;
+ rule_dir(n) = -1;
+ rule_index(n) = 0;
+ rule_transform(n) = 0;
+ 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 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;
+ }
+ if (synctex_par) {
+ /* 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:
+ 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);
+ /* lua_properties_set */
+ }
+ type(n) = (quarterword) i;
+ subtype(n) = (quarterword) j;
+ return n;
+}
+
+halfword raw_glyph_node(void)
+{
+ register halfword 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 = 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);
+ /* lua_properties_set */
+ 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 */
+ register halfword s ;
+ lua_properties_push; /* saves stack and time */
+ while (p != end) {
+ s = copy_node(p);
+ if (h == null) {
+ h = s;
+ } else {
+ couple_nodes(q, s);
+ }
+ q = s;
+ p = vlink(p);
+ }
+ lua_properties_pop; /* saves stack and time */
+ return h;
+}
+
+halfword copy_node_list(halfword p)
+{
+ return do_copy_node_list(p, null);
+}
+
+#define copy_sub_list(target,source) do { \
+ if (source != null) { \
+ s = do_copy_node_list(source, null); \
+ target = s; \
+ } else { \
+ target = null; \
+ } \
+ } while (0)
+
+#define copy_sub_node(target,source) do { \
+ if (source != null) { \
+ s = copy_node(source); \
+ target = s ; \
+ } else { \
+ target = null; \
+ } \
+} while (0)
+
+@ make a dupe of a single node
+
+@c
+static void copy_node_wrapup_core(halfword p, halfword r)
+{
+ halfword s ;
+ switch (subtype(p)) {
+ case write_node:
+ case special_node:
+ add_token_ref(write_tokens(p));
+ break;
+ case late_lua_node:
+ copy_late_lua(r, p);
+ break;
+ case user_defined_node:
+ switch (user_node_type(p)) {
+ case 'a':
+ add_node_attr_ref(user_node_value(p));
+ break;
+ case 'l':
+ copy_user_lua(r, p);
+ break;
+ case 'n':
+ s = copy_node_list(user_node_value(p));
+ user_node_value(r) = s;
+ break;
+ case 's':
+ /* |add_string_ref(user_node_value(p));| */
+ break;
+ case 't':
+ add_token_ref(user_node_value(p));
+ break;
+ }
+ break;
+ default:
+ break ;
+ }
+}
+
+void copy_node_wrapup_dvi(halfword p, halfword r)
+{
+}
+
+void copy_node_wrapup_pdf(halfword p, halfword r)
+{
+ switch(subtype(p)) {
+ 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 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;
+ default:
+ break;
+ }
+}
+
+halfword copy_node(const halfword p)
+{
+ halfword r; /* current node being fabricated for new list */
+ halfword w; /* whatsit subtype */
+ halfword t; /* type of node */
+ 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;
+ }
+ t = type(p);
+ i = get_node_size(t,subtype(p));
+ r = get_node(i);
+
+ (void) memcpy((void *) (varmem + r), (void *) (varmem + p), (sizeof(memory_word) * (unsigned) i));
+
+ /* possible speedup: */
+ /*
+ if t == glue_spec) {
+ return r;
+ }
+ */
+
+ if (synctex_par) {
+ /* handle synctex extension */
+ switch (t) {
+ 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(t)) {
+ add_node_attr_ref(node_attr(p));
+ alink(r) = null;
+ lua_properties_copy(r,p);
+ }
+ vlink(r) = null;
+
+ switch (t) {
+ case glyph_node:
+ copy_sub_list(lig_ptr(r),lig_ptr(p)) ;
+ break;
+ case glue_node:
+ copy_sub_list(leader_ptr(r),leader_ptr(p)) ;
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ copy_sub_list(list_ptr(r),list_ptr(p)) ;
+ 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 math_node:
+ break;
+ case ins_node:
+ copy_sub_list(ins_ptr(r),ins_ptr(p)) ;
+ break;
+ case margin_kern_node:
+ copy_sub_node(margin_char(r),margin_char(p));
+ break;
+ case mark_node:
+ add_token_ref(mark_ptr(p));
+ break;
+ case adjust_node:
+ copy_sub_list(adjust_ptr(r),adjust_ptr(p));
+ break;
+ case choice_node:
+ copy_sub_list(display_mlist(r),display_mlist(p)) ;
+ copy_sub_list(text_mlist(r),text_mlist(p)) ;
+ copy_sub_list(script_mlist(r),script_mlist(p)) ;
+ copy_sub_list(script_script_mlist(r),script_script_mlist(p)) ;
+ break;
+ case simple_noad:
+ copy_sub_list(nucleus(r),nucleus(p)) ;
+ copy_sub_list(subscr(r),subscr(p)) ;
+ copy_sub_list(supscr(r),supscr(p)) ;
+ break;
+ case radical_noad:
+ copy_sub_list(nucleus(r),nucleus(p)) ;
+ copy_sub_list(subscr(r),subscr(p)) ;
+ copy_sub_list(supscr(r),supscr(p)) ;
+ copy_sub_node(left_delimiter(r),left_delimiter(p)) ;
+ copy_sub_list(degree(r),degree(p)) ;
+ break;
+ case accent_noad:
+ copy_sub_list(nucleus(r),nucleus(p)) ;
+ copy_sub_list(subscr(r),subscr(p)) ;
+ copy_sub_list(supscr(r),supscr(p)) ;
+ copy_sub_list(top_accent_chr(r),top_accent_chr(p)) ;
+ copy_sub_list(bot_accent_chr(r),bot_accent_chr(p)) ;
+ copy_sub_list(overlay_accent_chr(r),overlay_accent_chr(p)) ;
+ break;
+ case fence_noad:
+ copy_sub_node(delimiter(r),delimiter(p)) ;
+ break;
+ case sub_box_node:
+ case sub_mlist_node:
+ copy_sub_list(math_list(r),math_list(p)) ;
+ break;
+ case fraction_noad:
+ copy_sub_list(numerator(r),numerator(p)) ;
+ copy_sub_list(denominator(r),denominator(p)) ;
+ copy_sub_node(left_delimiter(r),left_delimiter(p)) ;
+ copy_sub_node(right_delimiter(r),right_delimiter(p)) ;
+ break;
+ case glue_spec_node:
+ case dir_node:
+ case local_par_node:
+ case boundary_node:
+ break;
+ case whatsit_node:
+ w = subtype(p) ;
+ if (w >= backend_first_pdf_whatsit) {
+ copy_node_wrapup_pdf(p,r);
+ } else if (w >= backend_first_dvi_whatsit) {
+ copy_node_wrapup_dvi(p,r);
+ } else {
+ copy_node_wrapup_core(p,r);
+ }
+ break;
+ }
+ return r;
+}
+
+/* x */
+
+#define free_sub_list(source) if (source != null) flush_node_list(source);
+#define free_sub_node(source) if (source != null) flush_node(source);
+
+@ @c
+
+static void flush_node_wrapup_core(halfword p)
+{
+ switch (subtype(p)) {
+ case open_node:
+ case write_node:
+ case close_node:
+ case save_pos_node:
+ break;
+ case special_node:
+ delete_token_ref(write_tokens(p));
+ break;
+ case late_lua_node:
+ free_late_lua(p);
+ break;
+ case user_defined_node:
+ switch (user_node_type(p)) {
+ case 'a':
+ delete_attribute_ref(user_node_value(p));
+ break;
+ case 'd':
+ break;
+ case 'l':
+ free_user_lua(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 't':
+ delete_token_ref(user_node_value(p));
+ 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;
+ }
+}
+
+void flush_node_wrapup_dvi(halfword p)
+{
+}
+
+void flush_node_wrapup_pdf(halfword p)
+{
+ switch(subtype(p)) {
+ case pdf_save_node:
+ case pdf_restore_node:
+ case pdf_refobj_node:
+ case pdf_end_link_node:
+ case pdf_end_thread_node:
+ 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 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_action_node:
+ if (pdf_action_type(p) == pdf_action_user) {
+ delete_token_ref(pdf_action_tokens(p));
+ } else {
+ if (pdf_action_file(p) != null)
+ delete_token_ref(pdf_action_file(p));
+ if (pdf_action_type(p) == pdf_action_page)
+ delete_token_ref(pdf_action_tokens(p));
+ else if (pdf_action_named_id(p) > 0)
+ delete_token_ref(pdf_action_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;
+ }
+}
+
+void flush_node(halfword p)
+{
+ halfword w;
+ if (p == null) /* legal, but no-op */
+ return;
+ if (free_error(p))
+ return;
+ switch (type(p)) {
+ case glyph_node:
+ free_sub_list(lig_ptr(p));
+ break;
+ case glue_node:
+ free_sub_list(leader_ptr(p));
+ break;
+ case hlist_node:
+ case vlist_node:
+ case unset_node:
+ free_sub_list(list_ptr(p));
+ break;
+ case disc_node:
+ /* watch the start at temp node hack */
+ free_sub_list(vlink(pre_break(p)));
+ free_sub_list(vlink(post_break(p)));
+ free_sub_list(vlink(no_break(p)));
+ break;
+ case rule_node:
+ case kern_node:
+ case penalty_node:
+ case math_node:
+ break;
+ case glue_spec_node:
+ /* this allows free-ing of lua-allocated glue specs */
+//if (valid_node(p)) {
+// free_node(p, subtype(p));
+//}
+// return ;
+ break ;
+ case dir_node:
+ case local_par_node:
+ case boundary_node:
+ break;
+ case whatsit_node:
+ w = subtype(p) ;
+ if (w >= backend_first_pdf_whatsit) {
+ flush_node_wrapup_pdf(p);
+ } else if (w >= backend_first_dvi_whatsit) {
+ flush_node_wrapup_dvi(p);
+ } else {
+ flush_node_wrapup_core(p);
+ }
+ break;
+ case ins_node:
+ flush_node_list(ins_ptr(p));
+ break;
+ case margin_kern_node:
+ flush_node(margin_char(p));
+ break;
+ case mark_node:
+ delete_token_ref(mark_ptr(p));
+ break;
+ case adjust_node:
+ flush_node_list(adjust_ptr(p));
+ break;
+ case style_node: /* nothing to do */
+ break;
+ case choice_node:
+ free_sub_list(display_mlist(p));
+ free_sub_list(text_mlist(p));
+ free_sub_list(script_mlist(p));
+ free_sub_list(script_script_mlist(p));
+ break;
+ case simple_noad:
+ free_sub_list(nucleus(p));
+ free_sub_list(subscr(p));
+ free_sub_list(supscr(p));
+ break;
+ case radical_noad:
+ free_sub_list(nucleus(p));
+ free_sub_list(subscr(p));
+ free_sub_list(supscr(p));
+ free_sub_node(left_delimiter(p));
+ free_sub_list(degree(p));
+ break;
+ case accent_noad:
+ free_sub_list(nucleus(p));
+ free_sub_list(subscr(p));
+ free_sub_list(supscr(p));
+ free_sub_list(top_accent_chr(p));
+ free_sub_list(bot_accent_chr(p));
+ free_sub_list(overlay_accent_chr(p));
+ break;
+ case fence_noad:
+ free_sub_list(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:
+ free_sub_list(math_list(p));
+ break;
+ case fraction_noad:
+ free_sub_list(numerator(p));
+ free_sub_list(denominator(p));
+ free_sub_node(left_delimiter(p));
+ free_sub_node(right_delimiter(p));
+ break;
+ case pseudo_file_node:
+ free_sub_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 inserting_node:
+ case split_up_node:
+ case expr_node:
+ case attribute_node:
+ case attribute_list_node:
+ case temp_node:
+ break;
+ default:
+ formatted_error("nodes","flushing weird node type %d", type(p));
+ return;
+ }
+ if (nodetype_has_attributes(type(p))) {
+ delete_attribute_ref(node_attr(p));
+ lua_properties_reset(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;
+ if (p == null) /* legal, but no-op */
+ return;
+ if (free_error(p))
+ return;
+ lua_properties_push; /* saves stack and time */
+ while (p != null) {
+ register halfword q = vlink(p);
+ flush_node(p);
+ p = q;
+ }
+ lua_properties_pop; /* saves stack and time */
+}
+
+@ @c
+static void check_node_wrapup_core(halfword p)
+{
+ switch (subtype(p)) {
+ /* frontend code */
+ case special_node:
+ check_token_ref(write_tokens(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("unknown user node type");
+ break;
+ }
+ break;
+ case open_node:
+ case write_node:
+ case close_node:
+ case save_pos_node:
+ break;
+ }
+}
+
+void check_node_wrapup_dvi(halfword p)
+{
+}
+
+void check_node_wrapup_pdf(halfword p)
+{
+ switch (subtype(p)) {
+ 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 pdf_save_node:
+ case pdf_restore_node:
+ case pdf_refobj_node:
+ case pdf_end_link_node:
+ case pdf_end_thread_node:
+ break;
+ default:
+ confusion("wrapup pdf nodes");
+ break;
+ }
+}
+
+void check_node(halfword p)
+{
+ halfword w ;
+ switch (type(p)) {
+ case glyph_node:
+ dorangetest(p, lig_ptr(p), var_mem_max);
+ break;
+ case glue_node:
+ 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);
+ break;
+ case whatsit_node:
+ w = subtype(p) ;
+ if (w >= backend_first_pdf_whatsit) {
+ check_node_wrapup_pdf(p);
+ } else if (w >= backend_first_dvi_whatsit) {
+ check_node_wrapup_dvi(p);
+ } else {
+ check_node_wrapup_core(p);
+ }
+ break;
+ case margin_kern_node:
+ check_node(margin_char(p));
+ break;
+ case math_node:
+ 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, top_accent_chr(p), var_mem_max);
+ dorangetest(p, bot_accent_chr(p), var_mem_max);
+ dorangetest(p, overlay_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 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:
+ case dir_node:
+ case boundary_node:
+ case local_par_node:
+ break;
+ default:
+ fprintf(stdout, "check_node: type is %d\n", type(p));
+ */
+ }
+}
+
+@ @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 (s < MAX_CHAIN_SIZE) {
+ r = free_chain[s];
+ if (r != null) {
+ free_chain[s] = vlink(r);
+#ifdef CHECK_NODE_USAGE
+ 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);
+ } else {
+ normal_error("nodes","there is a problem in getting a node, case 1");
+ return null;
+ }
+}
+
+@ @c
+void free_node(halfword p, int s)
+{
+ if (p <= my_prealloc) {
+ formatted_error("nodes", "node number %d of type %d should not be freed", (int) p, type(p));
+ return;
+ }
+#ifdef CHECK_NODE_USAGE
+ 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;
+ }
+ /* maintain statistics */
+ var_used -= s;
+}
+
+@ @c
+static void free_node_chain(halfword q, int s)
+{
+ register halfword p = q;
+ while (vlink(p) != null) {
+#ifdef CHECK_NODE_USAGE
+ varmem_sizes[p] = 0;
+#endif
+ var_used -= s;
+ p = vlink(p);
+ }
+ var_used -= s;
+#ifdef CHECK_NODE_USAGE
+ varmem_sizes[p] = 0;
+#endif
+ vlink(p) = free_chain[s];
+ free_chain[s] = q;
+}
+
+@ At the start of the node memory area we reserve some special nodes,
+for instance frequently used glue specifications. We could as well just
+use new_glue here but for the moment we stick to the traditional approach.
+
+@c
+#define initialize_glue(n,wi,st,sh,sto,sho) \
+ vlink(n) = null; \
+ type(n) = glue_spec_node; \
+ width(n) = wi; \
+ stretch(n) = st; \
+ shrink(n) = sh; \
+ stretch_order(n) = sto; \
+ shrink_order(n) = sho;
+
+#define initialize_whatever(n,t) \
+ vinfo(n) = 0; \
+ type(n) = t; \
+ vlink(n) = null; \
+ alink(n) = null;
+
+#define initialize_point(n) \
+ type(n) = glyph_node; \
+ subtype(n) = 0; \
+ vlink(n) = null; \
+ vinfo(n + 1) = null; \
+ alink(n) = null; \
+ font(n) = 0; \
+ character(n) = '.'; \
+ vinfo(n + 3) = 0; \
+ vlink(n + 3) = 0; \
+ vinfo(n + 4) = 0; \
+ vlink(n + 4) = 0;
+
+void init_node_mem(int t)
+{
+ my_prealloc = var_mem_stat_max;
+
+ 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));
+#ifdef CHECK_NODE_USAGE
+ 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 */
+
+ initialize_glue(zero_glue,0,0,0,0,0);
+ initialize_glue(sfi_glue,0,0,0,sfi,0);
+ initialize_glue(fil_glue,0,unity,0,fil,0);
+ initialize_glue(fill_glue,0,unity,0,fill,0);
+ initialize_glue(ss_glue,0,unity,unity,fil,fil);
+ initialize_glue(fil_neg_glue,0,-unity,0,fil,0);
+
+ /* initialize node list heads */
+
+ initialize_whatever(page_ins_head,temp_node);
+ initialize_whatever(contrib_head,temp_node);
+ initialize_whatever(page_head,temp_node);
+ initialize_whatever(temp_head,temp_node);
+ initialize_whatever(hold_head,temp_node);
+ initialize_whatever(adjust_head,temp_node);
+ initialize_whatever(pre_adjust_head,temp_node);
+ initialize_whatever(align_head,temp_node);
+
+ initialize_whatever(active,unhyphenated_node);
+ initialize_whatever(end_span,span_node);
+
+ initialize_point(begin_point);
+ initialize_point(end_point);
+}
+
+@ @c
+void dump_node_mem(void)
+{
+ dump_int(var_mem_max);
+ dump_int(rover);
+ dump_things(varmem[0], var_mem_max);
+#ifdef CHECK_NODE_USAGE
+ 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);
+ undump_things(varmem[0], x);
+#ifdef CHECK_NODE_USAGE
+ 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;
+ }
+}
+
+@ @c
+halfword slow_get_node(int s)
+{
+ register int t;
+
+ RETRY:
+ t = node_size(rover);
+ if (vlink(rover) < var_mem_max && vlink(rover) != 0) {
+ if (t > s) {
+ /* allocating from the bottom helps decrease page faults */
+ register halfword 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;
+ }
+ if (vlink(rover) < var_mem_max) {
+#ifdef CHECK_NODE_USAGE
+ 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 {
+ normal_error("nodes","there is a problem in getting a node, case 2");
+ return null;
+ }
+ } else {
+ /* attempt to keep the free list small */
+ int x;
+ 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;
+ 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));
+#ifdef CHECK_NODE_USAGE
+ 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;
+ var_mem_max += x;
+ goto RETRY;
+ }
+ } else {
+ normal_error("nodes","there is a problem in getting a node, case 3");
+ return null;
+ }
+}
+
+@ @c
+char *sprint_node_mem_usage(void)
+{
+ char *s;
+#ifdef CHECK_NODE_USAGE
+ char *ss;
+ int i;
+ int b = 0;
+ char msg[256];
+ int node_counts[last_normal_node + last_whatsit_node + 2] = { 0 };
+ s = strdup("");
+ 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)]++;
+ }
+ }
+ }
+ 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 q = null;
+#ifdef CHECK_NODE_USAGE
+ halfword p = null;
+ halfword i, j;
+ 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;
+ }
+ }
+ /* newline, if needed */
+ print_nlp();
+}
+
+/* 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;
+ /* not used but nicer in print */
+ subtype(r) = 0;
+ 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|| attr_list_cache == null) {
+ update_attribute_cache();
+ if (attr_list_cache == null)
+ return;
+ }
+ attr_list_ref(attr_list_cache)++;
+ node_attr(b) = attr_list_cache;
+ }
+}
+
+@ @c
+halfword current_attribute_list(void)
+{
+ if (max_used_attr >= 0) {
+ if (attr_list_cache == cache_disabled) {
+ update_attribute_cache();
+ }
+ return attr_list_cache ;
+ }
+ return null ;
+}
+
+
+@ @c
+void reassign_attribute(halfword n, halfword new)
+{
+ halfword old;
+ old = node_attr(n);
+ if (new == null) {
+ /* there is nothing to assign but we need to check for an old value */
+ if (old != null)
+ delete_attribute_ref(old); /* also nulls attr field of n */
+ } else if (old == null) {
+ /* nothing is assigned so we just do that now */
+ assign_attribute_ref(n,new);
+ } else if (old != new) {
+ /* something is assigned so we need to clean up and assign then */
+ delete_attribute_ref(old);
+ assign_attribute_ref(n,new);
+ }
+ /* else: same value so there is no need to assign and change the refcount */
+ node_attr(n) = new ;
+}
+
+@ @c
+void delete_attribute_ref(halfword b)
+{
+ if (b != null) {
+ if (type(b) == attribute_list_node){
+ attr_list_ref(b)--;
+ 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;
+ }
+ } else {
+ normal_error("nodes","trying to delete an attribute reference of a non attribute node");
+ }
+ }
+}
+
+void reset_node_properties(halfword b)
+{
+ if (b != null) {
+ lua_properties_reset(b);
+ }
+}
+
+@ |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;
+ if (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;
+ } else {
+ normal_error("nodes","trying to set an attribute fails, case 1");
+ return null ;
+ }
+}
+
+@ @c
+void set_attribute(halfword n, int i, int val)
+{
+ register halfword p;
+ register int j = 0;
+ /* not all nodes can have an attribute list */
+ if (!nodetype_has_attributes(type(n)))
+ return;
+ /* if we have no list, we create one and quit */
+ 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;
+ }
+ /* we check if we have this attribute already and quit if the value stays the same */
+ if (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);
+ }
+ /* j has now the position (if found) .. we assume a sorted list ! */
+ p = node_attr(n);
+
+ if (attr_list_ref(p) == 0 ) {
+ /* the list is invalid i.e. freed already */
+ formatted_warning("nodes","node %d has an attribute list that is free already, case 1",(int) n);
+ /* the still dangling list gets ref count 1 */
+ attr_list_ref(p) = 1;
+ } else if (attr_list_ref(p) == 1) {
+ /* this can really happen HH-LS */
+ if (p == attr_list_cache) {
+ /* we can invalidate the cache setting */
+ /* attr_list_cache = cache_disabled */
+ /* or save the list, as done below */
+ p = copy_attribute_list(p);
+ node_attr(n) = p;
+ /* the copied list gets ref count 1 */
+ attr_list_ref(p) = 1;
+ }
+ } else {
+ /* the list is used multiple times so we make a copy */
+ p = copy_attribute_list(p);
+ /* we decrement the ref count or the original */
+ delete_attribute_ref(node_attr(n));
+ node_attr(n) = p;
+ /* the copied list gets ref count 1 */
+ attr_list_ref(p) = 1;
+ }
+
+
+ /* we go to position j in the list */
+ while (j-- > 0)
+ p = vlink(p);
+ /* if we have a hit we just set the value otherwise we add a new node */
+ 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;
+ }
+ } else {
+ normal_error("nodes","trying to set an attribute fails, case 2");
+ }
+}
+
+@ @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) {
+ formatted_warning("nodes","node %d has an attribute list that is free already, case 2", (int) n);
+ return UNUSED_ATTRIBUTE;
+ }
+ if (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;
+ } else {
+ normal_error("nodes","trying to unset an attribute fails");
+ return null;
+ }
+}
+
+@ @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_is_zero(p))
+ 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;
+ }
+}
+
+@ @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_node_wrapup_core(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 late_lua_node:
+ show_late_lua(p);
+ break;
+ case save_pos_node:
+ tprint_esc("savepos");
+ 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;
+ }
+}
+
+void show_node_wrapup_dvi(int p)
+{
+}
+
+void show_node_wrapup_pdf(int p)
+{
+ switch (subtype(p)) {
+ 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("colorstack");
+ 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 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_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:
+ normal_error("pdf backend", "unknown action type for link");
+ 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;
+ default:
+ 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)
+
+#define node_list_display_x(A,B) do { \
+ if ((B) != null) { \
+ append_char('.'); \
+ append_char(A); \
+ append_char(' '); \
+ show_node_list(B); \
+ flush_char(); \
+ flush_char(); \
+ flush_char(); \
+ } \
+} while (0)
+
+/* prints a node list symbolically */
+
+void show_node_list(int p)
+{
+ int n = 0; /* the number of items already printed at this level */
+ halfword w;
+ 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;
+ }
+ while (p != null) {
+ print_ln();
+ print_current_string(); /* display the nesting history */
+ if (tracing_online_par < -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|; */
+ if (subtype(p) == normal_rule) {
+ tprint_esc("rule(");
+ } else if (subtype(p) == empty_rule) {
+ tprint_esc("norule(");
+ } else if (subtype(p) == user_rule) {
+ tprint_esc("userrule(");
+ } else if (subtype(p) == box_rule) {
+ tprint_esc("box(");
+ } else if (subtype(p) == image_rule) {
+ tprint_esc("image(");
+ }
+ 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 dir_node:
+ if (dir_dir(p) < 0) {
+ tprint_esc("enddir");
+ print_char(' ');
+ print_dir(dir_dir(p) + dir_swap);
+ } else {
+ tprint_esc("begindir");
+ print_char(' ');
+ print_dir(dir_dir(p));
+ }
+ break;
+ case local_par_node:
+ tprint_esc("localpar");
+ 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 boundary_node:
+ if (subtype(p)==0) {
+ tprint_esc("noboundary");
+ } else {
+ switch (subtype(p)) {
+ case 1:
+ tprint_esc("boundary");
+ break;
+ case 2:
+ tprint_esc("protrusionboundary");
+ break;
+ case 3:
+ tprint_esc("wordboundary");
+ break;
+ default:
+ tprint_esc("boundary");
+ print_char(':');
+ print_int(subtype(p));
+ break;
+ }
+ print_char('=');
+ print_int(boundary_value(p));
+ }
+ break;
+ case whatsit_node:
+ w = subtype(p) ;
+ if (w >= backend_first_pdf_whatsit) {
+ show_node_wrapup_pdf(p);
+ } else if (w >= backend_first_dvi_whatsit) {
+ show_node_wrapup_dvi(p);
+ } else {
+ show_node_wrapup_core(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:
+ normal_warning("nodes","weird glue leader subtype ignored");
+ }
+ tprint("leaders ");
+ print_spec(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(p, NULL);
+ else
+ print_spec(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) == accent_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 (!glue_is_zero(p)) {
+ tprint(", glued ");
+ print_spec(p, NULL);
+ } else if (surround(p) != 0) {
+ tprint(", surrounded ");
+ print_scaled(surround(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. */
+ /* We're not compatible anyway so ...
+ tprint_esc("discretionary");
+ print_int(disc_penalty(p));
+ print_char('|');
+ if (vlink(no_break(p)) != null) {
+ tprint(" replacing ");
+ node_list_display(vlink(no_break(p)));
+ }
+ node_list_display(vlink(pre_break(p)));
+ append_char('|');
+ show_node_list(vlink(post_break(p)));
+ flush_char();
+ */
+ tprint_esc("discretionary");
+ tprint(" (penalty ");
+ print_int(disc_penalty(p));
+ print_char(')');
+ node_list_display_x('<',vlink(pre_break(p)));
+ node_list_display_x('>',vlink(post_break(p)));
+ node_list_display_x('=',vlink(no_break(p)));
+ 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 (subtype(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
+static pointer get_actual_box_width(pointer r,pointer p, scaled initial_width)
+{
+ scaled d; /* increment to |v| */
+ scaled w = -max_dimen; /* calculated |size| */
+ scaled v = initial_width; /* |w| plus possible glue amount */
+ 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 disc_node:
+ /* at the end of the line we should actually take the pre */
+ if (no_break(p) != null) {
+ d = get_actual_box_width(r,vlink_no_break(p),0);
+ if (d <= -max_dimen || d >= max_dimen) {
+ d = 0;
+ }
+ } else {
+ d = 0;
+ }
+ goto FOUND;
+ break;
+ case math_node:
+ /* begin mathskip code */
+ if (glue_is_zero(p)) {
+ d = surround(p);
+ break;
+ } else {
+ /* fall through */
+ }
+ /* end mathskip code */
+ 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.
+ */
+ d = width(p);
+ if (glue_sign(r) == stretching) {
+ if ((glue_order(r) == stretch_order(p)) && (stretch(p) != 0))
+ v = max_dimen;
+ } else if (glue_sign(r) == shrinking) {
+ if ((glue_order(r) == shrink_order(p)) && (shrink(p) != 0))
+ v = max_dimen;
+ }
+ if (subtype(p) >= a_leaders)
+ goto FOUND;
+ 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;
+}
+
+pointer actual_box_width(pointer r, scaled base_width)
+{
+ /* often this is the same as:
+ return + shift_amount(r) + base_width +
+ natural_sizes(list_ptr(r),null,(glue_ratio) glue_set(r),glue_sign(r),glue_order(r),box_dir(r));
+ */
+ return get_actual_box_width(r,list_ptr(r),shift_amount(r) + base_width);
+}
+
+@ @c
+halfword tail_of_list(halfword p)
+{
+ halfword q = p;
+ while (vlink(q) != null)
+ q = vlink(q);
+ return q;
+}
+
+
+
+@ @c
+int var_used;
+
+@ 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 = new_node(hlist_node, min_quarterword);
+ box_dir(p) = text_direction_par;
+ 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(int s)
+{
+ halfword p = new_node(rule_node,s);
+ 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_par, cur_lang_par, left_hyphen_min_par, right_hyphen_min_par);
+ 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 = char_width(font(p), character(p));
+ return w;
+}
+
+scaled glyph_height(halfword p)
+{
+ scaled w = char_height(font(p), character(p)) + y_displace(p);
+ if (w < 0)
+ w = 0;
+ return w;
+}
+
+scaled glyph_depth(halfword p)
+{
+ scaled 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 = new_node(disc_node, 0);
+ disc_penalty(p) = hyphen_penalty_par;
+ 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 = 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 q) /* safeguard for copying a glue node */
+{
+ if (q == null) {
+ return copy_node(zero_glue);
+ } else if (type(q) == glue_spec_node) {
+ return copy_node(q);
+ } else if (type(q) == glue_node) {
+ halfword p = copy_node(zero_glue);
+ width(p) = width(q);
+ stretch(p) = stretch(q);
+ shrink(p) = shrink(q);
+ stretch_order(p) = stretch_order(q);
+ shrink_order(p) = shrink_order(q);
+ return p;
+ } else {
+ /* alternatively we can issue a warning */
+ return copy_node(zero_glue);
+ }
+}
+
+@ 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 = new_node(glue_node, n + 1);
+ halfword q = glue_par(n);
+ width(p) = width(q);
+ stretch(p) = stretch(q);
+ shrink(p) = shrink(q);
+ stretch_order(p) = stretch_order(q);
+ shrink_order(p) = shrink_order(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 = new_node(glue_node, normal);
+ width(p) = width(q);
+ stretch(p) = stretch(q);
+ shrink(p) = shrink(q);
+ stretch_order(p) = stretch_order(q);
+ shrink_order(p) = shrink_order(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 = new_node(glue_node, n + 1);
+ halfword q = glue_par(n);
+ width(p) = width(q);
+ stretch(p) = stretch(q);
+ shrink(p) = shrink(q);
+ stretch_order(p) = stretch_order(q);
+ shrink_order(p) = shrink_order(q);
+ 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 = 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 = 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@>
+
+@ This function creates a |local_paragraph| node
+
+@c
+
+halfword make_local_par_node(int mode)
+{
+ int callback_id;
+ halfword q;
+ halfword p = new_node(local_par_node,0);
+ local_pen_inter(p) = local_inter_line_penalty_par;
+ local_pen_broken(p) = local_broken_penalty_par;
+ if (local_left_box_par != null) {
+ q = copy_node_list(local_left_box_par);
+ local_box_left(p) = q;
+ local_box_left_width(p) = width(local_left_box_par);
+ }
+ if (local_right_box_par != null) {
+ q = copy_node_list(local_right_box_par);
+ local_box_right(p) = q;
+ local_box_right_width(p) = width(local_right_box_par);
+ }
+ local_par_dir(p) = par_direction_par;
+ /* callback with node passed */
+ callback_id = callback_defined(insert_local_par_callback);
+ if (callback_id > 0) {
+ int sfix = lua_gettop(Luas);
+ if (!get_callback(Luas, callback_id)) {
+ lua_settop(Luas, sfix);
+ return p;
+ }
+ nodelist_to_lua(Luas, p);
+ lua_push_local_par_mode(Luas,mode)
+ if (lua_pcall(Luas, 2, 0, 0) != 0) { /* 2 arg, 0 result */
+ char errmsg[256]; /* temp hack ... we will have a formatted error */
+ snprintf(errmsg, 255, "error: %s\n", lua_tostring(Luas, -1));
+ errmsg[255]='\0';
+ lua_settop(Luas, sfix);
+ normal_error("insert_local_par",errmsg); /* to be done */
+ return p;
+ }
+ lua_settop(Luas, sfix);
+ }
+ /* done */
+ return p;
+}