diff options
| author | Akira Kakuto <kakuto@fuk.kindai.ac.jp> | 2017-02-09 22:44:03 +0000 |
|---|---|---|
| committer | Akira Kakuto <kakuto@fuk.kindai.ac.jp> | 2017-02-09 22:44:03 +0000 |
| commit | f901b04fd7e232afdf1f7b5a3f49846e9f98e399 (patch) | |
| tree | 0967ec4ef40a2e9dfa22f46727d0c62cc2770294 | |
| parent | 733aac09881d5da8a41e58c774daff3f7ce74fdc (diff) | |
luatexdir: sync with the upstream
git-svn-id: svn://tug.org/texlive/trunk@43177 c570f23f-e606-0410-a88d-b1316a301751
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 @@ +[](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(®, 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, ®); + 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, ®, 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, ®); + 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, ®, 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, ®, 0); + dasm_put(Dst, 289); + get_float(Dst, ct, ®, 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, ®, 1); + dasm_put(Dst, 284); + /* imag */ + get_float(Dst, ct, ®, 1); + dasm_put(Dst, 296); + break; + + case FLOAT_TYPE: + case DOUBLE_TYPE: + lua_pop(L, 1); + get_float(Dst, ct, ®, mt->type == DOUBLE_TYPE); + dasm_put(Dst, 302); + break; + + case BOOL_TYPE: + lua_pop(L, 1); + get_int(Dst, ct, ®, 0); + dasm_put(Dst, 310); + break; + + case INT8_TYPE: + lua_pop(L, 1); + get_int(Dst, ct, ®, 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, ®, 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, ®, 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(®, 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, ®); + } + 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, ®); + } 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, ®); + 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, ®, 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, ®, 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, ®, 0); + lua_pop(L, 1); + break; + + case BOOL_TYPE: + dasm_put(Dst, 1197, i); + add_int(Dst, ct, ®, 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, ®, 0); + lua_pop(L, 1); + break; + + case INTPTR_TYPE: + dasm_put(Dst, 1231, i); + add_pointer(Dst, ct, ®); + 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, ®, 1); + lua_pop(L, 1); + break; + + case DOUBLE_TYPE: + dasm_put(Dst, 1267, i); + add_float(Dst, ct, ®, 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, ®, 1); + dasm_put(Dst, 1291); + add_float(Dst, ct, ®, 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, ®, 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, ®, 1); +#else + /* returned complex floats use eax and edx */ + dasm_put(Dst, 1335, i); + add_float(Dst, ct, ®, 0); + dasm_put(Dst, 1353); + add_float(Dst, ct, ®, 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(®, 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, ®); + 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, ®, 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, ®); + 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, ®, 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, ®, 0); + dasm_put(Dst, 261); + get_float(Dst, ct, ®, 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, ®, 1); + dasm_put(Dst, 256); + /* imag */ + get_float(Dst, ct, ®, 1); + dasm_put(Dst, 268); + break; + + case FLOAT_TYPE: + case DOUBLE_TYPE: + lua_pop(L, 1); + get_float(Dst, ct, ®, mt->type == DOUBLE_TYPE); + dasm_put(Dst, 274); + break; + + case BOOL_TYPE: + lua_pop(L, 1); + get_int(Dst, ct, ®, 0); + dasm_put(Dst, 287); + break; + + case INT8_TYPE: + lua_pop(L, 1); + get_int(Dst, ct, ®, 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, ®, 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, ®, 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(®, 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, ®); + } + 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, ®); + } 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, ®); + 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, ®, 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, ®, 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, ®, 0); + lua_pop(L, 1); + break; + + case BOOL_TYPE: + dasm_put(Dst, 1178, i); + add_int(Dst, ct, ®, 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, ®, 0); + lua_pop(L, 1); + break; + + case INTPTR_TYPE: + dasm_put(Dst, 1212, i); + add_pointer(Dst, ct, ®); + 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, ®, 1); + lua_pop(L, 1); + break; + + case DOUBLE_TYPE: + dasm_put(Dst, 1248, i); + add_float(Dst, ct, ®, 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, ®, 1); + dasm_put(Dst, 1272); + add_float(Dst, ct, ®, 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, ®, 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, ®, 1); +#else + /* returned complex floats use eax and edx */ + dasm_put(Dst, 1316, i); + add_float(Dst, ct, ®, 0); + dasm_put(Dst, 1334); + add_float(Dst, ct, ®, 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(®, 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, ®); + | 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, ®, 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, ®); + | 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, ®, 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, ®, 0); + | fstp dword [rax] + get_float(Dst, ct, ®, 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, ®, 1); + |.if X64 + | movq qword [rax], xmm0 + |.else + | fstp qword [rax] + |.endif + /* imag */ + get_float(Dst, ct, ®, 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, ®, 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, ®, 0); + | movzx ecx, cl + | call_rr extern lua_pushboolean, L_ARG, rcx + break; + + case INT8_TYPE: + lua_pop(L, 1); + get_int(Dst, ct, ®, 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, ®, 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, ®, 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(®, 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, ®); + } + 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, ®); + } 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, ®); + 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, ®, 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, ®, 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, ®, 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, ®, 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, ®, 0); + lua_pop(L, 1); + break; + + case INTPTR_TYPE: + | call_rr extern check_uintptr, L_ARG, i + add_pointer(Dst, ct, ®); + 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, ®, 1); + lua_pop(L, 1); + break; + + case DOUBLE_TYPE: + | call_rr extern check_double, L_ARG, i + add_float(Dst, ct, ®, 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, ®, 1); + | movq xmm0, xmm1 + add_float(Dst, ct, ®, 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, ®, 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, ®, 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, ®, 0); + | mov [rsp], edx + | fld dword [rsp] + add_float(Dst, ct, ®, 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(®, 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, ®); + 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, ®, 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, ®); + 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, ®, 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, ®, 0); + dasm_put(Dst, 259); + get_float(Dst, ct, ®, 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, ®, 1); + dasm_put(Dst, 266); + /* imag */ + get_float(Dst, ct, ®, 1); + dasm_put(Dst, 269); + break; + + case FLOAT_TYPE: + case DOUBLE_TYPE: + lua_pop(L, 1); + get_float(Dst, ct, ®, mt->type == DOUBLE_TYPE); + dasm_put(Dst, 273); + break; + + case BOOL_TYPE: + lua_pop(L, 1); + get_int(Dst, ct, ®, 0); + dasm_put(Dst, 285); + break; + + case INT8_TYPE: + lua_pop(L, 1); + get_int(Dst, ct, ®, 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, ®, 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, ®, 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(®, 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, ®); + } + 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, ®); + } 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, ®); + 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, ®, 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, ®, 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, ®, 0); + lua_pop(L, 1); + break; + + case BOOL_TYPE: + dasm_put(Dst, 1208, i); + add_int(Dst, ct, ®, 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, ®, 0); + lua_pop(L, 1); + break; + + case INTPTR_TYPE: + dasm_put(Dst, 1244, i); + add_pointer(Dst, ct, ®); + 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, ®, 1); + lua_pop(L, 1); + break; + + case DOUBLE_TYPE: + dasm_put(Dst, 1283, i); + add_float(Dst, ct, ®, 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, ®, 1); + dasm_put(Dst, 1309); + add_float(Dst, ct, ®, 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, ®, 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, ®, 1); +#else + /* returned complex floats use eax and edx */ + dasm_put(Dst, 1354, i); + add_float(Dst, ct, ®, 0); + dasm_put(Dst, 1373); + add_float(Dst, ct, ®, 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, <); + to_cdata(L, 2, &rt); + + ret = call_user_binop(L, "__concat", 1, 3, <, 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, <); + rp = to_cdata(L, 2, &rt); + assert(lua_gettop(L) == 4); + + ret = call_user_binop(L, "__add", 1, 3, <, 2, 4, &rt); + if (ret >= 0) { + return ret; + } + assert(lua_gettop(L) == 4); + + ct_usr = rank(<) > rank(&rt) ? 3 : 4; + ct = rank(<) > rank(&rt) ? lt : rt; + + if (IS_COMPLEX(ct.type)) { + complex_double left, right, res; + + left = check_complex(L, 1, lp, <); + 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, <); + 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, <); + + } 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, <); + rp = to_cdata(L, 2, &rt); + + ret = call_user_binop(L, "__sub", 1, 3, <, 2, 4, &rt); + if (ret >= 0) { + return ret; + } + + ct_usr = rank(<) > rank(&rt) ? 3 : 4; + ct = rank(<) > rank(&rt) ? lt : rt; + + if (IS_COMPLEX(ct.type)) { + complex_double left, right, res; + + left = check_complex(L, 1, lp, <); + 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, <); + 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, <); + + } 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, <); \ + rp = to_cdata(L, 2, &rt); \ + \ + ret = call_user_binop(L, OPSTR, 1, 3, <, 2, 4, &rt); \ + if (ret >= 0) { \ + return ret; \ + } \ + \ + ct_usr = rank(<) > rank(&rt) ? 3 : 4; \ + ct = rank(<) > rank(&rt) ? lt : rt; \ + \ + if (IS_COMPLEX(ct.type)) { \ + complex_double res; \ + complex_double left = check_complex(L, 1, lp, <); \ + 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, <); \ + 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, <); \ + rp = to_cdata(L, 2, &rt); \ + \ + ret = call_user_binop(L, OPSTR, 1, 3, <, 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, <); \ + 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, <); \ + int64_t right = check_intptr(L, 2, rp, &rt); \ + \ + if (lt.pointers && rt.pointers) { \ + if (is_void_ptr(<) || is_void_ptr(&rt) || is_same_type(L, 3, 4, <, &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, <); + push_type_name(L, -2, <); + 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, <); + push_type_name(L, -2, <); + 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, <); + to_cdata(L, 2, &rt); + + ret = call_user_binop(L, "__concat", 1, 3, <, 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, <); + rp = to_cdata(L, 2, &rt); + assert(lua_gettop(L) == 4); + + ret = call_user_binop(L, "__add", 1, 3, <, 2, 4, &rt); + if (ret >= 0) { + return ret; + } + assert(lua_gettop(L) == 4); + + ct_usr = rank(<) > rank(&rt) ? 3 : 4; + ct = rank(<) > rank(&rt) ? lt : rt; + + if (IS_COMPLEX(ct.type)) { + complex_double left, right, res; + + left = check_complex(L, 1, lp, <); + 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, <); + 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, <); + + } 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, <); + rp = to_cdata(L, 2, &rt); + + ret = call_user_binop(L, "__sub", 1, 3, <, 2, 4, &rt); + if (ret >= 0) { + return ret; + } + + ct_usr = rank(<) > rank(&rt) ? 3 : 4; + ct = rank(<) > rank(&rt) ? lt : rt; + + if (IS_COMPLEX(ct.type)) { + complex_double left, right, res; + + left = check_complex(L, 1, lp, <); + 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, <); + 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, <); + + } 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, <); \ + rp = to_cdata(L, 2, &rt); \ + \ + ret = call_user_binop(L, OPSTR, 1, 3, <, 2, 4, &rt); \ + if (ret >= 0) { \ + return ret; \ + } \ + \ + ct_usr = rank(<) > rank(&rt) ? 3 : 4; \ + ct = rank(<) > rank(&rt) ? lt : rt; \ + \ + if (IS_COMPLEX(ct.type)) { \ + complex_double res; \ + complex_double left = check_complex(L, 1, lp, <); \ + 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, <); \ + 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, <); \ + rp = to_cdata(L, 2, &rt); \ + \ + ret = call_user_binop(L, OPSTR, 1, 3, <, 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, <); \ + 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, <); \ + int64_t right = check_intptr(L, 2, rp, &rt); \ + \ + if (lt.pointers && rt.pointers) { \ + if (is_void_ptr(<) || is_void_ptr(&rt) || is_same_type(L, 3, 4, <, &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, <); + push_type_name(L, -2, <); + 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, <); + push_type_name(L, -2, <); + 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) = ¬_b; +void* g_p = (void*) ¬_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;
+}
|